Copia de varios objetos

AutoCAD ActiveX

previous page next page

Copia de objetos en la misma ubicación

Copia de objetos

Desfase de objetos

Manual del desarrollador de ActiveX y VBA > Creación y edición de entidades de AutoCAD > Modificación de objetos > Copia de objetos >

Copia de varios objetos

Para copiar varios objetos, utilice el método CopyObjects o bien cree una matriz de objetos para utilizarla con el método Copy. (para copiar los objetos de un conjunto de selección, itere en el conjunto de selección y guarde los objetos en una matriz). Itere en la matriz, copiando cada objeto por separado, y reúna en una segunda matriz los objetos recién creados.

Para copiar varios objetos en un dibujo distinto, utilice el método CopyObjects y ajuste el parámetro Owner en el espacio modelo del dibujo.

Copia de dos objetos circulares

En este ejemplo, se crean dos objetos de círculo y se utiliza el método CopyObjects para crear una copia de los mismos.

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

          ' Define the Circle object
          centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
          radius1 = 5#: radius2 = 7#
          radius1Copy = 1#: radius2Copy = 2#
                   ' Create a new drawing
          Set DOC1 = ThisDrawing.Application.Documents.Add
                ' Add two circles to the drawing
          Set circleObj1 = DOC1.ModelSpace.AddCircle _
                           (centerPoint, radius1)
          Set circleObj2 = DOC1.ModelSpace.AddCircle _
                           (centerPoint, radius2)
          ZoomAll
                ' Put the objects to be copied into a form
          ' compatible with CopyObjects
          Set objCollection(0) = circleObj1
          Set objCollection(1) = circleObj2
                ' Copy object and get back a collection of
          ' the new objects (copies)
          retObjects = DOC1.CopyObjects(objCollection)
                ' Get newly created object and apply
          ' new properties to the copies
          Set circleObj1Copy = retObjects(0)
          Set circleObj2Copy = retObjects(1)
                circleObj1Copy.radius = radius1Copy
          circleObj1Copy.Color = acRed
          circleObj2Copy.radius = radius2Copy
          circleObj2Copy.Color = acRed
                ZoomAll
      End Sub

Copia de objetos en un dibujo distinto

Este ejemplo crea objetos Circle y después utiliza el método CopyObjects para copiar los círculos en un dibujo nuevo.

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

          ' Define the Circle object
          centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
          radius1 = 5#: radius2 = 7#
          radius1Copy = 1#: radius2Copy = 2#
                ' Add two circles to the current drawing
          Set circleObj1 = ThisDrawing.ModelSpace.AddCircle _
                          (centerPoint, radius1)
          Set circleObj2 = ThisDrawing.ModelSpace.AddCircle _
                          (centerPoint, radius2)
          ThisDrawing.Application.ZoomAll
                ' Save pointer to the current drawing
          Set DOC0 = ThisDrawing.Application.ActiveDocument
                ' Copy objects
          '
          ' First put the objects to be copied into a form compatible
          ' with CopyObjects
          Set objCollection(0) = circleObj1
          Set objCollection(1) = circleObj2
                ' Create a new drawing and point to its model space
          Dim Doc1MSpace As AcadModelSpace
          Dim DOC1 As AcadDocument
                Set DOC1 = Documents.Add
          Set Doc1MSpace = DOC1.ModelSpace
                ' Copy the objects into the model space of the new drawing. A
          ' collection of the new (copied) objects is returned.
          retObjects = DOC0.CopyObjects(objCollection, Doc1MSpace)
                Dim circleObj1Copy As AcadCircle, circleObj2Copy As AcadCircle
                ' Get the newly created object collection and apply new
          ' properties to the copies.
          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