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

Извлечение информации из атрибутов

Для извлечения атрибутов есть два метода GetAttributes и GetConstantAttributes. Первый из них возвращает массив атрибутных ссылок присоединенных к блоку. Второй метод возвращает массив постоянных атрибутов (не ссылок). По полученному массиву можно пройти, просматривая свойства TagString и TextString для получения информации о каждом атрибуте. Пример извлечения атрибутов:

Sub GettingAttributes()
    ' Создаем блок
    Dim blockObj As AcadBlock
    Dim insPnt(0 To 2) As Double
    insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insPnt, "TESTBLOCK")
    
    ' определим атрибуты
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1#
    mode = acAttributeModeVerify
    prompt = "Attribute Prompt"
    insPoint(0) = 5: insPoint(1) = 5:insPoint(2) = 0
    tag = "Attr Tag"
    value = "Attr Value"
    ' Создаем определение атрибута в блоке
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insPoint, tag, value)

    ' Вставим блок
    Dim blockRefObj As AcadBlockReference
    insPnt(0) = 2: insPnt(1) = 2: insPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insPnt, "TESTBLOCK", 1, 1, 1, 0)
    ZoomAll
    
    ' Получить атрибуты для блочной ссылки
    Dim varAttributes As Variant
    varAttributes = blockRefObj.GetAttributes
    
    ' Поместим Тэг и содержимое текстовой части
    ' атрибута в Msgbox
    Dim strAttributes As String
    strAttributes = ""
    Dim I As Integer
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes + "  Tag: " + _
        varAttributes(I).TagString + vbCrLf + _
        "   Value: " + varAttributes(I).textString
    Next
    MsgBox "Атрибуты для блочной ссылки " + _
                   blockRefObj.Name & " : " & vbCrLf & strAttributes
    
   ' Изменим значение атрибута
   ' Не SetAttributes. Если есть массив то он является объектом.
   ' Изменение его изменяет объекты чертежа.
    varAttributes(0).textString = "NEW VALUE!"
    
    ' Снова получим атрибуты
    Dim newvarAttributes As Variant
    newvarAttributes = blockRefObj.GetAttributes
    
    ' Снова отобразим
    strAttributes = ""
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes + "  Tag: " + _
        newvarAttributes(I).TagString + vbCrLf + _
        "   Value: " + newvarAttributes(I).textString
    Next
    MsgBox "Атрибуты для блочной ссылки " & _
                  blockRefObj.Name & " : " & vbCrLf & strAttributes
End Sub    

Использование внешних ссылок

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

При открытии или печати рисунка Autocad перезагружает каждую внешнюю ссылку, чтобы отобразить ее в "свежайшем" виде. В отличие от блока при вставке внешней ссылки в чертеж вставляется только определение, а не сам файл. Если файл внешней ссылки отсутствует или поврежден, то Autocad его просто не отображает. Если значение системной переменной VISRETAIN=On Autocad сохраняет любую информацию о зависимых от внешней ссылки слоях в базе данных чертежа и она используется при следующем открытии. Можно вставлять неограниченное число внешних ссылок. Можно также управлять слоями и типами линий внешней ссылки. Для добавления внешней ссылки используйте метод AttachExternalReference. Он требует путь и имя вставляемого файла, имя ссылки, точку вставки, масштаб и угол вращения и возвращает объект ExternalReference. Пример:

Sub AttachingExternalReference()
    On Error GoTo ERRORHANDLER
    Dim InsPoint(0 To 2) As Double
    Dim insertedBlock As AcadExternalReference
    Dim tempBlock As AcadBlock
    Dim msg As String, PathName As String
    
    ' определим внешнюю ссылку
    InsPoint(0) = 1: InsPoint(1) = 1: InsPoint(2) = 0
    PathName = "c:/acad2002/sample/db_samp.dwg"
    
    ' Отобразим информацию о блоках
    GoSub ListBlocks
    
    ' Добавим внешнюю ссылку
    Set insertedBlock = ThisDrawing.ModelSpace. _
    AttachExternalReference(PathName, "XREF_IMAGE", InsPoint, 1, 1, 1, 0, False)
    ZoomExtents
    
    ' Отобразим информацию о блоках
    GoSub ListBlocks
    Exit Sub
