Программирование на VBA

Доступ к командной строке autocad

Имитировать ввод команд в командную строку с возможностью передачи параметров команде позволяет метод SendCommand. Пробел в данной строке эквивалентен нажатию Enter. Вызов данного метода без аргументов не допускается.

Следующий пример создает окружность с центром (2,2,0) и радиусом 4.

Sub SendACommandToAutoCAD()
ThisDrawing.SendCommand "_Circle 2,2,0 4 "
ThisDrawing.SendCommand "_zoom a "
End Sub

Обратите внимание на пробел в конце каждой строки.

Если не открыт ни один документ

Несмотря на то, что Autocad всегда стартует с пустым или открытым документом существует возможность закрыть все документы, при этом главное меню сократится до 4-х пунктов (File, View, Window, Help), а также пропадет командная строка. Интерфейс ActiveX в данном случае позволяет выполнять только следующие действия

• Открыть документ
• Создать документ
• Импортировать документ
• Выйти из Autocad

Эти действия доступны для всей коллекции Documents, кроме того методы и свойства данной коллекции ограничены набором методов и свойств объекта Application. Свойство Count коллекции Documents открыт ли хоть один документ .If Documents.Count > 0 Then открыт как минимум один документ. Здесь важно также заметить, что объект ThisDrawing не определен, если не открыт ни один документ, поэтому попытка выполнить макрос с ThisDrawing приведет к ошибке периода выполнения. Вместо этого используй функцию GetObject.

Импорт файлов других форматов

Метод Import позволяет импортировать файлы форматов DXF, SAT, BMP, PostScript. Он принимает три параметра: имя файла, точку вставки и фактор масштабирования.

Экспорт в другие форматы

Метод Export поддерживает следующие форматы: WMF, SAT, EPS, DXF, DWF, BMP. Он принимает три параметра: имя создаваемого файла, тип создаваемого файла и набор экспортируемых объектов. При экспорте в WMF, SAT или BMP должен существовать непустой набор. В EPS и DXF экспортируется весь рисунок.

Пример эскпорта-импорта в DXF

Sub ImportingAndExporting()
  ' Созадим окружность, чтоб было что экспортировать
  Dim circleObj As AcadCircle
  Dim centerPt(0 To 2) As Double,radius As Double
  centerPt(0) = 2: centerPt(1) = 2: centerPt(2) = 0: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
  ThisDrawing.Application.ZoomExtents
  ' Создадим пустой набор
  Dim sset As AcadSelectionSet
  Set sset = ThisDrawing.SelectionSets.Add("NEWSSET")
  ' Экспорт в файл C:\DXFExprt, если каталог не существует - ошибка
  Dim exportFile As String
  exportFile = "C:\DXFExprt"
  ThisDrawing.Export exportFile, "DXF", sset
  ' Определим импорт
  Dim importFile As String
  Dim insertPoint(0 To 2) As Double
  Dim scalefactor As Double
  importFile = "C:\DXFExprt.dxf"
  insertPoint(0) = 0: insertPoint(1) = 0: insertPoint(2) = 0: scalefactor = 2#
  ' Импортируем файл
  ThisDrawing.Import importFile, insertPoint, scalefactor
  ThisDrawing.Application.ZoomExtents
End Sub

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

Создание различных объектов возможно как в пространстве листа, так и в пространстве модели, кроме того объекты могут входить в состав блоков. Обычно для создания объекта используется метод Add. После того как объект создан можно изменять его свойства слой, цвет, тип линий и т.д.

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

Несмотря, на то что Autocad> может создать один и тот же объект разными путями, ActiveX автоматизация допускает только один метод на объект. Например, для создания окружности можно указать 1. центр и радиус 2. две точки, задающие диаметр, 3. три точки определяющие окружность, 4. два тангенса и радиус. Однако ActiveX позволят воспользоваться только первым из них.

Примечание: метод VB и VBA CreateObject или Dim позволяют создать только объект Autocad Application, все остальные объекты создаются методами Add и Add[Object] .

Определение объекта-контейнера

Объекты создаются в коллекциях ModelSpace, PaperSpace или объекте Block. На объект можно сослаться непосредственно или через объектную переменную. Непосредственная ссылка включает всю иерархию:

Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint,endPoint)

Для ссылки на объект через объектную переменную следует создать переменную типа AcadModelSpace или AcadPaperSpace. И установить ссылку на нужное свойство активного документа. В следующем примере две объектные переменные ссылаются на Model Space и PaperSpace соответственно:

Dim moSpace As AcadModelSpace
Dim paSpace As AcadPaperSpace
Set moSpace = ThisDrawing.ModelSpace
Set paSpace = ThisDrawing.PaperSpace

