• kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Как добавить вершину в полилинию нажатием одной кнопки?

Так опять-таки, отслеживания, циклы, заморозки и прочая.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Как добавить вершину в полилинию нажатием одной кнопки?

Зато если все ок, то можно и в Готовые программы закинуть.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

Решил тоже отметиться в этой ветке...
Предложенная программа умеет добавлять точки в любые "LWPOLYLINE" сохраняя ширину сегментов, ассоциативность штриховки, нормальный откат.

(defun C:LW_pt(/ ENT I LST LW PAR PT)
(setq pt(getpoint "\n Укажите новую вершину на полилинии. "))
(if(and pt(setq lw(ssget pt '((0 . "LWPOLYLINE"))))(setq lw(ssname lw 0)))
(progn
(setq par(vlax-curve-getParamAtPoint lw(vlax-curve-getClosestPointTo lw pt))
 ent(entget lw)
 ent(subst(cons 90(1+(cdr(assoc 90 ent))))(assoc 90 ent) ent)
 i 0
 lst nil)
(while(or(/=(caar ent) 41)(if(< i(fix par))(setq i(1+ i))))(setq lst(cons(car ent) lst) ent(cdr ent)))
(setq lst(cons(cons 41
(+(cdr(assoc 40 lst))(*(-(cdr(assoc 41 ent))(cdr(assoc 40 lst)))(- par(fix par))))) lst)
 lst(cons(cons 42
(/(sin(setq i(-(angle(vlax-curve-getPointAtParam lw(fix par)) pt)
(angle(vlax-curve-getPointAtParam lw(fix par))
(vlax-curve-getPointAtParam lw(+(fix par)(/(- par(fix par)) 2.)))))))
(cos i))) lst)
lst(cons(assoc 41 ent)(cons(cons 40(cdr(assoc 41 lst)))(cons(list 10(car pt)(cadr pt)) lst)))
lst(cons(cons 42
(/(sin(setq i(-(angle pt(vlax-curve-getPointAtParam lw(1+(fix par))))
(angle pt(vlax-curve-getPointAtParam lw(+ par(/(-(1+(fix par)) par) 2.)))))))
(cos i))) lst))
(vla-StartUndoMark(vla-get-activedocument(vlax-get-acad-object)))
(entmod(append(reverse lst)(cddr ent)))
(entupd lw)
(vla-EndUndoMark(vla-get-activedocument(vlax-get-acad-object))))
(princ "\n Указанная точка не лежит на полилинии. ")))

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 8

Re: Как добавить вершину в полилинию нажатием одной кнопки?

У меня давно уже работает вариант из этого поста:

> kpblc
хоть и не обрабатывет блокированные слои. А "раздувшуюся" программу я даже не тестировал, она меня пугает.

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 8

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Евгений Елпанов
Начал пробовать вашу программу. Вершина вставляется и в линейный и в дуговой сегмент. Лучше, конечно, если бы автоматически включалась привязка "_nea" ("бли"). Неплохо бы добавить сообщение типа "Добавлена 1 вершина." или сразу выделить полилинию ручками. Еще получилась некая чертовщина в каком-то случае: если я хочу заштриховать замкнутый контур с новыми вершинами, то AutoCAD сообщает, что не найден подходящий контур штриховки. Заштриховать можно только, если указать сам контур. С этим надо разобраться, может сам что-то испортил. Ассоциативность шштриховки сохраняется. У kpblc мне понравилась возможность вставки вершины в отрезок с одновременным превращением этого отрезка в полилинию. Вообще, возможность немедленного перемещения новой вершины, как у kpblc как-то нагляднее, IMHO.

  • PalStudio
  • Восстановленный участник
  • На форуме с 15 августа 2005г.
  • Сообщений: 50
  • Спасибо: 0

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Azor
(qF_InsPtisPtls q_PtLs q_PtIns q_Pres)
где
q_PtLs - лист точек плине, линии и т.д.
q_PtIns - Точка вставки
q_Pres - погрешность
Возращает лист со вставленой точкой, если точка прнадлежит одному из отрезков с погрешностью
(qF_InsPtisPtls q_PtLs q_PtIns q_Pres)

(Setq q_PtIns (getPoint))
(Setq q_Pres 0.00000001)
(Defun qF_InsPtisPtls (q_PtLs q_PtIns q_Pres / q_flag q_k q_Pres q_pt1 q_pt2 q_PtIns q_PtLs1 q_v)
  (if (not (vl-remove-if-not '(lambda (q_v) (equal q_v q_PtIns q_Pres)) q_PtLs)); Sovpadenie Tochek
    (progn
    (setq q_k 0
          q_flag 1
          q_PtLs1 (list (car q_PtLs)))
    (while (and q_flag (setq q_pt2 (nth (1+ q_k) q_PtLs)))
      (setq q_pt1 (nth q_k q_PtLs))
      (cond
        ((<= (abs (- (distance q_pt2 q_pt1)(+ (distance q_PtIns q_pt1)(distance q_PtIns q_pt2)))) q_Pres); Vstavka
         (setq q_PtLs1 (append q_PtLs1 (List  q_PtIns q_pt2)) q_flag 2))
        (t (setq q_PtLs1 (append q_PtLs1 (List q_pt2 )))))
      (setq q_k (1+ q_k)))))
    q_PtLs1)

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

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

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Евгений Елпанов
Изменять osmode на +512 на время выполнения команды (т.е. нечто типа
(if (= (logand (getvar "osmode") 512) 0)
  (setvar "osmode" (+ (getvar "osmode") 512))
  )
Попытаться проработать вариант с окружностями.
Учесть вариант заблокированных слоев.
Правый щелчок означает простое добавление верщины, без изменения геометрии.
Щелчок на существующей вершине не приводит к выполнению проги (т.е. фактически идет выполнение _.stretch).
Обрабатывать замкнутые полилинии.
Предлагать вариант обработки в блоках (хотя это уже из части "ну скотина kpblc, совсем зажрался!")
Кстати, у меня вообще отказалась работать (по шагам не проходил, так что более подробно ничего не скажу. Проверялось на ACAD2005Eng+SP1). Для такого варианта, наверное, лучше будет выводить какое-то сообщение о причинах отказа срабатывания.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> kpblc
>Попытаться проработать вариант с окружностями.
А что надо получить из окружности после указания на ней точки? У меня фантазии не хватает - наверное дело к вечеру...
>Учесть вариант заблокированных слоев.
Сейчас он учитывается - на заблокированных слоях ничего не изменяется (короче ничего не делается - на то он и заблокированный).

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> kpblc
>Обрабатывать замкнутые полилинии.
Замкнутые полилинии сейчас обрабатываются правильно, так же правильно обрабатываются полилинии с переменной шириной сегмента...

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 8

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Евгений Елпанов
Вроде, эта "чертовщина" получается иногда, когда в качестве новый вершины выбирается существующая вершина с привязкой "_int" ("пер"). У нас многие держат включенными по 5-6 привязок, поэтому их лучше выключать на время выполнения программы. Больше пока ничего в голову не приходит.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Евгений Елпанов
Да меня тут как-то просили сделать, я отказался. Суть в следующем: фактически рисуется полилиния с установленной шириной 0, состоящая из 2 дуг. Ессно, замкнутая. А потом добавление вершины и вытягивание.
Причина моих "пожеланий" в том, что, еще раз повторяю, у меня не сработал почему-то код. Почему - пока не разбирался.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

(defun c:lw_pt(/ ent i gr lst lw par pt)
(princ "\n Укажите новую вершину на полилинии. ")
(while(and(setq gr(grread 5))(=(car gr) 5))
(if lw(redraw lw 4))
(if(and(setq pt(osnap(cadr gr) "_nea,_end"))
(setq lw(ssget pt '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE"))))
(setq lw(ssname lw 0))
(setq ent(entget lw)))
(redraw lw 3)))
(cond((=(cdr(assoc 0 ent)) "LWPOLYLINE")
(setq par(vlax-curve-getparamatpoint lw(vlax-curve-getclosestpointto lw pt))
 ent(subst(cons 90(1+(cdr(assoc 90 ent))))(assoc 90 ent) ent)
 i 0
 lst nil)
(if(/= par(fix par))
(progn(while(or(/=(caar ent) 41)
(if(< i(fix par))
(setq i(1+ i))))
(setq lst(cons(car ent) lst)
 ent(cdr ent)))
(setq lst(cons(cons 41
(+(cdr(assoc 40 lst))
(*(-(cdr(assoc 41 ent))(cdr(assoc 40 lst)))(- par(fix par)))))
 lst)
 lst(cons(cons 42
(/(sin(setq i(-(angle(vlax-curve-getpointatparam lw(fix par)) pt)
(angle(vlax-curve-getpointatparam lw(fix par))
(vlax-curve-getpointatparam lw(+(fix par)(/(- par(fix par)) 2.)))))))
(cos i)))
 lst)
 lst(cons(assoc 41 ent)
(cons(cons 40(cdr(assoc 41 lst)))
(cons(list 10(car pt)(cadr pt))
 lst)))
 lst(cons(cons 42
(/(sin(setq i(-(angle pt(vlax-curve-getpointatparam lw(1+(fix par))))
(angle pt(vlax-curve-getpointatparam lw(+ par(/(-(1+(fix par)) par) 2.)))))))
(cos i)))
 lst))
(vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
(entmod(append(reverse lst)(cddr ent)))
(entupd lw)
(vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))))
(vl-cmdf "_.stretch" "_C" pt pt "" pt(getpoint pt "Укажите новую точку : ")))
((=(cdr(assoc 0 ent)) "LINE")
(setq lst '((0 . "LWPOLYLINE")))
(foreach x '(100 67 410 8 62 6 370)
(if(assoc x ent)
(setq lst(cons(assoc x ent) lst))))
(vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
(entmakex
(append(reverse lst)
(list '(100 . "AcDbPolyline") '(90 . 3) '(70 . 0)
(cons 38(cadddr(assoc 10 ent)))
(assoc 10 ent) '(40 . 0) '(41 . 0) '(42 . 0)
(cons 10(list(car pt)(cadr pt)))
 '(40 . 0) '(41 . 0) '(42 . 0)
(cons 10(list(cadr(assoc 11 ent))(caddr(assoc 11 ent))))
 '(40 . 0) '(41 . 0) '(42 . 0)(assoc 210 ent))))
(entdel lw)
(vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
(vl-cmdf "_.stretch" "_C" pt pt "" pt(getpoint pt "Укажите новую точку : ")))
((=(cdr(assoc 0 ent)) "ARC")
(setq lst '((0 . "LWPOLYLINE"))
 par(vlax-curve-getparamatpoint lw(vlax-curve-getclosestpointto lw pt)))
(foreach x '(100 67 410 8 62 6 370)(if(assoc x ent)(setq lst(cons(assoc x ent) lst))))
(vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
(entmakex
(append(reverse lst)
(list '(100 . "AcDbPolyline") '(90 . 3) '(70 . 0)
(cons 38(cadddr(assoc 10 ent)))
(cons 10
(reverse(cdr(reverse(polar(cdr(assoc 10 ent))(cdr(assoc 50 ent))(cdr(assoc 40 ent)))))))
 '(40 . 0) '(41 . 0)
(cons 42
(/(sin(setq i(-(angle(vlax-curve-getstartpoint lw) pt)
(angle(vlax-curve-getstartpoint lw)
(vlax-curve-getpointatparam
 lw
(+(vlax-curve-getstartparam lw)(/(- par(vlax-curve-getstartparam lw)) 2.)))))))
(cos i)))
(cons 10(list(car pt)(cadr pt)))
 '(40 . 0) '(41 . 0)
(cons 42
(/(sin
(setq i(-(angle pt(vlax-curve-getendpoint lw))
(angle pt(vlax-curve-getpointatparam lw(+ par(/(-(vlax-curve-getendparam lw) par) 2.)))))))
(cos i)))
(cons 10(reverse(cdr(reverse(polar(cdr(assoc 10 ent))(cdr(assoc 51 ent))(cdr(assoc 40 ent)))))))
 '(40 . 0) '(41 . 0) '(42 . 0)(assoc 210 ent))))
(entdel lw)
(vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
(vl-cmdf "_.stretch" "_C" pt pt "" pt(getpoint pt "Укажите новую точку : ")))
((=(cdr(assoc 0 ent)) "CIRCLE")
(setq lst '((0 . "LWPOLYLINE")))
(foreach x '(100 67 410 8 62 6 370)
(if(assoc x ent)
(setq lst(cons(assoc x ent) lst))))
(vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
(entmakex
(append(reverse lst)
(list '(100 . "AcDbPolyline") '(90 . 2) '(70 . 1)
(cons 38(cadddr(assoc 10 ent)))
(cons 10(list(car pt)(cadr pt)))
 '(40 . 0) '(41 . 0)
(cons 42(/(sin(/ pi 4.))(cos(/ pi 4.))))
(cons 10
(reverse
(cdr(reverse(polar(cdr(assoc 10 ent))(angle pt(cdr(assoc 10 ent)))(cdr(assoc 40 ent)))))))
 '(40 . 0) '(41 . 0)
(cons 42(/(sin(/ pi 4.))(cos(/ pi 4.))))
(assoc 210 ent))))
(entdel lw)
(vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
(vl-cmdf "_.stretch" "_C" pt pt "" pt(getpoint pt "Укажите новую точку : ")))
(t(princ "\n Указанная точка не лежит на полилинии. "))))

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

Как и просили...
Обрабатывает полилинии, дуги, линии и окружности.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

Забыл добавить, что при обработке дуг, линий и окружностей генерируются полилинии на высоте начальной точки (для дуг и окружностей на высоте центра).

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

Первый недочет - при обработке дуг, линий и окружностей на блокированном слое поверх них создается полилиния...
Короче исходные объекты не удаляются и вновь созданные не редактируются - причина блокированный слой.
Если у кого нибудь есть желание доделать / переделать - буду рад, у самого руки дойдут не скоро...

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 8

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Евгений Елпанов
Вот еще недочет (?). Если мне не надо перемещать новую вершину, то напрашивается нажать правую кнопку мыши. Вершина вставляется, но AutoCAD выдает такое сообщение:

Команда: LW_PT
 Укажите новую вершину на полилинии. Укажите новую точку :
Ошибка приложения: В команду послан неверный тип

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

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Владимир Громов
А в остальном как?
Стоит ли тратить время на доработку или никому не нужная програмка...

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 8

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Евгений Елпанов
Насчет ненужная...? Не знаю, у меня уже задействована предпоследняя программа kpblc, включена в меню и в 2005 и в 2006. Архитекторам понравилось.

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Владимир Громов
Тогда оставлю эту затею...

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 8

Re: Как добавить вершину в полилинию нажатием одной кнопки?

А вообще, мое мнение такое. Программа добавления вершины в любом месте полилинии + программа замены линейного сегмента дуговым + программа замены дугового сегмента линейным - эти три программы значительно расширяют возможности полилинии и делают ее применение более привлекательным. Последние 2 программы выложены в "Готовых программах", а эта (ни один ее вариант) пока нет. Неужели сами авторы не уверенны в ее нужности? Отзывов маловато, может еще кто-нибудь из пользователей выскажется?

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Владимир Громов
Дык ить ета... В общем, последний вариант-то не понравился, а предыдущие грешат некоторыми ошибками... Если есть желание, можно и положить. Вопрос - кому и какой вариант? Может, проще тему туда переместить?

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Владимир Громов
Я сейчас занимаюсь близкими задачаьи, поэтому и попытался сделать "добавление точки", а вообще, мне в работе такая программа не требуется...

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 8

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> kpblc
Да, нет, тему туда перемещать не надо. Ладно, я сам скомпоную тему под названием "Добавление вершины в полилинию в произвольном сегменте".

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Как добавить вершину в полилинию нажатием одной кнопки?

> Владимир Громов
Кстати, а обратная функция (удаление вершины) нужна?