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