如何遍历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]