9.7. Типы данных, определяемые пользователем

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

9.7.1. Объявление нового типа

Перед тем как описать и применить переменные нового типа, вначале необходимо этот тип определить. Его можно сконструировать из стандартных типов данных VBA: Byte, Integer, Long, Single, Currency, Double, String, Date, Boolean, Variant. В создаваемые типы можно также включить массивы и уже определенные ранее типы.

Общий синтаксис для определения нового типа таков:

Type VarName

elementName As type

[ElementName As type]

[ElementName As type]

….

End Type

VarName и ElementName представляют собой любой идентификатор, соответствующий правилам VBA. Type представляет собой любое имя типа данных VBA.

Ниже представлен пример программы, которая вычисляет длину вектора.

1: Type coordinates

2: X As Double

3: Y As Double

4: End Type

5: Function Dist(N1 As coordinates, N2 As coordinates)

6: Dist = Swr((N1.X – N2.X) ^ 2 + (N1.Y – N2.Y) ^ 2)

7: End Function

8: Sub Distance()

9: Dim coord1 As coordinates

10: Dim coord2 As coordinates

11: Dim Distance As Double

12: coord1.X = InputBox(«Введите координату Х первой точки»)

13: coord1.Y = InputBox(«Введите координату Y первой точки»)

14: coord2.X = InputBox(«Введите координату Х второй точки»)

15: coord1.Y = InputBox(«Введите координату Y второй точки»)

16: Distance = Dist(coord1, coord2)

17: MsgBox Distance

18: End Sub

В строках 1 – 4 определен пользовательский тип данных Coordinates в котором содержится два элемента: координата X и координата Y.

В строках 9 – 10 определены две переменные coord1 и coord2 пользовательского типа данных. В другом случае, без использования новых типов данных нам пришлось бы задавать четыре переменные.

В строках 12 – 15 задаем переменными значения координат.

В строке 16 вызываем функцию Dist, куда передаем две переменные нового типа. Без их использования передавали бы четыре переменные.

Функция Dist определена в строках 5 – 7. Эта функция вычисляет длину вектора и присваивает значение переменной Distance.

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

10. Создание макросов в AutoCad

10.1. Программа для привязки растра

В AutoCAD нет встроенной программы для привязки растра. Необходимо либо приобретать программы – дополнение к AutoCAD, либо попытаться создать такую программу самостоятельно.

Пример 1.

1: Option Explicit

2: Const MinArray As Byte = 2

3: Option Base 1

4: Declare Function GetOpenFileName Lib “comdlg32.dll”_

5: Alias “GetOpenFileNameA” (pOpenfilename As OPENFILENAME) As Long

6: Type OPENFILENAME

7: IStructSize As Long

8: hwndOwner As Long

9: hInstance As Long

10: IpstrFilter As String

11: IpstrCustomFilter As String

12: nMaxCustFilter As Long

13: nFilterIndex As Long

14: IpstrFile As String

15: nMaxFile As Long

16: IpstrFileTitle As String

17: nMaxFileTitle As Long

18: IpstrIntialDir As String

19: IpstrTitle As String

20: flags As Long

21: nFileOffset As Integer

22: nFileExtension As Integer

23: IpstrDefExt As String

24: ICustData As Long

25: IpfnHook As Long

26: IpTemplateName As String

27: End Type

28: Function ShowOpen() As String

29: Dim strTemp As String

30: Dim VertName As OPENFILENAME

31: VertName.IStructSize = Len(VertName)

32: VertName.IpstrFilter = “Text Files (*.txt)” + Chr$(0)+_

33: “*.txt” + Chr$(0) + “Excel Files(*.xls)” + _

34: Chr$(0) + “*.xls + Chr$(0)

35: VertName.IpstrFile = Space$(254)

36: VertName.nMaxFile = 255

37: VertName.IpstrFileTitle = Space$(254)

38: VertName.nMaxFileTitle = 255

39: VertName.IpstrInitialDir = CurDir

40: VertName.IpstrTitle = «Файл результатов»

41: VertName.flags = 0

42: If GetOpenFileName(VertName) Then

43: strTemp = (Trim(VertName.IpstrFile))

44: ShowOpen = Mid(strTemp, 1, Len(strTemp) – 1)

45: End If

46: End Function

47: Sub Rastr()

48: Dim intFile As Integer

49: Dim strFileName As String

50: Dim NumArray_x() As Double ‘массив значений х растра

