Обработка объектов размеров

Автор: | Дата: 16 Март 2014 · Прокомментировать 

Разгребая старые завалы, нашел вот такой текст. Вроде бы в нем ничего не забыл, кроме одного: исходных кодов в виде lsp нет.

Иногда бывает необходимо "проконтролировать" правильность проставленных размеров. Контроль бывает разным - иногда надо исправленные вручную размеры переместить в какой-то слой, или цвет назначить, или еще что-то. Попробую сделать что-то достаточно универсальное, т.к. подо все требования расписывать разные функции малоинтересно.

Прародителем поста выступила тема на dwg.ru.

Начальный код получается таким:

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
                     ;|
*    Функция обработки размеров.
*    Параметры вызова:
  selset  Набор или список объектов размеров. nil прекращает выполнение функции.
  lst     Список параметров вида
  '(("change" ; Для измененных размеров
      ("prefix" . <Символ(ы) префикса>) ; вставляется для измененных размеров
      ("suffix" . <Символ(ы) суффикса>)  ; вставляется для измененных размеров
      ("color" . <Назначаемый цвет>)   ;
      ("lw" . <Вес линии>)              ;
      ("layer" . <Слой>)                ;
      ("ltype" . <Тип линии>)           ; должен быть в файле. Наличие не проверяется
      )
    ("unchange" ; Для неизмененных размеров
      ("prefix" . <Символ(ы) префикса>) ; вставляется для измененных размеров
      ("suffix" . <Символ(ы) суффикса>)  ; вставляется для измененных размеров
      ("color" . <Назначаемый цвет>)   ;
      ("lw" . <Вес линии>)              ;
      ("layer" . <Слой>)                ;
      ("ltype" . <Тип линии>)           ; должен быть в файле. Наличие не проверяется
      )
    ("norm" . <Выполнять нормализацию или нет>)
      ; все подобъекты размера получают цвет, тип и вес линии ByBlock
    )
*    Обрабатываются только указанные размеры.
*    Возвращает список размеров
|;

  ) ;_ end of defun

