четверг, 7 марта 2013 г.

Пишем на VisualLisp под Civil 3D

Обсуждение на форуме DWG.RU
Пример блока с картограммой

Предыстория

С 2000-го по 2005-ый я работал в небольшой проектной фирме, где сначала был чертежником в отделе генплана. Иногда приходилось заниматься расчетом плана земляных масс. Из софта был Autodesk Land Desktop (LDD) и набор DOS-овских программ (sever.exe и plazma.exe, если не ошибаюсь, разработка Гипротюменнефтегаза), в которых был заложен некий алгоритм расчета осадок на болотах.

Процесс ввода данных был муторный - вручную вбивать координаты границ площадки. Потом sever рассчитывал координаты всех узловых и граничных точек. После этого нужно вручную ввести все отметки в узловых и граничных точках. На выходе получался DXF-файл c готовой картограммой.

Надо было как-то автоматизировать процесс. Методом научного тыка был определен формат файлов sever'a (оказалось, что это простые бинарные файлы с фиксированной длиной записи).

Программка на Delphi брала из LDD координаты полилинии (границ площадки) и записывала их в нужный файл расчетной программы. Затем вручную запускался sever и создавал файл с промежуточными точками. Далее снова Delphi, и в файле с промежуточными точками оказывались отметки поверхностей из LDD. Как-то так...

Чтобы исключить ручные шаги, добавил посылку нажатий клавиш в DOSовскую консоль. Стало еще проще. Но все равно это был набор костылей. К тому же нельзя было вмешаться в генерацию DXF-файла.

В итоге всей этой истории было решено написать программу с нуля под Land Desktop. Динамическая библиотека на Delphi вызывалась из Land Desktop (кстати с помощью самописного же модуля MtmdLoadDll на С++) и строила картограмму с осадкой по имеющимся цифровым моделям поверхностей.

Для тех кто не в курсе - вызовы COM-методов из DLL (т.е. в пределах одного процесса) на порядок быстрее чем межпроцессные COM-вызовы

С 2005-го года я долго занимался делами, далекими от генплана, пока в сентябре 2012 года не попал в Тюменьнефтегазпроект, где к тому времени успешно внедрили 3D-проектирование в технологическом отделе.

От меня требовалось перевести на рельсы 3D отдел генплана, учитывая мой некоторый опыт работы с Land Desktop. Всему отделу установили свеженький Civil 3D 2013, который оказался к тому же довольно глючноватым продуктом.

Собственно о Civil 3D

Первым делом я адаптировал свою старую программу на Delphi под новый Civil 3D, что оказалось не так уж и сложно. Но оставалась одна проблема - DLL у меня 32-битная, а у пользователей крутые новые компы с кучей оперативки и конечно с 64-битным Civil 3D. Правда программу можно было еще запускать в виде EXE-шника, но тогда дикие тормоза при общении с Civil 3D гарантированы. В общем, решил переписать на чем-то более правильном. Выбор небольшой - VisualLisp либо C# (ну или даже VB.NET). Учитывая мою любовь к первому и стойкое отвращение ко второму начал писать на лиспе. До сих пор не разочаровался в выборе, хотя под конец пришлось пару небольших функций переписать на C#.

Для справки: Civil 3D судя по всему унаследовал COM-интерфейс от Land Desktop, но в последнее время почти для всего есть и .NET-обертки. Плохо то, что некоторые новые функции появляются только в .NET, а COM-интерфейсов к ним нет. А это значит, что напрямую из лиспа к ним уже не обратиться и нужно писать лисп-функцию на C#.

Писать на лиспе под Civil 3D оказалось довольно приятно. Почувствуйте, как говорится разницу: в C# для отладки нужно каждый раз перезапускать Civil и ждать несколько минут, в случае с VisualLisp я в Civil набираю определенную мной же команду LPZM и вуаля - через секунду загружена свежая версия исходников.

В случае необходимости IDE VisualLisp можно запустить прямо на компьютере пользователя и посмотреть, что пошло не так. Выручало уже несколько раз. К тому же код на лиспе гораздо выразительнее и короче варианта на C#.

Далее попробую перечислить интересные моменты и подводные камни:

