Добрый день!
Недавно начал знакомится с VBA, и как результат написал свой первый код.
В двух словах о задаче которую выполняет данный код:
Имеется N количество файлов DWG, в каждом файле N количество листов, на каждом листе расположен блок "Штамп основной надписи".
Текстовые надписи в "Штампе" реализованы как Атрибуты.
Задача кода, Открыть выбранный файл DWG --- Найти в этом файле блок "Штамп" --- Заменить Текст Атрибутов на значения из таблицы Exel.
Собственно представленный код решает эту задачу.
Просьба моя состоит в следующем:
Так как я совсем новичок в VBA, кропотливым трудом я код написал и он работает, но хотелось бы довести его до ума, в плане оптимизации и различных проверок на ошибки в ходе выполнения.
Взгляните пожалуйста опытным взглядом, и набросайте советов. Очень нужен взгляд со стороны.
Public Sub Object_DATA()
'Создаем список файлов
Dim FileName As Variant
Dim x As Variant
Dim Acad As Object
On Error Resume Next
Set Acad = CreateObject("AutoCAD.Application")
FileName = Sheets("Content").Range("A2:A12")
'Открываем файл DWG
For x = LBound(FileName) To UBound(FileName) 'Начинаем цикл: открыть DWG - Изменить атрибуты - сохранить и закрыть DWG
With Acad.Documents
.Open FileName(x, 1)
End With
'Выбираем в открытом чертеже нужный блок
Dim sset As AcadSelectionSet
Dim modeX(0) As Integer
Dim modeY(0) As Variant
Dim Name As String
Dim objEnt As AcadEntity
Name = "ДП_штамп2"
modeX(0) = 2
modeY(0) = Name
Acad.ActiveDocument.SelectionSets("SS2").Delete
Set sset = Acad.ActiveDocument.SelectionSets.Add("SS2")
sset.Select acSelectionSetAll, , , modeX, modeY
'Создаем массив данных из Exel
Dim attEx As Variant
Dim i As Variant
Dim k As Variant
attEx = Sheets("Object").Range("B2:C27")
'Получаем атрибуты и изменяем их значения
For Each objEnt In sset
If objEnt.HasAttributes = True Then
att = objEnt.GetAttributes
For i = LBound(att) To UBound(att)
For k = LBound(attEx) To UBound(attEx)
If att(i).TagString = attEx(k, 1) Then
att(i).TextString = attEx(k, 2)
End If
Next k
Next i
End If
Next
'Сохраняем и закрываем чертеж
Acad.Documents.Save
Acad.Documents.Close
Next x 'Завершаем цикл: открыть DWG - Изменить атрибуты - сохранить и закрыть DWG
End Sub
