Help with this macro

I have made a macro that will modify blocks in a bunch of drawings (made by my predecessor) to add imperial units beneath the metric units. I have the macro working, but I was wondering if there is an easier or more efficient way of doing what I'm doing. Also, I have 2 problem areas.
1. Some times the block names I am searching for are in lower case (predecessor) and then I get an error. How do I get around this.
2. for the conversion of the metric scale to the imperial scale, I strip out the m² that would normally be at the end. What I really wanted to do is strip out anything that is not a number, is there any way of doing this?

Any comments or criticisms are welcome.

Thanks.

Sub FixBlocks()

Dim oSSet As AcadSelectionSet, iGroup(0 To 1) As Integer, vData(0 To 1) As Variant
Dim oBlkRef As AcadBlockReference
Dim vAttribs As Variant, vAttrib As Variant
Dim nAttribs As Variant, nAttrib As Variant
Dim oBlkRefNew As AcadBlockReference
Dim RmNum As Variant, RmName As Variant, Aream2 As Variant, Areasf As Variant
Dim xscl As Variant, yscl As Variant, zscl As Variant, Blkrot As Variant, insertionPnt As Variant
Dim Layername As Variant

'build selection set
On Error Resume Next
Set oSSet = ThisDrawing.SelectionSets.Add("SSet1")
If Err Then
Err.Clear
Set oSSet = ThisDrawing.SelectionSets("SSet1")
oSSet.Clear
End If
Err.Clear
On Error GoTo 0

' fill the selection set
iGroup(0) = 0: vData(0) = "INSERT"
iGroup(1) = 2: vData(1) = "ROOM-IDEN,ROOM-IDEN-PORT,ROOM-IDEN-NO-NUM"
oSSet.Select acSelectionSetAll, , , iGroup, vData

' step through the blocks and get properties
If oSSet.count > 0 Then
For Each oBlkRef In oSSet
insertionPnt = oBlkRef.insertionPoint
xscl = oBlkRef.XScaleFactor
yscl = oBlkRef.YScaleFactor
zscl = oBlkRef.ZScaleFactor
Blkrot = oBlkRef.Rotation
Layername = oBlkRef.Layer

If oBlkRef.HasAttributes Then
vAttribs = oBlkRef.GetAttributes
For Each vAttrib In vAttribs
Aream2 = ""
Areasf = ""
Select Case vAttrib.TagString
Case "XXX": RmNum = vAttrib.textString
Case "ROOM-NAME": RmName = vAttrib.textString
Case "SQUAREFEET": Aream2 = vAttrib.textString ' Old units in metric (used to be imp thats why it says squarefeet)
End Select
Next vAttrib
' Using a code I found on the net to find and replace
Aream2 = CCIS(Aream2, "m²", "")
Aream2 = CCIS(Aream2, "m2", "")
Aream2 = CCIS(Aream2, "m", "")
' If the block didn't have a value
If Aream2 <> "" Then
' If the area is smaller than 5m²(omit the imperial version, room is too small)
If Aream2 > 5 Then
Areasf = (Round(Aream2 * 10.764262, 0)) & "s.f."
End If
Aream2 = (Round(Aream2, 2) & "m²")
End If
End If
' Insert new block to replace existing one based on existing block name
Select Case oBlkRef.Name
Case "ROOM-IDEN": Set oBlkRefNew = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "ROOM-IDEN-CLASS.dwg", xscl, yscl, zscl, Blkrot)
Case "ROOM-IDEN-PORT": Set oBlkRefNew = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "ROOM-IDEN-PORT.dwg", xscl, yscl, zscl, Blkrot)
Case "ROOM-IDEN-NO-NUM": Set oBlkRefNew = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "ROOM-IDEN.dwg", xscl, yscl, zscl, Blkrot)
End Select
' Set the layer and insert the attributes
oBlkRefNew.Layer = Layername
nAttribs = oBlkRefNew.GetAttributes
For Each nAttrib In nAttribs
Select Case nAttrib.TagString
Case "RMNUM": nAttrib.textString = RmNum
Case "RMNAME": nAttrib.textString = RmName
Case "AREA-M2": nAttrib.textString = Aream2
Case "AREA-SF": nAttrib.textString = Areasf
End Select
Next nAttrib
oBlkRef.Delete
Next oBlkRef
End If
End Sub

'And the code for CCIS

Public Function CCIS(ByVal CurStr As String, OldChars As String, NewChars As String) As String
Dim iPos As Integer, iLen1 As Integer, iLen2 As Integer
iLen1 = Len(OldChars)
iLen2 = Len(NewChars)
iPos = IIf(iLen1 > 0, InStr(1, CurStr, OldChars), 0)
Do While iPos > 0
CurStr = Left$(CurStr, iPos - 1) + NewChars + Mid$(CurStr, iPos + iLen1)
iPos = InStr(iPos + iLen2, CurStr, OldChars)
Loop
CCIS = CurStr
End Function

 

1. Some times the block names I am searching for are in lower case

when you compare use LCASE(string-to-check) - it will convert the string
value to all upper case.

You have to write a loop and using the Mid command step thru every
character in the dimension string, or use split if there is a space between
the value and the text.

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

I resisted the urge to re-write the sub (I don't like the way your
predecessor used the Variants for the Areas), but I think the VAL function
in the following place would work to get rid of all the extra characters,
and not interfere with the logic of the program. The only assumption is
that the Aream2 starts with the number portion -- I think this is safe since
his/her program was already assuming it. Otherwise, you'll have to follow
Mike's suggestion.

' If the block didn't have a value
If Aream2 <> "" Then
Aream2 = Val(Aream2)
' If the area is smaller than 5m²(omit the imperial version, room is
too small)
If Aream2 > 5 Then
....
....
' Insert new block to replace existing one based on existing block
name
Select Case UCase$(oBlkRef.Name)
Case "ROOM-IDEN": Set oBlkRefNew =
ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "ROOM-IDEN-CLASS.dwg",
xscl, yscl, zscl, Blkrot)
....
....


HTH,
James

 

1. Some times the block names I am searching for are in lower case

ooops! LCase takes you to all lower and UCase takes to all upper. What can
I say, its been a loonnngggg week!

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

A simpler way to disregard case issues is to put the following line of code at the top of your module.

Option Compare Text

 

A simpler way to disregard case issues is to put the following line of
code at the top of your module.

Yes, I'd agree with you. I miss a lot of these shortcuts in VB because I
try to make it as portable as possible. So by explicitly using UCASE, my
subroutine will run the same regardless of what module I drop it in. I do
other obsessive things, like TRIM'ming strings that I know won't have extra
spaces (...just in case), and dimensioning both bounds of my arrays in case
a module has a different 'Option Base' in it than I would use.

James

 

thanks for the help, I have tried both examples and they both worked. I like the option version (less typing), but the point of the macro being more portable the other way is something I should remember for the future.