fjfhgdwfn 发表于 2006-8-9 19:09:00

[求助]如何把从一个文件中的部分对象拷贝到另一个文件中(解决了)

()如何把从一个文件中的部分对象拷贝到另一个文件中
不知道用哪个命令啊.
建了个选择集,好像用copybojects不行啊.
Dim doc1 As AcadDocument
Set doc1 = acadApp.Documents(acadApp.ActiveDocument.Name)
Dim doc2 As AcadDocument
Set doc2 = acadApp.Documents.Add("acaddocument")
doc1.CopyObjects appendobjs, doc2.ModelSpace
调用CopyObjects的文档,必须是包含appendobjs的文档。

雪山飞狐_lzh 发表于 2006-8-9 21:54:00

怎么不行?看看你的代码

fjfhgdwfn 发表于 2006-8-10 08:06:00

Dim FilterType(1) As Integer
   Dim FilterData(1) As Variant
   Set sjx = ThisDrawing.SelectionSets.Add("sjx")
   
   FilterType(0) = 2
   FilterData(0) = "TK" '是圆
   'FilterType(1) = 62
   'FilterData(1) = 10'颜色是3
   FilterType(1) = 8
   FilterData(1) = "0"'图层是0
   
   Dim mode As Integer
mode = acSelectionSetAll
'sjx.Select mode, , , FilterType, FilterData
sjx.SelectOnScreen FilterType, FilterData '选择设计线
    Dim newvarAttributes, inpoint, entry1 As Variant
    Dim ss, sss, ssss As String
    Dim sjxcount As Integer
    sjxcount = sjx.Count
   
   Dim templateFileName As String
   Dim DOC1 As AcadDocument
    ReDim objects(sjxcount) As AcadEntity
   Dim retObjects As Variant
      i = 0
   For Each entry In sjx
   Set objects(i) = entry
    i = i + 1
   Next entry
         
   Set DOC1 = Documents.Add
   retObjects = ThisDrawing.CopyObjects(objects) '这里出错啊
      
MsgBox "1"
ThisDrawing.Application.ZoomAll

雪山飞狐_lzh 发表于 2006-8-10 08:39:00

sjxcount = sjx.Count-1

wyj7485 发表于 2006-8-10 08:39:00

ReDim objects(sjxcount-1) As AcadEntity

fjfhgdwfn 发表于 2006-8-10 11:22:00

retObjects = ThisDrawing.CopyObjects(objects) '这里出错啊
改了这里还是出错啊
页: [1]
查看完整版本: [求助]如何把从一个文件中的部分对象拷贝到另一个文件中(解决了)