Динамическое изменение примитивов
Скажу честно: лично меня зрелище изменения примитивов чертежа "на лету" всегда завораживало. До очень многих вещей мне не дорасти (например, как показан здесь), но кое-что можно попытаться разобрать.
Не далее как вчера мне (точнее, не мне, а пользователям) понадобилось "подогнать" угол штриховки так, чтобы он был параллелен определенной линии. Самой линии не существует.
Можно, конечно, снять угол командой _.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 |
Конечно, если Евгений Елпанов или любой другой зубр лиспа сюда заглянет, головы мне не сносить (даже сейчас я вижу несколько моментов, которые можно было бы реализовать): привязки не отслеживаются, точные координаты не ввести и т.п.
Сейчас я хотел бы сказать о нескольких вещах, на которых лично я "споткнулся" (не обсуждая саму логику команды):
- Сам по себе (redraw) в данном варианте необходим - в противном случае на экране будет черт-те что. Но на насыщенных чертежах именно эта функция может весьма серьезно тормозить работу.
- В коде учтен вариант градиентной заливки - у нее, конечно, есть свойство PatternAngle, да только вот проблема: его изменение ведет к ошибке. Поэтому приходится предусматривать обработку GradientAngle.
- В некоторых случаях (особенно это касается версий 2005 и 2006) может понадобится принудительно обновление примитива (понадобится раскомментировать строку
1;; (vla-update (cdr (assoc "item" item)))
, что тоже не самым лучшим образом сказывается на быстродействии.
Если код надо разобрать "пошагово", то это можно сделать.
>> "Конечно, если Евгений Елпанов или любой другой зубр лиспа сюда заглянет, головы мне не сносить (даже сейчас я вижу несколько моментов, которые можно было бы реализовать): привязки не отслеживаются, точные координаты не ввести и т.п."
Тебе можно дать только комплимент! Нашел время, написал статью, показал код и указал на тонкости использования в реальных чертежах...
Меня, чаще всего, хватает только на код. Кстати, сегодня выложил в болото код динамического оффсета отдельного сегмента полилинии. Посмотреть можно:
http://www.theswamp.org/index.php?topic=30650.msg378370#msg378370
Евгений, спасибо на добром слове
О твоем коде: я знал, что по математике тебе нет равных. И по коду тоже Твой лисп - та вершина, до которой, боюсь, мне никогда не дорасти
Мы уже давно на равных!
Забыл, я иногда обращаюсь к тебе за советом?