Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → Настройка меню и DIESEL → _pline в макрокоманде
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Уважаемые!
Есть конструкция типа:
^C^C_pline;\\;_change;_last;;_p;слой;05;;
которая рисует один сегмент полилинии и меняет его свойства.
Вопрос: как нарисовать произвольное количество сегментов?
Если зациклить (* вначале, как я пока и делаю), то полилинию потом еще собирать надо, да и точек в два раза больше надо указывать.
ACAD2006(rus)
Вариант 1. Сначала сделать слой, а потом уже рисовать. Нечто наподобие:
^C^C_-layer;_m;05;_pline;
Вариант 2. Использовать lisp (наподобие):
^C^C(defun myfunc() (command "_.pline") (while (/= (getvar "cmdactive") 0) (command pause)) (command "_.change" "_last" "" _p" "_l" "05" ""));(myfunc);
Спасибо, krblc!
Был почти уверен, что ты отзовешься.
В1 - а как потом на текущий слой вернуться? Что то подобное на dwg.ru обсуждалось, но я чего то сегодня на него попасть не могу.
В2 - lisp, конечно lisp... моя задача смешная и не столько практическая, сколько позновательная. Пользуюсь многими готовыми lisp решениями, как баран, ничего не понимая. Тут типа "програмирую":))
В любом случае спасибо. Понял, что произвольное количество точек не получится.
> wo!
На палитре инструментов (AutoCAD 2005-2007) можно создать инструмент, который будет отрисовывать полилинию на нужном слое, например, на слое "05" независимо от того, какой слой является текущим.
> Владимир Громов
Спасибо. Такой способ тоже пригодится.
Эх! Макрокоманды подкочали...
> wo!
Тут одно из двух - либо > Владимир Громов (2006-12-19 13:59:42), либо Lisp - запомнить тек.слой, установить новый, отрисовать, вернуть слой. Думаю, что вариант Владимира будет более приемлемым
> kpblc
Спасибо, понимаю...
А lisp функцию cmd-start Андрея кочеткова я уже
использую, думаю и в этом случае ее возможности подойдут.
Там все размеры, штриховки, тексты автоматически разносятся
по своим слоям. С полилинией также можно сделать.
Только вопрос возникает, а если я не все плинии хочу
на слой 05 отправить, а только некоторые.
Поэтому я и придумывал такую кнопку. Есть обычная кнопка _pl,
а есть моя которая присваивает для плинии слой или тип линии
или еще чего.
> wo!
Ну хшо. Чтоб тебе было сухо и комфортно :) Получай!
;|
* Функция отрисовки полилинии на указанном слое. Если слоя нет, он создается
* Параметры вызова:
* layer-name - имя слоя. nil -> текущий
* layer-set - настройки слоя. Если настройки были изменены, они
будут установлены по этому списку
'(("color" . 1) ; цвет. nil -> 7
("lw" . 25) ; вес линиию nil -> 0.25
("lt" . "dashed") ; тип линии. nil -> Continuous.
* Задавать надо слова английскими буквами. Регистр значения не имеет.
* Примеры вызова:
(_kpblc-draw-pline nil nil) ; отрисовка полилинии с текущими настройками
(_kpblc-draw-pline "1" nil) ; создание слоя и отрисовка на нем полилинии
(_kpblc-draw-pline "234" '(("color" . 10)))
; а дальше уж сам поиграйся :)
|;
(defun _kpblc-draw-pline (layer-name layer-set
/ adoc
*error* _kpblc-layer-create-by-list
_kpblc-linetype-load _kpblc-error-catch
)
(defun *error* (msg)
(mapcar '(lambda (x)
(vl-catch-all-apply
'(lambda ()
(setvar (car x) (cdr x))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of lambda
*kpblc-error-list*
) ;_ end of mapcar
(vla-endundomark adoc)
(princ)
) ;_ end of defun
(defun _kpblc-error-catch (protected-function
on-error-function
/
catch_error_result
)
(setq catch_error_result (vl-catch-all-apply protected-function))
(if (and (vl-catch-all-error-p catch_error_result)
on-error-function
) ;_ end of and
(apply on-error-function
(list (vl-catch-all-error-message catch_error_result))
) ;_ end of apply
catch_error_result
) ;_ end of if
) ;_ end of defun
(defun _kpblc-linetype-load (ltype-name ltype-file / ltype_list)
(vl-load-com)
(if
(not (member (strcase ltype-name t) '("continuous" "byblock" "bylayer")))
(progn
(setq ltype_list '(("border" . "рант")
("border2" . "рант2")
("borderX2" . "рантX2")
("center" . "осевая")
("center2" . "осевая2")
("centerX2" . "осеваяX2")
("dashdot" . "штрихпунктирная")
("dashdot2" . "штрихпунктирная2")
("dashdotX2" . "штрихпунктирнаяX2")
("dashed" . "штриховая")
("dashed2" . "штриховая2")
("dashedX2" . "штриховаяX2")
("divide" . "линия_сгиба")
("divide2" . "линия_сгиба2")
("divideX2" . "линия_сгибаX2")
("dot" . "пунктирная")
("dot2" . "пунктирная2")
("dotX2" . "пунктирнаяX2")
("hidden" . "невидимая")
("hidden2" . "невидимая2")
("hiddenX2" . "невидимаяX2")
("phantom" . "фантом")
("phantom2" . "фантом2")
("phantomX2" . "фантомX2")
("fenceline1" . "ограждение1")
("fenceline2" . "ограждение2")
("tracks" . "пути")
("batting" . "изоляция")
("hot_water_supply" . "горячая_вода")
("gas_line" . "газопровод")
("zigzag" . "зигзаг")
)
ltype-name (strcase ltype-name t)
) ;_ end of setq
(if (not ltype-file)
(setq ltype-file "acadiso.lin")
(setq ltype-file
(strcat (_kpblc-dir-get-root-menu)
(vl-filename-base ltype-file)
".lin"
) ;_ end of strcat
) ;_ end of setq
) ;_ end of if
(if (assoc ltype-name ltype_list)
(setq ltype-name
(if (vl-string-search "419" (vlax-product-key))
(cdr (assoc ltype-name ltype_list))
(car (assoc ltype-name ltype_list))
) ;_ end of if
) ;_ end of setq
) ;_ end of if
(if (not (tblsearch "ltype" ltype-name))
;; тип линии не найден, надо его загрузить. Тип линии должен быть
;; описан в файле
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-load
(list
(vlax-get-property
adoc
'linetypes
) ;_ end of vlax-get-property
ltype-name
ltype-file
) ;_ end of list
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(if (tblsearch "ltype" ltype-name)
(vla-item (vla-get-linetypes adoc) ltype-name)
(vla-item (vla-get-linetypes adoc) "continuous")
) ;_ end of if
) ;_ end of defun
(defun _kpblc-layer-create-by-list (name lst / res)
(foreach pr
(list
'("color" . 7)
(cons "lt"
(vla-get-linetype (vla-get-activelayer adoc))
) ;_ end of cons
'("ltfile" . "acadiso.lin")
(cons "lw" aclnwtbylwdefault)
) ;_ end of list
(if (not (assoc (car pr) lst))
(setq lst (append lst (list pr)))
) ;_ end of if
) ;_ end of foreach
(setq res (vla-add (vla-get-layers adoc) name))
(_kpblc-error-catch
(function
(lambda ()
(vla-put-color res (cdr (assoc "color" lst)))
(vla-put-lineweight res (cdr (assoc "lw" lst)))
(vla-put-linetype
res
(vla-get-name
(_kpblc-linetype-load
(cdr (assoc "lt" lst))
(cdr (assoc "ltfile" lst))
) ;_ end of _kpblc-linetype-load
) ;_ end of vla-get-name
) ;_ end of vla-put-linetype
(vla-put-plottable
res
(if (cdr (assoc "plot" lst))
:vlax-true
:vlax-false
) ;_ end of if
) ;_ end of vla-put-Plottable
(vla-put-layeron
res
(if (cdr (assoc "on" lst))
:vlax-true
:vlax-false
) ;_ end of if
) ;_ end of vla-put-layeron
(if
(/= (strcase (vla-get-name res))
(strcase (vla-get-name (vla-get-activelayer adoc)))
) ;_ end of /=
(progn
(cond
((cdr (assoc "active" lst))
(vla-put-activelayer adoc res)
)
((cdr (assoc "freeze" lst))
(vl-catch-all-apply
'(lambda () (vla-put-freeze res :vlax-true))
) ;_ end of vl-catch-all-apply
)
((not (cdr (assoc "freeze" lst)))
(vl-catch-all-apply
'(lambda () (vla-put-freeze res :vlax-false))
) ;_ end of vl-catch-all-apply
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
) ;_ end of lambda
) ;_ end of function
(function
(lambda (x)
(princ (strcat "\nОшибка создания слоя : " x))
) ;_ end of lambda
) ;_ end of function
) ;_ end of _kpblc-error-catch
res
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark
(setq layer-set (mapcar '(lambda (x) (cons (strcase (car x) t) (cdr x)))
layer-set
) ;_ end of mapcar
) ;_ end of setq
(foreach item
(list
(cons "clayer"
(if layer-name
(vla-get-name
(_kpblc-layer-create-by-list
layer-name
(append layer-set (list (cons "plot" t) (cons "on" t)))
) ;_ end of _kpblc-layer-create-by-list
) ;_ end of vla-get-name
(getvar "clayer")
) ;_ end of if
) ;_ end of cons
(cons "cecolor"
(vl-princ-to-string
(if (cdr (assoc "color" layer-set))
(cdr (assoc "color" layer-set))
(getvar "cecolor")
) ;_ end of if
) ;_ end of VL-PRINC-TO-STRING
) ;_ end of cons
(cons "celweight"
(if (cdr (assoc "lw" layer-set))
(cdr (assoc "lw" layer-set))
(getvar "celweight")
) ;_ end of if
) ;_ end of cons
(cons "celtype"
(if (cdr (assoc "lt" layer-set))
(cdr (assoc "lt" layer-set))
(getvar "celtype")
) ;_ end of if
) ;_ end of cons
) ;_ end of list
(setq *kpblc-error-list*
(append *kpblc-error-list*
(list (cons (car item) (getvar (car item))))
) ;_ end of append
) ;_ end of setq
(vl-catch-all-apply '(lambda () (setvar (car item) (cdr item))))
) ;_ end of foreach
(command "_.pline")
(while (/= (getvar "cmdactive") 0)
(command pause)
) ;_ end of while
(mapcar '(lambda (x)
(vl-catch-all-apply
'(lambda ()
(setvar (car x) (cdr x))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of lambda
*kpblc-error-list*
) ;_ end of mapcar
(vla-endundomark adoc)
(princ)
) ;_ end of defunНда... Лисп такой, правда, так просто в DIESEL Не засунешь :)
P.P.S. Пока код писал, несколько идей перепутались между собой, так что за качество прошу не бить ногами. Там по идее было достаточно тип, вес и цвет устанавливать ByLayer, чего я не сделал :( Стыдно-то как...
> kpblc
Стыдно ему... А мне тогда какого, отвлекаю умных, отзывчивых людей.
Спасибо тебе, горячо уважаемый kpblc. Все опробую, о результатах доложу. Будет, как учебное пособие по lisp. Без него, проклятого, видно никак.
Будем учиться с вашей божьей помощью.
С уважением, wo!
kpblc,
не грузится.
; ошибка: В функции *error* возникла ошибка:неверный тип аргумента: VLA-OBJECT
nil
> wo!
Хм... Проверил... Спробуй такой код (тут только добавлены параметры отрисовки полилинии, да исправил ошибку логики назначения параметров полилинии - больше ничего). Проверял для таких вариантов вызова:
(_kpblc-draw-pline "234" '(("color" . 10)) '(("color" . 15) ("lt" . "dashed2")))(_kpblc-draw-pline "234" '(("color" . 10)) '(("color" . 15)))Работала, зараза...
;|=============================================================================
* Добавил 1 параметр.
* Функция отрисовки полилинии на указанном слое. Если слоя нет, он создается
* Параметры вызова:
* layer-name имя слоя. nil -> текущий
* layer-set настройки слоя. Если настройки были изменены, они
будут установлены по этому списку
'(("color" . 1) ; цвет. nil -> 7
("lw" . 25) ; вес линиию nil -> 0.25
("lt" . "dashed") ; тип линии. nil -> Continuous.
* draw-set настройки рисования. Аналогичны layer-set
* Задавать надо слова английскими буквами. Регистр значения не имеет.
* Примеры вызова:
(_kpblc-draw-pline nil nil nil) ; отрисовка полилинии с текущими настройками
(_kpblc-draw-pline "1" nil nil ) ; создание слоя и отрисовка на нем полилинии
(_kpblc-draw-pline "234" '(("color" . 10)) '(("color" . 15)))
; а дальше уж сам поиграйся :)
=============================================================================|;
(defun _kpblc-draw-pline (layer-name layer-set
draw-set /
adoc *error*
_kpblc-layer-create-by-list
_kpblc-linetype-load _kpblc-error-catch
)
(defun *error* (msg)
(mapcar '(lambda (x)
(vl-catch-all-apply
'(lambda ()
(setvar (car x) (cdr x))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of lambda
*kpblc-error-list*
) ;_ end of mapcar
(setq *kpblc-error-list* nil)
(vla-endundomark adoc)
(princ)
) ;_ end of defun
(defun _kpblc-error-catch (protected-function
on-error-function
/
catch_error_result
)
(setq catch_error_result (vl-catch-all-apply protected-function))
(if (and (vl-catch-all-error-p catch_error_result)
on-error-function
) ;_ end of and
(apply on-error-function
(list (vl-catch-all-error-message catch_error_result))
) ;_ end of apply
catch_error_result
) ;_ end of if
) ;_ end of defun
(defun _kpblc-linetype-load (ltype-name ltype-file / ltype_list)
(vl-load-com)
(if
(not (member (strcase ltype-name t) '("continuous" "byblock" "bylayer")))
(progn
(setq ltype_list '(("border" . "рант")
("border2" . "рант2")
("borderX2" . "рантX2")
("center" . "осевая")
("center2" . "осевая2")
("centerX2" . "осеваяX2")
("dashdot" . "штрихпунктирная")
("dashdot2" . "штрихпунктирная2")
("dashdotX2" . "штрихпунктирнаяX2")
("dashed" . "штриховая")
("dashed2" . "штриховая2")
("dashedX2" . "штриховаяX2")
("divide" . "линия_сгиба")
("divide2" . "линия_сгиба2")
("divideX2" . "линия_сгибаX2")
("dot" . "пунктирная")
("dot2" . "пунктирная2")
("dotX2" . "пунктирнаяX2")
("hidden" . "невидимая")
("hidden2" . "невидимая2")
("hiddenX2" . "невидимаяX2")
("phantom" . "фантом")
("phantom2" . "фантом2")
("phantomX2" . "фантомX2")
("fenceline1" . "ограждение1")
("fenceline2" . "ограждение2")
("tracks" . "пути")
("batting" . "изоляция")
("hot_water_supply" . "горячая_вода")
("gas_line" . "газопровод")
("zigzag" . "зигзаг")
)
ltype-name (strcase ltype-name t)
) ;_ end of setq
(if (not ltype-file)
(setq ltype-file "acadiso.lin")
(setq ltype-file
(strcat (_kpblc-dir-get-root-menu)
(vl-filename-base ltype-file)
".lin"
) ;_ end of strcat
) ;_ end of setq
) ;_ end of if
(if (assoc ltype-name ltype_list)
(setq ltype-name
(if (vl-string-search "419" (vlax-product-key))
(cdr (assoc ltype-name ltype_list))
(car (assoc ltype-name ltype_list))
) ;_ end of if
) ;_ end of setq
) ;_ end of if
(if (not (tblsearch "ltype" ltype-name))
;; тип линии не найден, надо его загрузить. Тип линии должен быть
;; описан в файле
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-load
(list
(vlax-get-property
adoc
'linetypes
) ;_ end of vlax-get-property
ltype-name
ltype-file
) ;_ end of list
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(if (tblsearch "ltype" ltype-name)
(vla-item (vla-get-linetypes adoc) ltype-name)
(vla-item (vla-get-linetypes adoc) "continuous")
) ;_ end of if
) ;_ end of defun
(defun _kpblc-layer-create-by-list (name lst / res)
(foreach pr
(list
'("color" . 7)
(cons "lt"
(vla-get-linetype (vla-get-activelayer adoc))
) ;_ end of cons
'("ltfile" . "acadiso.lin")
(cons "lw" aclnwtbylwdefault)
) ;_ end of list
(if (not (assoc (car pr) lst))
(setq lst (append lst (list pr)))
) ;_ end of if
) ;_ end of foreach
(setq res (vla-add (vla-get-layers adoc) name))
(_kpblc-error-catch
(function
(lambda ()
(vla-put-color res (cdr (assoc "color" lst)))
(vla-put-lineweight res (cdr (assoc "lw" lst)))
(vla-put-linetype
res
(vla-get-name
(_kpblc-linetype-load
(cdr (assoc "lt" lst))
(cdr (assoc "ltfile" lst))
) ;_ end of _kpblc-linetype-load
) ;_ end of vla-get-name
) ;_ end of vla-put-linetype
(vla-put-plottable
res
(if (cdr (assoc "plot" lst))
:vlax-true
:vlax-false
) ;_ end of if
) ;_ end of vla-put-Plottable
(vla-put-layeron
res
(if (cdr (assoc "on" lst))
:vlax-true
:vlax-false
) ;_ end of if
) ;_ end of vla-put-layeron
(if
(/= (strcase (vla-get-name res))
(strcase (vla-get-name (vla-get-activelayer adoc)))
) ;_ end of /=
(progn
(cond
((cdr (assoc "active" lst))
(vla-put-activelayer adoc res)
)
((cdr (assoc "freeze" lst))
(vl-catch-all-apply
'(lambda () (vla-put-freeze res :vlax-true))
) ;_ end of vl-catch-all-apply
)
((not (cdr (assoc "freeze" lst)))
(vl-catch-all-apply
'(lambda () (vla-put-freeze res :vlax-false))
) ;_ end of vl-catch-all-apply
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
) ;_ end of lambda
) ;_ end of function
(function
(lambda (x)
(princ (strcat "\nОшибка создания слоя : " x))
) ;_ end of lambda
) ;_ end of function
) ;_ end of _kpblc-error-catch
res
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark
(setq layer-set (mapcar '(lambda (x) (cons (strcase (car x) t) (cdr x)))
layer-set
) ;_ end of mapcar
) ;_ end of setq
(foreach item
(list
(cons "clayer"
(if layer-name
(vla-get-name
(_kpblc-layer-create-by-list
layer-name
(append layer-set (list (cons "plot" t) (cons "on" t)))
) ;_ end of _kpblc-layer-create-by-list
) ;_ end of vla-get-name
(getvar "clayer")
) ;_ end of if
) ;_ end of cons
(cons "cecolor"
(vl-princ-to-string
(if (cdr (assoc "color" draw-set))
(cdr (assoc "color" draw-set))
(getvar "cecolor")
) ;_ end of if
) ;_ end of VL-PRINC-TO-STRING
) ;_ end of cons
(cons "celweight"
(if (cdr (assoc "lw" draw-set))
(cdr (assoc "lw" draw-set))
(getvar "celweight")
) ;_ end of if
) ;_ end of cons
(cons "celtype"
(if (cdr (assoc "lt" draw-set))
(vla-get-name
(_kpblc-linetype-load (cdr (assoc "lt" draw-set)) nil)
) ;_ end of vla-get-name
(getvar "celtype")
) ;_ end of if
) ;_ end of cons
) ;_ end of list
(setq *kpblc-error-list*
(append *kpblc-error-list*
(list (cons (car item) (getvar (car item))))
) ;_ end of append
) ;_ end of setq
(vl-catch-all-apply '(lambda () (setvar (car item) (cdr item))))
) ;_ end of foreach
(command "_.pline")
(while (/= (getvar "cmdactive") 0)
(command pause)
) ;_ end of while
(mapcar '(lambda (x)
(vl-catch-all-apply
'(lambda ()
(setvar (car x) (cdr x))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of lambda
*kpblc-error-list*
) ;_ end of mapcar
(setq *kpblc-error-list* nil)
(vla-endundomark adoc)
(princ)
) ;_ end of defunСейчас работает?
О! Вот еще! Иногда при копировании кода слетает форматирование.
Поищи у себя в коде строки типа:
;; тип линии не найден, надо его загрузить. Тип линии должен
быть
;; описан в файлеИ либо потри их, либо закомментируй по другому:
;|тип линии не найден, надо его загрузить. Тип линии должен
быть
описан в файле|;Во втором варианте не будет генерироваться ошибка синтаксиса. Моя вина, каюсь.
> kpblc
Все. Работает.
Тонкости есть, но в целом огромное СПАСИБО! Теперь сижу разбираюсь,
как все работает. А хотел то, глупый, одну строчку написать!
Еще раз спасибо.
С уважением, wo!
> wo!
Да там просто проверок много - тип линии загрузить, слой создать и настроить, отрисовать и вернуть все как было. В принципе это просто расширенный вариант > kpblc (2006-12-19 14:56:37) :)
Наличие проверок наверное хороший тон. Этому тоже надо учиться. Спасибо.
С уважением, wo!
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → Настройка меню и DIESEL → _pline в макрокоманде
Форум работает на PunBB, при поддержке Informer Technologies, Inc
