topic VBA Collection in VBA Forum

VBA Collection

grobnik — Sun, 11 Oct 2020 19:39:01 GMT

Hi to everybody, I'm trying to manage a Collection but I faced up a couple of issue that I'm not able to solve myself or with several documentation on web (mainly related to excel).

Here the code

Dim Coll As Collection Set Coll = New Collection ' Create a Collection object. For Each OBJECT In BSelSet Coll.Add OBJECT.Layer Coll.Add Str(OBJECT.Length / 1000) Next

Source of Collection it's coming from a Selection set of Objects, working I get the objects.

First of all I would like to highlight that may I have duplicated layer name and duplicated length, this is the reason of two line with Add to member to collection.

So the Add Method using a Key that is the main reason using a collection seems not applicable.

As second issue seems I have some issue with storing number instead string.

The final scope will be to have a count of object with the same layer and same length (where layer name could be checked, but the length it's variable from object property), this is the reason because I would like to use Collection.

For Example:

Object 1 Layer "GREEN" length 100

Object 2 Layer "GREEN" length 100

Object 3 Layer "GREEN" length 150

Object 4 Layer "BLUE" length 200

Count Result:

Layer BLUE Length 200 = 1

Layer GREEN Length 100 = 2

Layer GREEN Length 150 = 1

I tried also with Dictionary but I have the same issue of duplicated objects.

Third option will be use a bidimensional array and search (how I don't know, at this time) duplicated value and count it.

Thank you

Re: VBA Collection

norman.yuan — Mon, 12 Oct 2020 14:49:20 GMT

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.

Re: VBA Collection

grobnik — Mon, 12 Oct 2020 15:32:12 GMT

Hi @norman.yuan

thank you for lesson ! I'll try to applicate to my procedure, I'll keep you informed.

Your are right when saying "....general programming knowledge, a bit more, by learning the concept of "class" ...." I always said on this forum that programming it's not my job, even if I'm using cad often and many time I created macro for personal use, never for professional use.

All of what I know, and what sometimes I'm suggesting to others forum members, it's only a sort of "practice".

Bye and thank you again.

Re: VBA Collection

MakCADD — Sun, 18 Oct 2020 13:21:05 GMT

thank u norman,

I am also not a professional programmer

i learned programing through AutoCAD vba.

here you explained very well

thank s