Public Sub ExplodeINSERT()
On Error Resume Next
Dim ssetObj As AcadSelectionSet
If ThisDrawing.SelectionSets.Count = 0 Then
Set ssetObj = ThisDrawing.SelectionSets.Add("ssetObj")
Else
Set ssetObj = ThisDrawing.SelectionSets(0)
ssetObj.Clear
End If
Dim gpcode(0) As Integer
Dim datavalue(0) As Variant
gpcode(0) = 0
datavalue(0) = "INSERT"
Dim groupcode As Variant, datacode As Variant
groupcode = gpcode
datacode = datavalue
ssetObj.Select acSelectionSetAll, , , groupcode, datacode
Dim i As Integer
Dim ENT As AcadEntity
Dim Qty As Integer
Qty = 0
For i = 0 To ssetObj.Count - 1
Set ENT = ssetObj(i)
ENT.Explode
Qty = Qty + 1
Next i
MsgBox "炸开" & Str(Qty) & "个块！"
End Sub
试试看！
置顶卡
