Тема: Как заменить линейный сегмент полилинии на дуговой и наоборот?
Я думаю, эта задача может быть решена, может я и сам бы ее решил, но пока плохо еще вник в ActiveX. Поможет кто-нибудь?
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Как заменить линейный сегмент полилинии на дуговой и наоборот?
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Я думаю, эта задача может быть решена, может я и сам бы ее решил, но пока плохо еще вник в ActiveX. Поможет кто-нибудь?
Метод vla-SetBulge устанавливае кривизну сегмента полилинии.
Формат такой
(vla-SetBulge vla 1 0.656)
где vla - vla объект полилинии
1 - номер сегмента
0.656 - кривизна
Вообще, если вы решили вникать в ActiveX пользуйтесь разделом справки ActiveX Automation and VBA. Очень удобно и можно разобраться даже без особых знаний английского.
> Владимир Громов
Можно так же через entmod код 42 - это кривизна.
Можно и без ActiveX - напрямую править список (entget ...) код 42
Это тангенс четверти угла или по русски тангенс образованный высотой дугового сегмента.
> serzh
> Евгений Елпанов
Спасибо. Вообще-то, я предполагал, что есть опытные люди, которые легко решат эту задачу, а то, пока я вникну, рак устанет свистеть.
А процедура мне видится так:
Предлагается выбрать нужный сегмент полилинии, который в зависимости от его типа (линейный или дуговой) преобразуется соответственно в дуговой или линейный.
> Владимир Громов
Если терпит - вечерком напишу лиспик...
> Евгений Елпанов
Терпит. У меня есть мысль собрать несколько программ, связанных с полилиниями и созданных на этой конференции, в одну тему "Операции с полилиниями" для раздела "Готовые программы".
> Владимир Громов
Мне кажется постановка задачи не совсем корректной. Если преобразование дуговой->линейный можно считать однозначным (bulge=0), то обратное преобразование неоднозначно, т.е. требуется уточнить или кривизну, или среднюю точку дуги или радиус и т.д. для вычисления bulge.
> Александр Ривилис
Это так, в этом я и видел трудность для себя. Однако, если бы можно было задать кривизну, равной нулю (или близкую к нулю) в дуговом сегменте, то тогда можно было бы за среднюю ручку как-либо менять кривизну прямо на экране.
> Владимир Громов
Задать кривизну равной нулю можно - это будет линейный сегмент. Можно задать и кривизну близкую к нулю и тогда он будет трактоваться как дуговой сегмент и появится ручка в средней точке дуги. Если мне не изменят память, то пороговое значение при котором AutoCAD считает дугу линейным сегментом bulge=1e-6 Т.е. если, например, задать bulge=1e-5, то визуально сегмент не будет отличаться от линейного, но при этом будет дуговым с ручкой в средней точке. С другой стороны не очень будет понятно то ли это еще одна вершина полилинии, то ли это ручка дугового сегмента. Тут нужно подумать и возможно задавать большее значение bulge, чтобы сразу было видно, что это дуговой сегмент.
Вот вариант...
Прошу рассматривать только как демо...
Никаких проверок, никакой оптимизации!
(defun lw-arc (/ A1 ENT GR I LST LW PAR) (princ "\n Выберите полилинию в нужном сегменте ") (setq lw (entsel)) (setq par (vlax-curve-getParamAtPoint (car lw) (vlax-curve-getClosestPointTo (car lw) (cadr lw))) a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par)) (vlax-curve-getPointAtParam (car lw) (1+ (fix par))))) (princ "\n Выберите новый радиус ") (while (and (setq gr (grread 5)) (= (car gr) 5)) (setq i 0 lst nil ent (entget (car lw))) (while (or (/= (caar ent) 42) (if (< i (fix par)) (setq i (1+ i)))) (setq lst (cons (car ent) lst) ent (cdr ent))) (entmod(append(reverse(cons (cons 42 (/ (sin (- a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par)) (cadr gr)))) (cos (- a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par)) (cadr gr)))))) lst)) (cdr ent)))(entupd (car lw))))
> Евгений Елпанов
Действительно, это "демо". Линейный сегмент заменяется на дуговой с визуальным изменением кривизны. Численное значение радиуса не задашь, но зачем его задавать явно, пока мне не ясно. Дуговой сегмент остается дуговым. Вообще к чему все это нужно? А вот к чему. В CorelDRAW очень легко добавляются вершины в кривой, запросто меняется кривой сегмент на прямой, и наоборот, и поэтому легко меняется контур вообще. В AutoCAD'е в этом смысле имеется пробел. Вот и хотелось бы как-то приблизить редактирование полилинии в AutoCAD'е к возможностям CorelDRAW.
Программа добавления вершины уже фактически имеется, см. обсуждение здесь:
https://www.caduser.ru/forum/topic20243.html
Если теперь будет создана программа преобразования сегментов полилинии, то возможностей работы с полилиниями станет больше. Конечно, дуга - это не кривая Безье, но все же...
> Евгений Елпанов
Немного доработал программу:
(defun lw-arc (/ A1 ENT GR I LST LW PAR) (setq lw (entsel "\n Выберите нужный сегмент в полилинии: ")) (if (and lw (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE")) (progn (setq par (vlax-curve-getParamAtPoint (car lw) (vlax-curve-getClosestPointTo (car lw) (cadr lw))) a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par)) (vlax-curve-getPointAtParam (car lw) (1+ (fix par))))) (princ "\n Выберите новый радиус ") (while (and (setq gr (grread 5)) (= (car gr) 5)) (setq i 0 lst nil ent (entget (car lw))) (while (or (/= (caar ent) 42) (if (< i (fix par)) (setq i (1+ i)))) (setq lst (cons (car ent) lst) ent (cdr ent))) (entmod(append(reverse(cons (cons 42 (/ (sin (- a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par)) (cadr gr)))) (cos (- a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par)) (cadr gr)))))) lst)) (cdr ent)))(entupd (car lw))) ); progn (princ "\n Ничего не выбрано или объект не полилиния. ") ); if )
Происходит следующая ситуация. Я нарисовал полилинию, заменил линейный сегмент дуговым. Оказалось, не тот, хочу отменить, но отменяется и сама исходная полилиния, а хотелось бы отменить только сенмент. Это возможно?
сенмент -> сегмент
> Владимир Громов
Пожалуй после вашего апгрейда добавлю и свой...
(defun lw-arc(/ A1 ENT GR I LST LW PAR PT) (setq lw(entsel "\n Выберите нужный сегмент в полилинии: ")) (if(and lw(=(cdr(assoc 0(entget(car lw)))) "LWPOLYLINE")) (progn(setq par (vlax-curve-getParamAtPoint(car lw) (vlax-curve-getClosestPointTo(car lw)(cadr lw))) a1(angle(vlax-curve-getPointAtParam(car lw)(fix par)) (vlax-curve-getPointAtParam(car lw)(1+(fix par))))) (princ "\n Выберите новый радиус ") (while(and(setq gr(grread 5))(=(car gr) 5)) (setq i 0 lst nil ent(entget(car lw))) (while(or(/=(caar ent) 42) (if(< i(fix par))(setq i(1+ i)))) (setq lst(cons(car ent) lst)ent(cdr ent))) (redraw)(grdraw(setq pt(vlax-curve-getPointAtParam (car lw)(fix par)))(cadr gr) 6 1) (entmod(append(reverse(cons(cons 42 (/(sin(/(- a1(angle pt(cadr gr)))2.)) (cos(/(- a1(angle pt(cadr gr)))2.))))lst)) (cdr ent)))(entupd(car lw)))) (princ "\n Ничего не выбрано или объект не полилиния. ")) (redraw))
Пожалуй теперь нагляднее указание радиуса.
По поводу отмены, что-то не понял задачи...
> Евгений Елпанов
Ну, расскажу еще раз. Я нарисовал полилинию из линейных сегментов. Заменил с помощью этой программы линейный сегмент на дуговой. Потом решил отменить эту операцию с помощью "_undo" ("отменить"). Первый раз отменяется только замена сегмента. При последующем вызове программы после замены сегмента по команде "_undo" отменяется не только замена сегмента, отменяется и команда отрисовки полилинии, сама полилиния исчезает. Правда, у меня функция определена как:
(defun C:LW_ARC(/ A1 ENT GR I LST LW PAR PT)...
А при использовании последнего варианта программы полилиния отменяется с первого раза.
> Владимир Громов
Тогда можно так:
(defun c:lw-arc(/ A1 ENT GR I LST LW PAR PT) (vl-cmdf "_.undo" "_be") (setq lw(entsel "\n Выберите нужный сегмент в полилинии: ")) (if(and lw(=(cdr(assoc 0(entget(car lw)))) "LWPOLYLINE")) (progn(setq par (vlax-curve-getParamAtPoint(car lw) (vlax-curve-getClosestPointTo(car lw)(cadr lw))) a1(angle(vlax-curve-getPointAtParam(car lw)(fix par)) (vlax-curve-getPointAtParam(car lw)(1+(fix par))))) (princ "\n Выберите новый радиус ") (while(and(setq gr(grread 5))(=(car gr) 5)) (setq i 0 lst nil ent(entget(car lw))) (while(or(/=(caar ent) 42) (if(< i(fix par))(setq i(1+ i)))) (setq lst(cons(car ent) lst)ent(cdr ent))) (redraw)(grdraw(setq pt(vlax-curve-getPointAtParam (car lw)(fix par)))(cadr gr) 6 1) (entmod(append(reverse(cons(cons 42 (/(sin(/(- a1(angle pt(cadr gr)))2.)) (cos(/(- a1(angle pt(cadr gr)))2.))))lst)) (cdr ent)))(entupd(car lw)))) (princ "\n Ничего не выбрано или объект не полилиния. ")) (vl-cmdf "_.undo" "_e") (redraw))
> Евгений Елпанов
Теперь хорошо. Думаю, можно оформить и копировать в "Готовые программы". Ваше мнение?
> Владимир Громов
Выкладывайте это ваша идея...
Правда вы хотели через ActiveX, а я написал по старинке.
> Владимир Громов
Спасибо, что оформил и выложил!
Может кому и сгодится...
> Владимир Громов
Написал до кучи и обратную функцию - может потестируешь?
Правда на этот раз через вла...
(defun c:lw-arc>l(/ lw) (setq lw(entsel "\n Выберите нужный дуговой сегмент в полилинии: ")) (if(and lw(=(cdr(assoc 0(entget(car lw))))"LWPOLYLINE")) (progn(vl-cmdf "_.undo" "_be") (vl-load-com) (vla-SetBulge(vlax-ename->vla-object(car lw)) (fix(vlax-curve-getParamAtPoint(car lw) (vlax-curve-getClosestPointTo(car lw)(cadr lw))))0.) (vl-cmdf "_.undo" "_e")) (princ "\n Ничего не выбрано или объект не полилиния. ")))
Кажется поспешил - вот вариант без командной строки...
(defun c:lw-arc>l(/ lw) (setq lw(entsel"\nВыберите нужный дуговой сегмент в полилинии:")) (if(and lw(=(cdr(assoc 0(entget(car lw))))"LWPOLYLINE")) (progn(vla-StartUndoMark(vla-get-activedocument(vlax-get-acad-object))) (vl-load-com)(vla-SetBulge(vlax-ename->vla-object(car lw)) (fix(vlax-curve-getParamAtPoint(car lw) (vlax-curve-getClosestPointTo(car lw)(cadr lw))))0.) (vla-EndUndoMark(vla-get-activedocument(vlax-get-acad-object)))) (princ"\nНичего не выбрано или объект не полилиния.")))
> Евгений Елпанов
Нормально работает программа. Спасибо.
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Как заменить линейный сегмент полилинии на дуговой и наоборот?
Форум работает на PunBB, при поддержке Informer Technologies, Inc