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

Тема: LISP. Замена линейного сегмента в полилинии дуговым сегментом

;**************** lW_arc.lsp *************************************
;                Замена линейного сегмента в полилинии
;                дуговым сегментом.
;                Автор  Евгений Елпанов.
(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)
(princ)
)

Возможный макрос для кнопки или пункта меню:

^C^C^P(if (not C:LW_ARC) (load "lw_arc")) LW_ARC

  • Papila
  • Восстановленный участник
  • На форуме с 2 декабря 2003г.
  • Сообщений: 112
  • Спасибо: 0

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

Класс!!

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

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

> Papila
Спасибо! Очень приятно...
Кстати,
https://www.caduser.ru/forum/topic20794.html
есть много других версий этой программы.

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

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

Выдает ошибку:

 Выберите нужный сегмент в полилинии. ; ошибка: no function definition:
VLAX-CURVE-GETCLOSESTPOINTTO

С этим что делать?

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

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

Перед всем сделать (vl-load-com)

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

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

А как бы её (vl-load-com) в автозагрузку включить? Не нашёл что-то…

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

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

> SStas
Допиши в acad2004.lsp
или
acad2004doc.lsp
Версию акада может быть другой, суть та-же...

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

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

Спасиб

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

Re: LISP. Замена линейного сегмента в полилинии дуговым сегментом

Выкладываю новую версию...
Может кого то заинтересует?

;******** lW_arc.lsp ***************
;    Замена линейного сегмента полилинии
;    дуговым сегментом.
;    Автор  Евгений Елпанов.
;    Последняя редакция 04.06.06
(defun C:LW_ARC (/  LW i P1 P2 P3)
 (vl-load-com)
 (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
 (if (and (setq lw (entsel "\n Выберите нужный сегмент в полилинии. "))
          (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE")
     ) ;_  and
  (progn
   (setq i  (fix (vlax-curve-getParamAtPoint
                  (car
                   lw
                  ) ;_  car
                  (vlax-curve-getClosestPointTo (car lw) (cadr lw))
                 ) ;_  vlax-curve-getParamAtPoint
            ) ;_  fix
         p1 (vlax-curve-getPointAtParam (car lw) i)
         p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
         lw (vlax-ename->vla-object (car lw))
   ) ;_  setq
   (princ "\n Задайте визуально кривизну сегмента. ")
   (vla-StartUndoMark doc)
   (while (and (setq p2 (grread 5)) (= (car p2) 5))
    (vla-SetBulge
     lw
     i
     ((lambda (a) (/ (sin a) (cos a)))
      (/ (- (angle p1 (cadr p2)) (angle (cadr p2) p3)) -2.)
     )
    ) ;_  vla-SetBulge
   ) ;_  while
   (vla-EndUndoMark doc)
  ) ;_  progn
  (princ "\n Ничего не выбрано или объект не полилиния. ")
 ) ;_  if
) ;_  defun