Автоматизация переноса таблиц из Word в AutoCAD

Описание программы

Программа "CopyTableToAutoCAD_Full" предназначена для автоматического копирования таблиц из Microsoft Word в AutoCAD. Она создает аналогичную таблицу в AutoCAD, сохраняя структуру, ширину столбцов и текстовое содержимое.

Этот макрос полезен для инженеров, проектировщиков, архитекторов и всех, кто работает с чертежами в AutoCAD и часто переносит таблицы из текстовых документов. Программа значительно экономит время, устраняя необходимость ручного ввода данных и форматирования таблиц.

В каких случаях полезна?

1. Перенос спецификаций – если в документации Word содержатся таблицы с характеристиками деталей, материалами и другими параметрами, макрос автоматически перенесет их в чертеж.
2. Оформление ведомостей – ведомости материалов, сметы и прочие документы часто создаются в Word. Этот макрос ускорит их интеграцию в AutoCAD.
3. Таблицы с расчетами – если расчеты выполняются в Word, а результат должен быть в чертеже, макрос упростит этот процесс.
4. Сохранение точных размеров – программа автоматически подстраивает ширину столбцов, что позволяет избежать искажений при переносе данных.

Как работает программа?

1. Пользователь выделяет таблицу в Word.
2. Запускает макрос, который:
   Определяет количество строк и столбцов.
   Считывает ширину столбцов для точного воспроизведения в AutoCAD.
   Подключается к AutoCAD (если программа не запущена, она автоматически запускается).
   Запрашивает точку вставки таблицы.
   Создает таблицу в AutoCAD с корректными размерами.
   Переносит текст из ячеек Word в соответствующие ячейки AutoCAD.
3. После завершения копирования таблица обновляется и становится частью чертежа.

Как использовать код?

1. Открыть Word и выделить таблицу, которую нужно перенести в AutoCAD.
2. Открыть редактор VBA (нажать ALT + F11).
3. Создать новый модуль (в редакторе VBA выбрать Insert → Module).
4. Вставить код ниже в созданный модуль:

Sub CopyTableToAutoCAD_Full()
Dim WordTable As Table
Dim acadApp As Object
Dim acadDoc As Object
Dim columnWidths() As Single
Dim i As Integer, j As Integer
Dim insertionPoint As Variant
Dim cellText As String

' 1. Получение таблицы из Word
Set WordTable = Selection.Tables(1)
If WordTable Is Nothing Then
MsgBox "Выделите таблицу в Word", vbCritical
Exit Sub
End If

' 2. Сохранение ширины столбцов
ReDim columnWidths(WordTable.Columns.Count - 1)
For i = 1 To WordTable.Columns.Count
columnWidths(i - 1) = WordTable.Columns(i).Width
Next i

' 3. Подключение к AutoCAD
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox "Ошибка подключения к AutoCAD", vbCritical
Exit Sub
End If
End If

acadApp.Visible = True
Set acadDoc = acadApp.ActiveDocument
If acadDoc Is Nothing Then Set acadDoc = acadApp.Documents.Add

' 4. Выбор точки вставки
insertionPoint = acadDoc.Utility.GetPoint(, "Укажите точку вставки: ")
If IsEmpty(insertionPoint) Then Exit Sub

' 5. Параметры масштабирования
Const SCALE_WIDTH As Double = 1000
Const SCALE_HEIGHT As Double = 100
Const BASE_TEXT_HEIGHT As Double = 2.5 ' Исходная высота текста в мм

' 6. Создание таблицы в AutoCAD
Dim acadTable As Object
Set acadTable = acadDoc.ModelSpace.AddTable( _
insertionPoint, _
WordTable.Rows.Count, _
WordTable.Columns.Count, _
BASE_TEXT_HEIGHT * SCALE_HEIGHT * 2, _
BASE_TEXT_HEIGHT * SCALE_HEIGHT _
)

' 7. Установка ширины столбцов
For i = 0 To UBound(columnWidths)
acadTable.SetColumnWidth i, columnWidths(i) * 0.035 * SCALE_WIDTH
Next i

' 8. Копирование содержимого ячеек
For i = 1 To WordTable.Rows.Count
For j = 1 To WordTable.Columns.Count
' Извлечение текста из Word
cellText = WordTable.Cell(i, j).Range.Text
cellText = Left(cellText, Len(cellText) - 2) ' Удаление спецсимволов

' Запись в AutoCAD с масштабированием текста
acadTable.SetText i - 1, j - 1, cellText
acadTable.SetTextStyle i - 1, j - 1, "Standard"
acadTable.SetTextHeight i - 1, j - 1, BASE_TEXT_HEIGHT * SCALE_HEIGHT
Next j
Next i

' 9. Финализация
acadTable.Update
acadApp.ZoomAll
End Sub

Запустить макрос через Macros (ALT + F8 → выбрать CopyTableToAutoCAD_Full → Run).

Указать точку вставки в AutoCAD, после чего таблица появится в чертеже.

Дополнительные возможности

• Масштабирование текста для удобочитаемости.
• Автоматическое устранение лишних символов из Word (например, скрытых символов форматирования).
• Возможность выбора точного места вставки.