Рис.15. Тор с вырезанным сегментом – фигура вращения, виток спирали – экструдированная фигура

VBA-приложение целесообразно разрабатывать в среде VBA AutoCAD, так как программа предполагает выполнение геометрических расчетов, включающих в себя решение систем нелинейных уравнений и вычисление производных функций. Для решения таких задач удобно воспользоваться программой Mathcad, а управляющие формы, процедуры геометрических построений и преобразований выполнить в среде VBA AutoCAD.

Проект может включать в себя:

- управляющую форму с возможностью внесения исходных данных и запуска процедур обработки данных и построения на выполнение;

- документы Mathcad, осуществляющие математическую обработку данных;

- временные ASCII-файлы данных для обмена данными между Mathcad и AutoCAD;

- процедуры построений на поле чертежа AutoCAD и вспомогательные процедуры, размещенные в модулях, а также процедуры, размещенные как процедуры обработки событий управляющих элементов формы (кнопок, полей, полей со списком) в объекте «форма».

Использование в проекте временных ASCII-файлов существенно упрощает процесс обмена данными между приложениями, но является самой медленной технологией. Файлы создаются при необходимости в директории c:\Windows\Temp и удаляются после их использования.

Этапы разработки приложения.

1-й этап – разработка схемы проекта:

2-й этап – создание макроса, запускающего на выполнение форму:

- запускаем редактор Visual Basic: “СервисМакросРедактор Visual Basic” (ToolsMacroVisual Basic Editor);

- в редакторе с помощью команды «ВставкаМодуль» (InsrtModule) создаем новый модуль VBA-проекта, а затем командой «ВставкаПроцедура» (InsertProcedure) создаем процедуру, в которую заносим одну команду:

Sub Start_01() имя макроса

Start.Show команда вывода на экран формы Start

End Sub

Результат выполнения макроса – появление на экране формы по имени Start. Формы с таким именем пока нет, мы ее создадим позже.

3-й этап – создание управляющей формы:

- в редакторе Visual Basic командой «ВставкаФорма» (InsertUserForm) создаем объект «форма»;

- в окне свойств в графе Имя (Name) изменяем имя формы на Start;

- пользуясь панелью элементов управления создаем кнопки и поля, в окне свойств для каждого элемента задаем необходимые параметры: имена, надписи, цвет фона, шрифт и т.д. Форма принимает вид рис.16

Рис.16. Управляющая форма

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

Описание общих для проекта переменных

Option Explicit

Public FileName As String

Public Flag As String

Dim M(0 To 23) As Double

Public h As Double

Public B As Double

Public Gamma As Double

Public Epsil As Double

Установка фокуса в текстовом окне «Глубина в см» при открытии формы

Private Sub UserForm_Activate()

TextBox1.SetFocus

End Sub

Чтение данного (глубина) из окна как числа при выходе из окна

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

TextBox1.Text = Val(TextBox1.Text)

h = TextBox1.Text

End Sub

Чтение данного (ширина) из окна как числа при выходе из окна

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

TextBox2.Text = Val(TextBox2.Text)

B = TextBox2.Text

End Sub

Чтение данного (угол установки) из окна как числа при выходе из окна

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)

TextBox3.Text = Val(TextBox3.Text)

Gamma = TextBox3.Text

End Sub

Чтение данного (угол врезания) из окна как числа при выходе из окна

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)

TextBox4.Text = Val(TextBox4.Text)

Epsil = TextBox4.Text

End Sub

Создание файла, запись в него данных по нажатию кнопки «Ввод»

Private Sub CommandButton5_Click()

Dim q As String

Проверка правильности ввода исходных данных

If h <= 0 Then

q = MsgBox("Глубина должна быть >0. Повтори ввод!", 0)

ElseIf B <= 0 Then

q = MsgBox("Ширина должна быть >0. Повтори ввод!", 0)

ElseIf Gamma <= 0 Or Gamma > 90 Then

q = MsgBox("Угол установки задан неверно. Повтори ввод!", 0)

ElseIf Epsil <= 0 Or Epsil > 90 Then

q = MsgBox("Угол врезания задан неверно. Повтори ввод!", 0)

Else

Ввод имени файла данных

FileName = "c:\Windows\Temp\data.dat" 'имя файла обмена данными

FileName = InputBox("Введите имя файла для записи", "Запись", FileName)

If FileName = "" Then

q = MsgBox("Не задано имя файла!", 0)

