复制多个对象

From AutoCAD ActiveX/VBA

previous page next page

将对象复制到同一个位置

复制对象

偏移对象

ActiveX/VBA 开发人员手册 > 创建和编辑 AutoCAD 图元 > 编辑对象 > 复制对象 >

复制多个对象

要复制多个对象，请使用 CopyObjects 方法，或者创建一组对象与 Copy 方法配合使用。（要复制选择集中的对象，请遍历选择集并将对象保存到数组中。）遍历数组，分别复制每个对象，然后将新创建的对象收集到第二个数组中。

要将多个对象复制到不同的图形，请使用 CopyObjects 方法并将 Owner 参数设置为图形的模型空间。

复制两个 Circle 对象

本例创建两个 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

previous page start next page