CopyObjects Пример

Sub Example_CopyObjects()
    ' Этот пример создает объект Circle и использует метод CopyObjects
    ' чтобы сделать копию нового Circle.

    Dim DOC1 As AcadDocument
    Dim circleObj1 As AcadCircle, circleObj2 As AcadCircle
    Dim circleObj1Copy As AcadCircle, circleObj2Copy 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 DOC1 = Documents.Add
    
    ' Добавьте два круга к рисунку
    Set circleObj1 = DOC1.ModelSpace.AddCircle(centerPoint, radius1)
    Set circleObj2 = DOC1.ModelSpace.AddCircle(centerPoint, radius2)
    ThisDrawing.Application.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
    circleObj2Copy.radius = radius2Copy
        
    ThisDrawing.Application.ZoomAll
    
    MsgBox "Скопированные круги."
End Sub
Сайт управляется системой uCoz