[求助]插入图块问题

yuliang2477

请高手帮忙，在CAD中已有图块，如何将已有图块加入到另一个图块中去？

Dim obj_block As Object, obj_blockref As Object, obj_blockattribute As Object     '块对象、块参照、块属性
Dim InsertionPoint(0 To 2) As Double        '块的插入点
Dim point1(0 To 2) As Double, point2(0 To 2) As Double '直线的两个端点
Dim Height As Double
Dim panduan As Boolean

Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object

Set obj_Acad = GetObject(, "AutoCAD.application")

Set obj_Doc = obj_Acad.ActiveDocument
Set obj_ModelSpace = obj_Doc.ModelSpace
'下面建立1个块对象(newblock),在块中添加文字对象和直线对象

InsertionPoint(0) = 5: InsertionPoint(1) = 5: InsertionPoint(2) = 0

panduan = False
For i = 0 To obj_Doc.blocks.Count - 1 '遍历所有的块
    If obj_Doc.blocks.Item(i).Name = "newblock" Then
     Set obj_block = obj_Doc.blocks.Item("newblock")
     panduan = True

     Exit For    
     End If
   Next i
If Not panduan Then     '如果块不存在,建立块
 Set obj_block = obj_Doc.blocks.Add(InsertionPoint, "newblock")
 End If

＝＝＝想在此处加入图中已有的图块（图块名为“123”）请高手帮忙＝＝＝＝

obj_Doc.ActiveTextStyle.SetFont "宋体", False, False, 1, 0  '设置文字字体为"宋体"
Set obj_Text = obj_block.AddText("1.25", InsertionPoint, 0.5) '在块newblock中添加文字对象
point1(0) = 3#: point1(1) = 5#: point1(2) = 0#
point2(0) = 5: point2(1) = 5: point2(2) = 0#
obj_block.Addline point1, point2                 '在块"newblock"中添加直线对象
obj_Acad.zoomextents

poly168

Dim obj_block As Object, obj_blockref As Object, obj_blockattribute As Object     '块对象、块参照、块属性
Dim InsertionPoint(0 To 2) As Double        '块的插入点
Dim point1(0 To 2) As Double, point2(0 To 2) As Double '直线的两个端点
Dim Height As Double
Dim panduan As Boolean

Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object

Set obj_Acad = GetObject(, "autocad.application")

Set obj_Doc = obj_Acad.ActiveDocument
Set obj_ModelSpace = obj_Doc.ModelSpace
'下面建立1个块对象(newblock),在块中添加文字对象和直线对象

InsertionPoint(0) = 5: InsertionPoint(1) = 5: InsertionPoint(2) = 0

panduan = False
For i = 0 To obj_Doc.blocks.Count - 1 '遍历所有的块
    If obj_Doc.blocks.Item(i).Name = "newblock" Then
     Set obj_block = obj_Doc.blocks.Item("newblock")
     panduan = True

     Exit For    
     End If
   Next i
If Not panduan Then     '如果块不存在,建立块
 Set obj_block = obj_Doc.blocks.Add(InsertionPoint, "newblock")

Set newblock  = newblockj.AddPoint(insertionPoitnt) '在块中定义一个点

Set obj_block  = newblock.addline(p1(),p2())

height = 1: mode = acAttributeModeNormal
prompt = "0": tag = "文字"
Set attributeObj = obj_block  j.AddAttribute(height, mode, prompt, insertionPoint, tag,  "123.455")'在块中加入文字注记

 End If

'以上块定义完毕，块定义中有一个点一条直线一个附加属性

 Dim mm As AcadBlockReference

Set mm = ThisDrawing.ModelSpace.InsertBlock(newblock, "图层123t",  d, d, d, 0)

'以上创建块实体