For i = 0 To 12 'Рамка вертикальная

Select Case i

Case 0

Point1(0) = 20: Point1(1) = H0 / 2 - 5: Point1(2) = 0

Point2(0) = 8: Point2(1) = H0 / 2 - 5: Point2(2) = 0

Case 1

Point1(0) = 20: Point1(1) = H0 / 2 - 65: Point1(2) = 0

Point2(0) = 8: Point2(1) = H0 / 2 - 65: Point2(2) = 0

Case 2

Point1(0) = 20: Point1(1) = H0 / 2 - 125: Point1(2) = 0

Point2(0) = 8: Point2(1) = H0 / 2 - 125: Point2(2) = 0

Case 3

Point1(0) = 20: Point1(1) = 5: Point1(2) = 0

Point2(0) = 8: Point2(1) = 5: Point2(2) = 0

Case 4

Point1(0) = 20: Point1(1) = 30: Point1(2) = 0

Point2(0) = 8: Point2(1) = 30: Point2(2) = 0

Case 5

Point1(0) = 20: Point1(1) = 65: Point1(2) = 0

Point2(0) = 8: Point2(1) = 65: Point2(2) = 0

Case 6

Point1(0) = 20: Point1(1) = 90: Point1(2) = 0

Point2(0) = 8: Point2(1) = 90: Point2(2) = 0

Case 7

Point1(0) = 20: Point1(1) = 115: Point1(2) = 0

Point2(0) = 8: Point2(1) = 115: Point2(2) = 0

Case 8

Point1(0) = 20: Point1(1) = 150: Point1(2) = 0

Point2(0) = 8: Point2(1) = 150: Point2(2) = 0

Case 9

Point1(0) = 8: Point1(1) = 5: Point1(2) = 0

Point2(0) = 8: Point2(1) = 150: Point2(2) = 0

Case 10

Point1(0) = 13: Point1(1) = 5: Point1(2) = 0

Point2(0) = 13: Point2(1) = 150: Point2(2) = 0

Case 11

Point1(0) = 8: Point1(1) = H0 / 2 - 5: Point1(2) = 0

Point2(0) = 8: Point2(1) = H0 / 2 - 125: Point2(2) = 0

Case 12

Point1(0) = 13: Point1(1) = H0 / 2 - 5: Point1(2) = 0

Point2(0) = 13: Point2(1) = H0 / 2 - 125: Point2(2) = 0

End Select

With MSpace.AddLine(Point1, Point2)

.Color = Color

End With

Next i

End Sub

Процедура вычерчивания линий штампа (получает размеры высоты и ширины формата)

Sub Shtamp(L, H)

Dim Point1(0 To 2) As Double

Dim Point2(0 To 2) As Double

Dim aObj As Object

'Горизонтали штампа

For j = 0 To 10

Point1(0) = L - 190: Point1(1) = 10 + 5 * j: Point1(2) = 0

Point2(0) = L - 125: Point2(1) = 10 + 5 * j: Point2(2) = 0

With MSpace.AddLine(Point1, Point2)

.Color = Color

End With

Next j

For j = 0 To 3

Select Case j

Case 0

Point1(0) = L - 190: Point1(1) = 20: Point1(2) = 0

Point2(0) = L - 5: Point2(1) = 20: Point2(2) = 0

Case 1

Point1(0) = L - 190: Point1(1) = 45: Point1(2) = 0

Point2(0) = L - 5: Point2(1) = 45: Point2(2) = 0

Case 2

Point1(0) = L - 190: Point1(1) = 60: Point1(2) = 0

Point2(0) = L - 5: Point2(1) = 60: Point2(2) = 0

Case 3

Point1(0) = L - 190: Point1(1) = 5: Point1(2) = 0

Point2(0) = L - 5: Point2(1) = 5: Point2(2) = 0

End Select

With MSpace.AddLine(Point1, Point2)

.Color = Color

End With

Next j

For j = 0 To 1

Select Case j

Case 0

Point1(0) = L - 55: Point1(1) = 25: Point1(2) = 0

