Sub CadBlock() Dim tempBlock As Variant Dim msg As String Dim SsetObj As AcadSelectionSet Dim FilterType(0) As Integer, filterDate(0) As Variant
FilterType(0) = 0 filterDate(0) = "insert"
Do While ThisDrawing.SelectionSets.Count > 0 '=====安全创建选择集 ThisDrawing.SelectionSets.Item(0).Delete Loop Set SsetObj = ThisDrawing.SelectionSets.Add("CadBlock") SsetObj.SelectOnScreen FilterType, filterDate For Each tempBlock In SsetObj msg = tempBlock.Name MsgBox msg Next tempBlock SsetObj.Delete End Sub