求助，如何在cad图上快速得到块参考对象？

ths_2000

在图形中如何快速得到块参考对象的列表？
我用modelspace.item()遍历，感觉速度太慢，是否还有别的好办法？

mccad

用选择集，只先把块参照对象。

ths_2000

谢谢！
选择集无法选到被冻结的层上的对象。

mccad

没有试过怎么会知道不能选取呢？
选择集中对于全图的那个选项(acSelectionSetAll)与图层的状态无关。
看看示例吧：

2. Sub GetBlkRef()
   
3.     Dim ss As AcadSelectionSet
   
4.     Set ss = CreateSelectionSet
   
5.     Dim tFilter As Variant
   
6.     Dim dFilter As Variant
   
7.     BuildFilter tFilter, dFilter, 0, "Insert"
   
8.     ss.Select acSelectionSetAll, , , tFilter, dFilter
   
9.     Debug.Print ss.Count
   
10. End Sub
    
11. 
    
12. Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
    
13. 
    
14.     Dim ss As AcadSelectionSet
    
15.    
    
16.     On Error Resume Next
    
17.     Set ss = ThisDrawing.SelectionSets(ssName)
    
18.     If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    
19.     ss.Clear
    
20.     Set CreateSelectionSet = ss
    
21. 
    
22. End Function
    
23. 
    
24. Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
    
25.     Dim fType() As Integer, fData()
    
26.     Dim index As Long, i As Long
    
27.    
    
28.     index = LBound(gCodes) - 1
    
29.         
    
30.     For i = LBound(gCodes) To UBound(gCodes) Step 2
    
31.         index = index + 1
    
32.         ReDim Preserve fType(0 To index)
    
33.         ReDim Preserve fData(0 To index)
    
34.         fType(index) = CInt(gCodes(i))
    
35.         fData(index) = gCodes(i + 1)
    
36.     Next
    
37.     typeArray = fType: dataArray = fData
    
38. End Sub
    
39. 
    

Sub GetBlkRef()<br />     Dim ss As AcadSelectionSet<br />     Set ss = CreateSelectionSet<br />     Dim tFilter As Variant<br />     Dim dFilter As Variant<br />     BuildFilter tFilter, dFilter, 0, "Insert"<br />     ss.Select acSelectionSetAll, , , tFilter, dFilter<br />     Debug.Print ss.Count<br /> End Sub<br /> <br /> Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet<br /> <br />     Dim ss As AcadSelectionSet<br />     <br />     On Error Resume Next<br />     Set ss = ThisDrawing.SelectionSets(ssName)<br />     If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)<br />     ss.Clear<br />     Set CreateSelectionSet = ss<br /> <br /> End Function<br /> <br /> Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())<br />     Dim fType() As Integer, fData()<br />     Dim index As Long, i As Long<br />     <br />     index = LBound(gCodes) - 1<br />         <br />     For i = LBound(gCodes) To UBound(gCodes) Step 2<br />         index = index + 1<br />         ReDim Preserve fType(0 To index)<br />         ReDim Preserve fData(0 To index)<br />         fType(index) = CInt(gCodes(i))<br />         fData(index) = gCodes(i + 1)<br />     Next<br />     typeArray = fType: dataArray = fData<br /> End Sub<br /> <br />

ths_2000

解决了。
小弟非常感谢！