Solved: All to Pline - Page 2

aqdam1978 · ‎09-18-2013

Hi,

I need a lisp code to convert all Lines, Polylines, Arcs and Splines to Polylines with 0.4 width.

I prepare this:

(defun c:CH2pl ( / SS)
;changes all lines, plines, arcs and splines to POLYLINE with 0.4 width
	(if (setq SS (ssget "_X" '((0 . "LINE"))))
		(command "_.pedit" "m" SS "" "Y" "w" 0.4 ""))
	(if (setq SS (ssget "_X" '((0 . "*POLYLINE"))))
		(command "_.pedit" "m" SS "" "w" 0.4 ""))
	(if (setq SS (ssget "_X" '((0 . "ARC"))))
		(command "_.pedit" "m" SS "" "Y" "w" 0.4 ""))
	(if (setq SS (ssget "_X" '((0 . "SPLINE"))))
		(command "_.pedit" "m" SS "" "Y" 10 "w" 0.4 ""))
)

But I want pure lisp code in a professional way!

does anybody has any idea?

Thanks,

Abbas

marko_ribar · ‎09-23-2013

Just find the way not to process every INSERT - block, but only those that have once been proccessed with unique name... Every next INSERT won't be proccessed if that INSERT has the name that is member of list of previously proccessed INSERTS...

So, probably now this topic is solved... Can you at least confirm that you're satisfied with results by saying thanks?

(defun unit ( v )
  (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)

(defun mxv ( m v )
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun v^v ( u v )
  (mapcar '(lambda ( n ) (- (* (nth (car n) u) (nth (cadr n) v)) (* (nth (cadr n) u) (nth (car n) v)))) '((1 2) (2 0) (0 1)))
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
  (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
  (setq ux (unit (mapcar '- p2 p1)))
  (setq uy (unit (mapcar '- p3 p1)))
  
  (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
  (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
  (transptucs pt pt1n pt2n pt3n)
)

(defun entmakexlwpoly3dpts ( ptlst opclflag / ux uy uz uptlst )
  (setq uz (unit (v^v (mapcar '- (cadr ptlst) (car ptlst)) (mapcar '- (caddr ptlst) (car ptlst)))))
  (if (equal uz '(0.0 0.0 1.0) 1e-8) (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
  (if (equal uz '(0.0 0.0 -1.0) 1e-8) (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
  (if (not (or (equal uz '(0.0 0.0 1.0) 1e-8) (equal uz '(0.0 0.0 -1.0) 1e-8))) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
  (if (not uy) (setq uy (unit (v^v uz ux))))
  (setq uptlst (mapcar '(lambda ( p ) (transptucs p '(0.0 0.0 0.0) ux uy)) ptlst))
  (entmakex 
    (append
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        (cons 90 (length uptlst))
        (cons 70 opclflag)
        (cons 38 (caddar uptlst))
      )
      (mapcar '(lambda ( x ) (list 10 (car x) (cadr x))) uptlst)
      (list (cons 210 uz))
    )
  )
)

(defun 2dcurvewidth ( wid sego / adoc *error* pea seg ss i a1 a2 stpar enpar dpar opcl ii pt ptlst lw )

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  
  (defun *error* ( msg )
    (if pea (setvar 'peditaccept pea))
    (vla-endundomark adoc)
    (if msg (prompt msg))
    (princ)
  )
  
  (vla-startundomark adoc)
  (setq pea (getvar 'peditaccept))
;  (initget 7)
;  (setq wid (getdist "\nSpecify width of 2d curves (pick) : "))
;  (initget 7)
;  (setq sego (getint "\nSpecify segmentation ratio for conversion to LWPOLYLINE of ELLIPSES, 2d SPLINES or 2d HELIXES : "))
  (setq ss (ssget "_X" '((0 . "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE,HELIX"))))
  (setq i -1)
  (while (setq ent (ssname ss (setq i (1+ i))))
    (cond
      ( (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent))))))))
        nil
      )
      ( (eq (cdr (assoc 0 (entget ent))) "LINE")
        (command "_.pedit" ent "w" wid "")
      )
      ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
        (command "_.pedit" ent "w" wid "")
      )
      ( (and (eq (cdr (assoc 0 (entget ent))) "POLYLINE") (< (cdr (assoc 70 (entget ent))) 8))
        (command "_.pedit" ent "w" wid "")
      )
      ( (eq (cdr (assoc 0 (entget ent))) "ARC")
        (command "_.pedit" ent "w" wid "")
      )
      ( (eq (cdr (assoc 0 (entget ent))) "CIRCLE")
        (setvar 'peditaccept 1)
        (setq a1 (entmakex (append (list '(0 . "ARC")) (cdddr (entget ent)) (list '(100 . "AcDbArc") (cons 50 0.0) (cons 51 pi)))))
        (setq a2 (entmakex (append (list '(0 . "ARC")) (cdddr (entget ent)) (list '(100 . "AcDbArc") (cons 50 pi) (cons 51 (* 2.0 pi))))))
        (command "_.pedit" a1 "j" a1 a2 "" "w" wid "")
        (entdel ent)
      )
      ( (eq (cdr (assoc 0 (entget ent))) "ELLIPSE")
        (setq seg sego)
        (setq stpar (vlax-curve-getstartparam ent))
        (setq enpar (vlax-curve-getendparam ent))
        (setq dpar (/ (- enpar stpar) seg))
        (if (equal (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent) 1e-8) (setq opcl 1) (setq opcl 0 seg (1+ seg)))
        (setq ii -1.0)
        (repeat seg
          (setq pt (vlax-curve-getpointatparam ent (+ stpar (* (setq ii (1+ ii)) dpar))))
          (setq ptlst (cons pt ptlst))
        )
        (setq ptlst (reverse ptlst))
        (setq lw (entmakexlwpoly3dpts ptlst opcl))
        (command "_.pedit" lw "w" wid "")
        (entdel ent)
        (setq ptlst nil)
      )
      ( (and (eq (cdr (assoc 0 (entget ent))) "SPLINE") (vlax-curve-isplanar ent))
        (setq seg sego)
        (setq stpar (vlax-curve-getstartparam ent))
        (setq enpar (vlax-curve-getendparam ent))
        (setq dpar (/ (- enpar stpar) seg))
        (if (equal (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent) 1e-8) (setq opcl 1) (setq opcl 0 seg (1+ seg)))
        (setq ii -1.0)
        (repeat seg
          (setq pt (vlax-curve-getpointatparam ent (+ stpar (* (setq ii (1+ ii)) dpar))))
          (setq ptlst (cons pt ptlst))
        )
        (setq ptlst (reverse ptlst))
        (setq lw (entmakexlwpoly3dpts ptlst opcl))
        (command "_.pedit" lw "w" wid "")
        (entdel ent)
        (setq ptlst nil)
      )
      ( (and (eq (cdr (assoc 0 (entget ent))) "HELIX") (vlax-curve-isplanar ent))
        (setq seg sego)
        (setq stpar (vlax-curve-getstartparam ent))
        (setq enpar (vlax-curve-getendparam ent))
        (setq dpar (/ (- enpar stpar) seg))
        (if (equal (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent) 1e-8) (setq opcl 1) (setq opcl 0 seg (1+ seg)))
        (setq ii -1.0)
        (repeat seg
          (setq pt (vlax-curve-getpointatparam ent (+ stpar (* (setq ii (1+ ii)) dpar))))
          (setq ptlst (cons pt ptlst))
        )
        (setq ptlst (reverse ptlst))
        (setq lw (entmakexlwpoly3dpts ptlst opcl))
        (command "_.pedit" lw "w" wid "")
        (entdel ent)
        (setq ptlst nil)
      )
    )
  )
  (*error* nil)
  (princ)
)

(defun bedit ( bname )
  (command "_.bedit" bname)
  (2dcurvewidth 0.5 100);=>Change here width param. and segmentation param. for 2d spline, 2d helix, ellipse entities
  (test)
  (if (eq (getvar 'blockeditor) 1)
    (command "_.bclose" "s")
  )
)

(defun ApplytoBlockObjects ( name func )
  (setq func (eval func))
  (func name)
)

(defun ssxunlocked-insert ( / filter elst ss )
  (setq filter "")
  (while (setq elst (tblnext "layer" (null elst)))
    (if (= 4 (logand 4 (cdr (assoc 70 elst))))
      (setq filter (strcat filter (cdr (assoc 2 elst)) ","))
    )
  )
  (and (= filter "")(setq filter "~*"))
  (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons -4 "<not") (cons 8 filter) (cons -4 "not>"))))
)

(defun test ( / s i bl n )

  (vl-load-com)

  (if (setq s (ssxunlocked-insert))
    (progn
      (if (eq (getvar 'blockeditor) 1)
        (command "_.bclose" "s")
      )
      (setq i -1)
      (while (setq bl (ssname s (setq i (1+ i))))
        (setq n (vla-get-effectivename (vlax-ename->vla-object bl)))
        (if (not (member n nl))
          (ApplytoBlockObjects
             n
            '(lambda ( bname ) (bedit bname))
          )
        )
        (setq nl (cons n nl))
      )
    )
  )
)

(defun c:test ( / adoc *error* cmde nl )

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  
  (defun *error* ( msg )
    (if cmde (setvar 'cmdecho cmde))
    (vla-endundomark adoc)
    (if msg (prompt msg))
    (princ)
  )
  
  (vla-startundomark adoc)
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (test)
  (*error* nil)
  (princ)
)

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

aqdam1978 · ‎09-23-2013

Hi Marko,

Thank you so much for your ideas and solution.

Yes, you solved this problem. But I'm looking for easier than your approach!

You solved by a complicated way! I want to find easy solution!

please see agian me and Kent solution please:

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/All-to-Pline/m-p/4443741#M315194

by the way, I am apperciate your efforts and solution.

Thanks,

Abbas

marko_ribar · ‎10-26-2013

Hi, sorry for late revision... I've noticed that my code 3dhelix2d doesn't work correctly in A2014, so I modified it...

Here is it...

(defun c:3dhelix2d ( / adoc *error* cmde e ea el ll ell i y )

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

  (defun *error* ( msg )
    (if cmde (setvar 'cmdecho cmde))
    (vla-endundomark adoc)
    (if msg (prompt msg))
    (princ)
  )

  (vla-startundomark adoc)
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq e (car (entsel "\nPick 3d HELIX to convert it to 2d")))
  (setq ea (vlax-ename->vla-object e))
  (vla-put-height ea 0.0)
  (command "_.ucs" "w")
  (setq el (entget e))
  (command "_.ucs" "m" (cdr (assoc 11 el)))
  (command "_.ucs" "za" '(0.0 0.0 0.0) (cdr (assoc 12 el)))
  (setq ll el)
  (mapcar '(lambda (x) (if (eq (car x) 10) (setq ell (cons (trans (cdr x) 0 1) ell)))) el)
  (setq ell (reverse ell))
  (setq ell (mapcar '(lambda (x) (trans (list (car x) (cadr x) 0.0) 1 0)) ell))
  (setq ell (mapcar '(lambda (x) (list 10 (car x) (cadr x) (caddr x))) ell))
  (setq el (member (assoc 10 el) el))
  (setq i -1)
  (foreach x (reverse (cdr (reverse ell)))
    (setq i (1+ i))
    (setq y (nth i el))
    (setq ll (subst x y ll))
  )
  (entmod ll)
  (command "_.ucs" "p")
  (command "_.ucs" "p")
  (command "_.ucs" "p")
  (*error* nil)
  (princ)
)

Regards, M.R. and thanks for kudos...

Marko Ribar, d.i.a. (graduated engineer of architecture)

aqdam1978 · ‎10-30-2013

Hi Marko,

Do you have an easy and simple lisp code to convert an ellipse to polyline?

like as Circle to Polyline:

(defun _C2P ( edata W / cctr crad pdata)
;;This routine extracted from:
;;http://cadtips.cadalyst.com/curved-objects/circle-polyline-and-polyline-circle  
  (setq
    cctr (cdr (assoc 10 edata))
    crad (cdr (assoc 40 edata)) 
  ); end setq
  (setq 
    pdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) edata)
    pdata 
    (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity")) pdata
        (list '(100 . "AcDbPolyline") '(90 . 2) '(70 . 129) (cons 43 W))
        (list
          (cons 38 (caddr cctr))
          (cons 10 (list (- (car cctr) crad) (cadr cctr))) '(42 . 1)
          (cons 10 (list (+ (car cctr) crad) (cadr cctr))) '(42 . 1)
          (assoc 210 edata)); end list
      ); end append & pdata
  ); end setq
  (entmake pdata)
  (entdel (cdr (assoc -1 edata)));
  (princ)
); end defun

Thanks,

Abbas

Kent1Cooper · ‎10-30-2013

@aqdam1978 wrote:

....

Do you have an easy and simple lisp code to convert an ellipse to polyline?

like as Circle to Polyline:

....

That Circle-to-Polyline routine is one of mine. To do the same with an Ellipse wouldn't be as simple, and there are several ways to approach it. How closely would you need the Polyline to follow the shape of the Ellipse? An elliptical Polyline made with PELLIPSE set to 1 and using the Ellipse command is close, and a routine could be made to do that, but it could be done more accurately than that if needed. It could be done in such a way that all the endpoints and midpoints of the arc segments lie precisely on the true elliptical path, though the arc segments would then not be precisely tangent with each other [though with a high enough number of segments, you'd never be able to tell, visually]. That could be done to any degree of precision you like -- how many arc segments would you want to be used? [A PELLIPSE=1 Polyline Ellipse has 16.]

Kent Cooper, AIA

Lee_Mac · ‎10-30-2013

See this by gile.

Lee Mac Programming • Twitter • Exchange App Store

aqdam1978 · ‎10-30-2013

Hi Lee,

Thank you for your help.

;;Ellipses to polylines
;;http://www.theswamp.org/index.php?PHPSESSID=nte1qfppp8kahj3v46kaf82ek5&topic=30892.msg364485#msg3644...
;;updated By Abbas Aqdam
(defun C:EL2PL (/ E E1 O)
  (setq E (car (entsel "\nSelect the ellipse: ")))
  (setq O (vlax-ename->vla-object E))
  (vla-offset O 0.1)
  (setq E1 (entlast))
  (vla-offset (vlax-ename->vla-object E1) -0.1)
  (command "_.pedit" (entlast) 10 "w" 0.4 "")
  (entdel E)
  (entdel E1)
  (princ)
)

Abbas Aqdam

Kent1Cooper · ‎10-30-2013

@aqdam1978 wrote:

....

;;Ellipses to polylines
....
  (vla-offset O 0.1)
  (setq E1 (entlast))
  (vla-offset (vlax-ename->vla-object E1) -0.1)
  (command "_.pedit" (entlast) 10 "w" 0.4 "")
....

Ahhh -- PEDIT accepts Splines in newer versions. What I have here is before that capability....

Kent Cooper, AIA

marko_ribar · ‎10-30-2013

If you really want it... Here it goes - accepts elliptic arcs... You have to modify it to be appropriate for blocks... See my above posted code...

;; EllipseToPolyline
;; Returns a polyline (vla-object) which is an approximation of the ellipse (or elliptical arc)
;;
;; Argument : an ellipse (vla-object)

(defun EllipseToPolyline (el	/  *acdoc*   cl    norm  cen	elv   pt0   pt1	  pt2	pt3   pt4   ac0
			  ac4	a04   a02   a24	  bsc0	bsc2  bsc3  bsc4  plst	blst  spt   spa
			  fspa	srat  ept   epa	  fepa	erat  n
			 )
  (vl-load-com)
  (setq	cl   (= (ang<2pi (vla-get-StartAngle el))
		(ang<2pi (vla-get-EndAngle el)))
  *acdoc* (vla-get-activedocument (vlax-get-acad-object))
	norm (vlax-get el 'Normal)
	cen  (trans (vlax-get el 'Center) 0 norm)
	elv  (caddr cen)
	cen  (3dTo2dPt cen)
	pt0  (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen)
	ac0  (angle cen pt0)
	pt4  (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm))
	pt2  (3dTo2dPt (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm))
	ac4  (angle cen pt4)
	a04  (angle pt0 pt4)
	a02  (angle pt0 pt2)
	a24  (angle pt2 pt4)
	bsc0 (/ (ang<2pi (- a02 ac4)) 2.)
	bsc2 (/ (ang<2pi (- a04 a02)) 2.)
	bsc3 (/ (ang<2pi (- a24 a04)) 2.)
	bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.)
	pt1  (inters pt0
		     (polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
		     pt2
		     (polar pt2 (+ a02 bsc2) 1.)
		     nil
	     )
	pt3  (inters pt2
		     (polar pt2 (+ a04 bsc3) 1.)
		     pt4
		     (polar pt4 (+ a24 bsc4) 1.)
		     nil
	     )
	plst (list pt4 pt3 pt2 pt1 pt0)
	blst (mapcar '(lambda (b) (tan (/ b 2.)))
		     (list bsc4 bsc3 bsc2 bsc0)
	     )
  )
  (foreach b blst
    (setq blst (cons b blst))
  )
  (foreach b blst
    (setq blst (cons b blst))
  )
  (foreach p (cdr plst)
    (setq ang  (angle cen p)
	  plst (cons
		 (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
		 plst
	       )
    )
  )
  (foreach p (cdr plst)
    (setq ang  (angle cen p)
	  plst (cons
		 (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p))
		 plst
	       )
    )
  )
  (setq vlaLayout (vla-ObjectIdToObject *acdoc* (vla-get-OwnerId el)))
  (setq	pl
    (vlax-invoke
       vlaLayout
       'AddLightWeightPolyline
       (apply 'append
        (setq	 plst
        (reverse (if cl
              (cdr plst)
              plst
            )
        )
        )
       )
    )
  )
  (vlax-put pl 'Normal norm)
  (vla-put-Elevation pl elv)
  (mapcar '(lambda (i v) (vla-SetBulge pl i v))
	  '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
	  blst
  )
  (if cl
    (vla-put-Closed pl :vlax-true)
    (progn
      (setq spt	 (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint))
	    spa	 (vlax-curve-getParamAtPoint pl spt)
	    fspa (fix spa)
	    ept	 (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint))
	    epa	 (vlax-curve-getParamAtPoint pl ept)
	    fepa (fix epa)
	    n	 0
      )
      (cond
	((equal spt (trans pt0 norm 0) 1e-9)
	 (if (= epa fepa)
	   (setq plst (sublist plst 0 (1+ fepa))
		 blst (sublist blst 0 (1+ fepa))
	   )
	   (setq erat (/ (- (vlax-curve-getDistAtParam pl epa)
			    (vlax-curve-getDistAtParam pl fepa)
			 )
			 (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
			    (vlax-curve-getDistAtParam pl fepa)
			 )
		      )
		 plst (append (sublist plst 0 (1+ fepa))
			      (list (3dTo2dPt (trans ept 0 norm)))
		      )
		 blst (append (sublist blst 0 (1+ fepa))
			      (list (k*bulge (nth fepa blst) erat))
		      )
	   )
	 )
	)
	((equal ept (trans pt0 norm 0) 1e-9)
	 (if (= spa fspa)
	   (setq plst (sublist plst fspa nil)
		 blst (sublist blst fspa nil)
	   )
	   (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			    (vlax-curve-getDistAtParam pl spa)
			 )
			 (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			    (vlax-curve-getDistAtParam pl fspa)
			 )
		      )
		 plst (cons (3dTo2dPt (trans spt 0 norm))
			    (sublist plst (1+ fspa) nil)
		      )
		 blst (cons (k*bulge (nth fspa blst) srat)
			    (sublist blst (1+ fspa) nil)
		      )
	   )
	 )
	)
	(T
	 (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			  (vlax-curve-getDistAtParam pl spa)
		       )
		       (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			  (vlax-curve-getDistAtParam pl fspa)
		       )
		    )
	       erat (/ (- (vlax-curve-getDistAtParam pl epa)
			  (vlax-curve-getDistAtParam pl fepa)
		       )
		       (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
			  (vlax-curve-getDistAtParam pl fepa)
		       )
		    )
	 )
	 (if (< epa spa)
	   (setq plst (append
			(if (= spa fspa)
			  (sublist plst fspa nil)
			  (cons	(3dTo2dPt (trans spt 0 norm))
				(sublist plst (1+ fspa) nil)
			  )
			)
			(cdr (sublist plst 0 (1+ fepa)))
			(if (/= epa fepa)
			  (list (3dTo2dPt (trans ept 0 norm)))
			)
		      )
		 blst (append
			(if (= spa fspa)
			  (sublist blst fspa nil)
			  (cons
			    (k*bulge (nth fspa blst) srat)
			    (sublist blst (1+ fspa) nil)
			  )
			)
			(sublist blst 0 fepa)
			(if (= epa fepa)
			  (list (nth fepa blst))
			  (list (k*bulge (nth fepa blst) erat))
			)
		      )
	   )
	   (setq plst (append
			(if (= spa fspa)
			  (sublist plst fspa (1+ (- fepa fspa)))
			  (cons	(3dTo2dPt (trans spt 0 norm))
				(sublist plst (1+ fspa) (- fepa fspa))
			  )
			)
			(list (3dTo2dPt (trans ept 0 norm)))
		      )
		 blst (append
			(if (= spa fspa)
			  (sublist blst fspa (- fepa fspa))
			  (cons
			    (k*bulge (nth fspa blst) srat)
			    (sublist blst (1+ fspa) (- fepa fspa))
			  )
			)
			(if (= epa fepa)
			  (list (nth fepa blst))
			  (list (k*bulge (nth fepa blst) erat))
			)
		      )
	   )
	 )
	)
      )
      (vlax-put pl 'Coordinates (apply 'append plst))
      (foreach b blst
	(vla-SetBulge pl n b)
	(setq n (1+ n))
      )
    )
  )
  pl
)

;; Ang<2pi
;; Returns the angle expression betweem 0 and 2*pi
(defun ang<2pi (ang)
  (if (and (<= 0 ang) (< ang (* 2 pi)))
    ang
    (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
  )
)

;; 3dTo2dPt
;; Returns the 2d point (x y) of a 3d point (x y z)
(defun 3dTo2dPt (pt) (list (car pt) (cadr pt)))

;; Tan
;; Returns the angle tangent
(defun tan (a) (/ (sin a) (cos a)))

;; SUBLIST 
;; Returns a sub list
;;
;; Arguments
;; lst : a list
;; start : start index (first item = 0)
;; leng : the sub list length (number of items) or nil
(defun sublist (lst start leng / n r)
  (if (or (not leng) (< (- (length lst) start) leng))
    (setq leng (- (length lst) start))
  )
  (setq n (+ start leng))
  (while (< start n)
    (setq r (cons (nth (setq n (1- n)) lst) r))
  )
)

;; K*BULGE
;; Returns the proportinal bulge to the référence bulge
;; Arguments :
;; b : the bulge
;; k : the proportion ratio (between angles or arcs length)
(defun k*bulge (b k / a)
  (setq a (atan b))
  (/ (sin (* k a)) (cos (* k a)))
)

(defun unit ( v )
  (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)

(defun mxv ( m v )
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun v^v ( u v )
  (mapcar '(lambda ( n ) (- (* (nth (car n) u) (nth (cadr n) v)) (* (nth (cadr n) u) (nth (car n) v)))) '((1 2) (2 0) (0 1)))
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
  (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
  (setq ux (unit (mapcar '- p2 p1)))
  (setq uy (unit (mapcar '- p3 p1)))
  
  (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
  (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
  (transptucs pt pt1n pt2n pt3n)
)

(defun entmakexlwpoly3dpts ( ptlst opclflag / ux uy uz uptlst )
  (setq uz (unit (v^v (mapcar '- (cadr ptlst) (car ptlst)) (mapcar '- (caddr ptlst) (car ptlst)))))
  (if (equal uz '(0.0 0.0 1.0) 1e-8) (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
  (if (equal uz '(0.0 0.0 -1.0) 1e-8) (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
  (if (not (or (equal uz '(0.0 0.0 1.0) 1e-8) (equal uz '(0.0 0.0 -1.0) 1e-8))) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
  (if (not uy) (setq uy (unit (v^v uz ux))))
  (setq uptlst (mapcar '(lambda ( p ) (transptucs p '(0.0 0.0 0.0) ux uy)) ptlst))
  (entmakex 
    (append
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        (cons 90 (length uptlst))
        (cons 70 opclflag)
        (cons 38 (caddar uptlst))
      )
      (mapcar '(lambda ( x ) (list 10 (car x) (cadr x))) uptlst)
      (list (cons 210 uz))
    )
  )
)

(defun c:2dcw ( / adoc *error* pea wid sego seg ss i ent a1 a2 stpar enpar dpar opcl ii pt ptlst lw )

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  
  (defun *error* ( msg )
    (if pea (setvar 'peditaccept pea))
    (vla-endundomark adoc)
    (if msg (prompt msg))
    (princ)
  )
  
  (vla-startundomark adoc)
  (setq pea (getvar 'peditaccept))
  (initget 7)
  (setq wid (getdist "\nSpecify width of 2d curves (pick) : "))
  (initget 7)
  (setq sego (getint "\nSpecify segmentation ratio for conversion to LWPOLYLINE of 2d SPLINES or 2d HELIXES : "))
  (setq ss (ssget "_:L" '((0 . "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE,HELIX"))))
  (setq i -1)
  (while (setq ent (ssname ss (setq i (1+ i))))
    (cond
      ( (eq (cdr (assoc 0 (entget ent))) "LINE")
        (setvar 'peditaccept 1)
        (command "_.pedit" ent "w" wid "")
      )
      ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
        (command "_.pedit" ent "w" wid "")
      )
      ( (and (eq (cdr (assoc 0 (entget ent))) "POLYLINE") (< (cdr (assoc 70 (entget ent))) 8))
        (command "_.pedit" ent "w" wid "")
      )
      ( (eq (cdr (assoc 0 (entget ent))) "ARC")
        (command "_.pedit" ent "w" wid "")
      )
      ( (eq (cdr (assoc 0 (entget ent))) "CIRCLE")
        (setvar 'peditaccept 1)
        (setq a1 (entmakex (append (list '(0 . "ARC")) (cdddr (entget ent)) (list '(100 . "AcDbArc") (cons 50 0.0) (cons 51 pi)))))
        (setq a2 (entmakex (append (list '(0 . "ARC")) (cdddr (entget ent)) (list '(100 . "AcDbArc") (cons 50 pi) (cons 51 (* 2.0 pi))))))
        (command "_.pedit" a1 "j" a1 a2 "" "w" wid "")
        (entdel ent)
      )
      ( (eq (cdr (assoc 0 (entget ent))) "ELLIPSE")
        (EllipseToPolyline (vlax-ename->vla-object ent))
        (command "_.pedit" (entlast) "w" wid "")
        (entdel ent)
      )
      ( (and (eq (cdr (assoc 0 (entget ent))) "SPLINE") (vlax-curve-isplanar ent))
        (setq seg sego)
        (setq stpar (vlax-curve-getstartparam ent))
        (setq enpar (vlax-curve-getendparam ent))
        (setq dpar (/ (- enpar stpar) seg))
        (if (equal (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent) 1e-8) (setq opcl 1) (setq opcl 0 seg (1+ seg)))
        (setq ii -1.0)
        (repeat seg
          (setq pt (vlax-curve-getpointatparam ent (+ stpar (* (setq ii (1+ ii)) dpar))))
          (setq ptlst (cons pt ptlst))
        )
        (setq ptlst (reverse ptlst))
        (setq lw (entmakexlwpoly3dpts ptlst opcl))
        (command "_.pedit" lw "w" wid "")
        (entdel ent)
        (setq ptlst nil)
      )
      ( (and (eq (cdr (assoc 0 (entget ent))) "HELIX") (vlax-curve-isplanar ent))
        (setq seg sego)
        (setq stpar (vlax-curve-getstartparam ent))
        (setq enpar (vlax-curve-getendparam ent))
        (setq dpar (/ (- enpar stpar) seg))
        (if (equal (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent) 1e-8) (setq opcl 1) (setq opcl 0 seg (1+ seg)))
        (setq ii -1.0)
        (repeat seg
          (setq pt (vlax-curve-getpointatparam ent (+ stpar (* (setq ii (1+ ii)) dpar))))
          (setq ptlst (cons pt ptlst))
        )
        (setq ptlst (reverse ptlst))
        (setq lw (entmakexlwpoly3dpts ptlst opcl))
        (command "_.pedit" lw "w" wid "")
        (entdel ent)
        (setq ptlst nil)
      )
    )
  )
  (*error* nil)
  (princ)
)

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

aqdam1978 · ‎10-30-2013

Hi Marko,

Thank you for your solution, But as I said before: I want an easy and simple solution!

So, the last version is:

(defun c:CH2pl ( / W SS i edata ename)
;changes all lines, plines, arcs, splines & Circles to POLYLINES
;Written By Abbas Aqdam and Kent Cooper
(setvar 'cmdecho 0)
(setvar 'peditaccept 1)
(if  
  (setq 
    W 0.4
    i 0
    SS (ssget "_:L" '((0 . "LINE,*POLYLINE,ARC,SPLINE,CIRCLE,ELLIPSE")))
  );setq
  ;not nil then:
  (repeat (sslength SS)
    (setq 
      edata (entget (ssname ss i))
      ename (cdr (assoc -1 edata))
    )
    (cond
    ((not (wcmatch (substr (cdr (assoc 100 (reverse edata))) 5 2) "3d,Sp,Ci,El"))
    ;NOT AcDb3dPolyline,AcDbSpline,AcDbCircle (100 . Subclass marker)
      (command "_.pedit" ename "w" W "")
    ); Line/Arc/LWPolyline/2DHeavyPolyline condition
    ((= (cdr (assoc 0 edata)) "SPLINE")
      (command "_.pedit" ename 10 "w" W "")
    ); Spline condition
    ((= (cdr (assoc 0 edata)) "CIRCLE")
      (_C2P edata W)
    ); Circle condition
    ((= (cdr (assoc 0 edata)) "ELLIPSE")
      (_E2P edata W)
    ); Ellipse condition	
    ); cond
    (setq i (1+ i))
  );repeat
);if
);defun


(defun _C2P ( edata W / cctr crad pdata)
;;This routine extracted from:
;;http://cadtips.cadalyst.com/curved-objects/circle-polyline-and-polyline-circle  
  (setq
    cctr (cdr (assoc 10 edata))
    crad (cdr (assoc 40 edata)) 
  ); end setq
  (setq 
    pdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) edata)
    pdata 
    (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity")) pdata
        (list '(100 . "AcDbPolyline") '(90 . 2) '(70 . 129) (cons 43 W))
        (list
          (cons 38 (caddr cctr))
          (cons 10 (list (- (car cctr) crad) (cadr cctr))) '(42 . 1)
          (cons 10 (list (+ (car cctr) crad) (cadr cctr))) '(42 . 1)
          (assoc 210 edata)); end list
      ); end append & pdata
  ); end setq
  (entmake pdata)
  (entdel (cdr (assoc -1 edata)));
  (princ)
); end defun

(defun _E2P ( edata W / E E1)
;;idea from:
;;http://www.theswamp.org/index.php?PHPSESSID=nte1qfppp8kahj3v46kaf82ek5&topic=30892.msg364485#msg3644...
  (setq E (cdr (assoc -1 edata)))
  (vla-offset (vlax-ename->vla-object E) 0.1)
  (setq E1 (entlast))
  (vla-offset (vlax-ename->vla-object E1) -0.1)
  (command "_.pedit" (entlast) 10 "w" W "")
  (entdel E)
  (entdel E1)
)

Thanks to all!

Abbas Aqdam

marko_ribar · ‎10-31-2013

You have overlooked for HELIXES... Here is my adaptation - modify HELIXES to 2d and apply conversion to polyline with width...

;; EllipseToPolyline
;; Returns a polyline (vla-object) which is an approximation of the ellipse (or elliptical arc)
;;
;; Argument : an ellipse (vla-object)

(defun EllipseToPolyline (el    /     *acdoc*     cl    norm  cen
                          elv   pt0   pt1   pt2   pt3   pt4   ac0
                          ac4   a04   a02   a24   bsc0  bsc2  bsc3
                          bsc4  plst  blst  spt   spa   fspa  srat
                          ept   epa   fepa  erat  n     vlaLayout
                         )
  (vl-load-com)
  (setq cl      (= (ang<2pi (vla-get-StartAngle el))
                   (ang<2pi (vla-get-EndAngle el))
                )
        *acdoc* (vla-get-activedocument (vlax-get-acad-object))
        norm    (vlax-get el 'Normal)
        cen     (trans (vlax-get el 'Center) 0 norm)
        elv     (caddr cen)
        cen     (3dTo2dPt cen)
        pt0     (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen)
        ac0     (angle cen pt0)
        pt4     (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm))
        pt2     (3dTo2dPt
                  (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm)
                )
        ac4     (angle cen pt4)
        a04     (angle pt0 pt4)
        a02     (angle pt0 pt2)
        a24     (angle pt2 pt4)
        bsc0    (/ (ang<2pi (- a02 ac4)) 2.)
        bsc2    (/ (ang<2pi (- a04 a02)) 2.)
        bsc3    (/ (ang<2pi (- a24 a04)) 2.)
        bsc4    (/ (ang<2pi (- (+ ac0 pi) a24)) 2.)
        pt1     (inters pt0
                        (polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
                        pt2
                        (polar pt2 (+ a02 bsc2) 1.)
                        nil
                )
        pt3     (inters pt2
                        (polar pt2 (+ a04 bsc3) 1.)
                        pt4
                        (polar pt4 (+ a24 bsc4) 1.)
                        nil
                )
        plst    (list pt4 pt3 pt2 pt1 pt0)
        blst    (mapcar '(lambda (b) (tan (/ b 2.)))
                        (list bsc4 bsc3 bsc2 bsc0)
                )
  )
  (foreach b blst
    (setq blst (cons b blst))
  )
  (foreach b blst
    (setq blst (cons b blst))
  )
  (foreach p (cdr plst)
    (setq ang  (angle cen p)
          plst (cons
                 (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
                 plst
               )
    )
  )
  (foreach p (cdr plst)
    (setq ang  (angle cen p)
          plst (cons
                 (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p))
                 plst
               )
    )
  )
  (setq vlaLayout (vla-ObjectIdToObject *acdoc* (vla-get-OwnerId el)))
  (setq pl
         (vlax-invoke
           vlaLayout
           'AddLightWeightPolyline
           (apply 'append
                  (setq plst
                         (reverse (if cl
                                    (cdr plst)
                                    plst
                                  )
                         )
                  )
           )
         )
  )
  (vlax-put pl 'Normal norm)
  (vla-put-Elevation pl elv)
  (mapcar '(lambda (i v) (vla-SetBulge pl i v))
          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
          blst
  )
  (if cl
    (vla-put-Closed pl :vlax-true)
    (progn
      (setq spt  (vlax-curve-getClosestPointTo
                   pl
                   (vlax-get el 'Startpoint)
                 )
            spa  (vlax-curve-getParamAtPoint pl spt)
            fspa (fix spa)
            ept  (vlax-curve-getClosestPointTo
                   pl
                   (vlax-get el 'Endpoint)
                 )
            epa  (vlax-curve-getParamAtPoint pl ept)
            fepa (fix epa)
            n    0
      )
      (cond
        ((equal spt (trans pt0 norm 0) 1e-9)
         (if (= epa fepa)
           (setq plst (sublist plst 0 (1+ fepa))
                 blst (sublist blst 0 (1+ fepa))
           )
           (setq erat (/ (- (vlax-curve-getDistAtParam pl epa)
                            (vlax-curve-getDistAtParam pl fepa)
                         )
                         (- (vlax-curve-getDistAtParam
                              pl
                              (rem (1+ fepa) 17)
                            )
                            (vlax-curve-getDistAtParam pl fepa)
                         )
                      )
                 plst (append (sublist plst 0 (1+ fepa))
                              (list (3dTo2dPt (trans ept 0 norm)))
                      )
                 blst (append (sublist blst 0 (1+ fepa))
                              (list (k*bulge (nth fepa blst) erat))
                      )
           )
         )
        )
        ((equal ept (trans pt0 norm 0) 1e-9)
         (if (= spa fspa)
           (setq plst (sublist plst fspa nil)
                 blst (sublist blst fspa nil)
           )
           (setq srat (/ (- (vlax-curve-getDistAtParam
                              pl
                              (rem (1+ fspa) 17)
                            )
                            (vlax-curve-getDistAtParam pl spa)
                         )
                         (- (vlax-curve-getDistAtParam
                              pl
                              (rem (1+ fspa) 17)
                            )
                            (vlax-curve-getDistAtParam pl fspa)
                         )
                      )
                 plst (cons (3dTo2dPt (trans spt 0 norm))
                            (sublist plst (1+ fspa) nil)
                      )
                 blst (cons (k*bulge (nth fspa blst) srat)
                            (sublist blst (1+ fspa) nil)
                      )
           )
         )
        )
        (T
         (setq srat (/ (- (vlax-curve-getDistAtParam
                            pl
                            (rem (1+ fspa) 17)
                          )
                          (vlax-curve-getDistAtParam pl spa)
                       )
                       (- (vlax-curve-getDistAtParam
                            pl
                            (rem (1+ fspa) 17)
                          )
                          (vlax-curve-getDistAtParam pl fspa)
                       )
                    )
               erat (/ (- (vlax-curve-getDistAtParam pl epa)
                          (vlax-curve-getDistAtParam pl fepa)
                       )
                       (- (vlax-curve-getDistAtParam
                            pl
                            (rem (1+ fepa) 17)
                          )
                          (vlax-curve-getDistAtParam pl fepa)
                       )
                    )
         )
         (if (< epa spa)
           (setq plst (append
                        (if (= spa fspa)
                          (sublist plst fspa nil)
                          (cons (3dTo2dPt (trans spt 0 norm))
                                (sublist plst (1+ fspa) nil)
                          )
                        )
                        (cdr (sublist plst 0 (1+ fepa)))
                        (if (/= epa fepa)
                          (list (3dTo2dPt (trans ept 0 norm)))
                        )
                      )
                 blst (append
                        (if (= spa fspa)
                          (sublist blst fspa nil)
                          (cons
                            (k*bulge (nth fspa blst) srat)
                            (sublist blst (1+ fspa) nil)
                          )
                        )
                        (sublist blst 0 fepa)
                        (if (= epa fepa)
                          (list (nth fepa blst))
                          (list (k*bulge (nth fepa blst) erat))
                        )
                      )
           )
           (setq plst (append
                        (if (= spa fspa)
                          (sublist plst fspa (1+ (- fepa fspa)))
                          (cons (3dTo2dPt (trans spt 0 norm))
                                (sublist plst (1+ fspa) (- fepa fspa))
                          )
                        )
                        (list (3dTo2dPt (trans ept 0 norm)))
                      )
                 blst (append
                        (if (= spa fspa)
                          (sublist blst fspa (- fepa fspa))
                          (cons
                            (k*bulge (nth fspa blst) srat)
                            (sublist blst (1+ fspa) (- fepa fspa))
                          )
                        )
                        (if (= epa fepa)
                          (list (nth fepa blst))
                          (list (k*bulge (nth fepa blst) erat))
                        )
                      )
           )
         )
        )
      )
      (vlax-put pl 'Coordinates (apply 'append plst))
      (foreach b blst
        (vla-SetBulge pl n b)
        (setq n (1+ n))
      )
    )
  )
  pl
)

;; Ang<2pi
;; Returns the angle expression betweem 0 and 2*pi
(defun ang<2pi (ang)
  (if (and (<= 0 ang) (< ang (* 2 pi)))
    ang
    (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
  )
)

;; 3dTo2dPt
;; Returns the 2d point (x y) of a 3d point (x y z)
(defun 3dTo2dPt (pt) (list (car pt) (cadr pt)))

;; Tan
;; Returns the angle tangent
(defun tan (a) (/ (sin a) (cos a)))

;; SUBLIST 
;; Returns a sub list
;;
;; Arguments
;; lst : a list
;; start : start index (first item = 0)
;; leng : the sub list length (number of items) or nil
(defun sublist (lst start leng / n r)
  (if (or (not leng) (< (- (length lst) start) leng))
    (setq leng (- (length lst) start))
  )
  (setq n (+ start leng))
  (while (< start n)
    (setq r (cons (nth (setq n (1- n)) lst) r))
  )
)

;; K*BULGE
;; Returns the proportinal bulge to the référence bulge
;; Arguments :
;; b : the bulge
;; k : the proportion ratio (between angles or arcs length)
(defun k*bulge (b k / a)
  (setq a (atan b))
  (/ (sin (* k a)) (cos (* k a)))
)

(defun unit (v)
  (mapcar '(lambda (x) (/ x (distance '(0.0 0.0 0.0) v))) v)
)

(defun mxv (m v)
  (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)

(defun v^v (u v / cda)
  (defun cda (p) (cdr (append p p)))
  (mapcar '-
          (mapcar '* (cda u) (cdr (cda v)))
          (mapcar '* (cdr (cda u)) (cda v))
          '(0.0 0.0 0.0)
  )
)

(defun transptucs (pt p1 p2 p3 / ux uy uz)
  (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
  (setq ux (unit (mapcar '- p2 p1)))
  (setq uy (unit (mapcar '- p3 p1)))

  (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs (pt pt1 pt2 pt3 / pt1n pt2n pt3n)
  (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
  (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
  (transptucs pt pt1n pt2n pt3n)
)

(defun entmakexlwpoly3dpts (ptlst opclflag / ux uy uz uptlst)
  (setq uz (unit (v^v (mapcar '- (cadr ptlst) (car ptlst))
                      (mapcar '- (caddr ptlst) (car ptlst))
                 )
           )
  )
  (if (equal uz '(0.0 0.0 1.0) 1e-8)
    (setq ux '(1.0 0.0 0.0)
          uy '(0.0 1.0 0.0)
    )
  )
  (if (equal uz '(0.0 0.0 -1.0) 1e-8)
    (setq ux '(-1.0 0.0 0.0)
          uy '(0.0 1.0 0.0)
    )
  )
  (if (not (or (equal uz '(0.0 0.0 1.0) 1e-8)
               (equal uz '(0.0 0.0 -1.0) 1e-8)
           )
      )
    (setq ux (unit (v^v '(0.0 0.0 1.0) uz)))
  )
  (if (not uy)
    (setq uy (unit (v^v uz ux)))
  )
  (setq
    uptlst
     (mapcar '(lambda (p) (transptucs p '(0.0 0.0 0.0) ux uy))
             ptlst
     )
  )
  (entmakex
    (append
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        (cons 90 (length uptlst))
        (cons 70 opclflag)
        (cons 38 (caddar uptlst))
      )
      (mapcar '(lambda (x) (list 10 (car x) (cadr x))) uptlst)
      (list (cons 210 uz))
    )
  )
)

(defun c:2dcw (/     adoc  *error*     ea    el    ll    ell   y
               pea   wid   sego  seg   ss    i     ent   a1    a2
               stpar enpar dpar  opcl  ii    pt    ptlst lw
              )

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

  (defun *error* (msg)
    (if pea
      (setvar 'peditaccept pea)
    )
    (vla-endundomark adoc)
    (if msg
      (prompt msg)
    )
    (princ)
  )

  (vla-startundomark adoc)
  (setq pea (getvar 'peditaccept))
  (initget 5)
  (setq wid (getdist "\nSpecify width of 2d curves (pick) : "))
  (initget 7)
  (setq sego
         (getint
           "\nSpecify segmentation ratio for conversion to LWPOLYLINE of 2d SPLINES or 2d HELIXES : "
         )
  )
  (setq ss
         (ssget "_:L"
                '((0 . "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE,HELIX"))
         )
  )
  (setq i -1)
  (while (setq ent (ssname ss (setq i (1+ i))))
    (cond
      ((eq (cdr (assoc 0 (entget ent))) "LINE")
       (setvar 'peditaccept 1)
       (command "_.pedit" ent "w" wid "")
      )
      ((eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
       (command "_.pedit" ent "w" wid "")
      )
      ((and (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
            (< (cdr (assoc 70 (entget ent))) 8)
       )
       (command "_.pedit" ent "w" wid "")
      )
      ((eq (cdr (assoc 0 (entget ent))) "ARC")
       (command "_.pedit" ent "w" wid "")
      )
      ((eq (cdr (assoc 0 (entget ent))) "CIRCLE")
       (setvar 'peditaccept 1)
       (setq
         a1 (entmakex
              (append
                (list '(0 . "ARC"))
                (cdddr (entget ent))
                (list '(100 . "AcDbArc")
                      (cons 50 0.0)
                      (cons 51 pi)
                )
              )
            )
       )
       (setq a2 (entmakex (append (list '(0 . "ARC"))
                                  (cdddr (entget ent))
                                  (list '(100 . "AcDbArc")
                                        (cons 50 pi)
                                        (cons 51 (* 2.0 pi))
                                  )
                          )
                )
       )
       (command "_.pedit" a1 "j" a1 a2 "" "w" wid "")
       (entdel ent)
      )
      ((eq (cdr (assoc 0 (entget ent))) "ELLIPSE")
       (EllipseToPolyline (vlax-ename->vla-object ent))
       (command "_.pedit" (entlast) "w" wid "")
       (entdel ent)
      )
      ((and (eq (cdr (assoc 0 (entget ent))) "SPLINE")
            (vlax-curve-isplanar ent)
       )
       (setq seg sego)
       (setq stpar (vlax-curve-getstartparam ent))
       (setq enpar (vlax-curve-getendparam ent))
       (setq dpar (/ (- enpar stpar) seg))
       (if (equal (vlax-curve-getstartpoint ent)
                  (vlax-curve-getendpoint ent)
                  1e-8
           )
         (setq opcl 1)
         (setq opcl 0
               seg  (1+ seg)
         )
       )
       (setq ii -1.0)
       (repeat seg
         (setq pt (vlax-curve-getpointatparam
                    ent
                    (+ stpar (* (setq ii (1+ ii)) dpar))
                  )
         )
         (setq ptlst (cons pt ptlst))
       )
       (setq ptlst (reverse ptlst))
       (setq lw (entmakexlwpoly3dpts ptlst opcl))
       (command "_.pedit" lw "w" wid "")
       (entdel ent)
       (setq ptlst nil)
      )
      ((eq (cdr (assoc 0 (entget ent))) "HELIX")
       (setq ea (vlax-ename->vla-object ent))
       (vla-put-height ea 0.0)
       (command "_.ucs" "w")
       (setq el (entget ent))
       (command "_.ucs" "m" (cdr (assoc 11 el)))
       (command "_.ucs" "za" '(0.0 0.0 0.0) (cdr (assoc 12 el)))
       (setq ll el)
       (mapcar '(lambda (x)
                  (if (eq (car x) 10)
                    (setq ell (cons (trans (cdr x) 0 1) ell))
                  )
                )
               el
       )
       (setq ell (reverse ell))
       (setq
         ell
          (mapcar
            '(lambda (x) (trans (list (car x) (cadr x) 0.0) 1 0))
            ell
          )
       )
       (setq ell
              (mapcar '(lambda (x) (list 10 (car x) (cadr x) (caddr x)))
                      ell
              )
       )
       (setq el (member (assoc 10 el) el))
       (setq ii -1)
       (foreach x (reverse (cdr (reverse ell)))
         (setq ii (1+ ii))
         (setq y (nth ii el))
         (setq ll (subst x y ll))
       )
       (entmod ll)
       (setq ell nil)
       (command "_.ucs" "p")
       (command "_.ucs" "p")
       (command "_.ucs" "p")
       (setq seg sego)
       (setq stpar (vlax-curve-getstartparam ent))
       (setq enpar (vlax-curve-getendparam ent))
       (setq dpar (/ (- enpar stpar) seg))
       (if (equal (vlax-curve-getstartpoint ent)
                  (vlax-curve-getendpoint ent)
                  1e-8
           )
         (setq opcl 1)
         (setq opcl 0
               seg  (1+ seg)
         )
       )
       (setq ii -1.0)
       (repeat seg
         (setq pt (vlax-curve-getpointatparam
                    ent
                    (+ stpar (* (setq ii (1+ ii)) dpar))
                  )
         )
         (setq ptlst (cons pt ptlst))
       )
       (setq ptlst (reverse ptlst))
       (setq lw (entmakexlwpoly3dpts ptlst opcl))
       (command "_.pedit" lw "w" wid "")
       (entdel ent)
       (setq ptlst nil)
      )
    )
  )
  (*error* nil)
  (princ)
)

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

aqdam1978 · ‎11-01-2013

Hi Kent,

This code converts ellipses to polylines without problem.

But if there is a non complete ellipse (part of ellipse), it did not work and shows this error:

; error: Automation Error. Invalid offset

Do you have any idea?

Thanks,

hmsilva · ‎11-01-2013

Abbas,
why not use
(command "_.splinedit" (entlast) "_P" 10 "")

Henrique

hmsilva · ‎11-01-2013

Abbas,

please disregard my last post, I didn't read your post correctly... My bad

Henrique

Kent1Cooper · ‎11-01-2013

@aqdam1978 wrote:

.... if there is a non complete ellipse (part of ellipse), it did not work and shows this error:

; error: Automation Error. Invalid offset

....

I don't have any ideas, but I can't test the overall, since my older version here won't PEDIT a Spline. Even with Offsetting an Ellipse into a Spline and Offsetting that, and starting with a Polyline ellipse and doing the same, heading for extremes going inward where I know it might have trouble because AutoCAD won't draw an Ellipse below a certain very small axis ratio, I can't seem to get that message. But it may be relevant to know whether that's happening in the first offset or the second one.

Kent Cooper, AIA

aqdam1978 · ‎11-03-2013

Hi Kent,

I could not found a solution for this problem. (non-closed ellipses)

for now I just exclude non-closed ellipses to convert.

may be someone can find a solution in future.

I use this code to detect closed ellipses:

(setq ell(entget(car(entsel "Select an ellipse"))))
(if(= (- (cdr(assoc 42 ell))(cdr(assoc 41 ell))) (* 2 pi)) (alert "Closed Ellipse"))

so, the last version of programs is:

(defun c:CH2pl ( / W SS i edata ename)
;changes all lines, plines, arcs, splines & Circles to POLYLINES
;Written By Abbas Aqdam and Kent Cooper
(setvar 'cmdecho 0)
(setvar 'peditaccept 1)
(if  
  (setq 
    W 0.0	;WIDTH of polylines
    i 0
    SS (ssget "_:L" '((0 . "LINE,*POLYLINE,ARC,SPLINE,CIRCLE,ELLIPSE")))
  );setq
  ;not nil then:
  (repeat (sslength SS)
    (setq 
      edata (entget (ssname ss i))
      ename (cdr (assoc -1 edata))
    )
    (cond
    ((not (wcmatch (substr (cdr (assoc 100 (reverse edata))) 5 2) "3d,Sp,Ci,El"))
    ;NOT AcDb3dPolyline,AcDbSpline,AcDbCircle (100 . Subclass marker)
      (command "_.pedit" ename "w" W "")
    ); Line/Arc/LWPolyline/2DHeavyPolyline condition
    ((= (cdr (assoc 0 edata)) "SPLINE")
      (command "_.pedit" ename 10 "w" W "")
    ); Spline condition
    ((= (cdr (assoc 0 edata)) "CIRCLE")
      (_C2P edata W)
    ); Circle condition
    ((= (cdr (assoc 0 edata)) "ELLIPSE")
      (_E2P edata W)
    ); Ellipse condition	
    ); cond
    (setq i (1+ i))
  );repeat
);if
);defun


(defun _C2P ( edata W / cctr crad pdata)
;;This routine extracted from:
;;http://cadtips.cadalyst.com/curved-objects/circle-polyline-and-polyline-circle  
  (setq
    cctr (cdr (assoc 10 edata))
    crad (cdr (assoc 40 edata)) 
  ); end setq
  (setq 
    pdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) edata)
    pdata 
    (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity")) pdata
        (list '(100 . "AcDbPolyline") '(90 . 2) '(70 . 129) (cons 43 W))
        (list
          (cons 38 (caddr cctr))
          (cons 10 (list (- (car cctr) crad) (cadr cctr))) '(42 . 1)
          (cons 10 (list (+ (car cctr) crad) (cadr cctr))) '(42 . 1)
          (assoc 210 edata)); end list
      ); end append & pdata
  ); end setq
  (entmake pdata)
  (entdel (cdr (assoc -1 edata)));
  (princ)
); end defun

(defun _E2P ( edata W / E E1)
;;idea from:
;;http://www.theswamp.org/index.php?PHPSESSID=nte1qfppp8kahj3v46kaf82ek5&topic=30892.msg364485#msg3644...
(if(= (- (cdr(assoc 42 edata))(cdr(assoc 41 edata))) (* 2 pi));closed ellipse?
  (progn
	  (setq E (cdr (assoc -1 edata)))
	  (vla-offset (vlax-ename->vla-object E) 0.1)
	  (setq E1 (entlast))
	  (vla-offset (vlax-ename->vla-object E1) -0.1)
	  (command "_.pedit" (entlast) 10 "w" W "")
	  (entdel E)
	  (entdel E1)
  );progn
);if
);_E2P

hope to find a solution very soon!

Thanks,

Abbas

Kent1Cooper · ‎11-04-2013

@aqdam1978 wrote:

....

I use this code to detect closed ellipses:
(setq ell(entget(car(entsel "Select an ellipse"))))
(if(= (- (cdr(assoc 42 ell))(cdr(assoc 41 ell))) (* 2 pi)) (alert "Closed Ellipse"))
....

That might sometimes be subject to tiny rounding differences many decimal places down in the 41 and 42 values. You can avoid that by using (equal) with a fuzz factor, or more simply:

(if (vlax-curve-isClosed ell) (alert ....))

That may require you to have this somewhere in the routine:

(vl-load-com)

though maybe you have that already loaded by something else, since there's a (vl-remove-if...) function in there.

Kent Cooper, AIA

stevor · ‎11-04-2013

Perhaps you could use the end coords of the partial ellipse.

Add the code to create a full ellipse,

convert the full ellipse,

then 'break it at those points.

?

S

aqdam1978 · ‎11-04-2013

Hi Kent,

Thanks for your good point.

I applied your suggestion:

(defun _E2P ( edata W / E E_vl E1)
(setq E (cdr (assoc -1 edata)))
(setq E_vl (vlax-ename->vla-object E))
(if (vlax-curve-isClosed E_vl);closed ellipse?
  (progn
	  (vla-offset E_vl 0.1)
	  (setq E1 (entlast))
	  (vla-offset (vlax-ename->vla-object E1) -0.1)
	  (command "_.pedit" (entlast) 10 "w" W "")
	  (entdel E)
	  (entdel E1)
  );progn
);if
);_E2P

Thanks,

Abbas

aqdam1978 · ‎11-04-2013

Hi Stevor,

I thought about your idea couplr of days ago but I found it difficult to implement.

I think changing PELLIPSE to 1 and redrawing of it is easier than to TRIM closed ellipse.

Thanks,

Abbas

All to Pline

All to Pline

Forums Links

Post to forums