51: Dim NumArray_y() As Double ‘массив значений y растра

52: Dim NumArrayX() As Double ‘массив значений X плана

53: Dim NumArrayY() As Double ‘массив значений Y плана

54: Dim Array_Size As Long ‘размер массива

55: Dim X, Y, P, Z As Variant

56: Dim F, N, J, m, S As Integer

57: Z = ThisDrawing.Utility.GetPoint(, vbCrLf & «Укажите левый_

58: нижний угол растра:»)

59: Y= ThisDrawing.Utility.GetDistance(, vbCrLf & «Укажите текущий_

60: масштаб растра:»)

61:S= ThisDrawing.Utility.GetDistance(, vbCrLf & «Введите число_62: точек для привязки растра:»)

63: Array_Size = S

64: If Array_Size < MinArray Then

65: MsgBox «Введите больше точек:»

66: Exit Sub

67: Else

68: ReDim NumArray_x(Array_Size) ‘ объявление динамических массивов

69: ReDim NumArray_y(Array_Size)

70: ReDim NumArrayX(Array_Size)

71: ReDim NumArrayY(Array_Size)

72: End If

73: For N = 1 To Array_Size

74: X = ThisDrawing.Utility.GetPoint(, vbCrLf & «Укажите точку(“_

75: & N & “)на растре:»)

76: NumArray_x(N) = (X(1) – Z(1)) / Y

77: NumArray_y(N) = (X(0) – Z(0)) / Y

78: Next N

79: For N = 1 To Array_Size

80: X = ThisDrawing.Utility.GetPoint(, vbCrLf & «Укажите точку(“_

81: & N & “)на плане:»)

82: NumArrayX(N) = X(1)

83: NumArrayY(N) = X(0)

84: Next N

85: Dim Count As Long

86: Dim mm As Double

87: Dim d_x, d_y, DX, DY As Double

88: Dim m1, a1, a2, a3, a, C1, C2, C3, C4, Cx, Cy As Double

89: mm = 0 ‘переменная для суммирования масштабов

90: a = 0 ‘переменная для суммирования углов

91: Cx = 0 ‘2 переменные для суммирования свободных членов

92: Cy = 0

93: Count = 0

94: For N = 1 To Array_Size – 1

95: For J = N + 1 To Array_size

96 Count = Count + 1 ‘вычисляем приращения координат на растре и на плане

97: d_x = Round(NumArray_x(N) – NumArray_x(J), 3)

98: d_y = Round(NumArray_y(N) – NumArray_y(J), 3)

99: DX = Round(NumArrayX(N) – NumArrayX(J), 3)

100: DY = Round(NumArrayY(N) – NumArrayY(J), 3) ‘вычисляем масштабный фактор

101: m1 = Round((Sqr(DX ^ 2 + DY ^ 2)) / (Sqr(d_x ^ 2 + d_y ^ 2)), 3) ‘вычисляем угол между двумя точками на плане и растре

102: a1 = Round(Atn(d_y / d_x), 6)

103: a2 = Round(Atn(DY / DX), 6) ‘разность углов на плане и растре

104: a3 = a2 – a1 ‘свободные члены

105: C1 = Round(NumArrayX(N) – m1 * (NumArray_x(N) * Cos(a3) +_

106: NumArray_y(N) * Sin(a3)), 3)

107: C1 = Round(NumArrayY(N) – m1 * (NumArray_y(N) * Cos(a3) -_

108: NumArray_x(N) * Sin(a3)), 3)

109: C1 = Round(NumArrayX(J) – m1 * (NumArray_x(J) * Cos(a3) +_

110: NumArray_y(J) * Sin(a3)), 3)

111: C1 = Round(NumArrayY(J) – m1 * (NumArray_y(J) * Cos(a3) +_

112: NumArray_x(J) * Sin(a3)), 3) ‘суммируем масштабный фактор

113: mm = mm + m1 ‘суммируем разности углов

114: a = a + a3 ‘суммируем свободные члены

115: Cx = Cx + C1 + C3

116: Cy = Cy + C2 + C4

117: Next J

118: Next N ‘Начинаем записывать результаты в файл

119: F = FreeFile

120: strFileName = ShowOpen

121: If Not Right(strFileName, 4) = “.txt” Then

122: strFileName = strFileName & “.txt”

123: End If

124: Open strFileName For Append As F

125: Print #F, «Осредненные значения:»