ListBlocks:
    msg = vbCrLf
    For Each tempBlock In ThisDrawing.Blocks
        msg = msg & tempBlock.Name & vbCrLf
    Next
    MsgBox "Блоки в чертеже: " & msg
    Return
    
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Наложение внешних ссылок подобно присоединению, отличие только в том, как обрабатываются вложенные ссылки. В случае наложения - вложенные ссылки просто не отображаются. Наложение удобно использовать толгда когда конечному потребителю не нужны дополнительные детали созданного вами чертежа, который используется в качестве внешней ссылки. То есть этот тип ссылок предназначен для совместного использования данных. Кроме того, он позволяет избежать цикличесских ссылок. Чтобы ссылка была наложением, измените параметр метода AttachExternalReference на bOverlay=TRUE. Для исключения ссылки из рисунка нужно его оттсоединить, можно также стереть конкретное вхождение ссылки. Ссылка самоуничтожается при следующем открытии чертежа, если уже нет ни одного ее вхождения. Для отсоединения ссылки используй метод Detach. Нельзя, однако, отсоединить вложенную ссылку. Пример отсоединения ссылки:

Sub DetachingExternalReference()
    On Error GoTo ERRORHANDLER
                          
    ' Определим внешнюю ссылку
    Dim xrefHome As AcadBlock
    Dim xrefInserted As AcadExternalReference
    Dim insertionPnt(0 To 2) As Double
    Dim PathName As String
    insPnt(0) = 1: insPnt(1) = 1: insPnt(2) = 0
    PathName = "c:/acad2002/sample/db_samp.dwg"
    
    ' Добавим внешнюю ссылку
    Set xrefInserted = ThisDrawing.ModelSpace. _
        AttachExternalReference(PathName, "XREF_IMAGE", insPnt, 1, 1, 1, 0, False)
    ZoomExtents
    MsgBox "Внешняя ссылка присоединена."
    
    ' Остосединим внешнюю ссылку
    Dim name As String
    name = xrefInserted.name
    ThisDrawing.Blocks.Item(name).Detach
    MsgBox "Внешняя ссылка отсоединена."
    Exit Sub
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Выгрузка внешних ссылок

Для ускорения работы часть (или все) внешних ссылок можно выгрузить методом Unload. Пример:

Sub UnloadingExternalReference()
    On Error GoTo ERRORHANDLER
                          
    ' Определим внешнюю ссылку
    Dim xrefHome As AcadBlock
    Dim xrefInserted As AcadExternalReference
    Dim insPnt(0 To 2) As Double
    Dim PathName As String
    insPnt(0) = 1: insPnt(1) = 1: insPnt(2) = 0
    PathName = "c:/AutoCAD/sample/db_samp.dwg"
    
    ' Добавим внешнюю ссылку
    Set xrefInserted = ThisDrawing.ModelSpace. _
        AttachExternalReference(PathName, "XREF_IMAGE", insPnt, 1, 1, 1, 0, False)
    ZoomExtents
    MsgBox "Добавлена внешняя ссылка."
    
    ' Выгрузим определение внешней ссылки
    ThisDrawing.Blocks.Item(xrefInserted.name).Unload
    MsgBox "Внешняя ссылка выгружена."
    Exit Sub
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Привязка внешней ссылки

Привязка внешней ссылки делает ее постояннной частью рисунка, а не внешней ссылкой. То есть она становится блоком, отсюда следует что при изменении чертежа внешней ссылки в основном чертеже никаких изменений не получим. После привязки любые именованные объекты (блоки, размерные стили, слои, типы линий и стили текста) могут использоваться в основном рисунке. Метод Bind требует только один параметр bPrefixName, если он равен TRUE, то символьные имена получают префикс по имени блока + цифровой идентификатор. В противном случае символьные имена сливаются с уже существующими и при наличии совпадаений оставляются уже определенные в основном рисунке. Если Вы не уверены, будут ли в связываемой внешней ссылке дублироваться имена, используйте TRUE. Пример связывания:

Sub BindingExternalReference()
    On Error GoTo ERRORHANDLER
                          
    ' Определим внешнюю ссылку
    Dim xrefHome As AcadBlock
    Dim xrefInserted As AcadExternalReference
    Dim insPnt(0 To 2) As Double
    Dim PathName As String
    insPnt(0) = 1: insPnt(1) = 1: insPnt(2) = 0
    PathName = "c:/AutoCAD/sample/db_samp.dwg"
    
    ' Добавим внешнюю ссылку
    Set xrefInserted = ThisDrawing.ModelSpace. _
        AttachExternalReference(PathName, "XREF_IMAGE", insPnt, 1, 1, 1, 0, False)
    ZoomExtents
    MsgBox "Внешняя ссылка присоединена."
    
    ' Привяжем определение внешней ссылки
    ThisDrawing.Blocks.Item(xrefInserted.name).Bind False
    MsgBox "Внешняя ссылка связана."
    Exit Sub
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Не существует метода для обрезки блока или внешней ссылки в ActiveX, поэтому, если очень нужно, используйте метод SendCommand, вызывая команду XCLIP.

