Convert Straight Polyline segment to an Arc'd Segment?

[g_wong]

Is there a lisp routine out there that can do this. I looked at lxpolyedit.arx but it doesn't work with 2009.

['gile']

Hi,

You can try this one, the arc segment can be defined by its sagitta length (default) or arc center, or start tangent direction.

;; CURV (gile)
;; Transform a straight polyline segment into an arc


(defun c:curv (/ *error* pl pt no scu pa p1 p2 bu mid cor loop gr pm fl str
ce di)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)

(defun *error* (msg)
(or (= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
)
(vla-SetBulge pl pa bu)
(and scu
(vl-cmdf "_.ucs" "_restore" "SavedUcs")
(vl-cmdf "_.ucs" "_delete" "SavedUcs")
)
(grtext)
(redraw)
(vla-EndUndoMark *acdoc*)
)

(if
(and
(setq pl (entsel))
(setq pt (trans (osnap (cadr pl) "_nea") 1 0))
(setq no (cdr (assoc 210 (entget (car pl)))))
(setq pl (vlax-ename->vla-object (car pl)))
(= (vla-get-ObjectName pl) "AcDbPolyline")
)
(progn
(vla-StartUndoMark *acdoc*)
(if (not
(and (equal '(0 0 1)
(trans '(0 0 1) no 1 T)
1e-9
)
(equal 0.0 (vla-get-elevation pl) 1e-9)
)
)
(and
(vl-cmdf "_.ucs" "_save" "SavedUcs")
(setq scu T)
(vl-cmdf "_.ucs" "_object" (vlax-vla-object->ename pl))
)
)
(setq pa (fix (vlax-curve-getParamAtPoint pl pt))
p1 (trans (vlax-curve-getPointatParam pl pa) 0 no)
p2 (trans (vlax-curve-getPointatParam pl (1+ pa)) 0 no)
bu (vla-GetBulge pl pa)
mid (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
cor (distance mid p1)
loop T
)
(princ "\nSpecify the sagitta length [Center/Direction]: ")
(while (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
(cond
((= (car gr) 5)
(redraw)
(setq pm (trans (cadr gr) 1 no)
fl (distance mid pm)
)
(and (< (sin (- (angle p1 p2) (angle p1 pm))) -1e-14)
(setq fl (- fl))
)
(vla-setBulge
pl
pa
((lambda (a) (/ (sin a) (cos a)))
(/ (- (angle p2 pm) (angle pm p1)) 2.0)
)
)
(grdraw (trans mid no 1)
(trans (vlax-curve-getPointAtParam pl (+ pa 0.5)) 0 1)
-1
1
)
(grtext -1 (strcat "sagitta = " (rtos fl)))
)
((member (cadr gr) '(13 32))
(cond
((and str (numberp (read str)))
(vla-setBulge pl pa (/ (read str) cor))
(setq loop nil)
)
((and str (member (strcase str) '("C" "D")))
(setq loop nil)
(cond
((= (strcase str) "C")
(while
(not (and
(setq
ce
(trans (getpoint "\nSpecify the center: ")
1
no
)
)
(equal (distance ce p1) (distance ce p2) 1e-9)
)
)
(princ
"\nSpecified point cannot be the arc center."
)
)
(vla-SetBulge
pl
pa
(/ (- (distance ce p1) (distance ce mid))
(if
(< (sin (- (angle p1 p2) (angle p1 ce))) -1e-14)
(distance p1 mid)
(- (distance p1 mid))
)
)
)
(initget "Yes No")
(if
(=
"Yes"
(getkword
"\nDraw the complmentary arc ? [Yes/No] <n>: "
)
)
(vla-SetBulge
pl
pa
(/ (+ (distance ce p1) (distance ce mid))
(if (< (sin (- (angle p1 p2) (angle p1 ce)))
-1e-14
)
(- cor)
cor
)
)
)
)
)
((= (strcase str) "D")
(while
(not (setq di (getpoint (trans p1 no 1)
"\nSpecify the direction: "
)
)
)
)
((lambda (a)
(vla-SetBulge pl pa (/ (sin a) (cos a)))
)
(/ (- (angle p1 p2) (angle p1 (trans di 1 no))) 2.0)
)
)
)
)
(T
(princ
"\nNeeds a number, a valid option or a pointer input.
\nSpecify the sagitta length [Center/Direction]: "
)
(setq str "")
)
)
)
(T
(if (= (cadr gr) 8)
(or
(and str
(/= str "")
(setq str (substr str 1 (1- (strlen str))))
(princ (chr 8))
(princ (chr 32))
)
(setq str nil)
)
(or
(and str (setq str (strcat str (chr (cadr gr)))))
(setq str (chr (cadr gr)))
)
)
(and str (princ (chr (cadr gr))))
)
)
)
(and scu
(vl-cmdf "_.ucs" "_restore" "SavedUcs")
(vl-cmdf "_.ucs" "_delete" "SavedUcs")
)
(grtext)
(redraw)
(vla-EndUndoMark *acdoc*)
)
)
(princ)
)

[g_wong]

That works great is there way to do the opposite as the code above?

['gile']

Hi,

Something like this ?

(defun c:straight (/ pl pt pa)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(if
(and
(setq pl (entsel))
(setq pt (trans (cadr pl) 1 0))
(setq pl (vlax-ename->vla-object (car pl)))
(= (vla-get-ObjectName pl) "AcDbPolyline")
)
(progn
(setq pa (fix (vlax-curve-getParamAtPoint
pl
(vlax-curve-getClosestPointTo pl pt)
)
)
)
(vla-StartUndoMark *acdoc*)
(vla-setBulge pl pa 0.0)
(vla-EndUndoMark *acdoc*)
)
)
(princ)
)

[ElpanovEvgeniy]

(defun c:lw-arc- (/ lw)
  ;|
*****************************************************************************************

by ElpanovEvgeniy

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

Впервые опубликована
http://www.caduser.ru/cgi-bin/f1/board.cgi?t=20707ki

Дата создания 19.09.2005
Последняя редакция 04.06.2006
*****************************************************************************************

Replacement of a arc segment of a polyline with an linear segment

For the first time it is published
http://www.caduser.ru/cgi-bin/f1/board.cgi?t=20707ki

Date of creation 19.09.2005
Last edition 04.06.2006
*****************************************************************************************


(C:LW_ARC-)

*****************************************************************************************
|;
(vl-load-com)
 (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
 (if (and (setq lw (entsel "\n Select arc segment in a polyline. "))
  (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE")
  ) ;_ and
  (progn
  (vla-StartUndoMark doc)
  (vla-SetBulge
  (vlax-ename->vla-object (car lw))
  (fix (vlax-curve-getParamAtPoint
  (car lw)
  (vlax-curve-getClosestPointTo (car lw) (cadr lw))
  ) ;_ vlax-curve-getParamAtPoint
  ) ;_ fix
  0.
  ) ;_ vla-SetBulge
  (vla-EndUndoMark doc)
  ) ;_ progn
  (princ "\n It is select nothing or object not a polyline. ")
 ) ;_ if
) ;_ defun


http://elpanov.com/assets/images/lw-arc-.gif