xiaopei520 发表于 2004-10-4 16:51:00

再问一个问题:)

我的程序主要过程是:打开若干个DXF文件,将其中的线一一按原坐标复制到新的dwg文件中,但是这其中总是不稳定,有时会在原点处加几个识别不了的文字,显示问几个问号.下面是复制时用的命令:


                       ThisDrawing.Application.Documents(lst2.List(I)).SendCommand Chr(3) + Chr(3) + "._copyclip all       " + Chr(32) + Chr(32)       ' str + Chr(59)<BR>                       ThisDrawing.Application.Documents(MStrPrjName + "坡面.DWG").SendCommand Chr(3) + Chr(3) + "._pasteorig " '粘贴到原坐标系<BR>                       ThisDrawing.Application.Documents(lst2.List(I)).Close , False '关闭原文件<BR>                       ThisDrawing.SendCommand Chr(3) + Chr(3) + "Z E "<BR>

雪山飞狐_lzh 发表于 2004-10-4 19:03:00

用CopyObjects方法

bluelover 发表于 2004-10-5 13:47:00

本帖最后由 作者 于 2004-10-6 12:53:39 编辑

图元很多的情况下，copyObjects 方法效率其实比较低的，可以试试WBlock方法与 Explode方法相结合。

xiaopei520 发表于 2004-10-5 14:49:00

还好,俺的程序就是将一些线粘贴到一张新图中去,用copyObjects简单容易 实现       


                       Dim Doc1 As AcadDocument, Doc2 As Object<BR>                       Dim ssetObj As AcadSelectionSet<BR>                       Dim objCollection() As AcadEntity<BR>                       Set Doc1 = Application.Documents(lst2.List(I))'有多个DXF文件


                       DeleAllSelect<BR>                       Set ssetObj = ThisDrawing.SelectionSets.Add("ybssa")<BR>                       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


                                                                                               Set Doc2 = Documents("D:\mydwg.DWG")<BR>                                                                                               Doc1.CopyObjects objCollection, Doc2.ModelSpace<BR>                                                               End If<BR>                                                               ThisDrawing.Application.Documents(lst2.List(I)).Close , False<BR>                                                               ThisDrawing.Application.ZoomExtents<BR>
页: [1]
查看完整版本: 再问一个问题:)