急!!请教哪位知道炸开多层嵌套图形（块）的VBA代码

concord

如题。 谢谢！

雪山飞狐_lzh

Function ExplodeBlockRef(pBlockRef) As Collection
On Error Resume Next
Dim i, j
Dim pEnts
Dim EBR As New Collection
pEnts = pBlockRef.Explode
For i = 0 To UBound(pEnts)
If pEnts(i).ObjectName <> "AcDbBlockReference" Then
EBR.Add pEnts(i)
Else
Set Es = ExplodeBlockRef(pEnts(i))
pEnts(i).Delete
For j = 1 To Es.Count
EBR.Add Es(j)
Next j
End If
Next i
Set ExplodeBlockRef = EBR
End Function Sub tt()
Dim obj As AcadEntity
ThisDrawing.Utility.GetEntity obj, pnt
MsgBox ExplodeBlockRef(obj).Count
End Sub

concord

多谢雪山飞狐版主！！！

yanyanjun999

太妙了，帮我解决了个大问题，谢谢了