Загрузка по требованию и повышение производительности внешних ссылок

Комбинируя загрузку по требованию и сохранение чертежа с индексами можно увеличить скорость работы рисунков с внешними сслыками. Загрузка по требованию работает совместно с системными переменными XLOADCTL и INDEXCTL. Когда включена загрузка по требованию (при условии что были сохранены индексы в подчиненных рисунках), Autocad загружает в память только данные, которые нужны для регенирации текущего чертежа. Наиболее заметен выигрыш в производительности при использовании загрузки по требованию, когда внешняя ссылка подрезана и пространственный индекс сохранен во внешнем рисунке, а также в случае заморозки некоторых слоев внешней ссылки, а чертеж-внешняя ссылка сохранен с индексом слоя. Чтобы включить загрузку по требованию, есть свойство XRefDemandLoad. Если оно включено с параметром acDemandLoadEnabledWithCopy, Autocad создает временную копию файла внешней ссылки и загружает по требованию временный файл. При этом исходный файл внешней ссылки можно в этот момент редактировать. А когда загрузка по требованию отменена, Autocad загружает весь файл внешней ссылки, не обращая внимание на видимость слоев или обрезку. Для включения слоев и пространственных индексов установи значение переменной INDEXCTL таким образом - (0 - не создавать индексы, 1 - создать индекс слоев, 2 - создать пространственный индекс, 3 - создать оба индекса).

Пространственный индекс - список примитивов и данных их положения в трехмерном пространстве (используется при частичном открытии файла).

Индекс слоев - список слоев с перечнем объектов на них. По умолчанию файлы создаются без индексов.

Назначение и чтение расширенных данных

Объектам могут назначаться расширенные данные (дополнительная информация). Примеры установки и чтения:

Sub AttachXDataToSelectionSetObjects()
    ' Создаем набор
    Dim sset As Object
    Set sset = ThisDrawing.SelectionSets.Add("SS1")
    
    ' Предложим пользователю выбрать объекты
    sset.SelectOnScreen
    
    ' Определим расширенные данные
    Dim appName As String, xdataStr As String
    appName = "MY_APP"
    xdataStr = "Пример xdata (дополнительных данных)"
    Dim xdataType(0 To 1) As Integer
    Dim xdata(0 To 1) As Variant
    
    ' Зададим значения для каждого массива
    ' 1001 = appName
    xdataType(0) = 1001
    xdata(0) = appName
    ' 1000 отображает строковое значение
    xdataType(1) = 1000
    xdata(1) = xdataStr
    
    ' Проходим по элементам набора и устанавливаем
    ' каждому расширенные данные
    Dim ent As Object
    For Each ent In sset
        ent.SetXData xdataType, xdata
    Next ent
End Sub

Sub ViewXData()
    ' Ищем набор, созданный в предыдущем примере
    Dim sset As Object
    Set sset = ThisDrawing.SelectionSets.Item("SS1")
    
    ' Создаем переменные для хранения расширенных данных
    Dim xdataType As Variant
    Dim xdata As Variant
    Dim xd As Variant
    
    Dim xdi As Integer
    xdi = 0
    
    ' Проходим по всем объектам набора, читая расширенные данные
    Dim msgstr As String
    Dim appName As String
    Dim ent As AcadEntity
    appName = "MY_APP"
    For Each ent In sset
        msgstr = ""
        xdi = 0
        
        ' Имя приложения (appName) xdata Тип и Значение
        ent.GetXData appName, xdataType, xdata
        
        ' Если переменная xdataType не инициализирована, не
        ' будет appName xdata
        If VarType(xdataType) <> vbEmpty Then
            For Each xd In xdata
                msgstr = msgstr & vbCrLf & xdataType(xdi) & ": " & xd
                xdi = xdi + 1
            Next xd
        End If
        
        ' Если полученная строка пуста (NULL), нет расширенных данных
        If msgstr = "" Then msgstr = vbCrLf & "NONE"
        MsgBox appName & " xdata " & ent.ObjectName & ":" & vbCrLf & msgstr
    Next ent
End Sub

Разработка приложений с помощью vba

