Convert arc and circle in to line segments

[abdulhuck]

Hi all,

I have a situation: I need to export the AutoCAD entities to another software which accepts only line segments. Is there any easy way to convert the arcs and circles in to small line segments? Well, I tried manually by drawing a polygon with a lot of sides (the more number of sides, the smoother the shape looks) with centre point as centre of arc / circle and radius as the arc / circle. It serves the purpose, as the accuracy is not very important, but the representation of (or presence of) element is important.

There may be a lot of arcs / circles in a drawing. I expect any Lisp (or VBA also will do) routine to automate this process. It is better to have an option to input the segment length by the user.

Any help in this regard is highly appreciated. :)

Thanks

Abdul

[fixo]

Hope this will get you started
Just change the number of segments to suit



;;; acl.lsp
;;; 11/6/05
;;; convert arcs and circles to line segments
;;; local defun

(defun arctolines (acsp obj n / cnt d leng p pts s x y)
(setq d (/ (setq leng (vla-get-arclength obj)) n)
s d)
(setq cnt 0)
(while (<= (- d s) leng)
(setq p (vlax-curve-getclosestpointto obj
(vlax-curve-getpointatdist obj (* s cnt))))
(setq pts (cons p pts))
(setq cnt (1+ cnt))
(setq d (+ d s))
)
(mapcar (function (lambda (x y)(vlax-invoke acsp 'AddLine x y)))
pts (cdr pts)
)
(vla-delete obj)
)
;;local defun
(defun circletolines (acsp obj n / cnt d leng p pts s x y)
(setq d (/ (setq leng (vla-get-circumference obj)) n)
s d)
(setq cnt 0)
(while (<= (- d s) leng)
(setq p (vlax-curve-getclosestpointto obj
(vlax-curve-getpointatdist obj (* s cnt))))
(setq pts (cons p pts))
(setq cnt (1+ cnt))
(setq d (+ d s))
)
(setq pts (cons (vlax-curve-getclosestpointto obj
(vlax-curve-getpointatdist obj 0.0))
pts)
)
(mapcar (function (lambda (x y)(vlax-invoke acsp 'AddLine x y)))
pts (cdr pts)
)
(vla-delete obj)
)

;;main part
(defun C:ACL (/ acapp acsp adoc obj sset)
(vl-load-com)
(or acapp
(setq acapp (vlax-get-acad-object))
)
(or adoc
(setq adoc (vla-get-activedocument acapp))
)
(or acsp
(setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
)
(vla-endundomark adoc)
(vla-startundomark adoc)


(setq sset (ssget "_X" '((0 . "ARC,CIRCLE"))))
(vlax-for obj (vla-get-activeselectionset adoc)
(if
(eq "AcDbArc" (vla-get-objectname obj))
(arctolines acsp obj 12);<-- 12 is number of segments
(circletolines acsp obj 12);<-- 12 is number of segments
)
)

(vla-endundomark adoc)
(princ)
)
(princ "\n >> Start command with ACL")
(princ)


~'J'~

[rkmcswain]

Another easy way is to use WMFOUT and WMFIN. This turns everything, including text and custom linetypes into polylines.

If you use this method, when you WMFIN - the insertion point is the upper left of the viewport and the scale will be 2.

[abdulhuck]

Thanks a lot gentlemen for your quick response!

Fixo, the code worked fine. Cool stuff!

RK, it was a too quick and great tip! I would prefer to use the code because it gives me more control over the number of segments.

Here is my dirty stuff. It do convert all the arcs and circles, but at the end of the function, it prints an error to the command prompt, which I have yet to figure out. The error is:



; error: bad argument type: lentityp nil


And my code is:


(defun c:ExportEnts (/ ents numents count entdata)
(setq ents (ssget "X"))
(if ents
(progn
(setq numents (sslength ents)
count 0)
(while (> numents 0)
(setq ent (ssname ents count)
entdata (entget ent))
(cond
((= (cdr (assoc 0 entdata)) "ARC") (DrawArc ent 25))
((= (cdr (assoc 0 entData)) "CIRCLE")
(DrawCircle ent 25))
)
(setq count (1+ count))
)
)
)
;;; Export code here - yet to code
(princ)
)
(defun DrawArc
(data numSeg / arcobj stpoint edpoint arad arclen seglen)
(setq arcobj (vlax-ename->vla-object data))
(setq stpoint (vlax-curve-getstartpoint arcobj)
edpoint (vlax-curve-getendpoint arcobj)
arad (vlax-get-property arcobj 'Radius)
arclen (vlax-get-property arcobj 'arcLength)
seglen (/ arclen numSeg)
)
(repeat numSeg
(setq nextP (vlax-curve-getpointatdist arcobj seglen))
(entmake
(list
(cons 0 "LINE")
(cons 10 stPoint)
(cons 11 nextP)
)
)
(setq stPoint nextP
seglen (+ seglen (/ arclen numSeg))
)
)
(vla-delete arcobj)
(princ)
)
(defun DrawCircle
(data numSeg / arcobj stpoint edpoint arad arclen seglen)
(setq arcobj (vlax-ename->vla-object data))
(setq arad (vlax-get-property arcobj 'Radius)
arclen (vlax-get-property arcobj 'Circumference)
arccen (vlax-get-property arcobj 'Center)
stPoint (polar (vlax-safearray->list (vlax-variant-value arccen))
0
arad)
seglen (/ arclen numSeg)
)
(repeat numSeg
(setq nextP (vlax-curve-getpointatdist arcobj seglen))
(entmake
(list
(cons 0 "LINE")
(cons 10 stPoint)
(cons 11 nextP)
)
)
(setq stPoint nextP
seglen (+ seglen (/ arclen numSeg))
)
)
(vla-delete arcobj)
(princ)
)


Any suggestions are welcome.

Thanks,

Abdul

[abdulhuck]

Sorry for duplicating the post, I had some problem with the bowser.

[_gile]

Hi,

Here's one other I wrote somme time ago


;; A2PG (gile)
;; Convert arcs and circles in polygons

(defun c:a2pg (/ ss n n_seg obj dist pt_lst nb)
(prompt
"\nSelect arcs and circles to be converted <all>."
)
(if (not (setq ss (ssget '((0 . "ARC,CIRCLE")))))
(setq ss (ssget "_X" '((0 . "ARC,CIRCLE"))))
)
(initget 7)
(setq n_seg (getint "\nNumber of segments: "))
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
dist (/ (vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
n_seg
)
norm (vlax-get obj 'Normal)
pt_lst (list (vlax-curve-getEndPoint obj))
nb n_seg
)
(repeat n_seg
(setq
pt_lst (cons (vlax-curve-getPointAtDist
obj
(* dist (setq nb (1- nb)))
)
pt_lst
)
)
)
(if (= (vla-get-ObjectName obj) "AcDbCircle")
(setq pt_lst (reverse (cdr (reverse pt_lst))))
)
(setq elev (- (caddr (trans (car pt_lst) 0 norm))
(caddr (trans '(0 0) 0 norm))
)
pt_lst (apply 'append
(mapcar '(lambda (pt)
(setq pt (trans pt 0 norm))
(list (car pt) (cadr pt))
)
pt_lst
)
)
)
(setq pline
(vlax-invoke
(vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
'addLightWeightPolyline
pt_lst
)
)
(vlax-put pline 'Normal norm)
(vla-put-elevation pline elev)
(if (= (vla-get-ObjectName obj) "AcDbCircle")
(vla-put-closed pline :vlax-true)
)
(vla-delete obj)
)
(princ)
)

[Adesu]

Hi abdul,
test this code


; cctl is stand for Convert Circle To Line
; Design by : Adesu <Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 27 September 2006
; Program no.: 0436/09/2006
; Edit by :

(defun c:cctl (/ cmt cnt len lst opt spt ss sse ssl ssn ssp)
(setq ss (car (entsel "\nSelect a circle")))
(setq opt (getreal "\nEnter number of segment <12>: "))
(if
(= opt nil)
(setq opt 12)
(setq opt (fix opt))
) ; repeat
(command "_divide" ss opt "")
(setq ssp (ssget "x" '((0 . "point"))))
(setq ssl (sslength ssp))
(setq cnt 0)
(repeat
ssl
(setq ssn (ssname ssp cnt))
(setq sse (entget ssn))
(setq spt (cdr (assoc 10 sse)))
(setq lst (append lst (list spt)))
(command "_erase" ssn "")
(setq cnt (1+ cnt))
) ; repeat
(command "_erase" ss "")
(setq cmt 0)
(repeat
ssl
(command "_line" (nth cmt lst)
(nth (1+ cmt) lst) "")
(setq cmt (1+ cmt))
) ; repeat
(command "_line" (last lst)(car lst) "")
(princ)
) ; defun



Sorry for duplicating the post, I had some problem with the bowser.

[yasir.aman]

Hi,

Here's one other I wrote somme time ago


;; A2PG (gile)
;; Convert arcs and circles in polygons

(defun c:a2pg (/ ss n n_seg obj dist pt_lst nb)
(prompt
"\nSelect arcs and circles to be converted <all>."
)
(if (not (setq ss (ssget '((0 . "ARC,CIRCLE")))))
(setq ss (ssget "_X" '((0 . "ARC,CIRCLE"))))
)
(initget 7)
(setq n_seg (getint "\nNumber of segments: "))
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
dist (/ (vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
n_seg
)
norm (vlax-get obj 'Normal)
pt_lst (list (vlax-curve-getEndPoint obj))
nb n_seg
)
(repeat n_seg
(setq
pt_lst (cons (vlax-curve-getPointAtDist
obj
(* dist (setq nb (1- nb)))
)
pt_lst
)
)
)
(if (= (vla-get-ObjectName obj) "AcDbCircle")
(setq pt_lst (reverse (cdr (reverse pt_lst))))
)
(setq elev (- (caddr (trans (car pt_lst) 0 norm))
(caddr (trans '(0 0) 0 norm))
)
pt_lst (apply 'append
(mapcar '(lambda (pt)
(setq pt (trans pt 0 norm))
(list (car pt) (cadr pt))
)
pt_lst
)
)
)
(setq pline
(vlax-invoke
(vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
'addLightWeightPolyline
pt_lst
)
)
(vlax-put pline 'Normal norm)
(vla-put-elevation pline elev)
(if (= (vla-get-ObjectName obj) "AcDbCircle")
(vla-put-closed pline :vlax-true)
)
(vla-delete obj)
)
(princ)
)

Thanks gile. This is the perfect code and serves the purpose as it should. Just one thing. You forgot to include (vl-load-com) at the beginning. Just include it and its charming :mrgreen: