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