社区 › VB › ◆请问怎么将图元复制到新的文档

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

我用的就是这个方法，可是没有成功，不知道问题出在哪里。 下面是出错地方的代码：
                                                                                                                                                       Set DOC1 = Documents.Add
                                                                                                                                                       retObjects = DOC1.CopyObjects(objCollection)
其中DOC1是新建的dwg文档，objCollection是一个保存了一些图元的数组
在新建了一个文档后，下面这句：
retObjects = DOC1.CopyObjects(objCollection)
提示出错：
运行错误 '-2145386377 （80200077）' ：
对象不在数据库中
不知道这是什么问题，监视窗口中可以看到objCollection是存在对象的。
望大侠不吝赐教。谢谢

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

DOC1.CopyObjects(objCollection)
方法中        DOC1换成objCollection对象数组所在的Document

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

set DOC1=Application.ActiveDocument
                                                                                                               If ssetObj.Count > 0 Then
                                                                                                                                                       ReDim objCollection(ssetObj.Count - 1)
                                                                                                                                                       For k = 0 To ssetObj.Count - 1
                                                                                                                                                                                       Set objCollection(k) = ssetObj(k)
                                                                                                                                                       Next k
                                                                                                                                                       
                                                                                                                                                       Set DOC2 = Documents.Add
                                                                                                                                                       retObjects = DOC1.CopyObjects(objCollection)
                                                                                                                       End If
其中ssetObj是一个选择集，objCollection是一个动态数组

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

Sub t7()
Dim Doc1 As AcadDocument, Doc2 As Object
Dim ssetObj As AcadSelectionSet
Dim objCollection() As AcadEntity
Set Doc1 = Application.ActiveDocument
Set ssetObj = Doc1.ActiveSelectionSet
ssetObj.Select acSelectionSetAll
                                                                                                               If ssetObj.Count > 0 Then
                                                                                                                                                       ReDim objCollection(ssetObj.Count - 1) As AcadEntity
                                                                                                                                                       For k = 0 To ssetObj.Count - 1
                                                                                                                                                                                       Set objCollection(k) = ssetObj(k)
                                                                                                                                                       Next k
                                                                                                                                                       
                                                                                                                                                       Set Doc2 = Documents.Add
                                                                                                                                                       Doc1.CopyObjects objCollection, Doc2.ModelSpace
                                                                                                                       End If
End Sub

查看完整版本: ◆请问怎么将图元复制到新的文档