要复制多个对象，请使用 CopyObjects 方法，或者创建一组对象与 Copy 方法配合使用。（要复制选择集中的对象，请遍历选择集并将对象保存到数组中。）遍历数组，分别复制每个对象，然后将新创建的对象收集到第二个数组中。
要将多个对象复制到不同的图形，请使用 CopyObjects 方法并将 Owner 参数设置为图形的模型空间。
本例创建两个 Circle 对象并使用 CopyObjects 方法创建圆的副本。
Sub Ch4_CopyCircleObjects()
Dim DOC1 As AcadDocument
Dim circleObj1 As AcadCircle
Dim circleObj2 As AcadCircle
Dim circleObj1Copy As AcadCircle
Dim circleObj2Copy As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius1 As Double
Dim radius2 As Double
Dim radius1Copy As Double
Dim radius2Copy As Double
Dim objCollection(0 To 1) As Object
Dim retObjects As Variant
' 定义 Circle 对象
centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
radius1 = 5#: radius2 = 7#
radius1Copy = 1#: radius2Copy = 2#
' 创建新图形
Set DOC1 = ThisDrawing.Application.Documents.Add
' 向图形中添加两个圆
Set circleObj1 = DOC1.ModelSpace.AddCircle _
(centerPoint, radius1)
Set circleObj2 = DOC1.ModelSpace.AddCircle _
(centerPoint, radius2)
ZoomAll
' 将要复制的对象设置成
' 与 CopyObjects 兼容的形式
Set objCollection(0) = circleObj1
Set objCollection(1) = circleObj2
' 复制对象并取回新对象（副本）
' 的集合
retObjects = DOC1.CopyObjects(objCollection)
' 获取新创建的对象并
' 对副本应用新的特性
Set circleObj1Copy = retObjects(0)
Set circleObj2Copy = retObjects(1)
circleObj1Copy.radius = radius1Copy
circleObj1Copy.Color = acRed
circleObj2Copy.radius = radius2Copy
circleObj2Copy.Color = acRed
ZoomAll
End Sub
本例创建 Circle 对象，然后使用 CopyObjects 方法将圆复制到新的图形中。
Sub Ch4_Copy_to_New_Drawing()
Dim DOC0 As AcadDocument
Dim circleObj1 As AcadCircle, circleObj2 As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius1 As Double, radius2 As Double
Dim radius1Copy As Double, radius2Copy As Double
Dim objCollection(0 To 1) As Object
Dim retObjects As Variant
' 定义 Circle 对象
centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
radius1 = 5#: radius2 = 7#
radius1Copy = 1#: radius2Copy = 2#
' 向当前图形中添加两个圆
Set circleObj1 = ThisDrawing.ModelSpace.AddCircle _
(centerPoint, radius1)
Set circleObj2 = ThisDrawing.ModelSpace.AddCircle _
(centerPoint, radius2)
ThisDrawing.Application.ZoomAll
' 保存指向当前图形的指针
Set DOC0 = ThisDrawing.Application.ActiveDocument
' 复制对象
'
' 将要复制的对象设置为
' 与 CopyObjects 兼容的形式
Set objCollection(0) = circleObj1
Set objCollection(1) = circleObj2
' 创建新的图形并指向其模型空间
Dim Doc1MSpace As AcadModelSpace
Dim DOC1 As AcadDocument
Set DOC1 = Documents.Add
Set Doc1MSpace = DOC1.ModelSpace
' 将对象复制到新图形的模型空间。A
' 返回新（复制的）对象的集合。
retObjects = DOC0.CopyObjects(objCollection, Doc1MSpace)
Dim circleObj1Copy As AcadCircle, circleObj2Copy As AcadCircle
' 获取新创建的对象集合并
' 对副本应用新的特性
Set circleObj1Copy = retObjects(0)
Set circleObj2Copy = retObjects(1)
circleObj1Copy.radius = radius1Copy
circleObj1Copy.Color = acRed
circleObj2Copy.radius = radius2Copy
circleObj2Copy.Color = acRed
ThisDrawing.Application.ZoomAll
MsgBox "Circles copied."
End Sub