В следующей строке в пространство модели добавляется линия через объектную переменную:

Set lineObj = moSpace.AddLine(startPoint,endPoint)

Создание линий

Возможно создание различных типов линий - проcто линия, мультилиния, мультилиния с дуговыми сегментами. Обычно для обрисовки линий задаются координаты вершин. Тип линии по умолчанию непрерывный. Методы для создания линий:

• AddLine - создает линию по двум точкам;
• AddLightWeightPolyline - создает двумерную полилинию;
• AddMLine - создает мультилинию;
• AddPolyLine - создает двумерную или трехмерную полилинию.

Стандартные линии и мультилини создаются в плоскости XY полилинии создаются в Object Coordinat System. Пример создания полилини:

Sub AddLightWeightPolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 5) As Double
  ' Вершины двумерной полилини
  points(0) = 2: points(1) = 4
  points(2) = 4: points(3) = 2
  points(4) = 6: points(5) = 4
  ' Создаем полилинию в пространстве модели
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  ThisDrawing.Application.ZoomExtents
End Sub

Создание криволинейных объектов

Все подобные объекты (эллипсы, сплайны, дуги, окружности) строятся в плоскости XY мировой системы координат. Для их создания используется один из следующих методов:

• AddArc - дуга через центр, радиус, начальная точка и конечный угол;
• AddCircle - окружность через центр и радиус;
• Addellipse - эллипс через центр, точку на главной оси и радиус кривизны;
• AddSpline - кривая.

Пример создания сплайна

Sub CreateSpline()
  Dim splineObj As AcadSpline
  Dim noOfPoints As Integer
  Dim startTan(0 To 2) As Double
  Dim endTan(0 To 2) As Double
  Dim fitPoints(0 To 8) As Double
  ' Определение переменных
  noOfPoints = 3
  startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0
  endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0
  fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
  fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
  fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0
  ' Собственно сплайн
  Set splineObj = ThisDrawing.ModelSpace.AddSpline (fitPoints, startTan, endTan)
  ZoomExtents
End Sub

Более подробная информация о сплайнах в AutoCAD ActiveX and VBA Reference.

Создание точки

Стиль создаваемой точки и ее размер можно указать в относительных единицах к размеру экрана или в абсолютных. Управление видом точек делается через системные переменные PDMODE, PDSIZE. Значения переменной PDMODE равные 0,2,3,4 представляют разные формы точки, значение равное 1 - означает невидимую точку. Добавление 32, 64 или 96 означает вокруг точки фигуру (окружность, квадрат, окружность вписанную в квадрат). Значение переменной PDSIZE равное нулю задает размер точки 5% от размера экрана, а любые положительные значения - абсолютный размер. Отрицательные же значения интерпретируются как процент от размера видового экрана. Размер всех точек пересчитывается при регенерации, т.е. изменение PDMODE, PDSIZE сразу не заметно. Для установки значений системных переменных используется метод SetVariable, ниже приведен пример его применения:

Sub CreatePoint()
  Dim pointObj As AcadPoint
  Dim location(0 To 2) As Double
  ' Определение положения точки
  location(0) = 5#: location(1) = 5#: location(2) = 0#
  ' Ставим точку
  Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
  ThisDrawing.SetVariable "PDMODE", 34
  ThisDrawing.SetVariable "PDSIZE", 1
  ZoomExtents
End Sub

Создание сплошной заливки

Возможно создание треугольной и прямоугольной области со сплошной заливкой. Наиболее быстрый способ - создание области при выключенной системной переменной FILLMODE и затем включение ее. Последовательность второй и четвертой точки области определяют способ заливки (слева направо и сверху вниз - если 1,2,3,4 то прямоугольная, если 1,2,4,3 то треугольная). Первые две точки задают сторону полигона. Для создания области со сплошной заливкой есть метод AddSolid. Пример объекта с заливкой.

Sub CreateSolid()
  Dim solidObj As AcadSolid
  Dim point1(0 To 2) As Double,point2(0 To 2) As Double
  Dim point3(0 To 2) As Double,point4(0 To 2) As Double
  ' Определение сплошной заливки
  point1(0) = 0#: point1(1) = 0#: point1(2) = 0#
  point2(0) = 5#: point2(1) = 0#: point2(2) = 0#
  point3(0) = 5#: point3(1) = 8#: point3(2) = 0#
  point4(0) = 0#: point4(1) = 8#: point4(2) = 0#
  Set solidObj = ThisDrawing.ModelSpace.AddSolid (point1, point2, point3, point4)
  ZoomExtents
End Sub

Создание регионов

