Перенос таблицы AutoCAD в Word с помощью VBA

Работа с таблицами в AutoCAD нередко требует переноса данных в другие программы, например, Microsoft Word.

Цель скрипта

Макрос выполняет следующие задачи:

1. Определяет, запущен ли AutoCAD и открыт ли в нём документ.
2. Проверяет, существует ли именованный набор объектов (SelectionSet). Если да – удаляет его и создаёт заново.
3. Запрашивает у пользователя выбор таблицы в AutoCAD.
4. Копирует данные из таблицы AutoCAD.
5. Определяет, запущен ли Microsoft Word и есть ли в нём открытый документ.
6. Создаёт новую таблицу в Word и вставляет в неё данные из AutoCAD.

Код макроса

Приведённый ниже код написан на VBA и предназначен для выполнения в AutoCAD:

Sub CopyAcadTableToWord()
Dim acadApp As Object
Dim acadDoc As Object
Dim sset As Object
Dim ent As Object
Dim acadTable As Object
Dim wordApp As Object
Dim wordDoc As Object
Dim wordTable As Object
Dim rowCount As Integer
Dim colCount As Integer
Dim i As Integer, j As Integer

' Подключаемся к AutoCAD
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If acadApp Is Nothing Then
MsgBox "AutoCAD не запущен", vbCritical
Exit Sub
End If
On Error GoTo 0

Set acadDoc = acadApp.ActiveDocument
If acadDoc Is Nothing Then
MsgBox "Нет активного документа в AutoCAD", vbCritical
Exit Sub
End If

' Проверяем, существует ли именованный набор, если да - удаляем
On Error Resume Next
Set sset = acadDoc.SelectionSets.Item("TableSelection")
If Not sset Is Nothing Then sset.Delete
On Error GoTo 0

' Создаём новый набор
Set sset = acadDoc.SelectionSets.Add("TableSelection")

' Выбираем таблицу в AutoCAD
acadDoc.Utility.Prompt "Выберите таблицу: "
sset.SelectOnScreen

If sset.Count = 0 Then
MsgBox "Таблица не выбрана", vbExclamation
Exit Sub
End If

Set ent = sset.Item(0)
If TypeOf ent Is acadTable Then
Set acadTable = ent
Else
MsgBox "Выбранный объект не является таблицей", vbExclamation
Exit Sub
End If

' Определяем количество строк и столбцов
rowCount = acadTable.Rows
colCount = acadTable.Columns

' Подключаемся к Word
On Error Resume Next
Set wordApp = GetObject(, "Word.Application")
If wordApp Is Nothing Then
MsgBox "Microsoft Word не запущен", vbCritical
Exit Sub
End If
On Error GoTo 0

Set wordDoc = wordApp.ActiveDocument
If wordDoc Is Nothing Then
MsgBox "Нет открытого документа в Word", vbCritical
Exit Sub
End If

' Вставляем таблицу в Word
Set wordTable = wordDoc.Tables.Add(wordDoc.Range, rowCount, colCount)

' Заполняем таблицу значениями из AutoCAD
For i = 0 To rowCount - 1
For j = 0 To colCount - 1
wordTable.Cell(i + 1, j + 1).Range.Text = acadTable.GetText(i, j)
Next j
Next i

MsgBox "Таблица успешно скопирована в Word!", vbInformation

' Очистка
sset.Delete
Set acadTable = Nothing
Set ent = Nothing
Set sset = Nothing
Set acadDoc = Nothing
Set acadApp = Nothing
Set wordTable = Nothing
Set wordDoc = Nothing
Set wordApp = Nothing
End Sub

Разбор кода

• Подключение к AutoCAD и Word. Используется GetObject, чтобы получить доступ к уже запущенным приложениям.
• Работа с SelectionSet. Перед выбором таблицы старый набор объектов удаляется, чтобы избежать ошибок.
• Обработка ошибок. On Error Resume Next предотвращает сбои при отсутствии запущенных приложений.
• Перенос данных. Используется метод GetText, чтобы скопировать текст из таблицы AutoCAD в Word.

Как запустить макрос

1. Откройте AutoCAD и документ с таблицей.
2. Запустите Microsoft Word и откройте новый или существующий документ.
3. В AutoCAD откройте редактор VBA (ALT + F11).
4. Вставьте код и запустите макрос CopyAcadTableToWord.
5. Выберите таблицу в AutoCAD – данные перенесутся в Word автоматически.

Заключение

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

Если статья была полезной, ставьте лайк и подписывайтесь, чтобы не пропустить новые полезные скрипты для AutoCAD и Office!