concord 发表于 2005-1-13 03:04:00

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

本帖最后由 作者 于 2005-1-14 13:23:23 编辑

如题。 谢谢！

雪山飞狐_lzh 发表于 2005-1-16 22:19:00

Function ExplodeBlockRef(pBlockRef) As Collection<BR>On Error Resume Next<BR>Dim i, j<BR>Dim pEnts<BR>Dim EBR As New Collection<BR>pEnts = pBlockRef.Explode<BR>For i = 0 To UBound(pEnts)<BR>If pEnts(i).ObjectName &lt;&gt; "AcDbBlockReference" Then<BR>EBR.Add pEnts(i)<BR>Else<BR>Set Es = ExplodeBlockRef(pEnts(i))<BR>pEnts(i).Delete<BR>For j = 1 To Es.Count<BR>EBR.Add Es(j)<BR>Next j<BR>End If<BR>Next i<BR>Set ExplodeBlockRef = EBR<BR>End Function


Sub tt()<BR>Dim obj As AcadEntity<BR>ThisDrawing.Utility.GetEntity obj, pnt<BR>MsgBox ExplodeBlockRef(obj).Count<BR>End Sub<BR>

concord 发表于 2005-1-17 05:47:00

多谢雪山飞狐版主！！！

yanyanjun999 发表于 2011-2-4 21:34:05

太妙了，帮我解决了个大问题，谢谢了
页: [1]
查看完整版本: 急!!请教哪位知道炸开多层嵌套图形（块）的VBA代码