Point2(0) = L - 5: Point2(1) = 25: Point2(2) = 0

Case 1

Point1(0) = L - 55: Point1(1) = 40: Point1(2) = 0

Point2(0) = L - 5: Point2(1) = 40: Point2(2) = 0

End Select

With MSpace.AddLine(Point1, Point2)

.Color = Color

End With

Next j

'Вертикали штампа

For j = 0 To 12

Select Case j

Case 0

Point1(0) = L - 190: Point1(1) = 5: Point1(2) = 0

Point2(0) = L - 190: Point2(1) = 60: Point2(2) = 0

Case 1

Point1(0) = L - 183: Point1(1) = 60: Point1(2) = 0

Point2(0) = L - 183: Point2(1) = 35: Point2(2) = 0

Case 2

Point1(0) = L - 173: Point1(1) = 60: Point1(2) = 0

Point2(0) = L - 173: Point2(1) = 5: Point2(2) = 0

Case 3

Point1(0) = L - 150: Point1(1) = 60: Point1(2) = 0

Point2(0) = L - 150: Point2(1) = 5: Point2(2) = 0

Case 4

Point1(0) = L - 135: Point1(1) = 60: Point1(2) = 0

Point2(0) = L - 135: Point2(1) = 5: Point2(2) = 0

Case 5

Point1(0) = L - 125: Point1(1) = 60: Point1(2) = 0

Point2(0) = L - 125: Point2(1) = 5: Point2(2) = 0

Case 6

Point1(0) = L - 55: Point1(1) = 45: Point1(2) = 0

Point2(0) = L - 55: Point2(1) = 5: Point2(2) = 0

Case 7

Point1(0) = L - 40: Point1(1) = 45: Point1(2) = 0

Point2(0) = L - 40: Point2(1) = 25: Point2(2) = 0

Case 8

Point1(0) = L - 23: Point1(1) = 45: Point1(2) = 0

Point2(0) = L - 23: Point2(1) = 25: Point2(2) = 0

Case 9

Point1(0) = L - 50: Point1(1) = 40: Point1(2) = 0

Point2(0) = L - 50: Point2(1) = 25: Point2(2) = 0

Case 10

Point1(0) = L - 45: Point1(1) = 40: Point1(2) = 0

Point2(0) = L - 45: Point2(1) = 25: Point2(2) = 0

Case 11

Point1(0) = L - 35: Point1(1) = 20: Point1(2) = 0

Point2(0) = L - 35: Point2(1) = 25: Point2(2) = 0

Case 12

Point1(0) = L - 5: Point1(1) = 60: Point1(2) = 0

Point2(0) = L - 5: Point2(1) = 5: Point2(2) = 0

End Select

With MSpace.AddLine(Point1, Point2)

.Color = Color

End With

Next j

End Sub

Процедура вычерчивания текста (получает размеры высоты и ширины формата, номер формата)

Sub Text(L, H, F)

Dim TxtObj As Object

Dim Point(0 To 2) As Double

Dim FntFile As Variant

Const Height As Single = 3

Set TStyle = ADoc.ActiveTextStyle

'Чтение файла-шрифта из папки AutoCad R14\Fonts

TStyle.FontFile = "Gosta_w.shx"

Point(0) = L - 22: Point(1) = 41: Point(2) = 0

With MSpace.AddText("Масштаб", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 37: Point(1) = 41: Point(2) = 0

With MSpace.AddText("Масса", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 51: Point(1) = 41: Point(2) = 0

With MSpace.AddText("Лит.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 51: Point(1) = 21: Point(2) = 0

With MSpace.AddText("Лист", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 30: Point(1) = 21: Point(2) = 0

With MSpace.AddText("Листов", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 40: Point(1) = 1: Point(2) = 0

With MSpace.AddText("Формат А" + LTrim$(Str$(F)), Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 134: Point(1) = 36: Point(2) = 0

With MSpace.AddText("Дата", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 149: Point(1) = 36: Point(2) = 0

With MSpace.AddText("Подпись", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 170: Point(1) = 36: Point(2) = 0