Тема: Как заменить линейный сегмент полилинии на дуговой и наоборот?

Я думаю, эта задача может быть решена, может я и сам бы ее решил, но пока плохо еще вник в ActiveX. Поможет кто-нибудь?

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

Метод vla-SetBulge устанавливае кривизну сегмента полилинии.
Формат такой
(vla-SetBulge vla 1 0.656)
где vla - vla объект полилинии
   1 - номер сегмента
   0.656 - кривизна
Вообще, если вы решили вникать в ActiveX пользуйтесь разделом справки ActiveX Automation and VBA. Очень удобно и можно разобраться даже без особых знаний английского.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Можно так же через entmod код 42 -  это кривизна.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

Можно и без ActiveX - напрямую править список (entget ...) код 42
Это тангенс четверти угла или по русски тангенс образованный высотой дугового сегмента.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> serzh

> Евгений Елпанов
Спасибо. Вообще-то, я предполагал, что есть опытные люди, которые легко решат эту задачу, а то, пока я вникну, рак устанет свистеть.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

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

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Если терпит - вечерком напишу лиспик...

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Евгений Елпанов
Терпит. У меня есть мысль собрать несколько программ, связанных с полилиниями и созданных на этой конференции, в одну тему "Операции с полилиниями" для раздела "Готовые программы".

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Мне кажется постановка задачи не совсем корректной. Если преобразование дуговой->линейный можно считать однозначным (bulge=0), то обратное преобразование неоднозначно, т.е. требуется уточнить или кривизну, или среднюю точку дуги или радиус и т.д. для вычисления bulge.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Александр Ривилис
Это так, в этом я и видел трудность для себя. Однако, если бы можно было задать кривизну, равной нулю (или близкую к нулю) в дуговом сегменте, то тогда можно было бы за среднюю ручку как-либо менять кривизну прямо на экране.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Задать кривизну равной нулю можно - это будет линейный сегмент. smile Можно задать и кривизну близкую к нулю и тогда он будет трактоваться как дуговой сегмент и появится ручка в средней точке дуги. Если мне не изменят память, то пороговое значение при котором AutoCAD считает дугу линейным сегментом bulge=1e-6 Т.е. если, например, задать bulge=1e-5, то визуально сегмент не будет отличаться от линейного, но при этом будет дуговым с ручкой в средней точке. С другой стороны не очень будет понятно то ли это еще одна вершина полилинии, то ли это ручка дугового сегмента. Тут нужно подумать и возможно задавать большее значение bulge, чтобы сразу было видно, что это дуговой сегмент.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

Вот вариант...
Прошу рассматривать только как демо...
Никаких проверок, никакой оптимизации!

(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))))

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Евгений Елпанов
Действительно, это "демо". Линейный сегмент заменяется на дуговой с визуальным изменением кривизны. Численное значение радиуса не задашь, но зачем его задавать явно, пока мне не ясно. Дуговой сегмент остается дуговым. Вообще к чему все это нужно? А вот к чему. В CorelDRAW очень легко добавляются вершины в кривой, запросто меняется кривой сегмент на прямой, и наоборот, и поэтому легко меняется контур вообще. В AutoCAD'е в этом смысле имеется пробел. Вот и хотелось бы как-то приблизить редактирование полилинии в AutoCAD'е к возможностям CorelDRAW.
Программа добавления вершины уже фактически имеется, см. обсуждение здесь:
https://www.caduser.ru/forum/topic20243.html
Если теперь будет создана программа преобразования сегментов полилинии, то возможностей работы с полилиниями станет больше. Конечно, дуга - это не кривая Безье, но все же...

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Евгений Елпанов
Немного доработал программу:

(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
)

Происходит следующая ситуация. Я нарисовал полилинию, заменил линейный сегмент дуговым. Оказалось, не тот, хочу отменить, но отменяется и сама исходная полилиния, а хотелось бы отменить только сенмент. Это возможно?

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

сенмент -> сегмент

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Пожалуй после вашего апгрейда добавлю и свой...

(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))

Пожалуй теперь нагляднее указание радиуса.
По поводу отмены, что-то не понял задачи...

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Евгений Елпанов
Ну, расскажу еще раз. Я нарисовал полилинию из линейных сегментов. Заменил с помощью этой программы линейный сегмент на дуговой. Потом решил отменить эту операцию с помощью "_undo" ("отменить"). Первый раз отменяется только замена сегмента. При последующем вызове программы после замены сегмента по команде "_undo" отменяется не только замена сегмента, отменяется и команда отрисовки полилинии, сама полилиния исчезает. Правда, у меня функция определена как:

(defun C:LW_ARC(/ A1 ENT GR I LST LW PAR PT)...

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

А при использовании последнего варианта программы полилиния отменяется с первого раза.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Тогда можно так:

(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))

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Евгений Елпанов
Теперь хорошо. Думаю, можно оформить и копировать в "Готовые программы". Ваше мнение?

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Выкладывайте это ваша идея...
Правда вы хотели через ActiveX, а я написал по старинке.

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Спасибо, что оформил и выложил!
Может кому и сгодится...

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Владимир Громов
Написал до кучи и обратную функцию - может потестируешь?
Правда на этот раз через вла...

(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 Ничего не выбрано или объект не полилиния. ")))

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

Кажется поспешил - вот вариант без командной строки...

(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Ничего не выбрано или объект не полилиния.")))

Re: Как заменить линейный сегмент полилинии на дуговой и наоборот?

> Евгений Елпанов
Нормально работает программа. Спасибо.