如何选择块中的块，并让其高亮？

haohaohapp

我遇到一个难题，如何选择块中的块，并让其高亮？


并且不能采用炸开块的方法。


请高手指点

雪山飞狐_lzh

只能获得块中块的子实体，块中的块没办法获得，高亮显示好像也不好办 Sub tt()
Dim obj As Object
ThisDrawing.Utility.GetSubEntity obj, pnt, tr, c
MsgBox obj.ObjectName End Sub

haohaohapp

那就难办了，程序编不下去了。

龙龙仔

把块中的块COPY出来再让其高亮即可!

雪山飞狐_lzh

Sub tt()
On Error Resume Next
Dim obj As AcadEntity, pnt, tm, d

Dim oBigBlock As AcadBlock
Dim oBlock As AcadBlock
Dim ss As AcadSelectionSet
Dim i As AcadEntity

ThisDrawing.Utility.GetSubEntity obj, pnt, tm, d
Set oBlock = ThisDrawing.ObjectIdToObject(obj.OwnerID)

ThisDrawing.SelectionSets("Test").Delete
Set ss = ThisDrawing.SelectionSets.Add("Test")
Dim ft(0) As Integer, fd(0)
ft(0) = 0: fd(0) = "Insert"
ss.SelectAtPoint pnt, ft, fd
Set oBigBlock = ThisDrawing.Blocks(ss(0).Name)
p1 = ss(0).InsertionPoint
For Each i In oBigBlock

If i.Name = oBlock.Name Then
p2 = i.InsertionPoint
End If

Next i
p1(0) = p1(0) + p2(0)
p1(1) = p1(1) + p2(1)
p1(2) = p1(2) + p2(2)
ThisDrawing.ModelSpace.InsertBlock(p1, oBlock.Name, 1, 1, 1, 0).Highlight True

End Sub
没有考虑多层，三层或以上会出错，：） 块的缩放也没有考虑，自己改动一下吧 还有一种情况是如果该块包含两个同名块参照可能会错位