With MSpace.AddText("N докум.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

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

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

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

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

With MSpace.AddText("Изм", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 189.5: Point(1) = 31: Point(2) = 0

With MSpace.AddText("Разраб.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 189.5: Point(1) = 26: Point(2) = 0

With MSpace.AddText("Проверил", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

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

With MSpace.AddText("Т.контр.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 189.5: Point(1) = 11: Point(2) = 0

With MSpace.AddText("Н.контр.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

Point(0) = L - 189.5: Point(1) = 6: Point(2) = 0

With MSpace.AddText("Утв.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

End With

'вертикальные надписи

Point(0) = 12: Point(1) = 8: Point(2) = 0

With MSpace.AddText("Инв.N подл.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

.Rotation = 3.14 / 2

End With

Point(0) = 12: Point(1) = 36: Point(2) = 0

With MSpace.AddText("Подп. и дата", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

.Rotation = 3.14 / 2

End With

Point(0) = 12: Point(1) = 68: Point(2) = 0

With MSpace.AddText("Взам. инв.N", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

.Rotation = 3.14 / 2

End With

Point(0) = 12: Point(1) = 93: Point(2) = 0

With MSpace.AddText("Инв.N дубл.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

.Rotation = 3.14 / 2

End With

Point(0) = 12: Point(1) = 120: Point(2) = 0

With MSpace.AddText("Подп. и дата", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

.Rotation = 3.14 / 2

End With

Point(0) = 12: Point(1) = H0 / 2 - 45: Point(2) = 0

With MSpace.AddText("Перв. примен.", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

.Rotation = 3.14 / 2

End With

Point(0) = 12: Point(1) = H0 / 2 - 100: Point(2) = 0

With MSpace.AddText("Справ.N", Point, Height)

.Color = Color + 1

.ObliqueAngle = 3.14 * 15 / 180

.Rotation = 3.14 / 2

End With

End Sub

Использование VBA-приложения.

Для выполнения созданной программы следует:

- открыть книгу Excel с созданной программой;

- нажать на элемент управления «Старт меню»;

- заполнить окна необходимой информацией;

- если программа AutoCAD не загружена, загрузить ее нажатием кнопки «AutoCAD R14».

- для вычерчивания рамки и штампа заданного формата нажать кнопку «Формат»;

- для ввода текста в штамп нажать кнопку «Заполнение штампа»;

- перейти в окно AutoCAD, установить указатель мыши в графическую зону экрана. На экране появятся изображения рамки нужного формата , штампа и текста;

- для завершения работы с формой нажать кнопку «Выход».

При неверном вводе данных в поле «Формат А» программа сообщит о неверном вводе и позволит повторить ввод. При незапущенном приложении AutoCAD программа сообщит об ошибке и позволит ее исправить. Программа использует шрифт "Gosta_w.shx", соответствующий ГОСТу, который необходимо разместить в папке шрифтов AutoCAD: с:\Program Files\AutoCad R14\Fonts или с:\Program Files\AutoCad 2000\Fonts.

Задания на разработку:

1. Разработать VBA-приложение, вычерчивающее таблицу параметров зубчатого зацепления с возможностью выбора его параметров.

2. Разработать VBA-приложение, вычерчивающее обозначение сварочного соединения с возможностью выбора его параметров.

2. Разработать VBA-приложение, вычерчивающее изображение подшипника (поперечный разрез) с возможностью выбора его параметров.

Считывание атрибутов блоков чертежа (технологической схемы).

Задача – разработать VBA-приложение, позволяющее считывать из чертежа атрибуты его блоков.

Задача актуальна при составлении спецификаций схем, содержащих большое количество узлов и стандартных элементов (например, сборочные чертежи сложных механизмов, схемы технологических линий). Такие чертежи, как правило, включают в себя изображения элементов в виде блоков – групп примитивов, объединенных одним именем и распознаваемых в базе данных чертежа как один объект. Блоки имеют возможность содержать текстовую информацию – атрибуты (например, наименование узла, его марка, основные характеристики – производительность, потребляемая мощность и т.д.). Таблица атрибутов блоков представляет собой точную спецификацию сборочного чертежа или схемы, так как читается непосредственно из чертежа.

Существуют способы чтения атрибутов блоков с помощью команд самой программы AutoCAD, но работа с ними трудоемка и неудобна.

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

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

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

- Лист Excel с элементом управления, например, кнопкой, запускающим на выполнение процедуру чтения атрибутов;

- процедуру чтения атрибутов блоков чертежа AutoCAD. Процедура может быть размещена в модуле;

-Лист Excel с таблицей результатов.

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

1 этап – создание элемента управления. Запускаем программу Microsoft Excel, создаем книгу , в книге оставляем один Лист, переименовываем его в «Главный». Создаем элемент управления – кнопку, для чего:

- в меню ВидПанели инструментов открываем панель инструментов «Элементы управления»;

- выбираем элемент «Кнопка» и изображаем его на Листе;

- в контекстном меню элемента «Кнопка» выбираем команду «Свойства», в появившейся таблице свойств изменяем надпись (Caption) на кнопке на фразу «Читать атрибуты»;

- в контекстном меню элемента «Кнопка» выбираем команду «Обработка события», в результате получаем процедуру в объекте Лист, в которую вносим одну строку – имя макроса, выполняющего чтение атрибутов Blocks_Attributes. (этот макрос создадим позже):

Private Sub CommandButton1_Click()

Blocks_Attributes

End Sub

Процедура будет выполнена при нажатии на кнопку;

- на панели «Элементы управления» нажимаем на кнопку «Выход из режима редактирования», панель элементов управления закрываем.

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

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

- добавляем в проект ссылку на библиотеку типов AutoCAD: ToolsPreferencesAutoCAD Object Library;

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

Описание общих переменных

Public acad As Object

Public excelSheet As Object

Процедура чтения атрибутов блоков

Sub Blocks_Attributes()

Описание локальных переменных

Dim objMspace As Object

Dim objElement As Object

Dim objExcel As Object

Dim objDoc As Object

Dim intI As Integer

Dim objAttr As Variant

Dim strBlockName(1 To 1000) As String

Dim intNumBlockName(1 To 1000) As Integer

Dim intTotalNumOfBlocks As Integer

1-я часть – установление связи с программой AutoCAD и загрузка в нее нужного чертежа

On Error Resume Next Отложенный перехват ошибки

'Устанавливает связь с AutoCAD, если программа уже работает

Set acad = GetObject(, "AutoCAD.Application")

If Err Then

'Если ошибка (AutoCAD не запущен и связь не установлена), то переменная, содержащая ошибку, «обнуляется», и программа получает возможность исправить ошибку.

Err.Clear

'Создает сеанс работы AutoCAD, если программа не работает. Сеанс создается скрытым, то есть действия не отображаются на экране и панели задач, что экономит ресурсы компьютера и ускоряет процесс обработки. Проверить, что программа работает можно, нажав клавиши Ctrl+Alt+Del, и посмотрев список загруженных программ.

Set acad = CreateObject("AutoCAD.Application")

'Если приложение AutoCAD отсутствует, выводит сообщение и завершает работу программы.

If Err Then

MsgBox "Не могу установить связь с AutoCAD"

Exit Sub

End If

End If

Работу AutoCAD можно сделать видимой командой (здесь команда не работает, так как преобразована в комментарий):

'acad.Visible = True

'Выбор файла чертежа с помощью стандартного окна Windows "Открыть файл"

Powtor:

Параметры команды «Открыть файл» - типы доступных к открытию файлов ( в нашем случае – это файлы чертежей AutoCAD - Dwg Files (*.dwg)). Имя выбранного файла записывает в переменную DwgName

DwgName = Application.GetOpenFilename("Dwg Files (*.dwg), *.dwg")

Если имя не выбрано, например, нажата кнопка «Отмена», или в переменной DwgName нет значения, то предлагается завершить работу с программой или повторить выбор файла

If DwgName = False Then

Response = MsgBox("Завершить работу с программой?", 4, "Отказ выбора файла")

If Response = vbYes Then 'Подтверждаем выход из программы

'Если AutoCAD активен (то есть загружался до начала работы VBA-приложения, например, вручную), то запрашивает о выходе из AutoCAD

If acad.Visible = True Then

Response = MsgBox("Завершить работу с AutoCAD?", 4, "AutoCAD Quit")

If Response = vbYes Then 'Подтверждаем выход из AutoCAD

‘выгружает AutoCAD и завершает работу программы

acad.Quit

Exit Sub

End If

End If

Exit Sub ' Выходит из программы без выгрузки AutoCAD

Else 'Отказываемся от завершения работы программы

GoTo Powtor 'Возврат по метке в окно "Открыть файл"

End If

End If

Если выбранный файл не файл с расширением ".dwg", то следует повторить выбор. Для реализованного варианта работы с окном «Открыть файл» возможность ошибки исключена, так как доступны к открытию только файлы с расширением ".dwg".

If (Right(DwgName, 4) <> ".dwg") Then

MsgBox "Выбранный файл не чертеж AutoCAD. Повторите ввод."

GoTo Powtor

End If

Устанавливает в переменную objDoc активный документ AutoCAD

Set objDoc = acad.ActiveDocument

Если полное имя активного документа AutoCAD не совпадает с выбранным нами именем, которое записано в переменную DwgName, то устанавливает в переменную objDoc объект–коллекцию документов AutoCAD, затем открывает документ с именем, размещенным в переменной DwgName, методом Open.

If objDoc.FullName <> DwgName Then

Set objDoc = acad.Documents

objDoc.Open DwgName

End If

Устанавливает в переменную objDoc активный документ AutoCAD (теперь уже тот, который мы выбрали), а в переменную objMspace пространство модели активного документа.

Set objDoc = acad.ActiveDocument

Set objMspace = objDoc.ModelSpace

2-я часть – создание или очистка от данных листа «Атрибуты»

Устанавливает связь с приложением Excel

Set objExcel = GetObject(, "Excel.Application")

В переменную Key устанавливает значение 0

Key = 0

'Просматривает все листы активной книги Excel. Если есть лист с именем «Атрибуты», в переменную Key устанавливает значение 1

For Each objElement In ActiveWorkbook.Sheets

With objElement

If (.Name = "Атрибуты") Then

Key = Key + 1

End If

End With

Next

Если переменная Key=0 (листа «Атрибуты» в книге нет), то создает новый лист и задает ему имя «Атрибуты»

If Key = 0 Then

ActiveWorkbook.Sheets.Add

ActiveSheet.Name = "Атрибуты"

End If

Активизирует лист «Атрибуты»

Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Атрибуты")

Worksheets("Атрибуты").Activate

Очищает содержимое диапазона ячеек листа «Атрибуты»

objExcelSheet.Range(Cells(1, 1), Cells(100, 12)).Clear

intI = 1

3-я часть – чтение атрибутов чертежа и запись их в ячейки листа «Атрибуты»

'Читает из чертежа имена блоков, просматривая коллекцию блоков открытого чертежа, и записывает их в ячейки Листа (в 1-й столбец, начиная с 1-й строки), если имя блока не начинается символом «*» (этим символом начинаются имена служебных блоков базы данных чертежа AutoCAD). Имена блоков записывает в массив strBlockName.

Следует различать имена блоков, входящих в базу данных чертежа, и вхождения блоков, то есть их реализации на чертеже. Блок в чертеже может быть один (например, изображение подшипника), а вхождений этого блока в чертеж несколько (несколько изображений этого блока на поле чертежа). Каждое вхождение имеет свои атрибуты (тип подшипника, его размеры).

For Each objElement In objDoc.Blocks

With objElement

If (Left(.Name, 1) <> "*") Then

objExcelSheet.Cells(intI, 1) = objElement.Name

strBlockName(intI) = objElement.Name

intI = intI + 1

End If

End With

Next

'Обнуляет количество "вхождений" каждого блока в чертеж

intI = intI - 1

intTotalNumOfBlocks = intI

For intI = 1 To intTotalNumOfBlocks

intNumBlockName(intI) = 0

Next