GoTo End2

End If

On Error GoTo End1

'Открытие файла для передачи данных в Mathcad-программу

Open FileName For Output Shared As #1

Write #1, h, B, Gamma, Epsil 'Write comma-delimited data.

Close #1

Flag = "yes" 'флаг наличия файла данных

End If

End2:

Exit Sub

End1:

q = MsgBox("Ошибка открытия файла!", 0)

End0:

End Sub

Вызов программы Mathcad расчета направляющей кривой по нажатию кнопки «Направляющая кривая»

Private Sub CommandButton2_Click()

Dim Arm

Dim MCadFileName

Dim ProjectFileName

Dim q As String

Если существует файл данных:

If Flag = "yes" Then 'флаг наличия файла данных

Открытие и выполнение Mathcad-программы

MCadFileName = "c:\Program Files\Mathsoft\Mathcad\mcad.exe"

MCadFileName = InputBox("Введите путь к программе Mathcad", "Открытие Mathсad", MCadFileName)

If MCadFileName = "" Then

q = MsgBox("Неверный путь к программе!", 0)

Exit Sub

End If

ProjectFileName = "c:\Plug-Project\Plug1_VB.mcd"

ProjectFileName = InputBox("Введите имя проекта", "Имя проекта", ProjectFileName)

If ProjectFileName = "" Then

q = MsgBox("Неверный путь к файлу!", 0)

Exit Sub

End If

On Error GoTo End1

Запуск программы расчета Mathcad в режиме активного окна

Arm = Shell(MCadFileName + " " + ProjectFileName, 3)

Открытие формы Hello после выхода из программы Mathcad

Hello.Show

Exit Sub

Else

q = MsgBox("Файл данных не создан", 0)

End If

End Sub

Вызов программы Mathcad расчета профиля и контура по нажатию кнопки «Лобовое сечение и контур»

Private Sub CommandButton3_Click()

Dim Arm

Dim MCadFileName

Dim ProjectFileName

Dim q As String

If Flag = "yes" Then 'флаг наличия файла данных

Открытие и выполнение Mathcad-программы

MCadFileName = "c:\Program Files\Mathsoft\Mathcad\mcad.exe"

MCadFileName = InputBox("Введите путь к программе Mathcad", "Открытие Mathсad", MCadFileName)

If MCadFileName = "" Then

q = MsgBox("Неверный путь к программе!", 0): Exit Sub

End If

ProjectFileName = " c:\Plug-Project\Plug2_VB.mcd"

ProjectFileName = InputBox("Введите имя проекта", "Имя проекта", ProjectFileName)

If ProjectFileName = "" Then

q = MsgBox("Неверный путь к файлу!", 0): Exit Sub

End If

On Error Exit Sub

Запуск программы расчета Mathcad в режиме активного окна

Arm = Shell(MCadFileName + " " + ProjectFileName, 3)

Открытие формы Hello после выхода из программы Mathcad

Hello.Show

Exit Sub

Else

q = MsgBox("Файл данных не создан", 0)

End If

End Sub

Чтение результатов расчета из ASCII-файла, закрытие формы и вызов подпрограммы рисования лобового сечения по нажатию кнопки «Лобовое сечение»

Private Sub CommandButton1_Click()

Dim alfa1 As String

Dim q As String

Dim i As Single

Dim FileName1 As String

FileName1 = "c:\Windows\Temp\profil" 'имя файла обмена данными

If Flag = "yes" Then

'Открытие файла для чтения данных после работы Mathcad-программы

Open FileName1 For Input As #1

i = 0

Do While Not EOF(1)

