class based solutions are always a fine thing to see
besides, I'd throw in the following thoughts
1) function IsTargetBlock() can be simplified to
Private Function IsTargetBlock(blkName As String) As Boolean
IsTargetBlock = blkName = "110 x 10" Or blkName = "10"
End Function
2) you could directly feed ExportBlockData() with CollectBlockData()
ExportBlockData CollectBlockData()
thus eliminating both
Private mBlockData As Variant
and
mBlockData = CollectBlockData()
3) clsBlock class OutputText() method can be simplified to
Public Function OutputText()
OutputText = "Block Name: " & BlockName & vbTab & _
Format(X, "#####0.000") & vbTab & _
Format(Y, "#####0.000") & vbTab & _
Format(Z, "#####0.000") & vbTab & _
Format(Angle, "##0.0")
End Function
4) in ExportBlockData()
4.1) you should check for blkData to be not empty before iterating though it
If UBound(blkData) = -1 Then Exit Sub
4.2) no need for
Dim txt As String
4.3) you could avoid blk As clsBlock helper variable and directly go:
Dim i As Integer
For i = 0 To UBound(blkData)
Write #fileNum, blkData(i).OutputText
Next
or you could use a Variant iterator (instead of i as Integer😞
Dim clsBlk As Variant
For Each clsBlk In blkData
Write #fileNum, clsBlk.OutputText
Next
Finally an alternative SelectionSet approach could be used to:
- avoid iterating through each ModelSpace entity and check for both proper type and name
- iterate trough the SelectionSet already filled with properly typed (i.e. AcadBlockReference) objects and avoid the Set blk = ent casting
To adopt such an approach you should:
a) add a new function to collect block references in a SelectionSet object, like the following GetBlockReferences() one:
Function GetBlockReferences(ssetObj As AcadSelectionSet) As Boolean
Dim gpCode(0 To 4) As Integer
Dim dataValue(0 To 4) As Variant
gpCode(0) = 0: dataValue(0) = "INSERT"
gpCode(1) = -4: dataValue(1) = "<OR"
gpCode(2) = 2: dataValue(2) = "110 X 10"
gpCode(3) = 2: dataValue(3) = "10"
gpCode(4) = -4: dataValue(4) = "OR>"
On Error Resume Next
With ThisDrawing
Set ssetObj = .SelectionSets.Item("blcksRefs")
On Error GoTo 0
If ssetObj Is Nothing Then Set ssetObj = .SelectionSets.Add("blcksRefs")
End With
With ssetObj
.Clear
.Select acSelectionSetAll, , , gpCode, dataValue
GetBlockReferences = .Count > 0
End With
End Function
b) erase IsTargetBlock() function, no more needed since the SelectionSet filtering criteria are doing the type/name filtering job on all ModelSpace entities
c) modify CollectBlockData() function to exploit GetBlockReferences() function as follows:
Private Function CollectBlockData() As Variant
Dim ssetBlckRefs As AcadSelectionSet
If GetBlockReferences(ssetBlckRefs) Then
ReDim data(ssetBlckRefs.Count - 1) As Variant
Dim i As Integer
Dim blk As AcadBlockReference
For Each blk In ssetBlckRefs
With blk
Set data(i) = New clsBlock
data(i).X = .InsertionPoint(0)
data(i).Y = .InsertionPoint(1)
data(i).Z = .InsertionPoint(2)
data(i).Angle = .Rotation * (180# / 3.1415926)
data(i).BlockName = .EffectiveName
i = i + 1
End With
Next
CollectBlockData = data
End If
End Function
