ДОСТУП К ИЕРАРХИИ ОБЪЕКТОВ

С использованием VBA это очень просто, т.к. VBA является одним из процессов порожденных текущей сессией Autocad нет необходимости в каких-либо дополнительных действиях для обеспечения связи с приложением.

Связь VBA с активным рисунком обеспечивается посредством объекта ThisDrawing. С его помощью можно получить немедленный доступ ко всем свойствам и методам объекта Document а так же ко всем другим объектам в иерархии.

Когда используются глобальные проекты ThisDrawing всегда ссылается на активный документ. При использовании внедренных проектов ThisDrawing всегда ссылается на документ содержащий проект. Например следующая строка кода в глобальном проекте сохраняет любой рисунок который в данный момент активен.

ThisDrawing.Save

ССЫЛКА НА ОБЪЕКТЫ В ИЕРАРХИИ ОБЪЕКТОВ

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

Sub Test()
  Dim startPoint(0 To 2) As Double, endPoint(0 To 2) As Double
  Dim LineObj As AcadLine
  startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
  endPoint(0) = 30: endPoint(1) = 20: endPoint(2) = 0
  Set LineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
End Sub
Для доступа к объекту через объектную переменную - определяем переменную желаемого типа, после чего устанавливаем переменную так чтобы она ссылалась на нужный объект. К примеру следующий код определят объектную переменную moSpace типа AcadModelSpace и делает так чтобы она ссылалась на текущее пространство модели.
Dim moSpace As AcadModelSpace
Set moSpace = ThisDrawing.ModelSpace
а следующие далее команды добавляют линию в пространство модели используя эту переменную.

Dim startPoint(0 To 2) As Double, endPoint(0 To 2) As Double
Dim LineObj as AcadLine
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 30: endPoint(1) = 20: endPoint(2) = 0
Set LineObj = moSpace.AddLine(startPoint,endPoint)

ДОСТУП К ОБЪЕКТУ APPLICATION (ПРИЛОЖЕНИЕ)

Так как объект ThisDrawing обеспечивает доступ к объекту Document, возникает вопрос, а как же получить доступ к корневому объекту Application, который расположен в иерархии выше объекта Document. Оказывается для этого у объекта Document есть свойство Application, которое и является ссылкой на объект Application. Например:

ThisDrawing.Application.Update

РАБОТАЕМ С КОЛЛЕКЦИЯМИ ОБЪЕКТОВ

Объект Collection - является предопределенным объектом содержащим все вхождения подобных объектов. Существуют следующие объекты коллекции:

ДОСТУП К КОЛЛЕКЦИИ

Большинство коллекций доступны через объект Document, т.к. он содержит свойства для каждой из коллекций. Следующий код устанавливает сслыку объектной переменной на коллекцию Layers

Dim layerCollection as AcadLayers
Set layerCollection = ThisDrawing.Layers
Коллекции Documents, MenuBar и MenuGroups доступны через объект Application. Он содержит свойства для каждой из этих коллекций. Следующий пример определяет объектную переменную и создает ссылку через нее на коллекцию.
Dim MenuGroupsCollection as AcadMenuGroups
Set MenuGroupsCollection = ThisDrawing.Application.MenuGroups

ДОБАВЛЕНИЕ НОВОГО ЧЛЕНА КОЛЛЕКЦИИ

Следующий пример создает слой и добавляет его в коллекцию
Dim newLayer as AcadLayer
Set newLayer = ThisDrawing.Layers.Add("MyNewLayer")

ПЕРЕБОР ЧЛЕНОВ КОЛЛЕКЦИИ

Для выбора нужного члена коллекции используется метод Item. В качестве параметра ему передается номер (Index) объекта в коллекции либо его символьный идентификатор. Пример демонстрирует перебор всех слоев с отображеним их имен
Sub IterateLayer()
  On Error Resume Next
  Dim I As Integer
  Dim msg As String
  msg = ""
  For I = 0 To ThisDrawing.Layers.count - 1
    msg = msg + ThisDrawing.Layers.Item(I).Name + vbCrLf
  Next
  MsgBox msg
End Sub
Пример поиска слоя с именем ABC