126: Print #F, «Масштаб:», Round(((mm / Count)), 3)

127: Print #F, «Угол поворота:», Round((a / Count), 3)

128: Print #F, «Свободный членX0:», Round((Cx / Count * 2)), 3)

129: Print #F, «Свободный членY0:», Round((Cy / Count * 2)), 3)

130: Print #F, «Ошибки в положении пунктов при пересчета:»

131: For N = 1 To Array_Size

132: Print #F, “Mx(“& N &”):”, Round(((Cx / Count * 2))) +_

133: (mm / Count) * (NumArray_x(N) * Cos(a / Count) + NumArray_y(N) *_

134: Sin(a / Count)) – NumArrayX(N), 3)

135: Print #F, “My(“& N &”):”, Round(((Cy / Count * 2))) +_

136: (mm / Count) * (NumArray_y(N) * Cos(a / Count) + NumArray_x(N) *_

137: Sin(a / Count)) – NumArrayY(N), 3)

138: Next N

139: Print #F, «Указанные точки на плане:»

140: For N = 1 To Array_Size

141: Print #F, “X(“ & N & “):”, Round(NumArrayX(N), 3)

142: Print #F, “Y(“ & N & “):”, Round(NumArrayY(N), 3)

143: Next N

144: Print #F, «Указанные точки на растре:»

145: For N = 1 To Array_Size

146: Print #F, “x(“ & N & “):”, Round(NumArray_x(N), 3)

147: Print #F, “y(“ & N & “):”, Round(NumArray_y(N), 3)

148: Next N

149: Close F

150: End Sub

В строке 1 директива Option Explicit запрещает неявное объявление переменных. То есть все переменные должны быть описаны.

В строке 2 определена константа MinArray = 2, которая затем будет использована для задания минимального размера массива.

В строке 3 директива Option Base 1 указывает на то, что индексы массивов должны начинаться с единицы.

В строках 4 – 5 вызывается функция, которая открывает диалоговое окно Open File. В AutoCAD такое окно не встроено. Однако с самой Windows поставляется с определенным количеством файлов DLL, которые обеспечивают разработчиков сотнями специализированных и очень надежных функций. Перед тем как использовать ту или иную функцию Windows нужно сообщить VBA, где ее искать. Для этого необходимо ввести инструкцию Declare на уровне модуля. Общий синтаксис таков:

Declare Function Name Lib “Libname” [AliasName] (Arguments) [AsType]

Declare Sub Name Lib ““Libname” [AliasName] (Arguments) [AsType]

Где Name – это имя процедуры, а LibName – имя DLL файла. Arguments – представляет собой список необходимых аргументов. Всего данной функции требуется 19 аргументов. Их не все требуется определять, но обязательно нужно передать в функцию. Для передачи такого большого количества переменных удобно использовать типы данных определенные пользователем (строки 6 – 27).Ниже приводится краткая характеристика данных.

Attribute VB_Name = "GetOpenFileName"

Option Explicit ' запрет на неявное объявление переменных

Declare Function GetOpenFileName Lib "comdlg32.dll" _

Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long ' объявление функции Windows

Type OPENFILENAME ' объявляем пользовательский тип дананных

lngStructSize As Long 'Размер структуры

hwndOwner As Long 'Дескриптор окна владельца

hInstance As Long 'Дескриптор приложения

strFilter As String 'Строка фильтра

strCustomFilter As String 'Строка с выбранным фильтром

intMaxCustFilter As Long 'Длина буфера для строки выбранного фильтра

'Всегда должна быть равна Len(strCustomFilter)

intFilterIndex As Long 'Индекс строки фильтра

strFile As String 'Полное имя выбранного файла (путь и файл)

intMaxFile As Long 'Длина буфера для полного имени файла

'Всегда должна быть равна Len(strFile)

strFileTitle As String 'Имя выбранного файла

intMaxFileTitle As Long 'Длина буфера для имени выбранного файла

'Всегда должна быть равна Len(strFileTitle)

strInitialDir As String 'Имя начального каталога (при открытии окна)

strTitle As String 'Заголовок диалогового окна

lngFlags As Long 'Флаги диалогового окна

intFileOffset As Integer 'Смещение имени файла

intFileException As Integer 'Смещение расширения файла

strDefExt As String 'Расширение файла по умолчанию

lngCustData As Long 'Данные для обработки

lngfnHook As Long 'Указатель функции обработки

