请教:如何遍历某图层内的所有对象?

czbming

本以为 for each entity in layer (傻)

今晚打老虎

差不多，判断以下不就行了~~~

for each objEntity in thisdrawing.modelspace
  if objEntity.Layer="TestLayer" then
   '取出来了~~~~
  end if
next objEntity

czbming

......这...太费时了吧!~要是图形上有上千个对象就要循环上千次.!~有没更好的方法?

topirol

用选择集过滤后再历遍选择集

今晚打老虎

楼上的正解~~~~~~

3kd

2楼的办法最简单但又最费时。4楼说用选择集，选择集怎么创建？用交互方式点取还是用遍历？能说清楚点吗？

czbming

用选择集?那好象还是回到老问题:怎么过滤出某图层的对象??

czbming

我有个笨笨的方法:
冻结其它图层只剩要遍历的图层.选择所有的对象加入选择集.再解冻.虽然可行.但还是较繁索.
希望哪位大大给小弟指条明路!~

efan2000

2. 
   
3. Sub test()
   
4.     On Error Resume Next
   
5.     '创建选择集
   
6.     Dim SSetObj As Object
   
7.     Set SSetObj = ThisDrawing.SelectionSets("LayerCount")
   
8.     If Err.Number <> 0 Then
   
9.         Err.Clear
   
10.         Set SSetObj = ThisDrawing.SelectionSets.Add("LayerCount")
    
11.     End If
    
12.     SSetObj.Clear
    
13.    
    
14.     On Error GoTo ErrTrap
    
15.     '创建过滤机制
    
16.     Dim fType(0 To 0) As Integer
    
17.     Dim fData(0 To 0) As Variant
    
18.     fType(0) = 8: fData(0) = "0" ' 层名
    
19.    
    
20.     '选择0层的所有实体
    
21.     SSetObj.Select acSelectionSetAll, , , fType, fData
    
22.    
    
23.     '返回0层的实体数目
    
24.     Debug.Print SSetObj.Count
    
25.    
    
26.     '删除数组
    
27.     Erase fType: Erase fData
    
28.    
    
29.     '删除选择集
    
30.     SSetObj.Clear
    
31.     SSetObj.Delete
    
32.     Set SSetObj = Nothing
    
33.     Exit Sub
    
34.    
    
35. ErrTrap:
    
36.     MsgBox "出错了，请检查程序！"
    
37.     On Error GoTo 0
    
38. End Sub
    

<br /> Sub test()<br />     On Error Resume Next<br />     '创建选择集<br />     Dim SSetObj As Object<br />     Set SSetObj = ThisDrawing.SelectionSets("LayerCount")<br />     If Err.Number <> 0 Then<br />         Err.Clear<br />         Set SSetObj = ThisDrawing.SelectionSets.Add("LayerCount")<br />     End If<br />     SSetObj.Clear<br />     <br />     On Error GoTo ErrTrap<br />     '创建过滤机制<br />     Dim fType(0 To 0) As Integer<br />     Dim fData(0 To 0) As Variant<br />     fType(0) = 8: fData(0) = "0" ' 层名<br />     <br />     '选择0层的所有实体<br />     SSetObj.Select acSelectionSetAll, , , fType, fData<br />     <br />     '返回0层的实体数目<br />     Debug.Print SSetObj.Count<br />     <br />     '删除数组<br />     Erase fType: Erase fData<br />     <br />     '删除选择集<br />     SSetObj.Clear<br />     SSetObj.Delete<br />     Set SSetObj = Nothing<br />     Exit Sub<br />     <br /> ErrTrap:<br />     MsgBox "出错了，请检查程序！"<br />     On Error GoTo 0<br /> End Sub<br />

zzg4028061

我就是用9楼的办法，应该是最快的了