Далее последует краткий обзор методам обработки ошибок, управления фокусом окон и создания дистрибутивов.

Для отображения и скрытия формы используются методы Show и Hide

Public Sub MyApplication()
   UserForm1.Show
   UserForm1.Hide
End Sub

Все формы в VBA модальные, то есть пока их не закроешь невозможно что-либо править в чертеже. Когда форма скрыта уже возможно кое-что править. Форму можно загрузить, но сразу не отображать. С целью освобождения памяти ненужные формы можно выгружать методом Unload.

Все диалоговые окна в VBA также модальны, то есть если применяешь диалоговое окно в котором от пользователя ожидается выбор элементов на рисунке путем их указания следует сначала скрыть окно диалога, а по окончании выбора - показать.

Из трех типов ошибок (периода компиляции, логических и периода выполнения) обработать программным путем в полной мере можно только последние. Их следует отслеживать в местах наиболее вероятного появления и обрабатывать. Обработчик по-умолчанию только отображает окно с кодом ошибки и предлагает либо перейти в отладчик, либо завершить выполнение программы. Обычно обработчики ошибок ставятся в тех местах, где ожидается ввод от пользователя или файловый ввод-вывод. Для обработки ошибок в VBA используется оператор On Error который имеет три формы:

• On Error Resume Next
• On Error Goto Label
• On Error Goto 0

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

Sub ColorEntities()
    Dim entry As Object
    On Error Resume Next
    For Each entry In ThisDrawing.ModelSpace
        entry.Color = acRed
    Next entry
End Sub

Вариант On Error GoTo Label используется, если нужно написать особый обработчик ошибки:

Sub ColorEntities2()
    Dim entry As Object
    On Error GoTo MyErrorHandler
    For Each entry In ThisDrawing.ModelSpace
        entry.Color = acRed
    Next entry
    ' Важно! Выйти из программы чтобы не нарваться на обработчик ошибок
    Exit Sub
MyErrorHandler:
    Msgbox entry.EntityName + " на блокированном слое." + " хэндл: " + entry.Handle
    Resume Next
End Sub

Вариант On Error GoTo 0 отменяет текущий обработчик ошибок. Обработка ошибок завершается окончанием процедуры обработчика, новым обработчиком ошибок или переходом по "нулевой" метке.

Объект Err обладает следующими свойствами Number, Description, Source, HelpFile, HelpContext, и LastDLLError. Наиболее важны из них первые три (код ошибки, ее описание и источник). Использование метода InitializeUserInput перед получением ввода от пользователя ограничивает количество возможных ошибок.

Зашифровать и защитить паролем программу на VBA возможно через Tools=>Project>Properties=>Protection.

Чтобы запустить макрос VBA из командной строки

 -VBARUN Filename.dvb!projectname.macroname

При этом указывать имя файла проекта нужно только в случае если он еще не загружен в текущем сеансе.

Автозагрузка проекта на VBA возможна двумя способами:

При загрузке Autocad просматривает каталог, откуда он запущен, на предмет наличия файла acad.dvb который и выполняется, если найден.

Любой другой проект можно включить в автозагрузку посредством команды VBALOAD.

В следующем примере используется файл автозагрузки autolisp для запуска VBA и запуска проекта myproj.dvb. Эти строчки нужно добавить в acad.lsp

(defun S::STARTUP()
   (command "_VBALOAD" "myproj.dvb")
)
Для автоматического выполнения макроса из acad.dvb можно сделать так 

(defun S::STARTUP()
   (command "_VBARUN" "drawline")
)

Также при загрузке VBA автовыполняется макрос с именем AcadStartup.

Работа с VBA когда не открыт ни один документ

Если ни один документ не открыт, то возникнут следующие особенности:

• объект ThisDrawing в данный момент не определен, поэтому любое обращение к нему вызовет ошибку;
• не определены все документозависимые объекты, но доступны, например объекты Application или MenuBar;
• отсутствует командная строка.

Распространение программ

Возможны два варианта - внедрение в файл чертежа или отдельным файлом. В отдельном файле удобно хранить общие процедуры.

Взаимодействие с другими приложениями, базами данных и windows api

Для взаимодействия с другими приложениями через ActiveX нужно выполнить три основных операции:

• установить ссылку на другое приложение;
• создать экземпляр этого приложения;
• написать программу, использующую методы и свойства приложения.

Чтобы сделать ссылку на объектную библиотеку другого приложения, нужно в меню Tools - References указать нужное, после чего в окне просмотрщика объектов будут доступны объекты другого приложения. Чтобы создать экземпляр приложения, например, MSExcel, объявляется переменная-ссылка