Регион представляет двухмерную замкнутую фигуру, границы которой не имеют внутренних пересечений. Может состоять из комбинации линий, окружностей, дуг, эллипсов, эллиптических дуг, сплайнов и некоторых других объектов. Весь объект должен лежать в одной плоскости. Трехмерная полилиния может быть преобразована в регион путем "взрыва". К региону применима штриховка и тень, у него есть свойства - площадь и момент инерции. Создав фигуры можно выбрав их создать регион, используя метод AddRegion. AutoCAD преобразует замкнутые двумерные и трехмерные планарные полилинии в отдельные регионы, а полилинии, линии и кривые образуют замкнутые планарные петли. Если более двух кривых разделяют конечную точку результирующий регион может быть присужден. (arbitrary) используйте Variant для хранения вновь создаваемых массивов регионов. Для подсчета количества созданных объектов Region используйте UBound(objRegions) - LBound(objRegions) + 1, где objRegions переменная Variant содержащая массив возвращенный методом AddRegion. Пример простого региона из одной окружности:

Sub CreateRegion()
  ' Определим массив хранящий границы региона
  Dim curves(0 To 0) As AcadCircle
  ' Создаем окружность как границу региона
  Dim center(0 To 2) As Double,radius As Double
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 5#
  Set curves(0) = ThisDrawing.ModelSpace.AddCircle (center, radius)
  ' Теперь сам регион
  Dim regionObj As Variant
  regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
  ZoomExtents
End Sub

Создание составных регионов

Путем вычитания, комбинирования и нахождения пересечений регионов или 3-мерных заливок можно создать составной регион, для чего применяется метод Boolean. При вычитании регионов этот метод применяется к первому из них. Пример:

