Копирование нескольких объектов или в другой документ

Для этого есть метод CopyObjects или копирование через создание массива а потом методом Copy. Для копирования объектов набора, перебором его элементы засылаются в массив. Перебирая элементы массива, каждый копируется по отдельности в другой массив. Примеркопированиянескольких:

Sub CopyCircleObjects() Dim ACADApp As AcadApplication 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 ' Определимокружность centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0 radius1 = 5#: radius2 = 7# radius1Copy = 1#: radius2Copy = 2# ' Получимссылкунаобъект Application Set ACADApp = GetObject(, "AutoCAD.Application") ' Создадимновыйрисунок Set DOC1 = ACADApp.Documents.Add' Добавим в него пару окружностейSet circleObj1 = DOC1.ModelSpace.AddCircle(centerPoint, radius1) Set circleObj2 = DOC1.ModelSpace.AddCircle(centerPoint, radius2)ZoomExtents ' Поместим копируемые объекты в форму совместимую с CopyObjectsSet objCollection(0) = circleObj1 Set objCollection(1) = circleObj2' Копируем и получаем новую коллекцию retObjects = DOC1.CopyObjects(objCollection) ' Получаем вновь созданные объекты и применяем свойства к копиямSet circleObj1Copy = retObjects(0) Set circleObj2Copy = retObjects(1) circleObj1Copy.Radius = radius1Copy circleObj1Copy.Color = acRed circleObj2Copy.Radius = radius2Copy circleObj2Copy.Color = acRedZoomExtentsEnd Sub

Смещение объектов

Смещение объекта создает его копию на определенном расстоянии от оригинала. Смещению могут подвергаться дуги, окружности, эллипсы, линии, полилинии, сплайны и некоторые другие. Метод Offset принимает единственный параметр - это дистанция на которую следует сместить объект. Если его значение отрицательное, AutoCAD пытается построить уменьшенный объект (для окружностей), если это не имеет смысла, то объект строится с координатами меньшими текущего. Для многих объектов результат операции - новая кривая, которая может не быть подобной оригиналу. Например при смещении эллипса образуется сплайн. В некоторых случаях может потребоваться чтобы смещение создало несколько кривых, поэтому метод может создавать массив объектов. Примерсмещения полилини

Sub OffsetPolyline() Dim plineObj As AcadLWPolyline Dim points(0 To 11) As Double points(0) = 1: points(1) = 1 points(2) = 1: points(3) = 2 points(4) = 2: points(5) = 2 points(6) = 3: points(7) = 2 points(8) = 4: points(9) = 4 points(10) = 4: points(11) = 1 Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) plineObj.Closed = True ZoomExtents Dim offsetObj As Variant offsetObj = plineObj.Offset(0.25) offsetObj(0).Color = acRedZoomExtents End Sub

Отражение объекта

Данный метод создает зеркальную копию объекта относительно координатной оси или заданной линии. Действует на любые объекты. В отличие от команды Mirror метод Mirror не удаляет оригинальный объект, для удаления следует воспользоваться методом Erase. Принимает два параметра - координаты точек принадлежащих линии относительно которой будет отражаться объект.

Для управления свойствами отражения текстовых объектов используется системная переменная MIRRTEXT. Значение по умолчанию 1, говорит о том, что текст отражается как и другие объекты, а значение 0 приводит к тому, что текст не меняется при отражении объекта его содержащего. Пример отражения полилини по оси:

Sub MirrorPolyline() Dim plineObj As AcadLWPolylineDim points(0 To 11) As Double points(0) = 1: points(1) = 1 points(2) = 1: points(3) = 2 points(4) = 2: points(5) = 2 points(6) = 3: points(7) = 2 points(8) = 4: points(9) = 4 points(10) = 4: points(11) = 1 Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) plineObj.Closed = True ZoomExtents ' Определимосьотражения Dim point1(0 To 2) As Double,point2(0 To 2) As Double point1(0) = 0: point1(1) = 4.25: point1(2) = 0 point2(0) = 4: point2(1) = 4.25: point2(2) = 0 ' Отразим полилинию и покажем другим цветомDim mirrorObj As AcadLWPolyline Set mirrorObj = plineObj.Mirror(point1, point2) mirrorObj.Color = acRed ZoomExtentsEnd Sub

Создание массива объектов

Объект могут быть помещены в полярный или прямоугольный массив. Для полярного массива можно менять количество объектов и угол, для прямоугольного - число строк и столбцов, а так же расстояние между ними.

Создание полярного массива

Метод ArrayPolar выбранного объекта требует количество объектов, угол и центральную точку массива. Число объектов должно быть не меньше 1, угол в радианах не равный нулю (положительный угол против часовой стрелки), центр массива - переменная типа Variant, содержащая массив координат Double. AutoCAD определяет расстояние от центральной точки массива до референс-точки исходного объекта. Референс-точка зависит от типа объекта. (Для окружности и дуги это центр, для блока - точка вставки, для текста - начальная точка и т.д) Данный метод не поддерживает вращение в процессе копирования в отличие от команды ARRAY. Примерсозданияполярногомассива

Sub ArrayingACircle() Dim circleObj As AcadCircle Dim center(0 To 2) As Double, radius As Double center(0) = 2#: center(1) = 2#: center(2) = 0#: radius = 1 Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius) ZoomExtents ' Задаемполярныймассив Dim noOfObjects As Integer Dim angleToFill As Double Dim basePnt(0 To 2) As Double noOfObjects = 4 angleToFill = 3.14 ' 180 градусов basePnt(0) = 4#: basePnt(1) = 4#: basePnt(2) = 0# ' Создаем 4 копии объекта, вращением и копированием' относительноточки (3,3,0). Dim retObj As Variant retObj = circleObj.ArrayPolar(noOfObjects, angleToFill, basePnt)ZoomExtentsEnd Sub