Sub FindLayerABC()
  On Error Resume Next
  Dim ABCLayer As AcadLayer
  Set ABCLayer = ThisDrawing.Layers.Item("ABC")
  If Err <> 0 Then
    MsgBox "Слой 'ABC' не существует"
  End If
End Sub
Примечание: Не следует использовать методы редактирования примитивов (Copy, Array, Mirror и др.) на любом объекте который одновременно перебирается с помощью механизма For Each. Если очень нужно - то закончите перебор, создав временный массив эквивалентный коллекции и на нем выполняйте редактирование.

УДАЛЕНИЕ ЧЛЕНА КОЛЛЕКЦИИ

Пример удаления слоя
Dim ABCLayer as AcadLayer
Set ABCLayer = ThisDrawing.Layers.Item("ABC")
ABCLayer.Delete
Если объект удален, то это навсегда, его можно только создать заново.

ПОНЯТИЕ СВОЙСТВ И МЕТОДОВ

Каждый объект обладает связанными с ним свойствами и методами. Свойства описывают некоторые характеристики присущие объекту, а методы позволяют выполнять действия над объектами, в т.ч. менять и читать свойства. К примеру объект окружность имеет свойство Центр, которое представляет трехмерную координату центра окружности. Чтобы сменить свойство достаточно задать ему другое значение. Так же окружность имеет метод Offset, который создает новый объект на указанном смещении от существующего. Полный перечень свойств и методов есть в ActiveX and VBA Reference.

ПОНЯТИЕ РОДИТЕЛЬСКОГО ОБЪЕКТА

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

БИБЛИОТЕКИ ТИПОВ

Описание объектов, свойств и методов хранятся в библиотеке типов, с помощью которой браузеры и приложения могут определить характеристики объектов. Прежде чем использовать объекты автоматизации следует создать ссылку на библиотеку типов. Это нужно для того, чтобы глобальные функции были доступны непосредственно без подготовки. Вызовы функций при этом могут контролироваться компилятором на корректность. Увеличивается надежность и читабельность программы.

ПОЛУЧЕНИЕ ПЕРВОГО ПРИМИТИВА ИЗ БАЗЫ ДАННЫХ РИСУНКА

Sub FindFirstEntity()
  On Error Resume Next
  Dim entity As AcadEntity
  If ThisDrawing.ModelSpace.count <> 0 Then
    Set entity = ThisDrawing.ModelSpace.Item(0)
    MsgBox entity.ObjectName + " первый примитив в пространстве модели."
  Else
    MsgBox "Нет ни одного объекта в пространстве модели."
  End If
End Sub

ПРИМЕНЕНИЕ VARIANT В МЕТОДАХ И СВОЙСТВАХ

Для передачи массива данных автокад использует тип Variant который может принимать данные любого типа за исключением строк фиксированной длины и типов данных определяемых пользователем. Может так же принимать значения Empty, Error, Nothing, NULL. Чтобы узнать какой именно тип данных хранятся в переменной типа Variant есть функции VarType или TypeName

Тип данных Variant используется для передачи массива данных из/в AutoCAD ActiveX Automation. В AutoCAD VBA входные массивы автоматически преобразуются в тип Variant, что значит что при использовании VBA все ОК, однако c выходными массивами не так просто. Метод CreateTypedArray преобразует массив в Variant, содержащий "смесь" из Integer, Double и т.д. Эту адскую смесь можно передать в любой метод или любое свойство AutoCAD которые принимают массив чисел как Variant

Лучше всего видно на примере. Он преобразует три массива координат сплайна, и передает его методу AddSpline.

Sub CreateSplineUsingTypedArray()
  Dim splineObj As AcadSpline
  Dim startTan As Variant, endTan As Variant, fitPoints As Variant
  Dim noOfPoints As Integer
  Dim utilObj As Object
  Set utilObj = ThisDrawing.Utility
  ' Определение сплайна
  utilObj.CreateTypedArray startTan, vbDouble, 0.5, 0.5, 0
  utilObj.CreateTypedArray endTan, vbDouble, 0.5, 0.5, 0
  utilObj.CreateTypedArray fitPoints, vbDouble, 0, 0, 0, 5, 5, 0, 10, 0, 0
  noOfPoints = 3
  Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
  ZoomAll