M(i) = Val(Input(8, #1)) 'Чтение результатов в массив М

alfa1 = Input(2, #1)

i = i + 1

Loop

Close #1 'Закрытие файла данных

Закрытие формы Start и вызов процедуры построения лобового сечения Profil(M, h, B)

Start.Hide

Call Profil(M, h, B)

Else

q = MsgBox("Файл не создан", 0)

End If

End Sub

Чтение результатов расчета из ASCII-файла, закрытие формы и вызов подпрограммы рисования модели по нажатию кнопки «Модель»

Private Sub CommandButton4_Click()

Start.Hide

Call Region_07

End Sub

4-й этап – создание информационной формы:

- в редакторе Visual Basic командой «ВставкаФорма» (InsertUserForm) создаем объект «форма»;

- в окне свойств в графе Имя (Name) изменяем имя формы на Hello;

- пользуясь панелью элементов управления создаем кнопку, в окне свойств для каждого элемента задаем необходимые параметры: имена, надписи, цвет фона, шрифт и т.д. Форма принимает вид рис.17.

- создадим процедуру обработки события – нажатие кнопки, результат которой – закрытие формы Hello:

Private Sub CommandButton1_Click()

Hello.Hide

End Sub

5-й этап – создание процедур, выполняющих построения в пространстве модели AutoCAD:

- в редакторе Visual Basic с помощью команды «ВставкаМодуль» создаем новый модуль VBA-проекта, а затем командой «ВставкаПроцедура» создаем процедуры:

Описание общих для проекта переменных

Option Explicit

Public h As Double

Public B As Double

Dim M(0 To 23) As Double

Процедура вычерчивания лобового сечения (вызывается кнопкой «Лобовое сечение»)

массив М содержит координаты точек лобового сечения и расчетные углы и радиусы дуг

h – глубина резания, В – ширина резания

Public Sub Profil(M, h, B)

Dim lineObj As AcadLine

Dim startPoint(0 To 2) As Double

Dim endPoint(0 To 2) As Double

Dim arcObj As AcadArc

Dim centerPoint(0 To 2) As Double

Dim radius As Double

Dim startAngle As Double

Dim endAngle As Double

Dim ww, X, Y

Dim newViewport As AcadViewport

Создание нового видового экрана и его активация

Set newViewport = ThisDrawing.Viewports.Add("front1")

ThisDrawing.ActiveViewport = newViewport

X = 0: Y = 0

задание координат точек и рисование отрезка прямой между точками

startPoint(0) = M(0) + X

startPoint(2) = M(1) + Y

endPoint(0) = M(2) + X

endPoint(2) = M(3) + Y

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

задание координат точек и рисование отрезка прямой между точками

startPoint(0) = M(2) + X

startPoint(2) = M(3) + Y

endPoint(0) = M(6) + X

endPoint(2) = M(7) + Y

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

задание координат точек и рисование отрезка прямой между точками

startPoint(0) = M(0) + X

startPoint(2) = M(1) + Y

endPoint(0) = M(4) + X

endPoint(2) = M(5) + Y

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

задание координат точек и рисование отрезка прямой между точками

startPoint(0) = M(4) + X

startPoint(2) = M(5) + Y

endPoint(0) = M(10) + X

endPoint(2) = M(11) + Y

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

задание координат точек и рисование отрезка прямой между точками

startPoint(0) = M(10) + X

startPoint(2) = M(11) + Y

endPoint(0) = M(14) + X

endPoint(2) = M(15) + Y

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

задание координаты центра, радиуса, начального и конечного углов и рисование дуги

radius = M(18)

centerPoint(0) = M(16) + X

centerPoint(2) = M(17) + Y

endAngle = M(22)

startAngle = M(23)

Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)

задание координаты центра, радиуса, начального и конечного углов и рисование дуги

radius = M(19)

centerPoint(0) = M(8) + X

centerPoint(2) = M(9) + Y

endAngle = M(20)

startAngle = M(21)

Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)

Вывод всех изображенных линий в границах экрана

ZoomAll

End Sub

Процедура вычерчивания твердотельной модели

Sub Region_07()

Dim regionObj As Variant

Dim solidObj As Acad3DSolid

Dim sliceObj As Acad3DSolid

Dim Line(0 To 2) As AcadEntity

Dim startPoint(0 To 2) As Double

Dim endPoint(0 To 2) As Double

Dim data(0 To 1000) As Double

Dim FileName2 As String

Dim AAA As String

Dim i As Single

Dim j As Single

Dim buffallo As Double

Dim N As Single, N1 As Single

Dim h As Single, Angle As Single

h = 1 'Высота выдавливания

Angle = 0 'Угол выдавливания

Задание имени ASCII-файла с результатами расчета (координатами точек контура поверхности). Файл содержит матрицу координат Х, У, Z для точек контура с заданным шагом по высоте (координате Z).

FileName2 = "c:/windows/temp/left.dat"

i = 0

Open FileName2 For Input As #1 Открытие ASCII-файла для чтения

Input #1, AAA

Input #1, AAA

Input #1, AAA

Input #1, AAA

Do While Not EOF(1) 'Читать, пока файл не закончится

Input #1, data(i), buffallo 'Чтение данного в переменную

i = i + 1