Слайд 2Окно менеджера проектов - если нет в списке проектов ни одного проекта
![Окно менеджера проектов - если нет в списке проектов ни одного проекта](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-1.jpg)
с локацией Global( 1 или 2) надо через кнопку New создать такой проект и встать ( выделить) его после чего нажать Macros
Слайд 3Набираем имя процедуры создаваемой- box и жмем Create
![Набираем имя процедуры создаваемой- box и жмем Create](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-2.jpg)
Слайд 4В открывшемся окне выбираем Global( 1 или 2)- ОК
![В открывшемся окне выбираем Global( 1 или 2)- ОК](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-3.jpg)
Слайд 5Появляется окно с началом программы и концом, между этими двумя операторами набираете
![Появляется окно с началом программы и концом, между этими двумя операторами набираете](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-4.jpg)
текст. Операторы с апострофом в начале строки являются комментариями .
Для сохранения проекта воспользуйтесь командой File- save Global
Для запуска процедуры-
Результат работы отображается в графическом окне Автокада
Слайд 6Рассмотрим синтаксис VBA на примере фрагмента кода, рисующего параллелепипед.
' Вставка параллелепипеда
Public Sub Box ()
![Рассмотрим синтаксис VBA на примере фрагмента кода, рисующего параллелепипед. ' Вставка параллелепипеда](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-5.jpg)
'объявляем переменные для использования в AddBox
Dim dCenter (0 To 2) As Double
'массив чисел с плавающей точкой (x,y,z)
Dim dLength As Double
' длина
Dim dWidth As Double
' ширина
Dim dHeight As Double
' высота
Dim MyBox As Acad3DSolid
' возвращаемое значение
' задание значений переменных:
dCenter (0) = 0#
' # указывает на двойную точность значений
dCenter (1) = 0#
' с плавающей точкой
Слайд 7dCenter (2) = 0#
' задание размеров параллелепипеда:
dLength = 10#
dWidth = 20#
![dCenter (2) = 0# ' задание размеров параллелепипеда: dLength = 10# dWidth](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-6.jpg)
dHeight = 30#
' создание чертежа параллелепипеда в пространстве модели
Set MyBox = ThisDrawing.ModelSpace.AddBox(dCenter, dLength, dWidth, dHeight)
' изменение точки обзора для лучшего осмотра
ThisDrawing.SendCommand ("_VPOINT 1,1,1 _Shademode Gouraud ")
End Sub
Слайд 8Если вы уже сохранили свою программу, и открываете автокад, то прежде чем
![Если вы уже сохранили свою программу, и открываете автокад, то прежде чем](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-7.jpg)
запустить процедуру, ее следует загрузить. Загрузку процедуры можно произвести двумя способами:
набрать в командной строке VbaLoad;
выделить команду Tools - Macro - Load Project.
При загрузке программа просит подтвердить намерение подключить макросы.
Запуск загруженной процедуры можно произвести двумя способами:
набрать в командной строке VbaRun;
выделить команду Tools - Macro - Macros.
В открывшемся диалоговом окне Macros выберите модуль, который хотите запустить, и щелкните по кнопке RUN.
Слайд 9Задание
Создание, сохранение и запуск процедур
Создайте новый чертеж. По команде Tools - Macro
![Задание Создание, сохранение и запуск процедур Создайте новый чертеж. По команде Tools](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-8.jpg)
- Visual Basic Editor откройте редактор процедур.
Вставьте модуль по команде Insert - Module. Дайте ему имя TORUS. Вставьте процедуру по команде Insert - Procedure. Установите тип Sub, имя DrawTorus, область видимости - Public.
Введите следующий код:
' Вставка тора на чертеж
Public Sub DrawTorus ()
'объявляем переменные для использования в AddTorus
Dim dCenter (0 To 2) As Double
'массив чисел с плавающей точкой (x,y,z)
Слайд 10Dim dRadius1 As Double
' радиус тора
Dim dRadius2 As Double
' радиус
![Dim dRadius1 As Double ' радиус тора Dim dRadius2 As Double '](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-9.jpg)
трубки тора
Dim MyTorus As Acad3DSolid
' возвращаемое значение
' задание значений переменных
:dCenter (0) = 0#
' # указывает на двойную точность значений
dCenter (1) = 0# ' с плавающей точкой
dCenter (2) = 0# ' задание размеров тора:
dRadius1 = 10#
dRadius2 = 2#
' создание чертежа тора в пространстве модели
Set MyTorus = ThisDrawing.ModelSpace.AddTorus(dCenter, dRadius1, dRadius2)
' изменение точки обзора для лучшего осмотра
ThisDrawing.SendCommand ("_VPOINT 1,1,1 _Shademode Gouraud ")
End Sub
Слайд 11Запуск процедуры
Поскольку эта процедура активна, ее не нужно загружать.
Щелкните по кнопке SAVE стандартной
![Запуск процедуры Поскольку эта процедура активна, ее не нужно загружать. Щелкните по](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-10.jpg)
панели инструментов и сохраните проект под именем TORUS.dvb в каталоге AutoCAD\Support.
Вернитесь в пространство модели. Выберите командуTools - Macro - Macros.
В открывшемся диалоговом окне Macros выберите процедуру DrawTorus и щелкните по кнопкеRUN.
Слайд 12Пример
Sub AddCircle ()
Dim vPt As Variant
Dim dRadius As Double
Dim myCircle As AcadCircle
vPt
![Пример Sub AddCircle () Dim vPt As Variant Dim dRadius As Double](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-11.jpg)
= ThisDrawing.Utility.GetPoint (, vbCrLf & "Введите точку центра: ")
dRadius = ThisDrawing.Utility.GetReal ("Введите радиус: ")
Set myCircle = ThisDrawing.ModelSpace.AddCircle (vPt, dRadius)
End Sub
Слайд 13Задание 2
Создать процедуру, получающую информацию от пользователя
Создайте новый чертеж. Выберите команду Tools -
![Задание 2 Создать процедуру, получающую информацию от пользователя Создайте новый чертеж. Выберите](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-12.jpg)
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 & "Задайте центральную точку: "
Слайд 14prompt2 = vbCrLf & "Задайте радиус: “
'получение центральной точки и радиуса от
![prompt2 = vbCrLf & "Задайте радиус: “ 'получение центральной точки и радиуса](/_ipx/f_webp&q_80&fit_contain&s_1440x1080/imagesDir/jpg/1126135/slide-13.jpg)
пользователя
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