Key Пример |
Sub Example_Key() ' Этот пример создает два объекта Circle и использует метод CopyObjects, ' чтобы скопировать их. Затем возвращает ID исходных объектов, ' используя свойство Key и использует эти значения, чтобы удалить ' оригинальные (исходные) объекты 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 SourceObject 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).Key & vbCrLf & _ "Второй исходный объект ID: " & IDPairs(1).Key 'Это свойство может использоваться с objectIDtoObject и ' является удобным, если пользователь вручную выбрал исходные объекты. ' 'Удалите исходные объекты из полученного ID Set SourceObject = ThisDrawing.ObjectIdToObject(IDPairs(0).Key) SourceObject.Delete Set SourceObject = ThisDrawing.ObjectIdToObject(IDPairs(1).Key) SourceObject.Delete ThisDrawing.Regen acAllViewports MsgBox "Исходные объекты были только что удалены!", vbInformation End Sub