獲取圖層autocad中的元素總數VBA

Question

我的繪圖包含3個圖層。每個圖層都包含折線。 我需要計算使用VBA

每一層中的元素總數

Answer 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