Динамическое изменение примитивов

Скажу честно: лично меня зрелище изменения примитивов чертежа "на лету" всегда завораживало. До очень многих вещей мне не дорасти (например, как показан здесь), но кое-что можно попытаться разобрать.

Не далее как вчера мне (точнее, не мне, а пользователям) понадобилось "подогнать" угол штриховки так, чтобы он был параллелен определенной линии. Самой линии не существует.

Можно, конечно, снять угол командой _.dimangular, а потом в свойствах штриховки установить полученное значение. Но это скучно :) Интереснее написать код.

Как всегда существует как минимум 2 варианта лиспа: через ActiveX и через ename. Скажу честно: лично у меня вариант внесения изменений через модификацию ename-представлений работал неустойчиво в разных версиях, поэтому я его и не привожу. А вот ActiveX - пожалуйста.

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
(vl-load-com)

(defun c:hatch-rotate-vla (/ adoc *error* selset gr err)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq selset (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (ssget "_:L" '((0 . "HATCH")))
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (= (type (setq center (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (getpoint "\nНачальная точка поворота <Отмена> ")
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           ) ;_ end of and
    (progn
      (setq selset (mapcar
                     (function
                       (lambda (x)
                         (list
                           (cons "item" (setq x (vlax-ename->vla-object x)))
                           (cons "pattern" (vla-get-patternangle x))
                           (cons "gradient" (vla-get-gradientangle x))
                           ) ;_ end of list
                         ) ;_ end of lambda
                       ) ;_ end of function
                     ((lambda (/ tab item)
                        (repeat (setq tab  nil
                                      item (sslength selset)
                                      ) ;_ end setq
                          (setq tab (cons (ssname selset (setq item (1- item))) tab))
                          ) ;_ end repeat
                        ) ;_ end of lambda
                      )
                     ) ;_ end of mapcar
            ) ;_ end of setq
      (vl-catch-all-apply
        (function
          (lambda ()
            (while (= (car (setq gr (grread t 1))) 5)
              (redraw)
              (grdraw center (cadr gr) 1 1)
              (foreach item selset
                (if (vl-catch-all-error-p
                      (vl-catch-all-apply
                        (function
                          (lambda ()
                            (vla-put-patternangle
                              (cdr (assoc "item" item))
                              (+ (cdr (assoc "pattern" item)) (angle center (cadr gr)))
                              ) ;_ end of vla-put-patternangle
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                      ) ;_ end of vl-catch-all-error-p
                  (vla-put-gradientangle
                    (cdr (assoc "item" item))
                    (+ (cdr (assoc "gradient" item)) (angle center (cadr gr)))
                    ) ;_ end of vla-put-gradientangle
                  ) ;_ end of if
                ;; (vla-update (cdr (assoc "item" item)))
                ) ;_ end of foreach
              ) ;_ end of while
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of progn
    ) ;_ end of if
  (redraw)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Конечно, если Евгений Елпанов или любой другой зубр лиспа сюда заглянет, головы мне не сносить (даже сейчас я вижу несколько моментов, которые можно было бы реализовать): привязки не отслеживаются, точные координаты не ввести и т.п.

Сейчас я хотел бы сказать о нескольких вещах, на которых лично я "споткнулся" (не обсуждая саму логику команды):

  1. Сам по себе (redraw) в данном варианте необходим - в противном случае на экране будет черт-те что. Но на насыщенных чертежах именно эта функция может весьма серьезно тормозить работу.
  2. В коде учтен вариант градиентной заливки - у нее, конечно, есть свойство PatternAngle, да только вот проблема: его изменение ведет к ошибке. Поэтому приходится предусматривать обработку GradientAngle.
  3. В некоторых случаях (особенно это касается версий 2005 и 2006) может понадобится принудительно обновление примитива (понадобится раскомментировать строку
    1
    ;; (vla-update (cdr (assoc "item" item)))

    , что тоже не самым лучшим образом сказывается на быстродействии.

Если код надо разобрать "пошагово", то это можно сделать.

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



Комментарии

Есть 3 коммент. к “Динамическое изменение примитивов”
  1. ElpanovEvgeniy пишет:

    >> "Конечно, если Евгений Елпанов или любой другой зубр лиспа сюда заглянет, головы мне не сносить (даже сейчас я вижу несколько моментов, которые можно было бы реализовать): привязки не отслеживаются, точные координаты не ввести и т.п."

    Тебе можно дать только комплимент! Нашел время, написал статью, показал код и указал на тонкости использования в реальных чертежах...
    Меня, чаще всего, хватает только на код. Кстати, сегодня выложил в болото код динамического оффсета отдельного сегмента полилинии. Посмотреть можно:
    http://www.theswamp.org/index.php?topic=30650.msg378370#msg378370

  2. Кулик Алексей aka kpblc пишет:

    Евгений, спасибо на добром слове :)
    О твоем коде: я знал, что по математике тебе нет равных. И по коду тоже :) Твой лисп - та вершина, до которой, боюсь, мне никогда не дорасти :)

  3. ElpanovEvgeniy пишет:

    Мы уже давно на равных!
    Забыл, я иногда обращаюсь к тебе за советом? ;)

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


Я не робот.