Topic: How to convert Ellipse or Ellipse-Arc to Lwpolyine ?

[chlh_jd]

Hi all !
what all as the title .
I use points forec into arc ,  and found it dose not get the best result , is there better way to do it (Particularly it lost the symmetry) .

Code - Auto/Visual Lisp: [Select]

1. ;; Convert an ellipse or ellipse arc into lwpolyline
2. ;;
3. ;; test routine
4. (defun c:test () (ss-ellipse2pl (car (entsel "\nSelect an Ellipse or Ellipse-Arc to convert :")) 200 0.075))
5. ;;
6. ;; main function
7. (defun ss-ellipse2pl
8.                       (ell n tor / pas pae dpa pai p pts ptl ps arc an1
9.                        an2 cr p0 p1 p2 en ss)
10.   ;; ell -- ellipse or ellipse arc
11.   ;; n -- devided numbers to get pointset of the ell entity
12.   ;;       Fit number : >= 100
13.   ;; tor -- Tolerance , the ratio of the average distance of all centers with the Fit center and the Radius
14.   ;;        Fit value : 0.01~0.2
15.   (setq pas (vlax-curve-getstartparam ell)
16.         pae (vlax-curve-getendparam ell)
17.         dpa (- pae pas)
18.         pai (/ dpa n))
19.   (repeat (1+ n)
20.     (if (setq p (vlax-curve-getpointatparam ell pas))
21.       (setq pts (cons p pts))
22.       (if (and (equal pas pae 1e-6)
23.                (setq p (vlax-curve-getpointatparam ell pae)))
24.         (setq pts (cons p pts))))
25.     (setq pas (+ pas pai)))
26.   (setq pts (reverse pts))
27.   (setq ptl pts)
28.   (setq en (entlast))
29.   (while (> (length ptl) 2)
30.     (repeat (- 3 (length ps))
31.       (setq ps  (cons (car ptl) ps)
32.             ptl (cdr ptl)))
33.     (while
34.       (and (< (caddr (setq arc (ss-pts2arc (reverse ps)))) tor)
35.            ptl)
36.        (setq ps  (cons (car ptl) ps)
37.              ptl (cdr ptl)))
38.     (if (> (length ps) 3)
39.       (setq ptl (cons (car ps) ptl)
40.             ps  (cdr ps)
41.             arc (ss-pts2arc (reverse ps))))
42.     (if (and arc (< (caddr arc) tor))
43.       (progn
44.         (setq p2  (car ps)
45.               p0  (last ps)
46.               p1  (vlax-curve-getclosestpointto ell (midpt p0 p2))
47.               cr  (ss-3pcircle p0 p1 p2)
48.               an1 (angle (car cr) (last ps))
49.               an2 (angle (car cr) (car ps)))
50.         (setq ps (list (car ps)))
51.         (if (and (equal an1 an2 1e-6) (equal an1 0 1e-6))
52.           (setq an2 (* 2 pi)))
53.         (entmake (list (cons 0 "ARC")
54.                        (cons 100 "AcDbEntity")
55.                        (cons 100 "AcDbCircle")
56.                        (cons 10 (car cr))
57.                        (cons 40 (cadr cr))
58.                        (cons 100 "AcDbArc")
59.                        (cons 50 an1)
60.                        (cons 51 an2))
61.                  ))
62.       (setq ps (butlast ps))))
63.   (if (and (cadr ptl)
64.            ps
65.            (setq ps (append (reverse ptl) ps))
66.            (setq arc (ss-pts2arc (reverse ps)))
67.            )
68.     (progn
69.       (setq p2  (car ps)
70.             p0  (last ps)
71.             p1  (vlax-curve-getclosestpointto ell (midpt p0 p2))
72.             cr  (ss-3pcircle p0 p1 p2)
73.             an1 (angle (car cr) (last ps))
74.             an2 (angle (car cr) (car ps)))
75.       (if (and (equal an1 an2 1e-6) (equal an1 0 1e-6))
76.         (setq an2 (* 2 pi)))
77.       (entmake (list (cons 0 "ARC")
78.                      (cons 100 "AcDbEntity")
79.                      (cons 100 "AcDbCircle")
80.                      (cons 10 (car cr))
81.                      (cons 40 (cadr cr))
82.                      (cons 100 "AcDbArc")
83.                      (cons 50 an1)
84.                      (cons 51 an2))
85.                )
86.       )
87.     (entmod(ch-en (cons 51 (angle (car cr) (car ptl))) (entget (entlast))))
88.     )
89.   (setq ss (ssadd))
90.   (while (setq en (entnext en))
91.     (setq ss (ssadd en ss)))
92.   (vl-cmdf "pedit" "M" ss "" "y" "j" "" "")
93.   (entlast)
94.   )
95. ;;;force points into a circle
96. (defun ss-pts2arc  (pts / cs c dc r n)
97.   (if (setq cs (mapcar (function (lambda (p1 p2 p3 / p4 p5 p6 p7)
98.                                    (setq p4 (midpt p1 p2)
99.                                          p5 (midpt p2 p3))
100.                                    (setq p6 (polar p4 (+ (angle p1 p2) (/ pi 2.)) 1.)
101.                                          p7 (polar p5 (+ (angle p2 p3) (/ pi 2.)) 1.))
102.                                    (inters p4 p6 p5 p7 nil)))
103.                        pts
104.                        (cdr pts)
105.                        (cddr pts))
106.             cs (vl-remove nil cs))
107.     (setq
108.       c  (midpts cs)
109.       n  (length pts)
110.       dc (/ (apply (function +)
111.                    (mapcar (function (lambda (p)
112.                                        (distance p c)))
113.                            cs))
114.             n)
115.       r  (/ (apply (function +)
116.                    (mapcar (function (lambda (p)
117.                                        (distance p c)))
118.                            pts))
119.             n)))
120.   (if c
121.     (list c r (/ dc r)))
122.   )
123. ;;--------------------------
124. ;; Used functions
125. (defun ss-3PCirCle (p0 p1 p2 / v1 v2 m1 m2 v3 mat d0 d1 d2 v c )
126.   (setq p0 (trans p0 0 0)
127.         p1 (trans p1 0 0)
128.         p2 (trans p2 0 0)
129.         v1 (pt* (pt- p0 p1) 2.)
130.         v2 (pt* (pt- p1 p2) 2.)
131.         m1 (- (* (caddr v1) (cadr v2)) (* (cadr v1) (caddr v2)) )
132.         m2 (- (* (car v1) (caddr v2)) (* (caddr v1) (car v2)) )
133.         v3 (list (/ (* (caddr v1) m1) 8.)
134.                  (/ (* (caddr v1) m2) 8.)
135.                  (/ (+ (* (car v1) m1) (* (cadr v1) m2)) -8.))
136.         mat (list v1 v2 v3)
137.         d0 (apply (function +) (mapcar (function *) p0 p0))
138.         d1 (apply (function +) (mapcar (function *) p1 p1))
139.         d2 (apply (function +) (mapcar (function *) p2 p2))
140.         v (list (- d0 d1)
141.                  (- d1 d2)
142.                  (apply (function +) (mapcar (function *) p0 v3))
143.                  )     
144.         )
145.   (if (equal (last mat) (list 0.0 0.0 0.0) 1e-14)
146.     (setq mat (list (butlast (car mat)) (butlast (cadr mat)))))
147.   (setq c (flatset([*] ([inv] mat) (mapcar (function list) v))))
148.   (if c
149.     (list c (distance c p0)))
150. )
151. ;;--------
152. (defun butlast(a) (reverse (cdr(reverse a))))
153. ;;--------
154. (defun flatset (s / foo)
155.   ;;by Gile
156.   (defun foo (s p)
157.     (if s(foo(cdr s)(if (atom (car s))(cons (car s) p)(foo (car s) p)))p))
158.   (reverse (foo s nil)))
159. ;;--------
160. (defun [inv] (mat / col piv row res)
161.   ;; gauss-jordan elimination method to calculate the inverse
162.   ;; by gile
163.   ;;([inv] '((1 2 3) (2 4 5) (3 5 6)))
164.   (setq mat (mapcar (function (lambda (x1 x2)
165.                  (append  x1  x2))) mat([I] (length mat))))
166.   (while mat
167.     (setq col (mapcar(function(lambda (x)(abs (car x))))mat))
168.     (repeat (vl-position(apply(function max)col)col)
169.       (setq mat (append (cdr mat) (list (car mat)))))  
170.     (if (equal (setq piv (caar mat))0.0 1e-14)
171.       (setq mat nil  res nil)      
172.       (setq piv (/ 1.0 (caar mat))
173.             row (mapcar(function(lambda (x)(* x piv)))(car mat))
174.             mat (mapcar (function(lambda (r / e)
175.                      (setq e (car r))(cdr (mapcar(function(lambda (x n)
176.                                (- x (* n e))))r row))))          
177.                   (cdr mat))
178.             res (cons (cdr row)
179.                       (mapcar(function(lambda (r / e)
180.                            (setq e (car r))(cdr(mapcar(function(lambda (x n)
181.                                      (- x (* n e))))r row))))res))
182.       )))
183.   (reverse res)
184. )
185. ;;-------mat x mat
186. (defun [*](m q)(mapcar(function (lambda (r)(mxv ([trp] q) r)))m))
187. ;;-------
188. (defun mxv(m v)(mapcar(function(lambda (r)(vxv r v)))m))
189. ;;-------Transpose matrix
190. (defun [trp] (a)  
191.   (apply (function mapcar) (cons (function list) a)))
192. ;;; vxv returns the dot product of 2 vectors
193. ;; (vxv '(1 2 0) '(2 5 0))
194. (defun vxv(v1 v2)(apply(function +)(mapcar(function *)v1 v2)))
195. ;;-------get I matrix
196. (defun [I] (d / i r n m)
197.   (setq i d)
198.   (while (<= 0 (setq i (1- i)))
199.     (setq n d
200.           r nil)
201.     (while (<= 0 (setq n (1- n)))
202.       (setq r (cons (if (= i n)
203.                       1.0
204.                       0.0)
205.                     r)))
206.     (setq m (cons r m))))
207. ;;-------
208. (defun midpt (p1 p2)
209.   (mapcar (function /2) (mapcar (function +)  p1 p2))
210. )
211. (defun /2 (a) (cond ((numberp a) (/ a 2.))
212.                     ((vl-consp a) (mapcar (function /2) a))))
213. ;;-------
214. (defun pt-(p2 p1)(mapcar(function -)p2 p1))
215. ;;-------
216. (defun pt*(v c)(mapcar(function(lambda(x)(* x c)))v))
217. ;;-------
218. (defun midpts (l / n)
219.   (setq n (float(length l)))
220.   (mapcar (function (lambda (x) (/ x n)))
221.           (apply (function mapcar) (cons (function +) l))))
222. ;;-------
223. (defun ch-en  (co en / b)
224.   (if (eq (type en) (quote ename))
225.     (setq en (entget en (list "*"))))
226.   (cond ((not co) en)
227.         ((vl-every (function vl-consp) co)
228.          (ch-en (cdr co) (ch-en (car co) en))
229.          )
230.         (t
231.          (if (setq b (assoc (car co) en))
232.            (subst co b en)
233.            (reverse (cons co (reverse en))))))
234.   )
235.  

[Peter Guappa]

You could use Lee Mac 's :

http://lee-mac.com/entitytopointlist.html

and create a LWpoly from these points.

[gile]

Hi,

Here's my (quite old) attempt.
The polyline ellipse approximation is the same as AutoCAD's one (i.e. PELLIPSE = 1).

The EL2PL command converts the selected ellipses or elliptical arcs in lwpolylines.
The PELL command let the user draw a polyline ellipse approximation as with te native ELLIPSE command.

Code - Auto/Visual Lisp: [Select]

1. ;; EllipseToPolyline
2. ;; Returns a polyline (vla-object) which is an approximation of the ellipse (or elliptical arc)
3. ;;
4. ;; Argument : an ellipse (vla-object)
5.  
6. (defun EllipseToPolyline (el    /     cl    norm  cen   elv   pt0   pt1   pt2   pt3   pt4   ac0
7.                           ac4   a04   a02   a24   bsc0  bsc2  bsc3  bsc4  plst  blst  spt   spa
8.                           fspa  srat  ept   epa   fepa  erat  n
9.                          )
10.   (vl-load-com)
11.   (setq cl   (= (ang<2pi (vla-get-StartAngle el))
12.                 (ang<2pi (vla-get-EndAngle el)))
13.         norm (vlax-get el 'Normal)
14.         cen  (trans (vlax-get el 'Center) 0 norm)
15.         elv  (caddr cen)
16.         cen  (3dTo2dPt cen)
17.         pt0  (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen)
18.         ac0  (angle cen pt0)
19.         pt4  (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm))
20.         pt2  (3dTo2dPt (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm))
21.         ac4  (angle cen pt4)
22.         a04  (angle pt0 pt4)
23.         a02  (angle pt0 pt2)
24.         a24  (angle pt2 pt4)
25.         bsc0 (/ (ang<2pi (- a02 ac4)) 2.)
26.         bsc2 (/ (ang<2pi (- a04 a02)) 2.)
27.         bsc3 (/ (ang<2pi (- a24 a04)) 2.)
28.         bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.)
29.         pt1  (inters pt0
30.                      (polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
31.                      pt2
32.                      (polar pt2 (+ a02 bsc2) 1.)
33.                      nil
34.              )
35.         pt3  (inters pt2
36.                      (polar pt2 (+ a04 bsc3) 1.)
37.                      pt4
38.                      (polar pt4 (+ a24 bsc4) 1.)
39.                      nil
40.              )
41.         plst (list pt4 pt3 pt2 pt1 pt0)
42.         blst (mapcar '(lambda (b) (tan (/ b 2.)))
43.                      (list bsc4 bsc3 bsc2 bsc0)
44.              )
45.   )
46.   (foreach b blst
47.     (setq blst (cons b blst))
48.   )
49.   (foreach b blst
50.     (setq blst (cons b blst))
51.   )
52.   (foreach p (cdr plst)
53.     (setq ang  (angle cen p)
54.           plst (cons
55.                  (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
56.                  plst
57.                )
58.     )
59.   )
60.   (foreach p (cdr plst)
61.     (setq ang  (angle cen p)
62.           plst (cons
63.                  (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p))
64.                  plst
65.                )
66.     )
67.   )
68.   (setq pl
69.          (vlax-invoke
70.            (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
71.            'AddLightWeightPolyline
72.            (apply 'append
73.                   (setq plst
74.                          (reverse (if cl
75.                                     (cdr plst)
76.                                     plst
77.                                   )
78.                          )
79.                   )
80.            )
81.          )
82.   )
83.   (vlax-put pl 'Normal norm)
84.   (vla-put-Elevation pl elv)
85.   (mapcar '(lambda (i v) (vla-SetBulge pl i v))
86.           '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
87.           blst
88.   )
89.   (if cl
90.     (vla-put-Closed pl :vlax-true)
91.     (progn
92.       (setq spt  (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint))
93.             spa  (vlax-curve-getParamAtPoint pl spt)
94.             fspa (fix spa)
95.             ept  (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint))
96.             epa  (vlax-curve-getParamAtPoint pl ept)
97.             fepa (fix epa)
98.             n    0
99.       )
100.       (cond
101.         ((equal spt (trans pt0 norm 0) 1e-9)
102.          (if (= epa fepa)
103.            (setq plst (sublist plst 0 (1+ fepa))
104.                  blst (sublist blst 0 (1+ fepa))
105.            )
106.            (setq erat (/ (- (vlax-curve-getDistAtParam pl epa)
107.                             (vlax-curve-getDistAtParam pl fepa)
108.                          )
109.                          (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
110.                             (vlax-curve-getDistAtParam pl fepa)
111.                          )
112.                       )
113.                  plst (append (sublist plst 0 (1+ fepa))
114.                               (list (3dTo2dPt (trans ept 0 norm)))
115.                       )
116.                  blst (append (sublist blst 0 (1+ fepa))
117.                               (list (k*bulge (nth fepa blst) erat))
118.                       )
119.            )
120.          )
121.         )
122.         ((equal ept (trans pt0 norm 0) 1e-9)
123.          (if (= spa fspa)
124.            (setq plst (sublist plst fspa nil)
125.                  blst (sublist blst fspa nil)
126.            )
127.            (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
128.                             (vlax-curve-getDistAtParam pl spa)
129.                          )
130.                          (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
131.                             (vlax-curve-getDistAtParam pl fspa)
132.                          )
133.                       )
134.                  plst (cons (3dTo2dPt (trans spt 0 norm))
135.                             (sublist plst (1+ fspa) nil)
136.                       )
137.                  blst (cons (k*bulge (nth fspa blst) srat)
138.                             (sublist blst (1+ fspa) nil)
139.                       )
140.            )
141.          )
142.         )
143.         (T
144.          (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
145.                           (vlax-curve-getDistAtParam pl spa)
146.                        )
147.                        (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
148.                           (vlax-curve-getDistAtParam pl fspa)
149.                        )
150.                     )
151.                erat (/ (- (vlax-curve-getDistAtParam pl epa)
152.                           (vlax-curve-getDistAtParam pl fepa)
153.                        )
154.                        (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
155.                           (vlax-curve-getDistAtParam pl fepa)
156.                        )
157.                     )
158.          )
159.          (if (< epa spa)
160.            (setq plst (append
161.                         (if (= spa fspa)
162.                           (sublist plst fspa nil)
163.                           (cons (3dTo2dPt (trans spt 0 norm))
164.                                 (sublist plst (1+ fspa) nil)
165.                           )
166.                         )
167.                         (cdr (sublist plst 0 (1+ fepa)))
168.                         (if (/= epa fepa)
169.                           (list (3dTo2dPt (trans ept 0 norm)))
170.                         )
171.                       )
172.                  blst (append
173.                         (if (= spa fspa)
174.                           (sublist blst fspa nil)
175.                           (cons
176.                             (k*bulge (nth fspa blst) srat)
177.                             (sublist blst (1+ fspa) nil)
178.                           )
179.                         )
180.                         (sublist blst 0 fepa)
181.                         (if (= epa fepa)
182.                           (list (nth fepa blst))
183.                           (list (k*bulge (nth fepa blst) erat))
184.                         )
185.                       )
186.            )
187.            (setq plst (append
188.                         (if (= spa fspa)
189.                           (sublist plst fspa (1+ (- fepa fspa)))
190.                           (cons (3dTo2dPt (trans spt 0 norm))
191.                                 (sublist plst (1+ fspa) (- fepa fspa))
192.                           )
193.                         )
194.                         (list (3dTo2dPt (trans ept 0 norm)))
195.                       )
196.                  blst (append
197.                         (if (= spa fspa)
198.                           (sublist blst fspa (- fepa fspa))
199.                           (cons
200.                             (k*bulge (nth fspa blst) srat)
201.                             (sublist blst (1+ fspa) (- fepa fspa))
202.                           )
203.                         )
204.                         (if (= epa fepa)
205.                           (list (nth fepa blst))
206.                           (list (k*bulge (nth fepa blst) erat))
207.                         )
208.                       )
209.            )
210.          )
211.         )
212.       )
213.       (vlax-put pl 'Coordinates (apply 'append plst))
214.       (foreach b blst
215.         (vla-SetBulge pl n b)
216.         (setq n (1+ n))
217.       )
218.     )
219.   )
220.   pl
221. )
222.  
223. ;; Ang<2pi
224. ;; Returns the angle expression betweem 0 and 2*pi
225. (defun ang<2pi (ang)
226.   (if (and (<= 0 ang) (< ang (* 2 pi)))
227.     ang
228.     (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
229.   )
230. )
231.  
232. ;; 3dTo2dPt
233. ;; Returns the 2d point (x y) of a 3d point (x y z)
234. (defun 3dTo2dPt (pt) (list (car pt) (cadr pt)))
235.  
236. ;; Tan
237. ;; Returns the angle tangent
238. (defun tan (a) (/ (sin a) (cos a)))
239.  
240. ;; SUBLIST
241. ;; Returns a sub list
242. ;;
243. ;; Arguments
244. ;; lst : a list
245. ;; start : start index (first item = 0)
246. ;; leng : the sub list length (number of items) or nil
247. (defun sublist (lst start leng / n r)
248.   (if (or (not leng) (< (- (length lst) start) leng))
249.     (setq leng (- (length lst) start))
250.   )
251.   (setq n (+ start leng))
252.   (while (< start n)
253.     (setq r (cons (nth (setq n (1- n)) lst) r))
254.   )
255. )
256.  
257. ;; K*BULGE
258. ;; Returns the proportinal bulge to the référence bulge
259. ;; Arguments :
260. ;; b : the bulge
261. ;; k : the proportion ratio (between angles or arcs length)
262. (defun k*bulge (b k / a)
263.   (setq a (atan b))
264.   (/ (sin (* k a)) (cos (* k a)))
265. )
266.  
267. ;; EL2PL
268. ;; Converts ellipses and elliptcal arcs into polylines
269.  
270. (defun c:el2pl (/ *error* fra acdoc ss)
271.   (vl-load-com)
272.   (defun *error* (msg)
273.     (if (and (/= msg "Fonction annulée")
274.              (/= msg "Function cancelled")
275.         )
276.       (princ (strcat (if (= "FRA" (getvar 'locale))
277.                        "\nErreur: "
278.                        "\Error: "
279.                      )
280.                      msg
281.              )
282.       )
283.     )
284.     (vla-endUndoMark acdoc)
285.     (princ)
286.   )
287.   (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
288.   (if (ssget '((0 . "ELLIPSE")))
289.     (progn
290.       (vla-StartUndoMark acdoc)
291.       (vlax-for e (setq ss (vla-get-ActiveSelectionSet acdoc))
292.         (EllipseToPolyline e)
293.         (vla-delete e)
294.       )
295.       (vla-delete ss)
296.       (vla-EndUndoMark acdoc)
297.     )
298.   )
299.   (princ)
300. )
301.  
302. ;; PELL
303. ;; Draws an ellipse or an elliptical arc approximation (polyline) on the fly
304. (defun c:pell (/ *error* ec pe old ent)
305.   (vl-load-com)
306.   (defun *error* (msg)
307.     (if (and msg
308.              (/= msg "Fonction annulée")
309.              (/= msg "Function cancelled")
310.         )
311.       (princ (strcat (if (= "FRA" (getvar 'locale))
312.                        "\nErreur: "
313.                        "\Error: "
314.                      )
315.                      msg
316.              )
317.       )
318.     )
319.     (setvar 'cmdecho ec)
320.     (setvar 'pellipse pe)
321.     (princ)
322.   )
323.   (setq ec  (getvar 'cmdecho)
324.         pe  (getvar 'pellipse)
325.         old (entlast)
326.   )
327.   (setvar 'cmdecho 1)
328.   (setvar 'pellipse 0)
329.   (command "_.ellipse")
330.   (while (/= 0 (getvar 'cmdactive))
331.     (command pause)
332.   )
333.   (if (not (eq old (setq ent (entlast))))
334.     (progn
335.       (EllipseToPolyline (vlax-ename->vla-object ent))
336.       (entdel ent)
337.     )
338.   )
339.   (*error* nil)
340. )

[chlh_jd]

You could use Lee Mac 's :

http://lee-mac.com/entitytopointlist.html

and create a LWpoly from these points.

Thanks Peter !

[chlh_jd]

Hi,

Here's my (quite old) attempt.
The polyline ellipse approximation is the same as AutoCAD's one (i.e. PELLIPSE = 1).

The EL2PL command converts the selected ellipses or elliptical arcs in lwpolylines.
The PELL command let the user draw a polyline ellipse approximation as with te native ELLIPSE command.

Code: [Select]

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

(defun EllipseToPolyline (el /     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
)
    ...
  pl
)

Nice solution ,  Gile !
I always can see the master's demeanor from you ! 
Thank you a lot ![/code]

[nobody]

Hi,

Here's my (quite old) attempt.
The polyline ellipse approximation is the same as AutoCAD's one (i.e. PELLIPSE = 1).

The EL2PL command converts the selected ellipses or elliptical arcs in lwpolylines.
The PELL command let the user draw a polyline ellipse approximation as with te native ELLIPSE command.

Code - Auto/Visual Lisp: [Select]

1. ;; EllipseToPolyline
2. ;; Returns a polyline (vla-object) which is an approximation of the ellipse (or elliptical arc)
3. ;;
4. ;; Argument : an ellipse (vla-object)
5.  
6. (defun EllipseToPolyline (el    /     cl    norm  cen   elv   pt0   pt1   pt2   pt3   pt4   ac0
7.                           ac4   a04   a02   a24   bsc0  bsc2  bsc3  bsc4  plst  blst  spt   spa
8.                           fspa  srat  ept   epa   fepa  erat  n
9.                          )
10.   (vl-load-com)
11.   (setq cl   (= (ang<2pi (vla-get-StartAngle el))
12.                 (ang<2pi (vla-get-EndAngle el)))
13.         norm (vlax-get el 'Normal)
14.         cen  (trans (vlax-get el 'Center) 0 norm)
15.         elv  (caddr cen)
16.         cen  (3dTo2dPt cen)
17.         pt0  (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen)
18.         ac0  (angle cen pt0)
19.         pt4  (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm))
20.         pt2  (3dTo2dPt (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm))
21.         ac4  (angle cen pt4)
22.         a04  (angle pt0 pt4)
23.         a02  (angle pt0 pt2)
24.         a24  (angle pt2 pt4)
25.         bsc0 (/ (ang<2pi (- a02 ac4)) 2.)
26.         bsc2 (/ (ang<2pi (- a04 a02)) 2.)
27.         bsc3 (/ (ang<2pi (- a24 a04)) 2.)
28.         bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.)
29.         pt1  (inters pt0
30.                      (polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
31.                      pt2
32.                      (polar pt2 (+ a02 bsc2) 1.)
33.                      nil
34.              )
35.         pt3  (inters pt2
36.                      (polar pt2 (+ a04 bsc3) 1.)
37.                      pt4
38.                      (polar pt4 (+ a24 bsc4) 1.)
39.                      nil
40.              )
41.         plst (list pt4 pt3 pt2 pt1 pt0)
42.         blst (mapcar '(lambda (b) (tan (/ b 2.)))
43.                      (list bsc4 bsc3 bsc2 bsc0)
44.              )
45.   )
46.   (foreach b blst
47.     (setq blst (cons b blst))
48.   )
49.   (foreach b blst
50.     (setq blst (cons b blst))
51.   )
52.   (foreach p (cdr plst)
53.     (setq ang  (angle cen p)
54.           plst (cons
55.                  (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
56.                  plst
57.                )
58.     )
59.   )
60.   (foreach p (cdr plst)
61.     (setq ang  (angle cen p)
62.           plst (cons
63.                  (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p))
64.                  plst
65.                )
66.     )
67.   )
68.   (setq pl
69.          (vlax-invoke
70.            (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
71.            'AddLightWeightPolyline
72.            (apply 'append
73.                   (setq plst
74.                          (reverse (if cl
75.                                     (cdr plst)
76.                                     plst
77.                                   )
78.                          )
79.                   )
80.            )
81.          )
82.   )
83.   (vlax-put pl 'Normal norm)
84.   (vla-put-Elevation pl elv)
85.   (mapcar '(lambda (i v) (vla-SetBulge pl i v))
86.           '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
87.           blst
88.   )
89.   (if cl
90.     (vla-put-Closed pl :vlax-true)
91.     (progn
92.       (setq spt  (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint))
93.             spa  (vlax-curve-getParamAtPoint pl spt)
94.             fspa (fix spa)
95.             ept  (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint))
96.             epa  (vlax-curve-getParamAtPoint pl ept)
97.             fepa (fix epa)
98.             n    0
99.       )
100.       (cond
101.         ((equal spt (trans pt0 norm 0) 1e-9)
102.          (if (= epa fepa)
103.            (setq plst (sublist plst 0 (1+ fepa))
104.                  blst (sublist blst 0 (1+ fepa))
105.            )
106.            (setq erat (/ (- (vlax-curve-getDistAtParam pl epa)
107.                             (vlax-curve-getDistAtParam pl fepa)
108.                          )
109.                          (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
110.                             (vlax-curve-getDistAtParam pl fepa)
111.                          )
112.                       )
113.                  plst (append (sublist plst 0 (1+ fepa))
114.                               (list (3dTo2dPt (trans ept 0 norm)))
115.                       )
116.                  blst (append (sublist blst 0 (1+ fepa))
117.                               (list (k*bulge (nth fepa blst) erat))
118.                       )
119.            )
120.          )
121.         )
122.         ((equal ept (trans pt0 norm 0) 1e-9)
123.          (if (= spa fspa)
124.            (setq plst (sublist plst fspa nil)
125.                  blst (sublist blst fspa nil)
126.            )
127.            (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
128.                             (vlax-curve-getDistAtParam pl spa)
129.                          )
130.                          (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
131.                             (vlax-curve-getDistAtParam pl fspa)
132.                          )
133.                       )
134.                  plst (cons (3dTo2dPt (trans spt 0 norm))
135.                             (sublist plst (1+ fspa) nil)
136.                       )
137.                  blst (cons (k*bulge (nth fspa blst) srat)
138.                             (sublist blst (1+ fspa) nil)
139.                       )
140.            )
141.          )
142.         )
143.         (T
144.          (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
145.                           (vlax-curve-getDistAtParam pl spa)
146.                        )
147.                        (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
148.                           (vlax-curve-getDistAtParam pl fspa)
149.                        )
150.                     )
151.                erat (/ (- (vlax-curve-getDistAtParam pl epa)
152.                           (vlax-curve-getDistAtParam pl fepa)
153.                        )
154.                        (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
155.                           (vlax-curve-getDistAtParam pl fepa)
156.                        )
157.                     )
158.          )
159.          (if (< epa spa)
160.            (setq plst (append
161.                         (if (= spa fspa)
162.                           (sublist plst fspa nil)
163.                           (cons (3dTo2dPt (trans spt 0 norm))
164.                                 (sublist plst (1+ fspa) nil)
165.                           )
166.                         )
167.                         (cdr (sublist plst 0 (1+ fepa)))
168.                         (if (/= epa fepa)
169.                           (list (3dTo2dPt (trans ept 0 norm)))
170.                         )
171.                       )
172.                  blst (append
173.                         (if (= spa fspa)
174.                           (sublist blst fspa nil)
175.                           (cons
176.                             (k*bulge (nth fspa blst) srat)
177.                             (sublist blst (1+ fspa) nil)
178.                           )
179.                         )
180.                         (sublist blst 0 fepa)
181.                         (if (= epa fepa)
182.                           (list (nth fepa blst))
183.                           (list (k*bulge (nth fepa blst) erat))
184.                         )
185.                       )
186.            )
187.            (setq plst (append
188.                         (if (= spa fspa)
189.                           (sublist plst fspa (1+ (- fepa fspa)))
190.                           (cons (3dTo2dPt (trans spt 0 norm))
191.                                 (sublist plst (1+ fspa) (- fepa fspa))
192.                           )
193.                         )
194.                         (list (3dTo2dPt (trans ept 0 norm)))
195.                       )
196.                  blst (append
197.                         (if (= spa fspa)
198.                           (sublist blst fspa (- fepa fspa))
199.                           (cons
200.                             (k*bulge (nth fspa blst) srat)
201.                             (sublist blst (1+ fspa) (- fepa fspa))
202.                           )
203.                         )
204.                         (if (= epa fepa)
205.                           (list (nth fepa blst))
206.                           (list (k*bulge (nth fepa blst) erat))
207.                         )
208.                       )
209.            )
210.          )
211.         )
212.       )
213.       (vlax-put pl 'Coordinates (apply 'append plst))
214.       (foreach b blst
215.         (vla-SetBulge pl n b)
216.         (setq n (1+ n))
217.       )
218.     )
219.   )
220.   pl
221. )
222.  
223. ;; Ang<2pi
224. ;; Returns the angle expression betweem 0 and 2*pi
225. (defun ang<2pi (ang)
226.   (if (and (<= 0 ang) (< ang (* 2 pi)))
227.     ang
228.     (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
229.   )
230. )
231.  
232. ;; 3dTo2dPt
233. ;; Returns the 2d point (x y) of a 3d point (x y z)
234. (defun 3dTo2dPt (pt) (list (car pt) (cadr pt)))
235.  
236. ;; Tan
237. ;; Returns the angle tangent
238. (defun tan (a) (/ (sin a) (cos a)))
239.  
240. ;; SUBLIST
241. ;; Returns a sub list
242. ;;
243. ;; Arguments
244. ;; lst : a list
245. ;; start : start index (first item = 0)
246. ;; leng : the sub list length (number of items) or nil
247. (defun sublist (lst start leng / n r)
248.   (if (or (not leng) (< (- (length lst) start) leng))
249.     (setq leng (- (length lst) start))
250.   )
251.   (setq n (+ start leng))
252.   (while (< start n)
253.     (setq r (cons (nth (setq n (1- n)) lst) r))
254.   )
255. )
256.  
257. ;; K*BULGE
258. ;; Returns the proportinal bulge to the référence bulge
259. ;; Arguments :
260. ;; b : the bulge
261. ;; k : the proportion ratio (between angles or arcs length)
262. (defun k*bulge (b k / a)
263.   (setq a (atan b))
264.   (/ (sin (* k a)) (cos (* k a)))
265. )
266.  
267. ;; EL2PL
268. ;; Converts ellipses and elliptcal arcs into polylines
269.  
270. (defun c:el2pl (/ *error* fra acdoc ss)
271.   (vl-load-com)
272.   (defun *error* (msg)
273.     (if (and (/= msg "Fonction annulée")
274.              (/= msg "Function cancelled")
275.         )
276.       (princ (strcat (if (= "FRA" (getvar 'locale))
277.                        "\nErreur: "
278.                        "\Error: "
279.                      )
280.                      msg
281.              )
282.       )
283.     )
284.     (vla-endUndoMark acdoc)
285.     (princ)
286.   )
287.   (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
288.   (if (ssget '((0 . "ELLIPSE")))
289.     (progn
290.       (vla-StartUndoMark acdoc)
291.       (vlax-for e (setq ss (vla-get-ActiveSelectionSet acdoc))
292.         (EllipseToPolyline e)
293.         (vla-delete e)
294.       )
295.       (vla-delete ss)
296.       (vla-EndUndoMark acdoc)
297.     )
298.   )
299.   (princ)
300. )
301.  
302. ;; PELL
303. ;; Draws an ellipse or an elliptical arc approximation (polyline) on the fly
304. (defun c:pell (/ *error* ec pe old ent)
305.   (vl-load-com)
306.   (defun *error* (msg)
307.     (if (and msg
308.              (/= msg "Fonction annulée")
309.              (/= msg "Function cancelled")
310.         )
311.       (princ (strcat (if (= "FRA" (getvar 'locale))
312.                        "\nErreur: "
313.                        "\Error: "
314.                      )
315.                      msg
316.              )
317.       )
318.     )
319.     (setvar 'cmdecho ec)
320.     (setvar 'pellipse pe)
321.     (princ)
322.   )
323.   (setq ec  (getvar 'cmdecho)
324.         pe  (getvar 'pellipse)
325.         old (entlast)
326.   )
327.   (setvar 'cmdecho 1)
328.   (setvar 'pellipse 0)
329.   (command "_.ellipse")
330.   (while (/= 0 (getvar 'cmdactive))
331.     (command pause)
332.   )
333.   (if (not (eq old (setq ent (entlast))))
334.     (progn
335.       (EllipseToPolyline (vlax-ename->vla-object ent))
336.       (entdel ent)
337.     )
338.   )
339.   (*error* nil)
340. )

This 400 pages of code (lol...jk) is why lisp is so valuable