如何遍历cad的块

a_way

然后修改块属性？

Flyingdancing

2. Sub s()
   
3. Dim b As AcadBlockReference
   
4. On Error Resume Next
   
5. '手选确定某块
   
6. 选择:
   
7. ThisDrawing.Utility.GetEntity b, p, "请选择需要搜索的块"
   
8. If Err Then
   
9.     Err.Clear
   
10.     'Exit Sub '或者用GOTO重复
    
11.     GoTo 选择 '若此处用GOTO，则导致ESC无效，直到选择到某个块为止或强行退出CAD
    
12. End If
    
13. If b.ObjectName <> "AcDbBlockReference" Then
    
14.     GoTo 选择
    
15. End If
    
16. '建立上面选择的块的选择集遍历
    
17. Dim data(1) As Integer
    
18. Dim datatype(1) As Variant
    
19. Dim sel As AcadSelectionSet
    
20. 
    
21. data(0) = 100: datatype(0) = "AcDbBlockReference"
    
22. data(1) = 2: datatype(1) = b.Name '块名
    
23. Set sel = ThisDrawing.SelectionSets("rrr")
    
24. sel.Clear
    
25. If Err Then
    
26.     Err.Clear
    
27.     Set sel = ThisDrawing.SelectionSets.Add("rrr")
    
28. End If
    
29. 输入:
    
30. Select Case ThisDrawing.Utility.GetInteger("1.全图；2.手动选择" & vbCrLf)
    
31. Case 1
    
32.     sel.Select acSelectionSetAll, , , data, datatype
    
33. Case 2
    
34.     sel.SelectOnScreen data, datatype
    
35. Case Else
    
36.     MsgBox "输入不正确，请重新输入"
    
37.     GoTo 输入
    
38. End Select
    
39. '遍历选择集
    
40. For Each b In sel
    
41.     '你的命令
    
42.     ThisDrawing.Utility.Prompt ii + 1 & "个" & vbCrLf
    
43.     ii = ii + 1
    
44. Next
    
45. End Sub
    

Sub s()<br /> Dim b As AcadBlockReference<br /> On Error Resume Next<br /> '手选确定某块<br /> 选择:<br /> ThisDrawing.Utility.GetEntity b, p, "请选择需要搜索的块"<br /> If Err Then<br />     Err.Clear<br />     'Exit Sub '或者用GOTO重复<br />     GoTo 选择 '若此处用GOTO，则导致ESC无效，直到选择到某个块为止或强行退出CAD<br /> End If<br /> If b.ObjectName <> "AcDbBlockReference" Then<br />     GoTo 选择<br /> End If<br /> '建立上面选择的块的选择集遍历<br /> Dim data(1) As Integer<br /> Dim datatype(1) As Variant<br /> Dim sel As AcadSelectionSet<br /> <br /> data(0) = 100: datatype(0) = "AcDbBlockReference"<br /> data(1) = 2: datatype(1) = b.Name '块名<br /> Set sel = ThisDrawing.SelectionSets("rrr")<br /> sel.Clear<br /> If Err Then<br />     Err.Clear<br />     Set sel = ThisDrawing.SelectionSets.Add("rrr")<br /> End If<br /> 输入:<br /> Select Case ThisDrawing.Utility.GetInteger("1.全图；2.手动选择" & vbCrLf)<br /> Case 1<br />     sel.Select acSelectionSetAll, , , data, datatype<br /> Case 2<br />     sel.SelectOnScreen data, datatype<br /> Case Else<br />     MsgBox "输入不正确，请重新输入"<br />     GoTo 输入<br /> End Select<br /> '遍历选择集<br /> For Each b In sel<br />     '你的命令<br />     ThisDrawing.Utility.Prompt ii + 1 & "个" & vbCrLf<br />     ii = ii + 1<br /> Next<br /> End Sub<br />

齐天大圣3386

选择集是可以选择图中所有块的无论是COM的还是NET的。