|
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