[求助]插入图块问题
<p><strong>请高手帮忙，在CAD中已有图块，如何将已有图块加入到另一个图块中去？</strong></p><p>Dim obj_block As Object, obj_blockref As Object, obj_blockattribute As Object '块对象、块参照、块属性<br/>Dim InsertionPoint(0 To 2) As Double '块的插入点<br/>Dim point1(0 To 2) As Double, point2(0 To 2) As Double '直线的两个端点<br/>Dim Height As Double<br/>Dim panduan As Boolean</p><p>Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object</p><p>Set obj_Acad = GetObject(, "autocad.application")</p><p>Set obj_Doc = obj_Acad.ActiveDocument<br/>Set obj_ModelSpace = obj_Doc.ModelSpace<br/>'下面建立1个块对象(newblock),在块中添加文字对象和直线对象</p><p>InsertionPoint(0) = 5: InsertionPoint(1) = 5: InsertionPoint(2) = 0</p><p>panduan = False<br/>For i = 0 To obj_Doc.blocks.Count - 1 '遍历所有的块<br/> If obj_Doc.blocks.Item(i).Name = "newblock" Then<br/> Set obj_block = obj_Doc.blocks.Item("newblock")<br/> panduan = True</p><p> Exit For <br/> End If<br/> Next i<br/>If Not panduan Then '如果块不存在,建立块<br/> Set obj_block = obj_Doc.blocks.Add(InsertionPoint, "newblock")<br/> End If</p><p><strong>＝＝＝想在此处加入图中已有的图块（图块名为“123”）请高手帮忙＝＝＝＝</strong></p><p><br/>obj_Doc.ActiveTextStyle.SetFont "宋体", False, False, 1, 0 '设置文字字体为"宋体"<br/>Set obj_Text = obj_block.AddText("1.25", InsertionPoint, 0.5) '在块newblock中添加文字对象<br/>point1(0) = 3#: point1(1) = 5#: point1(2) = 0#<br/>point2(0) = 5: point2(1) = 5: point2(2) = 0#<br/>obj_block.Addline point1, point2 '在块"newblock"中添加直线对象<br/>obj_Acad.zoomextents<br/></p> <p>Dim obj_block As Object, obj_blockref As Object, obj_blockattribute As Object '块对象、块参照、块属性<br/>Dim InsertionPoint(0 To 2) As Double '块的插入点<br/>Dim point1(0 To 2) As Double, point2(0 To 2) As Double '直线的两个端点<br/>Dim Height As Double<br/>Dim panduan As Boolean</p><p>Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object</p><p>Set obj_Acad = GetObject(, "autocad.application")</p><p>Set obj_Doc = obj_Acad.ActiveDocument<br/>Set obj_ModelSpace = obj_Doc.ModelSpace<br/>'下面建立1个块对象(newblock),在块中添加文字对象和直线对象</p><p>InsertionPoint(0) = 5: InsertionPoint(1) = 5: InsertionPoint(2) = 0</p><p>panduan = False<br/>For i = 0 To obj_Doc.blocks.Count - 1 '遍历所有的块<br/> If obj_Doc.blocks.Item(i).Name = "newblock" Then<br/> Set obj_block = obj_Doc.blocks.Item("newblock")<br/> panduan = True</p><p> Exit For <br/> End If<br/> Next i<br/>If Not panduan Then '如果块不存在,建立块<br/> Set obj_block = obj_Doc.blocks.Add(InsertionPoint, "newblock")</p><p>Set newblock = newblockj.AddPoint(insertionPoitnt) '在块中定义一个点</p><p>Set obj_block = newblock.addline(p1(),p2())</p><p>height = 1: mode = acAttributeModeNormal<br/>prompt = "0": tag = "文字"<br/>Set attributeObj = obj_block j.AddAttribute(height, mode, prompt, insertionPoint, tag, "123.455")'在块中加入文字注记</p><p><br/> End If</p><p>'以上块定义完毕，块定义中有一个点一条直线一个附加属性</p><p> Dim mm As AcadBlockReference</p><p>Set mm = ThisDrawing.ModelSpace.InsertBlock(newblock, "图层123t", d, d, d, 0)</p><p>'以上创建块实体</p>
页:
[1]