End Sub

ИНТЕРПРЕТАЦИЯ VARIANT-МАССИВОВ

Передаваемая AutoCAD ActiveX Automation информация массива возвращается как тип Variant, если типы данных элементов массива известны, то нет проблем, иначе применяем функции VarType Typename. Для перебора элементов массива удобно For Each. Пример вычисления расстояния между двумя точками введенными пользователем

Sub CalculateDistance()
  Dim point1 As Variant,point2 As Variant
  ' Запрос на ввод координат
  point1 = ThisDrawing.Utility.GetPoint (, vbCrLf & "1-ая точка: ")
  point2 = ThisDrawing.Utility.GetPoint (point1, vbCrLf & "2-ая: ")
  Dim x As Double, y As Double, z As Double
  Dim dist As Double
  x = point1(0) - point2(0)
  y = point1(1) - point2(1)
  z = point1(2) - point2(2)
  dist = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
  MsgBox "Расстояние между точками: " & dist
End Sub

ИСПОЛЬЗОВАНИЕ ДРУГИХ ЯЗЫКОВ ПРОГРАММИРОВАНИЯ

Чтобы использовать приведенные примеры не в VBA а в VB следует во-первых сослаться на автокадовскую библиотеку типов, во-вторых заменить все ссылки ThisDrawing Для этого определить переменную для приложения автокад (myApp) и для активного документа (myDoc). Если Автокад запущен метод GetObject возвращает объект AutoCAD Application, если не запущен вызывается обработчик ошибок. Затем метод CreateObject пытается создать объект AutoCAD Application. Смотри следующий пример:
Sub ConnectToAcad()
  Dim acadApp As AcadApplication
  On Error Resume Next
  Set acadApp = GetObject(, "AutoCAD.Application")
    If Err Then
      Err.Clear
      Set acadApp = CreateObject("AutoCAD.Application")
    If Err Then
      MsgBox Err.Description
      Exit Sub
    End If
  MsgBox "Запушен " + acadApp.Name + " версии " + acadApp.Version
End Sub
' Далее установить ссылку на Document object в приложении Автокад
Dim acadDoc as AcadDocument
Set acadDoc = acadApp.ActiveDocument
Здесь уже используем acadDoc переменную для ссылки на текущий рисунок автокад.

Если запущены несколько сессий Автокад функция GetObject возвращает первое вхождение из Windows Running Object Table (ROT).

Следующий пример демонстрирует создание линии в VB и VBA

Sub AddLineVBA()
  Dim lineObj As AcadLine
  Dim startPoint(0 To 2) As Double,endPoint(0 To 2) As Double
  ' Определим начальные и конечные координаты линии
  startPoint(0) = 1: startPoint(1) = 1: startPoint(2) = 0
  endPoint(0) = 5: endPoint(1) = 5: endPoint(2) = 0
  Set lineObj = ThisDrawing.ModelSpace.AddLine (startPoint, endPoint)
  ZoomExtents
End Sub

Sub AddLineVB()
  On Error Resume Next
  ' Подключение к приложению Автокад
  Dim acadApp As AcadApplication
  Set acadApp = GetObject (, "AutoCAD.Application")
  If Err Then
    Err.Clear
    Set acadApp = CreateObject ("AutoCAD.Application")
  If Err Then
    MsgBox Err.Description
    Exit Sub
  End If
  ' Подключение к рисунку Автокад
  Dim acadDoc As AcadDocument
  Set acadDoc = acadApp.ActiveDocument
  Dim lineObj As AcadLine
  Dim startPoint(0 To 2) As Double
  Dim endPoint(0 To 2) As Double
  startPoint(0) = 1: startPoint(1) = 1: startPoint(2) = 0
  endPoint(0) = 5: endPoint(1) = 5: endPoint(2) = 0
  Set lineObj = acadDoc.ModelSpace.AddLine (startPoint, endPoint)
  ZoomExtents
End Sub
Читать дальше - В начало - На главную