Опубликован: 21.02.2012 | Уровень: специалист | Доступ: свободно
Лекция 8:

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

Создание диалоговых окон в VBA

Диалоговое окно создается в редакторе VBA в виде формы по команде Insert - UserForm. Возникает пустая форма, ограниченная маркерами. Одновременно возникают панель инструментов ToolBox (рис.8.1).

 Создание формы в редакторе VBA

увеличить изображение
Рис. 8.1. Создание формы в редакторе VBA

Как правило, оформление формы производят вручную, хотя можно это выполнить в программе. Элементы управления перетаскивают на форму мышью из панели ToolBox. Свойства выбирают или устанавливают в окне Properties.

На панели ToolBox имеются следующие элементы управления:

Кнопка Описание
Select Object Выделение объектов Предоставляет возможность выделить объект
Label Надпись Создает надпись в диалоговом окне
TextBox Поле Позволяет вводить текст
ComboBox Раскрывающийся список Объединяет возможности поля ввода и списка
ListBox Список Предоставляет возможность выбора элемента списка
CheckBox Флажок Создает флажок
OptionButton Переключатель Позволяет выбрать один параметр из нескольких возможных
ToggleButton Переключающая кнопка Создает переключатель "Вкл/Выкл"
Frame Рамка Создает прямоугольник вокруг группы элементов управления
CommandButton Командная кнопка Создает кнопку для запуска команды
TabStrip Строка вкладок Создает вкладки
MultiPage Страницы Создает несколько страниц
ScrolBar Полоса прокрутки Создает полосу прокрутки
SpinButton Кнопка прокрутки Дает возможность указать числовое значение
Image Изображение Вставляет рисунок

Задание 8.1

Создать три одинаковых тора . Радиусы малой и большой окружностей задать в диалоговом окне. Соединить все три тора либо в конструкцию "тор в торе" либо цепочкой. Закрасить торы в три последовательных цвета.

Составим таблицу элементов управления для UserForm:

Параметр Элемент Имя элемента
Диалог UserForm
Радиус малой окружности TextBox
Радиус большой окружности TextBox
Переключатель "Тор в торе" OptionButton
Переключатель "Цепочка" OptionButton
Переключатель "Красный" OptionButton
Переключатель "Желтый" OptionButton
Переключатель "Зеленый" OptionButton
Закрытие диалога CommandButton
Отказ от диалога CommandButton
Надписи Label

Разместим элементы на форме, например, так, как показано на рис.8.1. Текстовые надписи выполнены с помощью инструмента Label. Текстовые поля созданы элементом TextBox, а числовые значения вписаны в них в строке Text окна Properties. Переключатели (радиокнопки) установлены путем перетаскивания на форму элементов OptionButton. Кнопки с надписями OK и Cancel образованы элементом управления CommandButton. Имена элементам следует задавать близкие к выполняемым ими функциям.

При выделенной форме нужно открыть модуль и записать там процедуру инициализации. Наиболее краткая форма этой процедуры выглядит так:

Public Sub Torus()
TorsForm.Show
End Sub

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

Вставьте модуль и скопируйте в него следующий текст:


Private Sub Cancel_Click()
Unload Me
End Sub

Private Sub OK_Click()

Dim clr As Integer
Dim dCenter(0 To 2) As Double 'центр торов
Dim dY(0 To 2) As Double 'точка по Y
Dim dX(0 To 2) As Double ' точка по X
Dim toPointY(0 To 2) As Double 'точка по Y для смещения

Dim dRadius1           As Double                ' радиус тора
Dim dRadius2            As Double               ' радиус трубки тора
Dim dAng            As Double                  ' угол поворота тора
Dim MyTorus            As Acad3DSolid        ' тор
Dim Layer               As AcadLayer           'слой
Dim MyTorus1            As Acad3DSolid        ' тор
Dim Layer1               As AcadLayer       'слой
Dim MyTorus2            As Acad3DSolid        ' тор
Dim Layer2               As AcadLayer       'слой

            ' задание значений переменных:

'центр торов
dCenter(0) = 0#
dCenter(1) = 0#
dCenter(2) = 0#

'вторая точка для задания прямой вращения для поворота тора - прямая параллельна OY
dY(0) = 0#
dY(1) = 10#
dY(2) = 0#

'вторая точка для задания прямой вращения для поворота тора - прямая параллельна OX
dX(0) = 10#
dX(1) = 0#
dX(2) = 0#
' задание размеров тора:
'угол поворота вокруг осей
dAng = 3.14 / 2
dRadius2 = Val(TorsForm.smallRad.Text)
dRadius1 = Val(TorsForm.bigRad.Text)

'точка для перемещения
toPointY(0) = 0#
toPointY(1) = (4 * dRadius1) / 3

toPointY(2) = 0#

ThisDrawing.SendCommand ("_VSCURRENT R _VIEW Top ")
ThisDrawing.SendCommand ("setvar gridmode 0 ")
Set MyTorus1 = ThisDrawing.ModelSpace.AddTorus(dCenter, dRadius1, dRadius2)
If TorsForm.Red.Value Then clr = 1
If TorsForm.Yellow.Value Then clr = 2
If TorsForm.Green.Value Then clr = 3

