图层间图形实体的移动？

pzddzp · 发表于 2002-9-22 11:11:00

请问各位高手：在 VBA中怎样通过程序实现
将一图层中的图形实体移到另一图形的图层上去
我的e-mail :pzddzp@sina.com
谢谢

pzddzp · 发表于 2002-9-22 15:54:00

对于同一图形可以，但对不同图形不能实现
以以下程序，我试了一下但不对
Private Sub CommandButton7_Click()
Dim Myln As AcadLine
Dim Pnt1(0 To 2) As Double, Pnt2(0 To 2) As Double
Pnt1(0) = 0: Pnt1(1) = 0
Pnt2(0) = 200: Pnt2(1) = 0
Set Myln = ThisDrawing.Application.Documents("Drawing1.dwg").ModelSpace.AddLine(Pnt1, Pnt2)
Myln.Layer = ThisDrawing.Application.Documents("Drawing2.dwg").Layers(1).name
End Sub

mccad · 发表于 2002-9-23 12:57:00

CopyObjects方法是一个非常有用的工具。这里我们看看它是怎样在图形间复制对象。首先准备两个文档。在一个文档中，创建一些对象。如果另一个文档的名称不是Drawing1.dwg，可修改以下程序中的文档名称为你的图形名称。最后，确定激活包含有要复制对象的图形并运行以下宏，这样可以将本文档中的对象复制到名称为Drawing1.dwg的另一个文档中。
Dim ss As AcadSelectionSet, doc As AcadDocument
Set doc = ThisDrawing.Application.Documents("Drawing1.dwg")
Set ss = CreateSelectionSet
ss.SelectOnScreen
ThisDrawing.CopyObjects ssArray(ss), doc.ModelSpace
doc.Regen acAllViewports

pzddzp · 发表于 2002-9-24 14:12:00

谢谢斑竹上次的指教，在下试了几次但没有成功
我通过以下代码可以实现一个图形拷贝到另一个图形
，但对一个具体的图层好象行不通
Private Sub CommandButton6_Click()
Dim str As String, I As Integer, j As Integer
Dim Myss As AcadSelectionSet
Dim Doc1 As AcadDocument, Doc2 As AcadDocument
Set Doc1 = ThisDrawing.Application.Documents("Drawing1.dwg")
Set Doc2 = ThisDrawing.Application.Documents("Drawing2.dwg")
Dim pnmin As Variant, pnmax As Variant
Dim pn1(0 To 2) As Double, pn2(0 To 2) As Double
Me.Hide
ThisDrawing.Application.Documents("Drawing1.dwg").SendCommand Chr(3) + Chr(3) + "._copyclip all" + Chr(32) + Chr(32) ' str + Chr(59)
ThisDrawing.Application.Documents("Drawing2.dwg").SendCommand Chr(3) + Chr(3) + ".__ _pasteorig "
Me.Show
End Sub

图层间图形实体的移动？

发表回复

精选推荐