乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 141|回复: 9

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

[复制链接]

24

主题

83

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
179
发表于 2004-6-22 22:23:00 | 显示全部楼层 |阅读模式
我用select方法在drawing1.dwg上选择了一些图元,然后用add方法创建了一个新的文档drawing2.dwg,请问怎样才能将前面选中的那些图元复制到drawing.dwg中同样的位置?
还有,一个选择集好像只能保存256个对象,如果给定的范围内被选的对象数目多余256个,该怎么做?
望赐教,谢谢。
回复

使用道具 举报

26

主题

589

帖子

10

银币

中流砥柱

Rank: 25

铜币
693
发表于 2004-6-22 22:27:00 | 显示全部楼层
使用CopyObjects,先定义一个对象数组,将选择集中的所有对象赋给它,然后调用这个函数拷贝到另一个文档。
回复

使用道具 举报

24

主题

83

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
179
发表于 2004-6-23 10:25:00 | 显示全部楼层
我用的就是这个方法,可是没有成功,不知道问题出在哪里。 下面是出错地方的代码:
                                                                                                                                                         Set DOC1 = Documents.Add
                                                                                                                                                         retObjects = DOC1.CopyObjects(objCollection)
其中DOC1是新建的dwg文档,objCollection是一个保存了一些图元的数组
在新建了一个文档后,下面这句:
retObjects = DOC1.CopyObjects(objCollection)
提示出错:
运行错误 '-2145386377 (80200077)' :
对象不在数据库中
不知道这是什么问题,监视窗口中可以看到objCollection是存在对象的。
望大侠不吝赐教。谢谢
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2004-6-23 10:32:00 | 显示全部楼层
DOC1.CopyObjects(objCollection)
方法中        DOC1换成objCollection对象数组所在的Document
回复

使用道具 举报

24

主题

83

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
179
发表于 2004-6-23 10:46:00 | 显示全部楼层
我将代码改成了如下: set doc1=application.activedocument ' 源图元所在的文档
set doc2=docements.add
retObjects=doc1.CopyObjects(objCollection)
没有原来的错误了,可是图元并没有拷贝到新的文件中,why?
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2004-6-23 10:52:00 | 显示全部楼层
你的对象数组的代码看看?
回复

使用道具 举报

24

主题

83

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
179
发表于 2004-6-23 10:55:00 | 显示全部楼层
我是在Add 之前将文档赋给DOC1的,应该没问题吧,
现在我改成了下面的语句,错误倒没有了,新的文档中什么也没有
set doc1=application.activedocument ' 源图元所在的文档
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2004-6-23 10:58:00 | 显示全部楼层
贴你的完整一点的代码?
回复

使用道具 举报

24

主题

83

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
179
发表于 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是一个动态数组
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 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
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-15 21:18 , Processed in 0.545539 second(s), 72 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表