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
答案 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