bluelover 发表于 2004-6-22 22:23:00

◆请问怎么将图元复制到新的文档

我用select方法在drawing1.dwg上选择了一些图元,然后用add方法创建了一个新的文档drawing2.dwg,请问怎样才能将前面选中的那些图元复制到drawing.dwg中同样的位置?


还有,一个选择集好像只能保存256个对象,如果给定的范围内被选的对象数目多余256个,该怎么做?


望赐教,谢谢。

efan2000 发表于 2004-6-22 22:27:00

使用CopyObjects,先定义一个对象数组,将选择集中的所有对象赋给它,然后调用这个函数拷贝到另一个文档。

bluelover 发表于 2004-6-23 10:25:00

我用的就是这个方法,可是没有成功,不知道问题出在哪里。



下面是出错地方的代码:


<FONT color=#3300ff>                                                                                                                                                       Set DOC1 = Documents.Add<BR>                                                                                                                                                       retObjects = DOC1.CopyObjects(objCollection)</FONT>


其中DOC1是新建的dwg文档,objCollection是一个保存了一些图元的数组


在新建了一个文档后,下面这句:


<FONT color=#0000ff>retObjects = DOC1.CopyObjects(objCollection)</FONT>


提示出错:


<FONT color=#ff0000>运行错误 '-2145386377 (80200077)' :</FONT>


<FONT color=#ff0000>对象不在数据库中</FONT>


<FONT color=#000000>不知道这是什么问题,监视窗口中可以看到objCollection是存在对象的。</FONT>


望大侠不吝赐教。谢谢

雪山飞狐_lzh 发表于 2004-6-23 10:32:00

<FONT color=#0000ff>        DOC1.CopyObjects(objCollection)</FONT>


<FONT color=#0000ff>方法中        DOC1换成objCollection对象数组所在的</FONT><FONT color=#3300ff>Document</FONT>

bluelover 发表于 2004-6-23 10:46:00

我将代码改成了如下:



set doc1=application.activedocument ' 源图元所在的文档


set doc2=docements.add


retObjects=doc1.CopyObjects(objCollection)


没有原来的错误了,可是图元并没有拷贝到新的文件中,why?

雪山飞狐_lzh 发表于 2004-6-23 10:52:00

你的对象数组的代码看看?

bluelover 发表于 2004-6-23 10:55:00

我是在Add 之前将文档赋给DOC1的,应该没问题吧,


现在我改成了下面的语句,错误倒没有了,新的文档中什么也没有


set doc1=application.activedocument ' 源图元所在的文档

雪山飞狐_lzh 发表于 2004-6-23 10:58:00

贴你的完整一点的代码?

bluelover 发表于 2004-6-23 11:00:00

<FONT color=#9900ff>                                                       set DOC1=Application.ActiveDocument</FONT>


<FONT color=#6600ff><FONT color=#000000>                                                                                                               </FONT>If ssetObj.Count &gt; 0 Then<BR>                                                                                                                                                       ReDim objCollection(ssetObj.Count - 1)<BR>                                                                                                                                                       For k = 0 To ssetObj.Count - 1<BR>                                                                                                                                                                                       Set objCollection(k) = ssetObj(k)<BR>                                                                                                                                                       Next k<BR>                                                                                                                                                       <BR>                                                                                                                                                       Set DOC2 = Documents.Add<BR>                                                                                                                                                       retObjects = DOC1.CopyObjects(objCollection)<BR>                                                                                                                       End If</FONT>


<FONT color=#000000>其中ssetObj是一个选择集,objCollection是一个动态数组</FONT>

雪山飞狐_lzh 发表于 2004-6-23 11:09:00

Sub t7()<BR>Dim Doc1 As AcadDocument, Doc2 As Object<BR>Dim ssetObj As AcadSelectionSet<BR>Dim objCollection() As AcadEntity<BR>Set Doc1 = Application.ActiveDocument


Set ssetObj = Doc1.ActiveSelectionSet<BR>ssetObj.Select acSelectionSetAll


                                                                                                               If ssetObj.Count &gt; 0 Then<BR>                                                                                                                                                       ReDim objCollection(ssetObj.Count - 1) As AcadEntity<BR>                                                                                                                                                       For k = 0 To ssetObj.Count - 1<BR>                                                                                                                                                                                       Set objCollection(k) = ssetObj(k)<BR>                                                                                                                                                       Next k<BR>                                                                                                                                                       <BR>                                                                                                                                                       Set Doc2 = Documents.Add<BR>                                                                                                                                                       Doc1.CopyObjects objCollection, Doc2.ModelSpace<BR>                                                                                                                       End If


<BR>End Sub<BR>
页: [1] 2
查看完整版本: ◆请问怎么将图元复制到新的文档