社区 › VB › VBA能不能实现遍历指定图层内所有实体

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

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

如题，能不能用类似如下格式遍历图层内所有实体？    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

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

zzyong00 发表于 2018-3-2 09:26:00

按图层选择，创建选择集，遍历。。。

mikewolf2k 发表于 2018-3-2 13:16:00

对象不是属于图层的，是属于document的。要实现这个效果可以遍历对象，然后看对象的图层是不是满足你需要的。

spano 发表于 2018-3-4 11:08:00

哦，谢谢了，这对对象很多的图会不会拖慢速度？

wuyunpeng888 发表于 2018-3-5 16:32:00

选择集处理不了块内图形对象，要处理全部，可以从块集合来遍历,或从模型空间开始，遇到参照再递归处理对应的块

查看完整版本: VBA能不能实现遍历指定图层内所有实体