в VisualLisp есть возможность импорта tlb-файлов (Type library), но tlb-библиотека Civil 3D ему оказалась не по зубам. Так что пришлось отказаться от этой затеи и обращаться к функциям Civil'а через vlax-get-property, vlax-put-property и vlax-invoke-method

Интерфейсы и методы COM API Civil 3D можно посмотреть в онлайн-справке, значения констант я подглядывал в .pas-файле, созданном в Delphi. Можно также воспользоваться VBA-редактором любого продукта из MS Office

;; алиасы для длинных названий функций
(setq prop> vlax-get-property
  putprop> vlax-put-property
  m> vlax-invoke-method
  d> vlax-dump-object

  *pzmXdataAppName "TNGPPZM" ;; имя приложения для хранения XDATA
  *pzmXdataVer "1.0" ;; версия расширенных данных блока картограммы
  *pzmDebug nil ;; режим отладки (временные поверхности не удаляются)
  *pzmProgIdTinVolHelper "TNGP.PZMTinVolumeHelper" )

(defun C:LPZM () ;; команда для быстрой перезагрузки локальной копии
  (setq *pzmTestLocal T) ;; тестирование на локальной копии программы
  (princ (load "D:/mtm/Projects/TNGP.Civil3D/2013/pzm-lib.lsp" 
    "\nОшибка загрузки pzm-lib.lsp") )
  (princ (load "D:/mtm/Projects/TNGP.Civil3D/2013/pzm-initstyles.lsp" 
    "\nОшибка загрузки pzm-initstyles.lsp") )
  (princ (load "D:/mtm/Projects/TNGP.Civil3D/2013/vertplan.lsp" 
    "\nОшибка загрузки vertplan.lsp") ) 
  (princ (load "D:/mtm/Projects/TNGP.Civil3D/2013/pzm-xrecord.lsp" 
    "\nОшибка загрузки pzm-xrecord.lsp") )
  (setq *pzmDebug T)
  (princ)  
)

;; в зависимости от флага *pzmTestLocal грузим локальную или сетевую копию
;; .NET-модуля и DCL-ресурса
;; к тому же программа работает как под Civil 3D 2012, так и под Civil 3D 2013
(cond 
  ((= (acadver) "2012")
    (setq 
      *pzmProgIdAeccApp "AeccXUiLand.AeccApplication.9.0"
      *pzmProgIdTinCrData "AeccXLand.AeccTinCreationData.9.0"
      *pzmProgIdTinVolCrData "AeccXLand.AeccTinVolumeCreationData.9.0"
      *pzmDlgPath "TNGP.Civil3D/2013/pzm2012.dcl"
      *pzmDotNetModule "TNGP.Civil3D/2012/TNGP_Civil3D.NET.dll" )
    (if *pzmTestLocal 
      (setq 
        *pzmDlgPath "d:/TNGP.Civil3D/2013/pzm2012.dcl"
        *pzmDotNetModule "d:/TNGP.Civil3D.NET/2012/TNGP_Civil3D.NET.dll" ) ) )
  ((= (acadver) "2013")
    (setq 
      *pzmProgIdAeccApp "AeccXUiLand.AeccApplication.10.0"
      *pzmProgIdTinCrData "AeccXLand.AeccTinCreationData.10.0"
      *pzmProgIdTinVolCrData "AeccXLand.AeccTinVolumeCreationData.10.0"
      *pzmDlgPath "TNGP.Civil3D/2013/pzm.dcl"
      *pzmDotNetModule "TNGP.Civil3D/2013/TNGP_Civil3D.NET.dll" )
    (if *pzmTestLocal 
      (setq 
        *pzmDlgPath "d:/TNGP.Civil3D/2013/pzm.dcl"
        *pzmDotNetModule "d:/TNGP.Civil3D.NET/2013/TNGP_Civil3D.NET.dll" ) ) ) )

