АвтоЗаполнялка. Часть 2
Entry posted by doctorraz in Автоматизация ·
1,433 views
Сделал автозаполнялку , по результатам боевых стрельб внезапно выяснилось, что нана не умеет работать с полями нативных объектов.
Зато умеет вставлять поля из свойств документа (хотя возможно в следующей версии пофиксят и все будет наоборот)))
Возник вопрос, как запихнуть данные в свойства документа....
Руками прям не вдохновляет
Второй вопрос откуда эти данные брать, решился просто, коль у нас на чертеже есть таблица, (автозаполнялка) в которую мы занесли все сведения...
отчего бы данные не подтянуть из нее.
Принцип в кратце:
- Хватаем конкретную таблицу на чертеже
- Пробегаем по значениям именованных ячеек
- Имя ячейки пишем как ключ в пользовательские свойства документа
- Значением-свойством ключа будет содержимое ячейки
------------------------
Некритичные проверки исключений я не делал, кому надо вполне может дописать, как надо
Если изменить "комментарии" ячеек, то соответственно в свойства документа запишутся другие ключи
Все ключи пишутся в пользовательские свойства документа, но при желании можно писать и в
Под спойлером код, старался комментировал))
Dim ThisDrawing As Object Sub docProp() 'заполнялка полей документа из таблицы (именованных ячеек) 'без проверки исключений, чисто для общего понятия как Set objApp = GetObject(, "nanoCAD.Application") 'цепляемся к нане, или AutoCAD Set SPDS = CreateObject("McCOM2.Server") 'Получаем COM-сервер СПДС Set ThisDrawing = objApp.ActiveDocument 'хватаем активный документ Set ff = ThisDrawing TabName = "Заполнялка Таблица в таблицы" 'эту таблицу будем искать на чертеже Set FindTable = SPDS.Query("McCom2.SymTable", "Name=""" & TabName & """") _ 'ищем таблицу, можно изменить на свое If FindTable.Count > 0 Then 'если хоть одна таблица с таким именем найдена Set PropTable = FindTable(1).Properties 'хватаем первую из коллекции с таким именем (предполагается, что она одна))) Dim varr '<тут готовим путь для записи в таблицу (мне так надо) If ThisDrawing.FullName Like "*\*" Then 'НАНОКОСТЫЛЬ если файл сохранялся FulPatch = ThisDrawing.FullName '<тут получаем имя файла без расширения varr = Split(ThisDrawing.Name, ".") ReDim Preserve varr(UBound(varr) - 1) Filename = Join(varr, "") Else FulPatch = "ФАЙЛ НЕ СОХРАНЯЛСЯ!!" Filename = ThisDrawing.Name End If Dim PropKey As String 'ключ для записи в свойства документа (коментарий ячейки) Dim PropVal As String 'свойство ключа)) (содержимое ячейки) On Error Resume Next 'страховочка вдруг такой ячейки нет(( PropTable("Путь к файлу") = FulPatch 'пишем в ячейку полный путь PropTable("Имя файла") = Filename 'пишем в ячейку имя файла On Error GoTo 0 'тут в цикле заполняем свойства документа из именованных ячеек For Each namProp In PropTable.Names 'перебираем имена свойств Set PropProp = PropTable(namProp) 'получаем свойство по имени PropCategory = PropProp.Category If PropCategory = "Именованные ячейки" Then 'из свойств нам нужны только именованные ячейки PropKey = namProp 'коментарий ячейки будет ключ PropVal = PropProp.Value 'значение ячейки SetOrAddKey PropKey, PropVal 'идем писать в свойства End If Next res = "Значения именованных ячеек из " & "<" & TabName & ">" & _ " записаны в свойства документа" ThisDrawing.SendCommand "(alert """ & res & """)" & vbCrLf SPDS.Message (res) Else MsgBox "Таблица: """ & TabName & """" & vbCrLf & _ "не найдена на чертеже!", vbInformation, "docProp" End If End Sub Function SetOrAddKey(Key1 As String, val As String) On Error Resume Next ThisDrawing.SummaryInfo.SetCustomByKey Key1, val 'НАНОКОСЯК если ключа нет в каде будет исключение, но нана создаст ключ))) If Err.Number <> 0 Then ThisDrawing.SummaryInfo.AddCustomInfo Key1, val Err.Number = 0 End If On Error GoTo 0 End Function Sub main() docProp End Sub
Сразу скажу из скрипта VBS внутри наны этот код работать не будет, хотя конечно заманчиво... (значения ключей и свойства должны быть String и никак иначе, а в скриптах типы данных я не умею )
Поэтому этот код запускается из Excel большой красной кнопкой.
В принципе, как дальнейшее развитие, этот код можно причесать, откомпилировать и запускать, хоть из командной строки нано, из меню или кнопкой на панели.
В аттаче шаблон чертежа и большая красная кнопка.
PS кода без багов не бывает, поэтому по мере... буду улучшать
Edited by doctorraz
-
2
-
2
16 Comments
Recommended Comments