Sub CreateCompositeRegions()
  ' Создадим две окружности - одна комната, вторая ковер в ней
  Dim RoomObjects(0 To 1) As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 4: center(1) = 4: center(2) = 0: radius = 2#
  Set RoomObjects(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
  radius = 1#
  Set RoomObjects(1) = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ' Теперь регион из двух окружностей
  Dim regions As Variant
  regions = ThisDrawing.ModelSpace.AddRegion(RoomObjects)
  ' Скопируем его в переменную для простоты использования
  Dim RoundRoomObj As AcadRegion,PillarObj As AcadRegion
  If regions(0).Area > regions(1).Area Then
    ' Первый регион - комната
    Set RoundRoomObj = regions(0)
    Set PillarObj = regions(1)
  Else
    ' Первый регион - ковер
    Set PillarObj = regions(0)
    Set RoundRoomObj = regions(1)
  End If
  ' Окрасим комнату и ковер разными цветами
  RoundRoomObj.Color = acRed
  PillarObj.Color = acCyan
  ZoomExtents
  ' Отнимем площадь ковра от площади комнаты
  RoundRoomObj.Boolean acSubtraction, PillarObj
  MsgBox "Площадь ковра: " & RoundRoomObj.Area
End Sub

Для объединения регионов вызывайте метод Boolean и вводите константу acUnion, для операции вместо acSubtraction, а для пересечения acIntersection.

Создание штриховок

Штриховки заполняют указанную область рисунка образцом. При ее создании сначала следует создать объект Hatch методом AddHatch. Ассоциированная штриховка привязана к определенным границам и меняется вместе с ними. Привязка может быть задана только при создании штриховки, после этого штриховку можно отвязать, но нельзя привязать снова. Чтобы сделать штриховку ассоциированной следует использовать параметр Associativity=TRUE для метода AddHatch, а для разрыва связи Associativity=FALSE.

Назначение имени и типа штриховке

В AutoCAD есть сплошная заливка и более 15 штриховок применяемых в производстве. Штриховка подчеркивает отельную часть рисунка или области. Поддерживаются внешние библиотеки с образцами штриховок. Для указания уникального образца следует давать полное имя и тип штриховки. Тип штриховки указывает местоположение образцов штриховки. acHatchPatternTypePredefined (в acad.pat), acHatchPatternTypeUserDefined (используя текущий тип линий), acHatchPatternTypeCustomDefined (из другого pat-файла).

Задание границ штриховки

Как только создан объект Hatch можно добавлять границы штриховки. Они могут задаваться комбинацией линий, дуг, окружностей, двумерных полилиний, эллипсов, сплайнов и регионов. Первая граница должна быть внешней границей штриховки, (метод AppendOuterLoop). Внутренние границы задаются методом AppendInnerLoop. Они определяют незаштрихованные "островки" внутри штрихованной области. Пример штриховки.

Sub CreateHatch()
  Dim hatchObj As AcadHatch
  Dim patternName As String
  Dim PatternType As Long
  Dim bAssociativity As Boolean
  ' Определение штриховки
  patternName = "ANSI31"
  PatternType = 0
  bAssociativity = True
  ' Создать связанный объект штриховку
  Set hatchObj = ThisDrawing.ModelSpace.AddHatch (PatternType, patternName, bAssociativity)
  ' Внешняя граница - окружность
  Dim outerLoop(0 To 0) As AcadEntity
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 3: center(1) = 3: center(2) = 0: radius = 1
  Set outerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
  hatchObj.AppendOuterLoop (outerLoop)
  hatchObj.Evaluate
  ThisDrawing.Regen True
End Sub

Редактирование объектов

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

Работа с именованными объектами и их переименование

Именованные объекты это блоки, слои, группы, размерные стили и т.п. Чистка именованных объектов на которые в текущем рисунке нет ссылок осуществляется методом ThisDrawing.PurgeAll.

По мере усложнения чертежа может возникать необходимость давать объектам другие более осмысленные имена. Переименовать можно почти все, кроме, например, 0 слоя и типа линий continuose. Имя может быть длиной до 255 символов (буквы, цифры, спецсимволы кроме тех которые используются самим AutoCADом < > / \ " : ; ? * | = ' и запятая). Пример переименования

Sub RenamingLayer()
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("NewLayer")
  layerObj.Name = "MyLayer"
End Sub

Выбор объектов

Набор представляет собой группу объектов AutoCAD указанных для обработки как одно целое. Набор может состоять из объектов разных слоев, разных цветов и т.п. Создание набора двухступенчатый процесс. Сначала создается набор и включается в коллекцию SelectionSets. Затем идет работа с объектами, входящими в набор. Для создания именованного набора используем метод Add.

Sub CreateSelectionSet()
  Dim selectionSet1 As AcadSelectionSet
  ' Создание набора
  Set selectionSet1 = ThisDrawing.SelectionSets.Add("NewSelectionSet")
End Sub

Добавление объектов в набор

Добавление объектов в набор может осуществляется одним из следующих методов:

• AddItem - добавляет один или более объектов в набор;
• Select - выбирает объекты и помещает в активный набор, можно выбрать все объекты, выбрать секущей или прямоугольной рамкой, последний созданный, из последнего созданного набора, окном или полигоном;
• SelectAtPoint - выбрать объекты проходящие через данную точку;
• SelectByPolygon - выбрать объекты полигоном;
• SelectOnScreen - запросить у пользователя указания объектов.

Sub AddToASelectionSet()
  Dim sset As AcadSelectionSet
  Set sset = ThisDrawing.SelectionSets.Add("SS1")
  ' Запрос объектов от пользователя, Enter - конец ввода
  sset.SelectOnScreen
  ' Пройтись по набору и перекрасить его в синий
  Dim entry As AcadEntity
  For Each entry In sset
    entry.Color = acBlue
    entry.Update
  Next entry
End Sub

Фильтрация набора

Фильтрация набора объектов (например по цвету, типу объекта) осуществляется через список фильтров. При этом фильтрация по цвету различает только цвета явно назначенные объектам, но не унаследованные от слоя (!). Для применения механизма фильтрации используется тип фильтра и данные фильтра, которые сортируются. AutoCAD ActiveX автоматизация использует DXF-коды групп для указания типа фильтров. Наиболее часто используемые фильтры перечислены ниже.

Примеры различных фильтров

FilterType = 0
FilterData = "TEXT"
sset.SelectOnScreen FilterType, FilterData
' Только линии
FilterType = 0
FilterData = "LINE"
sset.SelectOnScreen FilterType, FilterData
' Только со слоя FLOOR9
FilterType = 8
FilterData = "FLOOR9"
sset.SelectOnScreen FilterType, FilterData
' Только синие (5)
FilterType = 62
FilterData = 5
sset.SelectOnScreen FilterType, FilterData

Удаление объектов из набора

При выборе всех объектов в набор может быть необходимость исключить объекты, это делается следующими методами:

• RemoveItems - удаляет один или более объект из набора, но не из рисунка;
• Clear - очищает набор, не удаляя его;
• Erase - удаляет объекты из рисунка, очищая набор;
• Delete - удаляет набор, не трогая объекты.

Пример:

Sub AddToASelectionSet()
  Dim sset As AcadSelectionSet
  On Error GoTo ErrHandle

  ' создали произвольный набор, он пока пустой
  Set sset = ThisDrawing.SelectionSets.Add("SS1")
  ' Запрос объектов от пользователя, Enter - конец ввода
  sset.SelectOnScreen
  ' Пройтись по набору и перекрасить его в синий
  Dim entry As AcadEntity
  For Each entry In sset
    entry.Color = acBlue: entry.Update
  Next entry
  ThisDrawing.Application.ZoomExtents
  GoSub LISTOBJS

  Dim keyWord As String
  Dim gpCode(0) As Integer
  Dim dataValue(0) As Variant
  Dim groupCode As Variant, dataCode As Variant

  ThisDrawing.Utility.InitializeUserInput 1, "RemoveItem Clear Delete Erase Quit"
  keyWord = ThisDrawing.Utility.GetKeyword(vbCrLf & "RemoveItem/Clear/Delete/Erase/Quit")

  Select Case keyWord
  Case "RemoveItem"
    ' отбор по группе (62) Цвет, номер цвета (5) - синий
    gpCode(0) = 62: dataValue(0) = 5
    ' Методу будут передаваться переменные типа вариант, ссылающиеся на массивы
    groupCode = gpCode: dataCode = dataValue
    ' Собственно отбор по цвету
    sset.Select acSelectionSetAll, , , groupCode, dataCode
    GoSub LISTOBJS
    vsego = sset.Count - 1
    ' Если размер массива removeObjects задать больше чем число
    ' объектов в наборе, то метод RemoveItems выдаст ошибку, поэтому ReDim
    ReDim removeObjects(0 To vsego) As AcadEntity
    ' пройтись по SelectionSet
    For i = 0 To vsego
      Set removeObjects(i) = sset.Item(i)
      ' установить ссылки на объекты которые исключим из набора
      ' а именно те, что разукрасили синим
    Next

    GoSub LISTOBJS
    sset.RemoveItems removeObjects
    GoSub LISTOBJS

  Case "Clear": sset.Clear: GoSub LISTOBJS

  Case "Delete": sset.Delete: GoSub LISTOBJS

  Case "Erase": sset.Erase: GoSub LISTOBJS

  Case Else
  Exit Sub

  End Select

  sset.Delete
  Exit Sub

LISTOBJS:
  If sset.Count = 0 Then
     MsgBox "набор пуст"
  Else
     MsgBox "Набор содержит: " & sset.Count & " объектов"
  End If
  Return

ErrHandle:
  MsgBox Err.Description
End Sub

Копирование объектов

Объекты рисунка могут быть копированы, в том числе на определенное смещение от оригинала. Можно так же создать зеркальное отображение объекта относительно заданной линии. Объекты могут размножаться через прямоугольный или округлый шаблон. Нельзя только использовaть эти методы одновременно с перебором элементов коллекции, сначала следует завершить перебор. Для копирования единичного объекта метод Copy позволяет создать его дубликат по тем же координатам.

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

Для этого есть метод 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

  ' Поместим копируемые объекты в форму совместимую с CopyObjects
  Set 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 = acRed
  ZoomExtents
End 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 = acRed
  ZoomExtents

End Sub

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

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

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

Sub MirrorPolyline()
  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 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
  ZoomExtents
End 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)
  ZoomExtents
End Sub

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

Метод ArrayRectangular позволяет создать двумерный или трехмерный прямоугольный массив. Он требует число строк, столбцов, расстояния между ними, при создании трехмерного массива требуется так же указать количество уровней и расстояния между ними. Если задать одну строку, то следует указать несколько столбцов и наоборот. Предполагается что оригинальный объект расположен в левом нижнем углу массива, а сам массив создается вверх и вправо. Если нужно вниз и влево, задавай отрицательные расстояния между строками и столбцами.

AutoCAD строит прямоугольный массив вдоль базовой линии, определенной текущим углом привязки. По умолчанию равен нулю, столбцы и строки ортогональны в соответствии с расположением осей XY. Для изменения этого угла есть свойство SnapRotationAngle . Пример трехмерного прямоугольного массива

Sub ArrayRectangularExample()
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double, radius As Double
  center(0) = 2#: center(1) = 2#: center(2) = 0#: radius = 0.5
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ZoomExtents

  ' Определим прямоугольный массив
  Dim numOfRows As Long, numOfColumns As Long, numOfLevels As Long
  Dim distBwtnRows As Double, distBwtnColumns As Double, distBwtnLevels As Double
  numOfRows = 5: numOfColumns = 5: numOfLevels = 2
  distBwtnRows = 1: distBwtnColumns = 1: distBwtnLevels = 1

  ' Создадим массив
  Dim retObj As Variant
  retObj = circleObj.ArrayRectangular(numOfRows, numOfColumns, numOfLevels,_
  distBwtnRows, distBwtnColumns, distBwtnLevels)
  ZoomExtents
End Sub