strTemplateName As String 'Имя шаблона диалогового окна

End Type

В строках 28 – 46 определена функция ShowOpen, в которой определены некоторые начальные значения диалогового окна Open File, а также эта функция отображает это самое диалоговое окно. Комментарий к функции приводится ниже.

Function ShowOpen() As String ' функция для открытия диалогового окна OpenFile

Dim strTemp As String

Dim VertName As OPENFILENAME

With VertName

.lngStructSize = Len(VertName) 'Передаем размер созданной структуры

.strFilter = "Text Files (*.txt)" + Chr$(0) + _

"*.txt" + Chr$(0) + "Excel Files(*.xls)" + _

Chr$(0) + "*.xls" + Chr$(0) ' задаем типы расширений для выбираемых файлов

'.strCustomFilter = Space$(254) ' задаем строку фильтра. Максимальное количество символов

'254. Оператор space$ - резервирует строку 254 символа

.intMaxCustFilter = 254 ' задаем максимальное значение символов в строке фильтра

.intMaxFile = 255 'задаем масимальное количество символов в строке с полным именем

'выбираемого файла

.intMaxFileTitle = 254 ' длина буфера для имени файла

.strFile = Space$(254) ' резервируем строку для имени файла

.strInitialDir = "C:\Program Files" ' каталог по умолчанию

.strTitle = "Выбор файла" 'заголовок диалогового окна

.lngFlags = 0 ' 1 - тотько для чтения

End With

If GetOpenFileName(VertName) Then

strTemp = (Trim(VertName.strFile))

ShowOpen = strTemp

End If

'В строке strTemp присваиваем содержимое строки VertName.strFile без всяких пробелов

'до и после имени файла. Для этого вызываем встроенную в Visual Basic функцию Trim.

'После этого функции присваиваем значение strTemp

End Function

Sub DialogBox()

Dim strFileName As String

strFileName = ShowOpen 'вызываем на исполнение функцию ShowOpen

If Not Right(strFileName, 4) = ".txt" Then

strFileName = strFileName & ".txt"

End If

'Если в выбранном имени файла пользователь забыл ввести расширение то автоматически

'добавляем его

Shell PathName:="C:\Windows\notepad.exe " & strFileName

'функция Shell вызывает требуемое приложение и файл

End Sub

Сама функция Open File вызывается в строке 120 головной программы.

В строке 119 переменной F присваиваемый следующий свободный номер файла. В строке 124 открываем файл для добавления записей (Append).

Оператором Print# записываем информацию в файл.

Для построения диалогового окна работы с принтером предлагается следующая программа.

Attribute VB_Name = "Module3"

Public Const LBSELCHSTRING = "commdlg_LBSelChangedNotify"

Public Const SHAREVISTRING = "commdlg_ShareViolation"

Public Const FILEOKSTRING = "commdlg_FileNameOK"

Public Const COLOROKSTRING = "commdlg_ColorOK"

Public Const SETRGBSTRING = "commdlg_SetRGBColor"

Public Const HELPMSGSTRING = "commdlg_help"

Public Const FINDMSGSTRING = "commdlg_FindReplace"

Type PrintDlg

lStructSize As Long

hwndOwner As Long

hDevMode As Long

hDevNames As Long

hdc As Long

flags As Long

nFromPage As Integer

nToPage As Integer

nMinPage As Integer

nMaxPage As Integer

nCopies As Integer

hInstance As Long

lCustData As Long

lpfnPrintHook As Long

lpfnSetupHook As Long

lpPrintTemplateName As String

lpSetupTemplateName As String

hPrintTemplate As Long

hSetupTemplate As Long

End Type

Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long

Function ShowPrintDlg()

Dim sd As PrintDlg

Dim strTemp As Long

With sd

.lStructSize = Len(sd)

.nCopies = 6

.hdc = 10

.flags = 200

.nFromPage = 1

.nToPage = 2

.nMaxPage = 4

.nMinPage = 1

.hPrintTemplate = 3

.hSetupTemplate = 2

.hInstance = 2

.lpfnPrintHook = 11434324

.lpPrintTemplateName = COLOROKSTRING

.lpSetupTemplateName = LBSELCHSTRING

.lCustData = 12333

End With

strTemp = PrintDlg(sd)

End Function

Sub print_a()

Dim d As Long

d = ShowPrintDlg

End Sub

Ее предлагается изучить самостоятельно.