Особенности vla-функций и их применения, часть 3

Автор: | Дата: 16 Октябрь 2009 · Прокомментировать 

В предыдущих частях (здесь и здесь) велся разговор о графических примитивах. Здесь немного продолжим о них, но основной упор сделаем на неграфических элементах dwg-файла (стилях, слоях, описаниях блоков и т.п.).

В части 2 был показан вариант внесения изменений в свойство Normal (группа 210) примитива. А что будет, если заменить свойство слоя (Layer; DXF-группа 8)? Особенно для несуществующего слоя?
Если подобное выполнять через entmod, то слой будет создан. Обычно создается слой по аналогии с текущими настройками слоя "0", но, говорят, "бывают варианты". А вот vla-операции подобных вольностей не позволяют, и придется сначала слой создать, и только потом его назначать:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun lispru-ent-modify-ename (/ ent layer)
  (setq layer "Layer_Ent"
        ent   (entmakex
                '((0 . "LINE")
                  (10 0. 0. 0.)
                  (11 10. 100. 0.)
                  )
                ) ;_ end of entmakex
        ) ;_ end of setq
  (entmod (entmod (subst (cons 8 layer)
                         (assoc 8 (entget ent))
                         (entget ent)
                         ) ;_ end of subst
                  ) ;_ end of entmod
          ) ;_ end of entmod
  ) ;_ end of defun

Выполним код в пустом файле и проверим: действительно, отрезок создан, и получил слой Layer_Ent. А теперь попробуем аналогичное сделать для vla-функций:

1
2
3
4
5
6
7
8
9
10
11
12
13
(defun lispru-ent-modify-vla1 (/ ent layer)
  (vl-load-com)
  (setq layer "Layer_Vla"
        ent   (vla-addline
                (vla-get-modelspace
                  (vla-get-activedocument (vlax-get-acad-object))
                  ) ;_ end of vla-get-ModelSpace
                (vlax-3d-point '(100. 0. 0.))
                (vlax-3d-point '(110. 100. 0.))
                ) ;_ end of vla-addline
        ) ;_ end of setq
  (vla-put-layer ent layer)
  ) ;_ end of defun

Попытка выполнить такой код выдаст ошибку:

1
2
Command: (lispru-ent-modify-vla1)
; error: Automation Error. Key not found

Поэтому код надо переделывать. Перед тем, как вносить изменения, попробуем немного "потеоритизировать". Как было сказано, "Суха, мой друг, теория всегда". Поэтому будем теоретизировать и ставить эксперименты одновременно. Поскольку споткнулись мы на ActiveX-обработке, с ней и будем воевать.
Создадим слой с именем "1":

1
2
_$ (setq layer (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) "1"))
#<VLA-OBJECT IAcadLayer 0bd43c04>

Как известно, каждый элемент файла dwg имеет уникальную метку (handle, или "хендл"). Посмотрим хендл только что созданного слоя:

1
2
_$ (vla-get-handle layer)
"1F5"

Это нам понадобится немного позже.
А вот что будет, если повторно выполнить "создание" слоя? То есть

1
2
_$ (setq layer1 (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) "1"))
#<VLA-OBJECT IAcadLayer 0bd43d94>

Ух ты, а слой-то повторно создан, что ли? Да нет, не создан он. Просто получен новый указатель на него. Это будет видно, если мы уже для layer1 попробуем получить хендл:

1
2
_$ (vla-get-handle layer1)
"1F5"

Казалось бы, все становится просто и понятно: надо или нет, все равно создаем новые слои, т.к. для случая их отсутствия слой будет создан; а для случая их существования - получен указатель на него.
Но лично я не рекомендовал бы такое делать. Честно говоря, такой код мне не кажется красивым. Для подобных вариантов я предпочитаю делать по-другому: попытаться получить сначала указатель на существующий слой, и, если его нет, то слой создавать.
Вариантов получения указателя на слой для vla-варианта несколько:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
;;; Во-первых, через vl-catch-*
(defun lispru-get-or-create-layer-by-error-catch (doc name / res)
                                                 ;|
*    Получение или создание указателя на элемент коллекции через
* отлов ошибок
*    Параметры вызова:
  doc   указатель на обрабатываемый документ. nil -> текущий
  name    имя создаваемого слоя
*    Возвращает vla-указатель на созданный или существующий слой
|;
  (if (not doc)
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of if
  (if (vl-catch-all-error-p
        (setq res (vl-catch-all-apply
                    (function
                      (lambda ()
                        (vla-item (vla-get-layers doc) name)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
              ) ;_ end of setq
        ) ;_ end of vl-catch-all-error-p
    (setq res (vla-add (vla-get-layers doc) name))
    ) ;_ end of if
  res
  ) ;_ end of defun

Достаточно простое и очевидное решение, но в некоторых случаях неприемлемое. Проблема возникает там, где ее совсем не ждешь.
Представим себе, что в vl-catch-* "обернуто" выполнение некоей функции, которая сама вызывает vl-catch-*, а та уже, в свою очередь - вызывает lispru-get-or-create-layer-by-error-catch. То есть vl-catch-* вложены друг в друга.
В некоторых версиях AutoCAD и/или вертикальных приложениях уровень подобных вложений не может превышать 4-5. Не знаю, с чем это связано, но столкнуться с этим в условиях полноценной эксплуатации кода весьма неприятно. Возможно, сейчас эта проблема уже решена, не тестировал. Мне оказалось проще выполнять немного другой код:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
(defun lispru-get-or-create-layer-by-list (doc name /)
                                          ;|
*    Получение или создание указателя на элемент коллекции через
* список слоев
*    Параметры вызова:
  doc   указатель на обрабатываемый документ. nil -> текущий
  name    имя создаваемого слоя
*    Возвращает vla-указатель на созданный или существующий слой
|;
  (if (not doc)
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of if
  (if (member (strcase name)
              (mapcar
                (function
                  (lambda (x)
                    (strcase x)
                    ) ;_ end of lambda
                  ) ;_ end of function
                ((lambda (/ lst)
                   (vlax-for item (vla-get-layers doc)
                     (setq lst (cons (vla-get-name item) lst))
                     ) ;_ end of vlax-for
                   lst
                   ) ;_ end of lambda
                 )
                ) ;_ end of mapcar
              ) ;_ end of member
    (vla-item (vla-get-layers doc) name)
    (vla-add (vla-get-layers doc) name)
    ) ;_ end of if
  ) ;_ end of defun

Памятуя о времени выполнения, проведем тестирование:

1
2
3
4
5
_$ (benchmark '((lispru-get-or-create-layer-by-error-catch nil "Layer1") (lispru-get-or-create-layer-by-list nil "Layer2")))
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):

    (LISPRU-GET-OR-CREATE-LAYER-BY-ERROR...).....2031 / 2.54 <fastest>
    (LISPRU-GET-OR-CREATE-LAYER-BY-LIST ...).....5156 / 1 <slowest>

Как видим, в "пляжных" условиях (файл пустой, функция тестируется без вложенности и т.п.) выполнение через error-catch намного быстрее (по крайней мере у меня на компьютере). Но, вспоминая об ошибке вложений, я бы не рисковал. Если хотите - проведите несколько опытов. Может, Вам повезет больше чем мне.

Размещено в Код LISP, Новости · Метки: ,



Поделитесь своим мнением


Я не робот.