VBA Collection
Well, you may need to "enhance your VBA coding knowledge, or in general programming knowledge, a bit more, by learning the concept of "class", which is a way to group different piece of data into a single unit. for example, AcadEntity, is a class that has many properties (or data fields), such as ObjectId, Layer, LineType, Color....
In your case, you are interested in particular information of entities in a selectionset. Let assume, you are interested in length and layers of all Lines and LwPolylines, and you use a selectionset with filter to select them. Then you want to collect all the length/layer data of each of the line/polyline and store them in a collection for later use.
To do this, you create a class to store data of each entity, and you create a collection class to store all of them. After that, you can use your data collected from the target entities. See code samples below:
1. the class to store data from individual entity, called MyEntity
Option Explicit
Public EntityId As LongPtr
Public LayerName As String
Public Length As Double
2. the class to store a collection of MyEntity, called MyEntities
Option Explicit
Private mEntities As Collection
Public Property Get Entities() As Collection
Set Entities = mEntities
End Property
Public Function GetUniqueLayerNames() As Variant
Dim ent As MyEntity
Dim layers() As String
Dim i As Integer
If mEntities.Count >= 0 Then
ReDim layers(0)
Set ent = mEntities(1) '' Collection's index started from 1, not 0!!!
layers(0) = ent.LayerName
For Each ent In mEntities
If IsLayerNameUnique(ent.LayerName, layers) Then
ReDim Preserve layers(i)
layers(i) = ent.LayerName
i = i + 1
End If
Next
End If
GetUniqueLayerNames = layers
End Function
Public Function GetTotalLength() As Double
Dim l As Double
Dim ent As MyEntity
For Each ent In mEntities
l = l + ent.Length
Next
GetTotalLength = l
End Function
Private Function IsLayerNameUnique(layer As String, layers As Variant)
Dim i As Integer
If UBound(layers) >= 0 Then
For i = 0 To UBound(layers)
If UCase(layers(i)) = UCase(layer) Then
IsLayerNameUnique = False
Exit Function
End If
Next
End If
IsLayerNameUnique = True
End Function
Private Sub Class_Initialize()
Set mEntities = New Collection
End Sub
this class has 2 methods to return a unique layer name list, and total length of all line and polyline. You can add more based on your business requirement,,,
3. Now it is time to use these 2 classes to collet data and do something (obtaining a layer names related to all selected line/polylines, calculating total length) and a MACRO module
Option Explicit
Public Sub DoWork()
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets("mySS")
If Err.Number <> 0 Then
Set ss = ThisDrawing.SelectionSets.Add("mySS")
End If
'' Set filter to only select line, lwpolyline, or both
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0
dataValue(0) = "LINE,LWPOLYLINE"
ss.Select acSelectionSetAll, , , gpCode, dataValue
'' populate the collection of MyEntities with the selectionset
Dim entData As MyEntities
Set entData = GetDataFromSelectionSet(ss)
ss.Delete
If entData.Entities.Count = 0 Then
MsgBox "No line and/or polyline selected"
Else
Dim layers As String
Dim l As Double
layers = Join(entData.GetUniqueLayerNames, ", ")
l = entData.GetTotalLength
MsgBox "Layers: " & layers & vbCrLf & "Total length: " & l
End If
End Sub
Private Function GetDataFromSelectionSet(ss As AcadSelectionSet) As MyEntities
Dim ents As MyEntities
Set ents = New MyEntities
Dim ent As MyEntity
Dim e As AcadEntity
Dim line As AcadLine
Dim pline As AcadLWPolyline
Dim l As Double
If ss.Count > 0 Then
For Each e In ss
If TypeOf e Is AcadLine Then
Set line = e
l = line.Length
Else
Set pline = e
l = pline.Length
End If
Set ent = New MyEntity
ent.LayerName = e.layer
ent.Length = l
ent.EntityId = e.ObjectId
ents.Entities.Add ent, CStr(ent.EntityId)
Next
End If
Set GetDataFromSelectionSet = ents
End Function
Hope this would give you some idea on how to use "class" to collect/organize data and use it in later process. The point is that one you get a well designed class and its collection, you can extract information from the collectionas you need, just as I did in the GetUniqueLayerNames()/GetTotalLength() for other business requirements.
