VBA能不能实现遍历指定图层内所有实体

spano · 发表于 2018-3-2 07:58:00

如题，能不能用类似如下格式遍历图层内所有实体？ Dim k, l As Integer
Dim temp_entity As AcadEntity
Dim Temp_Layer As AcadLayer
k = 0
l = 0
For Each Temp_Layer In ThisDrawing.Layers
      Layer_Name(k) = Temp_Layer.Name
      For Each temp_entity In Temp_Layer  ‘此处报错
         l = l + 1
      Next
      MsgBox("该图层有"&Cstr(l)&“个实体”)
Next

zzyong00 · 发表于 2018-3-4 11:24:00

copy

Private Sub SelectLots(ByVal Ssetname As String, ByVal strLayerName As String)
    
    Dim sSetObj As AcadSelectionSet, flag As Boolean
    If ThisDrawing.GetVariable("cmdactive") Then ThisDrawing.SendCommand "(command)"
    
    For Each sSetObj In ThisDrawing.SelectionSets
        
        If sSetObj.Name = Ssetname Then
            flag = True
            Exit For
        End If
        
    Next
    
    If flag Then sSetObj.Delete                                                 '创建集合，如集存在，则删除，新建
    Set sSetObj = ThisDrawing.SelectionSets.Add(Ssetname)
    
    Dim gpCode(0)    As Integer
    
    Dim dataValue(0) As Variant
    
 
    gpCode(0) = 8
    dataValue(0) = strLayerName                                                 ' 图层名
    
    Dim groupCode As Variant, dataCode As Variant
    
    groupCode = gpCode
    dataCode = dataValue
    
    sSetObj.Select acSelectionSetAll, , , groupCode, dataCode
End Sub
Public Sub test()
    Dim objSset As AcadSelectionSet
    SelectLots "z1111", "0" '选0层的所有对象
    Set objSset = ThisDrawing.SelectionSets("z1111")
    If objSset.Count = 0 Then Exit Sub
    Dim objEnt As AcadEntity
    For Each objEnt In objSset
        Debug.Print objEnt.ObjectName
    Next objEnt
End Sub