Set MyTorus = ThisDrawing.ModelSpace.AddTorus(dCenter, dRadius1, dRadius2)
Call MyTorus.Rotate3D(dCenter, dY, dAng) 'поворот вокруг оси OY на 90

Set MyTorus2 = ThisDrawing.ModelSpace.AddTorus(dCenter, dRadius1, dRadius2)

If TorsForm.type1.Value Then
Call MyTorus2.Rotate3D(dCenter, dX, dAng) 'поворот вокруг оси OX на 90
Else
Call MyTorus.Move(dCenter, toPointY)
Call MyTorus2.Rotate3D(dCenter, dY, dAng) 'поворот вокруг оси OX на 90
toPointY(1) = -toPointY(1)
Call MyTorus2.Move(dCenter, toPointY)
End If

ThisDrawing.SendCommand ("_VPOINT 1,1,1 ")

'задание слоев, цветов торам
Set Layer1 = ThisDrawing.Layers.Add("Layer1") ' создание нового слоя
Layer1.color = clr 'задание слою цвета
MyTorus1.Layer = Layer1.Name 'присвоению тору нового слоя

Set Layer = ThisDrawing.Layers.Add("Layer")
Layer.color = clr + 1
MyTorus.Layer = Layer.Name

Set Layer2 = ThisDrawing.Layers.Add("Layer2")
Layer2.color = clr + 2
MyTorus2.Layer = Layer2.Name
Unload Me

End Sub
'изменяем демонстрационную картинку
Private Sub type1_Click()
TorsForm.Image1.Picture = LoadPicture(GetAppPath + "tor_in_tor.jpg")

End Sub
'изменяем демонстрационную картинку
Private Sub Type2_Click()
TorsForm.Image1.Picture = LoadPicture(GetAppPath + "chain.jpg")
End Sub