Dim ExcelAppObj as Excel.Application 
и устанавливается указатель
Set ExcelAppObj = New Excel.Application

По окончании работы нужно закрыть запущенный экземпляр приложения: ExcelAppObj.Application.Quit. Пример переноса атрибутов из Autocad в Excel:

Sub Extract()
    Dim Excel As Excel.Application
    Dim ExcelSheet As Object
    Dim ExcelWorkbook As Object

    Dim RowNum As Integer,Header As Boolean
    Dim elem As AcadEntity,Array1 As Variant
    Dim Count As Integer
   ' Запуск Excel.
   Set Excel = New Excel.Application

   ' Создаем книгу Excel и ищем активный лист
   Set ExcelWorkbook = Excel.Workbooks.Add
   Set ExcelSheet = Excel.ActiveSheet
   ExcelWorkbook.SaveAs "Attribute.xls"

   RowNum = 1
   Header = False
   ' Проходим по пространству модели в поисках блочных ссылок
   For Each elem In ThisDrawing.ModelSpace
     With elem
         ' Если найдена блочная ссылка проверить атрибутоы
         If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
            If .HasAttributes Then
               ' Читаем атрибуты
               Array1 = .GetAttributes
               ' Копируем их в Excel
               For Count = LBound(Array1) To UBound(Array1)
                   If Header = False Then
                     If StrComp(Array1(Count).EntityName, "AcDbAttribute", 1) = 0 Then
                        ExcelSheet.Cells(RowNum, Count + 1).value = Array1(Count).TagString
                     End If
                   End If
               Next Count
               RowNum = RowNum + 1
               For Count = LBound(Array1) To UBound(Array1)
                   ExcelSheet.Cells(RowNum, Count + 1).value = Array1(Count).textString
               Next Count
               Header = True
            End If
         End If
     End With
   Next elem
   Excel.Application.Quit
End Sub

Работа с DAO (Data Access Object) для доступа к базам данным

С помощью DAO можно работать с любой базой данных, поддерживающих интерфейс Microsoft Jet, (Access, dBase, FoxPro, Paradox, а также базами данных ODBC MS SQL Server и Oracle). Возможности следующие: создание БД, изменение структуры, добавление таблиц, определение связей между ними, создание и выполнение запросов, добавление, изменение или удаление записей. Для всего это нужно выполнить три основных шага:

1. Создать ссылку на объектную библиотеку MS DAO.
2. Открыть базу данных.
3. Написать код, используя объектные модели Autocad и DAO.

Для выполнения первого из этих шагов следует в среде VBA IDE выбрать пункт меню Tools - References и поставить галочку против Microsoft DAO Object Library. После чего все объекты, методы и свойства DAO станут доступными для просмотра в "просмотрщике" объектов. Причем установленная ссылка действует только для текущего проекта.

Второй шаг (открытие базы данных) можно выполнить так:

Dim db As Database
Set db = DBEngine.Workspaces(0).OpenDatabase("C:\TEST.MDB")

Наиболее важным и часто используемым объектом в DAO является объект RecordSet представляющий набор записей, возвращаемых таблицей на основе запроса SQL. Вообще по этому поводу необходимо ознакомиться со справочной системой Microsoft Access.

Доступ к Windows API из VBA

Функции Windows API доступны для любых приложений и позволяют реализовать все возможности программирования под Windows. Чтобы этим воспользоваться, следует сначала объявить функцию Windows API, с помощью оператора Declare. В качестве параметров требуется указание имени динамической библиотеки (DLL), содержащей нужную функцию, имя процедуры как она называется в DLL, имя процедуры, как она будет называться в вашей программе, параметров процедуры, которые она ожидает, типа возвращаемых данных, если процедура вызывается как функция.

Оператор Declare можно поместить в любое место программы, так если его поместить в стандартном модуле, то процедура будет доступна для любого модуля программы, если конечно не ограничить диапазон ее действия ключевым словом Private. Если объявить процедуру в модуле формы или класса, то она только там и будет доступна. Использование оператора Declare довольно сложно и требует хороших знаний от программиста, т.к. очень легко ошибиться, что может привести к тяжелым последствиям. Для облегчения данного процесса Microsoft создала специальные файлы в которых уже прописано объявление большинства часто используемых процедур. Они хранятся в файле Win32api.txt, поставляемым совместно с Visual Basic и Office. За дополнительной информацией обращаться к MSDN.