Под "измененными" или "неизмененными" размерами в данном случае понимаются размеры с измененным значением показываемого текста. При этом под неизмененным размером понимается как размер со значением TextOverride равным "", так и <>.
Нам для работы понадобятся несколько "библиотечных" функций:

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
33
34
35
36
37
38
39
          ; http://forum.dwg.ru/showpost.php?p=188342&postcount=21
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

          ; http://forum.dwg.ru/showthread.php?t=15401
  (defun _dwgru-conv-ent-to-vla (ent)
                                ;|
*    Выполняет преобразование переданного указателя в vlax-вариант
*    Параметры вызова:
  ent обрабатываемый указатель. Может быть:
    ename
    vla-object
    строка (воспринимается как хендл примитива).
*    Примеры вызова:
(setq entity (entmakex (list (cons 0 "POINT") (cons 10 (getpoint)))))
(_dwgru-conv-ent-to-vla entity) ; #<VLA-OBJECT IAcadPoint 064ad294>
|;
    (cond
      ((= (type ent) 'vla-object) ent)
      ((= (type ent) 'ename) (vlax-ename->vla-object ent))
      ;|
;; Оригинальный вариант:
((= (type ent) 'str) (vlax-ename->vla-object (handent ent)))
|;
      ;; Исправления Alaspher от 28.11.2007. Начало.
      ((= (type ent) 'str)
       (if (setq ent (handent ent))
         (vlax-ename->vla-object ent)
         ) ;_ end of if
       )
      ;; Исправления Alaspher от 28.11.2007. Конец
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

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

Немного теории. Работая с файлом, в котором есть внешние ссылки, можно обрабатывать и объекты этих внешних ссылок: модифицировать их, удалять, перемещать... Только все это до момента первой перезагрузки ссылки. Для того, чтобы внести "полноценные" изменения, надо сначала внешнюю ссылку открыть (например, через ObjectDBX), и только потом обрабатывать.

Прежде всего преобразуем переданный набор (или список) объектов в список 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
28
29
30
(setq selset (mapcar
               (function
                 (lambda (x)
                   (_dwgru-conv-ent-to-vla x)
                   ) ;_ end of lambda
                 ) ;_ end of function
               (if (= (type selset) 'pickset)
                 (_dwgru-conv-pickset-to-list selset)
                 selset
                 ) ;_ end of if
               ) ;_ end of mapcar
      ;; Сразу же "выкидываем" из обработки "не-размеры".
      selset (vl-remove-if-not
               (function
                 (lambda (x)
                   (wcmatch (strcase (vla-get-objectname x)) "*DIM*")
                   ) ;_ end of lambda
                 ) ;_ end of function
               selset
               ) ;_ end of vl-remove-if-not
      ;; "Выкидываем также объекты, лежащие на слоях внешних ссылок
      selset (vl-remove-if
               (function
                 (lambda (x)
                   (wcmatch (vla-get-layer x) "*|*")
                   ) ;_ end of lambda
                 ) ;_ end of function
               selset
               ) ;_ end of vl-remove-if
      ) ;_ end of setq

В "боевом" варианте код, конечно, будет значительно короче:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(setq selset (vl-remove-if-not
               (function
                 (lambda (x)
                   (and (wcmatch (strcase (vla-get-objectname x)) "*DIM*")
                        (not (wcmatch (vla-get-layer x) "*|*"))
                        ) ;_ end of and
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function
                   (lambda (x)
                     (_dwgru-conv-ent-to-vla x)
                     ) ;_ end of lambda
                   ) ;_ end of function
                 (if (= (type selset) 'pickset)
                   (_dwgru-conv-pickset-to-list selset)
                   selset
                   ) ;_ end of if
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if-not
      ) ;_ end of setq

Теперь напишем еще 2 локальные функции, обрабатывающие слои:

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;; Функция сохранения состояния слоев
;; с одновременной разморозкой и разблокировкой
(defun fun_layer-save (/ res)
  (vlax-for item (vla-get-layers adoc)
    (if (not (wcmatch (vla-get-name item) "*|*"))
      (progn
        (setq res (cons (list item
                              (cons "freeze" (vla-get-freeze item))
                              (cons "lock" (vla-get-lock item))
                              ) ;_ end of list
                        res
                        ) ;_ end of cons
              ) ;_ end of setq
        (vl-catch-all-apply
          (function
            (lambda ()
              (vla-put-freeze item :vlax-false)
              ) ;_ end of lambda
            ) ;_ end of function
          ) ;_ end of vl-catch-all-apply
        (vl-catch-all-apply
          (function
            (lambda ()
              (vla-put-lock item :vlax-false)
              ) ;_ end of lambda
            ) ;_ end of function
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of vlax-for
  res
  ) ;_ end of defun

;; И функция восстановления состояния слоев
(defun fun_layer-restore (lst)
  (foreach item lst
    (foreach prop (cdr item)
      (vl-catch-all-apply
        (function
          (lambda ()
            (vlax-put-property (car item) (car prop) (cdr prop))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of foreach
    ) ;_ end of foreach
  ) ;_ end of defun

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

Конечный код получился наподобие

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
(vl-load-com)

(defun dimoperations (selset              lst                 /                   fun_layer-save
                      fun_layer-restore   _dwgru-conv-pickset-to-list             _dwgru-conv-ent-to-vla
                      *error*             adoc                layer_lst           selset
                      )
                      ;|
*    Функция обработки размеров.
*    Параметры вызова:
  selset  Набор или список объектов размеров. nil прекращает выполнение функции.
  lst     Список параметров вида
  '(("change" ; Для измененных размеров
      ("prefix" . <Символ(ы) префикса>) ; вставляется для измененных размеров
      ("suffix" . <Символ(ы) суффикса>)  ; вставляется для измененных размеров
      ("color" . <Назначаемый цвет>)   ;
      ("lw" . <Вес линии>)              ;
      ("layer" . <Слой>)                ;
      ("ltype" . <Тип линии>)           ; должен быть в файле. Наличие не проверяется
      )
    ("unchange" ; Для неизмененных размеров
      ("prefix" . <Символ(ы) префикса>) ; вставляется для измененных размеров
      ("suffix" . <Символ(ы) суффикса>)  ; вставляется для измененных размеров
      ("color" . <Назначаемый цвет>)   ;
      ("lw" . <Вес линии>)              ;
      ("layer" . <Слой>)                ;
      ("ltype" . <Тип линии>)           ; должен быть в файле. Наличие не проверяется
      )
    ("norm" . <Выполнять нормализацию или нет>)
      ; все подобъекты размера получают цвет, тип и вес линии ByBlock
    )
*    Обрабатываются только указанные размеры.
*    Возвращает список размеров
|;

  ;; Функция сохранения состояния слоев
  ;; с одновременной разморозкой и разблокировкой
  (defun fun_layer-save (/ res)
    (vlax-for item (vla-get-layers adoc)
      (if (not (wcmatch (vla-get-name item) "*|*"))
        (progn
          (setq res (cons (list item
                                (cons "freeze" (vla-get-freeze item))
                                (cons "lock" (vla-get-lock item))
                                ) ;_ end of list
                          res
                          ) ;_ end of cons
                ) ;_ end of setq
          (vl-catch-all-apply
            (function
              (lambda ()
                (vla-put-freeze item :vlax-false)
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          (vl-catch-all-apply
            (function
              (lambda ()
                (vla-put-lock item :vlax-false)
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of vlax-for
    res
    ) ;_ end of defun

  ;; И функция восстановления состояния слоев
  (defun fun_layer-restore (lst)
    (foreach item lst
      (foreach prop (cdr item)
        (vl-catch-all-apply
          (function
            (lambda ()
              (vlax-put-property (car item) (car prop) (cdr prop))
              ) ;_ end of lambda
            ) ;_ end of function
          ) ;_ end of VL-CATCH-ALL-APPLY
        ) ;_ end of foreach
      ) ;_ end of foreach
    ) ;_ end of defun

          ; http://forum.dwg.ru/showpost.php?p=188342&postcount=21
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

          ; http://forum.dwg.ru/showthread.php?t=15401
  (defun _dwgru-conv-ent-to-vla (ent)
                                ;|
*    Выполняет преобразование переданного указателя в vlax-вариант
*    Параметры вызова:
  ent обрабатываемый указатель. Может быть:
    ename
    vla-object
    строка (воспринимается как хендл примитива).
*    Примеры вызова:
(setq entity (entmakex (list (cons 0 "POINT") (cons 10 (getpoint)))))
(_dwgru-conv-ent-to-vla entity) ; #<VLA-OBJECT IAcadPoint 064ad294>
|;
    (cond
      ((= (type ent) 'vla-object) ent)
      ((= (type ent) 'ename) (vlax-ename->vla-object ent))
      ;|
;; Оригинальный вариант:
((= (type ent) 'str) (vlax-ename->vla-object (handent ent)))
|;
      ;; Исправления Alaspher от 28.11.2007. Начало.
      ((= (type ent) 'str)
       (if (setq ent (handent ent))
         (vlax-ename->vla-object ent)
         ) ;_ end of if
       )
      ;; Исправления Alaspher от 28.11.2007. Конец
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun *error* (msg)
    (fun_layer-restore layer_lst)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))

  ;; Сначала преобразуем набор примитивов в список
  (if (or (= (type selset) 'pickset)
          (= (type selset) 'list)
          ) ;_ end of or
    (progn
      ;; Список понадобится из vla-указателей
      (setq selset (mapcar
                     (function
                       (lambda (x)
                         (_dwgru-conv-ent-to-vla x)
                         ) ;_ end of lambda
                       ) ;_ end of function
                     (if (= (type selset) 'pickset)
                       (_dwgru-conv-pickset-to-list selset)
                       selset
                       ) ;_ end of if
                     ) ;_ end of mapcar
            ;; Сразу же "выкидываем" из обработки "не-размеры".
            selset (vl-remove-if-not
                     (function
                       (lambda (x)
                         (wcmatch (strcase (vla-get-objectname x)) "*DIM*")
                         ) ;_ end of lambda
                       ) ;_ end of function
                     selset
                     ) ;_ end of vl-remove-if-not
            ) ;_ end of setq
      (setq layer_lst (fun_layer-save))
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  ) ;_ end of defun

Вот, как-то так, примерно...

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



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


Я не робот.