;; для корневых объектов используем несколько глобальных переменных   
(defun pzm-initrootobjects ()
  (cond
    ((not *pzm-TinVolHelper)
      (regapp *pzmXdataAppName)
      (setq *acadApp (vlax-get-Acad-object)
        *acadDoc (vla-get-ActiveDocument *acadApp)
        *aeccApp (vla-getInterfaceObject *acadApp *pzmProgIdAeccApp)
        *aeccDoc (prop> *aeccApp 'ActiveDocument)
        *aeccDb (prop> *aeccDoc 'Database)
        *pzm-TinVolHelper (vla-getInterfaceObject *acadApp *pzmProgIdTinVolHelper) )
      (pzm-initAllPointGrpCustProps)
      ) ) )

;; обнаружилась неприятная особенность встроенной функции rtos - отбрасывание
;; ведущего нуля в зависимости от переменной DIMZIN. 
;; В просторах сети нашлась готовая обертка:
;; rtos wrapper  -  Lee Mac
;; A wrapper for the rtos function to negate the effect of DIMZIN
(defun LM:rtos ( real units prec / dimzin result )
    (setq dimzin (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq result (vl-catch-all-apply 'rtos (list real units prec)))
    (setvar 'dimzin dimzin)
    (if (not (vl-catch-all-error-p result))
        result ) )
;; как выяснилось, в Civil 3D только у коллекций IAeccSurfaces и IAeccWatershedDrains 
;; есть свойство Item, у всех остальных - метод Item. С учетом этого была написана
;; универсальная  функция для доступа к элементам коллекций:
(defun item> (collName Itm / coll res)
  (setq coll 
    (cond 
      ((eq (type collName) 'VLA-OBJECT) ;; (item> collObject "ItemName")
        collName )
      ((eq (type collName) 'LIST)       ;; (item> (cons *parentObj 'CollName) "ItemName") 
        (prop> (car collName) (cdr collName)) )
      (T (prop> *aeccDb collName)) ) )  ;; (item> 'CollName "ItemName")
  (cond
    ((vlax-method-applicable-p coll 'Item)
      (setq res (vl-catch-all-apply 'm> (list coll 'Item Itm))) )
    ((vlax-property-available-p coll 'Item)
      (setq res (vl-catch-all-apply 'prop> (list coll 'Item Itm))) ) )
  (if (vl-catch-all-error-p res) nil res) )
;; Примеры вызова:
;; aeccDb.Surfaces("Surface 1") => (item> 'Surfaces "Surface 1")
;; aeccDb.Surfaces("Surface 1") => (item> (cons *aeccDb 'Surfaces) "Surface 1")
;; aeccDb.Surfaces("Surface 1") => (item> (prop> *aeccDb 'Surfaces) "Surface 1")

;; Обработка ошибок.
;; Так как я использую групповую отмену операций (vla-startundomark и vla-endundomark),
;; при возникновении ошибки проверяется состояние стека отмены операций
;; в случае необходимости добавляется маркер закрытия группы. 
(defun pzm-ErrHandler (msg)
  (if *pzm-error* (setq *error* *pzm-error* *pzm-error* nil))
  (if (= 8 (logand 8 (getvar "UNDOCTL"))) (vla-endundomark *acadDoc))
  (princ (if errmsg errmsg msg)) )

;; аналог функции assert: если первый аргумент вычисляется в nil, 
;; программа завершается с внятным сообщением об ошибке
;; пример: (pzm-assert 'elev "\nОшибка: elev = nil")
(defun pzm-assert (expr msg)
  (if (not (eval expr)) (pzm-ExitWithMsg msg)) )

;; функция завершения программы с сообщением об ошибке: 
;; пример: (if (not var) (pzm-ExitWithMsg "\nError: var=nil"))  
(defun pzm-ExitWithMsg (errmsg)
  (if *error* (setq *pzm-error* *error*))
  (setq *error* pzm-ErrHandler)
  (quit) )

В ходе разработки возникли проблемы с созданием поверхности объема. Оказалось, что из лиспа не работает присвоение объектных свойств:

TinCreationData.BaseSurface = BaseSurface;
TinCreationData.ComparisonSurface = CompSurface;

На помощь пришла чудесная вещь под названием WSC (Windows Script Components) - сценарий на VBScript/JScript, завернутый в специальный XML-формат и регистрируемый в системе как обычный COM-server. Как оказалось, эти сценарии отлично загружаются и в 64-битный процесс.

Файл tinvolume-helper.wsc

<?xml version='1.0' encoding='windows-1251' standalone='yes'?>  
<component>  
<registration
    description="Tin volume creation helper"
    progid="TNGP.PZMTinVolumeHelper"
    version="1.00"
    classid="{1AC5DCE8-0A61-4697-B1C6-62A62D6E5124}"
/>  
<public>  
<method name='AssignSurfaces'>
 <parameter name="TinCreationData"/>
 <parameter name="BaseSurface"/>
 <parameter name="CompSurface"/>
</method>  
</public>  
<script language="JScript"><![CDATA[  
function AssignSurfaces(TinCreationData, BaseSurface, CompSurface) {
 TinCreationData.BaseSurface = BaseSurface;
 TinCreationData.ComparisonSurface = CompSurface;
 return 0;
}
]]></script>  
</component>

Далее регистрируем сценарий: regsvr32 tinvolume-helper.wsc (кстати лучше вместо этого сделать обычный reg-файл, который может указывать на HKCU\SOFTWARE\Classes, тогда права администратора для регистрации компонента не потребуются. Теперь через vla-getInterfaceObject мы можем загрузить наш сценарий.

...
(setq *pzm-TinVolHelper (vla-getInterfaceObject *acadApp "TNGP.PZMTinVolumeHelper"))
...
(defun pzm-AddVolSurf (Name BaseSurf CompSurf / crData surf)
  (or (item> 'SurfaceStyles "NullWorkLines") (pzm-CheckSurfStyles))
  (if (setq surf (pzm-getSurface Name)) (m> surf 'Delete))
  (setq crData (vla-getInterfaceObject *acadApp *pzmProgIdTinVolCrData))
  (putprop> crData 'Name Name)
  (putprop> crData 'Style "NullWorkLines")
  (putprop> crData 'Layer "0")
  (putprop> crData 'BaseLayer "0")
  (putprop> crData 'Description "Volume surface")
  (m> *pzm-TinVolHelper 'AssignSurfaces crData BaseSurf CompSurf nil nil)
  (m> (pzm-Surfaces) 'AddTinVolumeSurface crData) )

Для построения картограммы я использую обычный блок с автоматической генерацией имени. Настройки конкретного экземпляра картограммы хранятся в расширенных данных ссылки на блок (BlockReference). Для генерации блока есть два способа: классический (entmake) и COM. Я выбрал первый вариант. Построение картограммы (с учетом расчета осадок) занимает буквально несколько секунд.

Особенности entmake: при повторном перестроении блока старое содержимое заменяется автоматически. При использовании COM блок бы пришлось предварительно очистить. Но способ с COM позволяет сделать хитрый финт ушами: можно обновить отметки в блоке картограммы, не перестраивая и не удаляя графические элементы. У пользователя появляется возможность редактировать картограмму и после этого обновлять ее, не теряя результатов редактирования.

Однако в дальнейшем я столкнулся с трудностями при отрисовке мультивыноски (объект MLEADER): непонятно, как с помощью entmake создать объект MLEADER c прикрепленным к нему блоком да еще и с атрибутами. В итоге пришлось MLEADER добавлять через COM уже после создания блока.

Возможно кому-то пригодится информация о работе с пользовательскими свойствами точек (AeccPoint). Оказывается для точек можно определить дополнительные поля разных типов (строки, числа и т.п) и использовать их для хранения и отображения дополнительной информации. Нюанс в том, что для работы с этими свойствами нужно предварительно вызвать метод SetUserDefinedPropertyClassification для группы точек (AeccPointGroup). В коде ниже приведен пример вызова этого метода

Также можно программно инициализировать практически все стили и настройки чертежа. Примеры смотрите ниже. Правда дело это неблагодарное... всё же гораздо проще один раз настроить шаблон ручками. Преимущество программного метода только в том, что чертеж может быть создан на любом (или на более старом) шаблоне, в котором не оказалось нужных стилей/настроек.

;; Для доступа к custom-свойствам точек необходимо для группы точек
;; вызвать SetUserDefinedPropertyClassification  
(defun pzm-initAllPointGrpCustProps ( / clName udp)
  (setq 
    clName "ГП" ;; наша группа классификации (в шаблоне)
    udp (item> 'PointUserDefinedPropertyClassifications clName) )
  (if (not udp) (pzm-ExitWithMsg
    (strcat "\nОшибка! Классификация пользовательских свойств \"" 
      clName "\" не найдена") ) )
  (vlax-for grp (prop> *aeccDb 'PointGroups)
    ;; aeccUDPClassificationApplyAll = 1
    (m> grp 'SetUserDefinedPropertyClassification 1 udp) ) )

(defun GetOrCreateItem (collName Name / coll)
  (setq curStyle ;; curStyle - глобальная переменная, указывает на текущий стиль 
    (cond 
      ((item> (setq coll (prop> *aeccDb collName)) Name))
      ((m> coll 'Add Name)) ) ) )

(defun setitem (L Val / Itm)
  (setq Itm curStyle)
  (cond 
    ((listp L)
      (while (cdr L) (setq Itm (prop> Itm (car L)) L (cdr L) ))
      (putprop> Itm (car L) Val) )
    (T (putprop> Itm L Val)) ) )

(defun pzm-GeneralSettings ()
  ;aeccDrawingUnitMeters = 2,
  ;; *aeccDb.Settings.DrawingSettings.UnitZoneSettings.DrawingUnits = aeccDrawingUnitMeters
  (setq curStyle *aeccDb)
  (setitem '(Settings DrawingSettings UnitZoneSettings DrawingUnits) 2) )

;; настройка стилей точек
(defun pzm-CheckPointStyles ( / 
  curStyle add-udp udpc props grpPeat)
  ;--- local functions ---
  ;; aeccUDPPropertyFieldTypeString = 17
  (defun add-udp (Name Desc)
    (m> props 'Add Name Desc 17 :vlax-false :vlax-false 0 
      :vlax-false :vlax-false 0 :vlax-true "??,??" 0) )
  ;--- end local functions ---
  ;; создаем стиль точки
  (GetOrCreateItem 'PointStyles "Точка планировки")
  (setitem 'CustomMarkerStyle 2)
  (setitem 'MarkerSize 0.001)
  (GetOrCreateItem 'PointStyles "Точка болота")
  (setitem 'CustomMarkerStyle 2)
  (setitem 'CustomMarkerSuperimposeStyle 2)
   
  (setitem 'MarkerSize 0.001)
  ;; стили отметок для точек
  (GetOrCreateItem 'PointLabelStyles "Номер-Отметка-Описание")
  (GetOrCreateItem 'PointLabelStyles "Точка планировки")
  (GetOrCreateItem 'PointLabelStyles "Отметка болота")
  (vlax-for itm (prop> curStyle 'TextComponents)
    (cond 
      ((= (prop> itm 'Name) "Описание точки")
        (putprop> (prop> itm 'AnchorPoint) 'Value 5)
        (putprop> (prop> itm 'Attachment) 'Value 3)
        (putprop> (prop> itm 'AnchorComponent) 'Value "")
        ;(d> (prop> itm 'AnchorComponent))
        ;(princ (strcat "\n" (prop> itm 'Name))) 
        )
      (T (putprop> (prop> itm 'Visibility) 'Value :vlax-false)) ) )
  
  ;; создаем пользовательские свойства для точек планировки
  (setq udpc (prop> *aeccDb 'PointUserDefinedPropertyClassifications)
    props (prop> (cond ((item> udpc "ГП")) ((m> udpc 'Add "ГП"))) 'UserDefinedProperties))
  (or (item> props "DIFF") (add-udp "DIFF" "Рабочая отметка"))
  (or (item> props "EG") (add-udp "EG" "Черная отметка")) )

Когда же мне понадобился C#? Пришлось на нем накатать пару функций:

(TNGP:SetVertexElevations surfename '((x y z) (x y z)... )), которая устанавливает отметки в нескольких точках поверхности (это потребовалось при генерации поверхности осадки);

(TNGP:PasteSurface dstsurfename srcsurfename), которая вставляет одну поверхность в другую.

Увы, разработчики Civil 3D не предоставили COM-интерфейс...

Комментариев нет: