Value Пример

Sub Example_Value()
    'Этот пример создает два объекта Circle и использует метод CopyObjects, 
    'чтобы скопировать их. Затем возвращает объектные ID новых 
    'объектов, используя свойство Value и использует объектные ID, чтобы 
    'удалить новые (целевые) объекты

    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
    Dim IDPairs As Variant
    Dim TargetObject As AcadObject
    
    'Определите объект 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
    
    'Объекты копии
    '
    'Сначала поместите объекты, которые будут скопированы в форму, совместимую с CopyObjects
    Set objCollection(0) = circleObj1
    Set objCollection(1) = circleObj2
    
    'Копия возвращает коллекцию новых объектов (копии)
    retObjects = ThisDrawing.CopyObjects(objCollection, , IDPairs)
    
    'Получите недавно созданный объект и примените новые свойства к копиям
    Set circleObj1Copy = retObjects(0)
    Set circleObj2Copy = retObjects(1)
    
    circleObj1Copy.radius = radius1Copy
    circleObj2Copy.radius = radius2Copy
        
    ThisDrawing.Application.ZoomAll
    ThisDrawing.Regen acAllViewports
    
    'Покажите объектный ID исходных объектов, используемых для копии
    MsgBox "Первый целевой объектный ID: " & IDPairs(0).value & vbCrLf & _
           "Второй целевой объектный ID: " & IDPairs(1).value

    'Этот ключ может использоваться с objectIDtoObject справочника исходных объектов, 
    'который является полезным, если пользователь вручную выбрал исходные объекты.
    '
    'Здесь мы удаляем исходные объекты по полученному ID
    Set TargetObject = ThisDrawing.ObjectIdToObject(IDPairs(0).value)
    TargetObject.Delete
    Set TargetObject = ThisDrawing.ObjectIdToObject(IDPairs(1).value)
    TargetObject.Delete
    
    ThisDrawing.Regen acAllViewports
    
    MsgBox "Целевые объекты были удалены!", vbInformation
End Sub
Сайт управляется системой uCoz