Get the total number of elements in a layer autocad VBA

时间:2016-04-25 09:16:55

标签: vba autocad

My drawing contain 3 layers. Each of the layers contain polylines. I need to count the total number of elements inside every layer using VBA

1 个答案:

答案 0 :(得分:1)

你可以试试这个

Option Explicit

Sub test()
Dim myLayer As AcadLayer

For Each myLayer In ThisDrawing.Layers
    MsgBox "Number of LWPolylines in layer '" & myLayer.Name & "' is: " & GetEntityTypeNumberInLayer("LWPOLYLINE", myLayer.Name)
Next myLayer

End Sub


Function GetEntityTypeNumberInLayer(entityType As String, layerName As String) As Long
Dim acSelSet As AcadSelectionSet
Dim grpCode(1) As Integer
Dim dataVal(1) As Variant

grpCode(0) = 0: dataVal(0) = entityType 'this will filter for the entity type passed with "entityType"
grpCode(1) = 8: dataVal(1) = layerName 'this will filter for layer with name as the one passed with "layerName" argument

Set acSelSet = CreateSelectionSet("sset", ThisDrawing) 'create a selection set via a proper function
acSelSet.Select acSelectionSetAll, , , grpCode, dataVal ' fill it with all elements filtered as above: LWPolylines in layer with name passed via "layername" argument
GetEntityTypeNumberInLayer = acSelSet.Count 'count the numbers of element in the selectionset

acSelSet.Delete ' delete the selection set

End Function


Function CreateSelectionSet(selsetName As String, Optional acDoc As Variant) As AcadSelectionSet
'this function returns a selection set with the given name
'if a selectionset with the given name already exists, it returns that selectionset after clearing it
'if a selectionset with the given name doesn't exist, it creates a new selectionset and returns it
Dim acSelSet As AcadSelectionSet

If IsMissing(acDoc) Then Set acDoc = ThisDrawing

On Error Resume Next
Set acSelSet = acDoc.SelectionSets.Item(selsetName) 'try to get an exisisting selection set
On Error GoTo 0
If acSelSet Is Nothing Then Set acSelSet = acDoc.SelectionSets.Add(selsetName) 'if unsuccsessful, then create it

acSelSet.Clear 'cleare the selection set

Set CreateSelectionSet = acSelSet
End Function