'получает директорию проекта
Public Function GetAppPath()
'путь к файлу проекта
Dim projFilePath As String
projFilePath = AcadApplication.ActiveDocument.Application.VBE.ActiveVBProject.FileName
'индекс последнего слэша в пути
Dim lastSlash As Integer
lastSlash = InStrRev(projFilePath, "\")
'директория проекта
GetAppPath = Replace(projFilePath, Replace(projFilePath, "\", "", lastSlash, Len(projFilePath) - lastSlash), "")
End Function

Private Sub UserForm_Initialize()
TorsForm.Image1.Picture = LoadPicture(GetAppPath + "tor_in_tor.jpg")
End Sub

Сохраните эту программу как файл Project_Torus.dvb. Картинки, приведенные ниже, сохраните в файлах Tor_in_tor.jpg и Chain.jpg. Файлы проекта и картинок поместите в одну папку.


Одной из задач программирования является организация интерактивности, т.е. возможности получения программой информации от пользователя. Это можно сделать двумя способами - из командной строки и через диалоговое окно.

Пример.

Рассмотрим обращение к объекту Utility. Он принадлежит объекту Document и управляет методами получения информации от пользователя.

Dim iReturn as Integer
iReturn = ThisDrawing.Utility.GetInteger ("Введите целое число: ")

Здесь переменной iReturn присваивается целое число, введенное пользователем в командную строку. Такой метод применяется для ввода коротких и простых данных: чисел, текста или объекта. Чтобы избежать появления нескольких приглашений в одной строке, используют константу vbCrLf в начале приглашения:

Prompt1 = vbCrLf & "Задайте центральную точку: "
Пример
Sub AddCircle ()
Dim vPt As Variant
Dim dRadius As Double
Dim myCircle As AcadCircle
vPt = ThisDrawing.Utility.GetPoint (, vbCrLf & "Введите точку центра: ")
dRadius = ThisDrawing.Utility.GetReal ("Введите радиус: ")
Set myCircle = ThisDrawing.ModelSpace.AddCircle (vPt, dRadius)
End Sub

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

Метод Синтаксис Описание
GetEntity Объект. GetEntity (объект, указанная точка, приглашение) Пользователь указывает объект. Метод возвращает объект и указанную точку. Пример: ThisDrawing.Utility. GetEntity(getObj,basePnt, "Выделите объект")
GetInteger Возвращаемое значение = GetInteger (Приглашение) Допустимо любое целое число в диапазоне от -32768 до 32767. Пример: getInt = ThisDrawing.Utility.GetInteger ("Введите целое число")
GetPoint Возвращаемое значение = GetPoint (точка, приглашение) Возвращает значение типа variant (оно содержит трехэлементный массив чисел типа double). Пользователь может указать точку или ввести ее координаты. Если имеется необязательный параметр точка, то AutoCAD прорисовывает "резиновую линию" от заданной точки до текущей позиции указателя. Пример: getPnt = ThisDrawing.Utility. GetPoint (, "Задайте точку: ")
GetReal Возвращаемое значение = GetReal (Приглашение) Получает вещественное (положительное или отрицательное число). Пример: GetReal = ThisDrawing.Utility.GetReal ("Введите вещественное число")
GetString Возвращаемое значение = GetString (содержит_пробелы, приглашение) Получение строки. Булев параметр содержит_пробел определяет, может ли получаемая строка содержать пробелы. Если параметр равен TRUE, то строка может содержать пробелы, а пользователь должен нажать ENTER для окончания ввода. Если значение параметра равно FALSE, то сигналом окончания ввода может служить не только нажатие ENTER, но знак пробела.

Упражнение

Создать процедуру, получающую информацию от пользователя

Создайте новый чертеж. Выберите команду Tools - Macro - VBA Manager. Щелкните по кнопке NEW, а затем по кнопке Visual Basic Editor. Выберите команду Insert - Module, а затем Insert - Procedure. Наберите в модуле следующий текст:

Public Sub HappyFace()
Dim prompt As String, prompt2 As String
Dim cen As Variant
Dim rad As Double
Dim cir As AcadCircle
Dim arc As AcadArc
Dim pi As Double
Dim dStart As Double 'начальный угол
Dim dEnd As Double 'конечный угол
pi = 3.1415
prompt = vbCrLf & "Задайте центральную точку: "
prompt2 = vbCrLf & "Задайте радиус: "
'получение центральной точки и радиуса от пользователя
cen = ThisDrawing.Utility.GetPoint(, prompt)
rad = ThisDrawing.Utility.GetDistance(cen, prompt2)
Set cir = ThisDrawing.ModelSpace.AddCircle(cen, rad)
'рисуем улыбку
dStart = 225 * pi / 180 'pi/180 - перевод в радианы
dEnd = 315 * pi / 180
Set arc = ThisDrawing.ModelSpace.AddArc(cen, rad / 2, dStart, dEnd)
'рисуем глаза
cen(0) = cen(0) - rad / 4
cen(1) = cen(1) + rad / 4
Set cir = ThisDrawing.ModelSpace.AddCircle(cen, rad / 8)
cen(0) = cen(0) + rad / 2
Set cir = ThisDrawing.ModelSpace.AddCircle(cen, rad / 8)
End Sub

Сохраните проект как Project_HappyFace.dvb в папке AutoCAD2007\Support. Вернитесь к чертежу и выберите команду Tools - Macro - Macros. В диалоговом окне выберите процедуру HappyFace и щелкните по кнопке Run. Ответьте на приглашения.

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

Как и во всех языках программирования, в VBA существует развитая технология поиска ошибок. Простейший сеанс отладки сводится к установке точек прерывания. Перейдите в редакторе в процедуру, где предполагается наличие ошибки. Поместите курсор в первую выполняемую строку и нажмите F9 или выберите команду Debug - Toggle Breakpoint. В строку будет добавлена точка прерывания.

Выполните операторы по одному, нажимая клавишу F8. На каждом шаге просматривайте значения переменных. При помещении указателя мыши на переменные типов Integer, Double, и String в подсказке выводится их текущее значение.

Когда ошибка обнаружена, выберите команду Run - Reset и внесите исправления в код. При следующем запуске процедуры точка прерывания останется активной. Отключить ее можно нажатием клавиши F9. Нормальный запуск процедуры можно осуществить командой Run Sub, либо нажатием клавиши F5.

Если программа зависает в редакторе Visual Basic, то выйдите в окно AutoCAD и прервите выполнение команды нажатием клавиши ESC.

Ключевые термины

Объектная модель AutoCAD - Иерархическая структура всех объектов AutoCAD.

Доступ - доступ к иерархии объектов, в частности, к свойствам и методам объекта Document, обеспечивается посредством объекта ThisDrawing.

Variant - тип, который может принимать данные любого типа, за исключением строк фиксированной длины и типов данных, определяемых пользователем.

Родительский объект - объект более высокого ранга. с которым данный объект постоянно связан. Все объекты имеют свойство Application, как непосредственную ссылку на корневой объект.

Пользовательская форма - диалоговое окно с элементами управления.

Реактор - процедура, которая дает возможность приложению реагировать на события, происходящие где угодно в AutoCAD.

Краткие итоги

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

Вопросы

  1. Каковы основные понятия объектной модели AutoCAD?
  2. Как обеспечивается связь VBA с активным чертежом AutoCAD?
  3. Каковы основные алгоритмы создания и редактирования примитивов?
  4. Как установить новые слои?
  5. Какие особенности работы с VBA в трех измерениях?
  6. Как создаются в VBA диалоговые окна?
Алексей Тимонин
Алексей Тимонин
Алексей Потапкин
Алексей Потапкин

Здравствуйте.

Подскажите, пожалуйста, каким образом можно передать параметры в макрос написанный в Autocad на VBA? Например, есть процедура, которая отрисовывает заштрихованный прямоугольник (см. ниже). Как её изменить, чтобы на входе от пользователя требовалось ввести также в качестве параметров координаты углов прямоугольника?

Public Sub DrawHatchedBox()

...

End Sub