CopyObjects方法在多个图形之间传递数据时注意：用拥有要复制实体的文档来调用

zfbj

下面的代码用于将当前图形中的对象复制到其他打开的图形：
Public Sub CopyFromOuterDwg()
' 判断图形是否存在
If Len(Dir("C:\test.dwg")) = 0 Then
MsgBox "指定的图形不存在！", vbCritical
Exit Sub
End If

Dim objCurDoc As AcadDocument
Set objCurDoc = ThisDrawing.Application.ActiveDocument

' 打开一个新图形
Dim objNewDoc As AcadDocument
Set objNewDoc = ThisDrawing.Application.Documents.Open("C:\test.dwg")

' 将原来的图形设置为当前图形
'ThisDrawing.Application.ActiveDocument = objCurDoc ' 将外部图形的实体复制到当前图形
Dim objCollection(0 To 1) As Object
Set objCollection(0) = objNewDoc.ModelSpace.Item(0)
Set objCollection(1) = objNewDoc.ModelSpace.Item(1)
objNewDoc.CopyObjects objCollection, objCurDoc.ModelSpace

' 关闭打开的图形
objNewDoc.Close
End Sub 接下来的代码用于将其他打开的图形中的对象复制到当前图形（不可用）：
Public Sub CopyFromOuterDwg()
' 判断图形是否存在
If Len(Dir("C:\test.dwg")) = 0 Then
MsgBox "指定的图形不存在！", vbCritical
Exit Sub
End If

Dim objCurDoc As AcadDocument
Set objCurDoc = ThisDrawing.Application.ActiveDocument

' 打开一个新图形
Dim objNewDoc As AcadDocument
Set objNewDoc = ThisDrawing.Application.Documents.Open("C:\test.dwg")

' 将原来的图形设置为当前图形
ThisDrawing.Application.ActiveDocument = objCurDoc ' 将外部图形的实体复制到当前图形
Dim objCollection(0 To 1) As Object
Set objCollection(0) = objNewDoc.ModelSpace.Item(0)
Set objCollection(1) = objNewDoc.ModelSpace.Item(1)
'objNewDoc.CopyObjects objCollection, objCurDoc.ModelSpace
ThisDrawing.CopyObjects objCollection, objCurDoc.ModelSpace

' 关闭打开的图形
objNewDoc.Close
End Sub