Thanks, Lee... I had some trouble finding all components correctly, ellipse center among others... But finally, I did it... It should work in any UCS and with elliptical arcs...
;; Polyline Ellipse to Ellipse - Lee Mac
;; Prompts the user for a selection of polylines approximating ellipses (PELLIPSEs)
;; and attempts to convert each polyline to an appropriate ellipse, retaining all properties.
(defun c:pl2ell ( / dis ell ent enx idx inc lst sel pst pen el e p ) (vl-load-com)
(if (setq sel (ssget "_:L" '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 88) (-4 . "NOT>"))))
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx)))
inc (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 5)
enx (entget ent)
dis 0.0
lst nil
pst (vlax-curve-getstartpoint ent)
pen (vlax-curve-getendpoint ent)
)
(repeat 5
(setq lst (cons (trans (vlax-curve-getpointatdist ent dis) 0 ent) lst)
dis (+ dis inc)
)
)
(if (and (setq ell (apply 'LM:5p-ellipse (cons ent (cons (caddar lst) lst))))
(setq el
(entmakex
(append
'(
(000 . "ELLIPSE")
(100 . "AcDbEntity")
(100 . "AcDbEllipse")
)
(LM:defaultprops enx) ell
(list (assoc 210 enx))
)
)
)
)
(entdel ent)
)
(if (not (equal pst pen 1e-6))
(progn
(setq e (entlast))
(command "_.ZOOM" "_OB" el "")
(command "_.LINE" "_non" (trans pst 0 1) "_non" (trans pen 0 1) "")
(command "_.UCS" "_M" "_non" (trans pst 0 1))
(command "_.UCS" "_ZA" "" (cdr (assoc 210 enx)))
(command "_.TRIM" "_L" "" (trans (vlax-curve-getclosestpointto e (trans (cadr lst) (cdr (assoc 210 enx)) 0)) 0 1) "")
(setq p (vlax-curve-getpointatparam e (+ (vlax-curve-getstartparam e) (/ (- (vlax-curve-getendparam e) (vlax-curve-getstartparam e)) 2.0))))
(command "_.UNDO" "")
(command "_.TRIM" "_L" "" (trans p 0 1) "")
(command "_.UCS" "_P")
(command "_.UCS" "_P")
(command "_.ZOOM" "_P")
(entdel (entlast))
)
)
)
)
(princ)
)
;; Default Properties - Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups
(defun LM:defaultprops ( enx )
(vl-remove nil
(mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ((not (assoc (car x) enx)) nil) ( x )))
'(
(006 . "BYLAYER")
(008 . "0")
(039 . 0.0)
(048 . 1.0)
(062 . 256)
(370 . -1)
(420 . 16777215)
)
)
)
)
;; 5-Point Ellipse - Lee Mac
;; Args: p1,p2,p3,p4,p5 - UCS points defining Ellipse
;; Returns a list of: ((10 <WCS Center>) (11 <WCS Major Axis Endpoint from Center>) (40 . <Minor/Major Ratio>))
;; Version 1.1 - 2013-11-28
(defun LM:5P-Ellipse ( ent elev p1 p2 p3 p4 p5 / a av b c cf cx cy d e f i m1 m2 rl v x )
(setq m1
(trp
(mapcar
(function
(lambda ( p )
(list
(* (car p) (car p))
(* (car p) (cadr p))
(* (cadr p) (cadr p))
(car p)
(cadr p)
1.0
)
)
)
(list p1 p2 p3 p4 p5)
)
)
)
(setq i -1.0)
(repeat 6
(setq cf (cons (* (setq i (- i)) (detm (trp (append (reverse m2) (cdr m1))))) cf)
m2 (cons (car m1) m2)
m1 (cdr m1)
)
)
(mapcar 'set '(f e d c b a) cf) ;; Coefficients of Conic equation ax^2 + bxy + cy^2 + dx + ey + f = 0
(if (< 0 (setq x (- (* 4.0 a c) (* b b))))
(progn
(if (equal 0.0 b 1e-8) ;; Ellipse parallel to coordinate axes
(setq av '((1.0 0.0) (0.0 1.0))) ;; Axis vectors
(setq av
(mapcar
(function
(lambda ( v / d )
(setq v (list (/ b 2.0) (- v a)) ;; Eigenvectors
d (distance '(0.0 0.0) v)
)
(mapcar '/ v (list d d))
)
)
(quad 1.0 (- (+ a c)) (- (* a c) (* 0.25 b b))) ;; Eigenvalues
)
)
)
(setq cx (/ (- (* b e) (* 2.0 c d)) x) ;; Ellipse Center
cy (/ (- (* b d) (* 2.0 a e)) x)
)
;; For radii, solve intersection of axis vectors with Conic Equation:
;; ax^2 + bxy + cy^2 + dx + ey + f = 0 }
;; x = cx + vx(t) }- solve for t
;; y = cy + vy(t) }
(setq rl
(mapcar
(function
(lambda ( v / vv vx vy )
(setq vv (mapcar '* v v)
vx (car v)
vy (cadr v)
)
(apply 'max
(quad
(+ (* a (car vv)) (* b vx vy) (* c (cadr vv)))
(+ (* 2.0 a cx vx) (* b (+ (* cx vy) (* cy vx))) (* c 2.0 cy vy) (* d vx) (* e vy))
(+ (* a cx cx) (* b cx cy) (* c cy cy) (* d cx) (* e cy) f)
)
)
)
)
av
)
)
(if (apply '> rl)
(setq rl (reverse rl)
av (reverse av)
)
)
(list
(cons 10 (trans (list cx cy elev) ent 0)) ;; WCS Ellipse Center
(cons 11 (trans (mapcar '(lambda ( v ) (* v (cadr rl))) (cadr av)) ent 0)) ;; WCS Major Axis Endpoint from Center
(cons 40 (apply '/ rl)) ;; minor/major ratio
)
)
)
)
;; Matrix Determinant (Upper Triangular Form) - ElpanovEvgeniy
;; Args: m - nxn matrix
(defun detm ( m / d )
(cond
( (null m) 1)
( (and (zerop (caar m))
(setq d (car (vl-member-if-not (function (lambda ( a ) (zerop (car a)))) (cdr m))))
)
(detm (cons (mapcar '+ (car m) d) (cdr m)))
)
( (zerop (caar m)) 0)
( (* (caar m)
(detm
(mapcar
(function
(lambda ( a / d ) (setq d (/ (car a) (float (caar m))))
(mapcar
(function
(lambda ( b c ) (- b (* c d)))
)
(cdr a) (cdar m)
)
)
)
(cdr m)
)
)
)
)
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Quadratic Solution - Lee Mac
;; Args: a,b,c - coefficients of ax^2 + bx + c = 0
(defun quad ( a b c / d r )
(if (<= 0 (setq d (- (* b b) (* 4.0 a c))))
(progn
(setq r (sqrt d))
(list (/ (+ (- b) r) (* 2.0 a)) (/ (- (- b) r) (* 2.0 a)))
)
)
)
Regards, Marko R.
[EDIT:] Added new code, after I saw Lee's answer...[/EDIT]
;; Polyline Ellipse to Ellipse - Lee Mac
;; Prompts the user for a selection of polylines approximating ellipses (PELLIPSEs)
;; and attempts to convert each polyline to an appropriate ellipse, retaining all properties.
(defun c:pl2ell ( / dis ell ent enx idx inc lst ocs sel ) (vl-load-com)
(if (setq sel (ssget "_:L" '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 88) (-4 . "NOT>"))))
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx)))
inc (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 5)
enx (entget ent)
ocs (assoc 210 enx)
dis 0.0
lst nil
)
(repeat 5
(setq lst (cons (trans (vlax-curve-getpointatdist ent dis) 0 ent) lst)
dis (+ dis inc)
)
)
(if (and (setq ell (apply 'LM:5p-ellipse (cons ent (cons (caddar lst) lst))))
(entmakex
(append
'(
(000 . "ELLIPSE")
(100 . "AcDbEntity")
(100 . "AcDbEllipse")
)
(LM:defaultprops enx) ell
(if (not (vlax-curve-isclosed ent))
(list
(cons 41 (LM:point->param (cons ocs ell) (vlax-curve-getstartpoint ent)))
(cons 42 (LM:point->param (cons ocs ell) (vlax-curve-getendpoint ent)))
)
)
(list ocs)
)
)
)
(entdel ent)
)
)
)
(princ)
)
;; Default Properties - Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups
(defun LM:defaultprops ( enx )
(vl-remove nil
(mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ((not (assoc (car x) enx)) nil) ( x )))
'(
(006 . "BYLAYER")
(008 . "0")
(039 . 0.0)
(048 . 1.0)
(062 . 256)
(370 . -1)
(420 . 16777215)
)
)
)
)
;; 5-Point Ellipse - Lee Mac
;; Args: p1,p2,p3,p4,p5 - UCS points defining Ellipse
;; Returns a list of: ((10 <WCS Center>) (11 <WCS Major Axis Endpoint from Center>) (40 . <Minor/Major Ratio>))
;; Version 1.1 - 2013-11-28
(defun LM:5P-Ellipse ( ent elev p1 p2 p3 p4 p5 / a av b c cf cx cy d e f i m1 m2 rl v x )
(setq m1
(trp
(mapcar
(function
(lambda ( p )
(list
(* (car p) (car p))
(* (car p) (cadr p))
(* (cadr p) (cadr p))
(car p)
(cadr p)
1.0
)
)
)
(list p1 p2 p3 p4 p5)
)
)
)
(setq i -1.0)
(repeat 6
(setq cf (cons (* (setq i (- i)) (detm (trp (append (reverse m2) (cdr m1))))) cf)
m2 (cons (car m1) m2)
m1 (cdr m1)
)
)
(mapcar 'set '(f e d c b a) cf) ;; Coefficients of Conic equation ax^2 + bxy + cy^2 + dx + ey + f = 0
(if (< 0 (setq x (- (* 4.0 a c) (* b b))))
(progn
(if (equal 0.0 b 1e-8) ;; Ellipse parallel to coordinate axes
(setq av '((1.0 0.0) (0.0 1.0))) ;; Axis vectors
(setq av
(mapcar
(function
(lambda ( v / d )
(setq v (list (/ b 2.0) (- v a)) ;; Eigenvectors
d (distance '(0.0 0.0) v)
)
(mapcar '/ v (list d d))
)
)
(quad 1.0 (- (+ a c)) (- (* a c) (* 0.25 b b))) ;; Eigenvalues
)
)
)
(setq cx (/ (- (* b e) (* 2.0 c d)) x) ;; Ellipse Center
cy (/ (- (* b d) (* 2.0 a e)) x)
)
;; For radii, solve intersection of axis vectors with Conic Equation:
;; ax^2 + bxy + cy^2 + dx + ey + f = 0 }
;; x = cx + vx(t) }- solve for t
;; y = cy + vy(t) }
(setq rl
(mapcar
(function
(lambda ( v / vv vx vy )
(setq vv (mapcar '* v v)
vx (car v)
vy (cadr v)
)
(apply 'max
(quad
(+ (* a (car vv)) (* b vx vy) (* c (cadr vv)))
(+ (* 2.0 a cx vx) (* b (+ (* cx vy) (* cy vx))) (* c 2.0 cy vy) (* d vx) (* e vy))
(+ (* a cx cx) (* b cx cy) (* c cy cy) (* d cx) (* e cy) f)
)
)
)
)
av
)
)
(if (apply '> rl)
(setq rl (reverse rl)
av (reverse av)
)
)
(list
(cons 10 (trans (list cx cy elev) ent 0)) ;; WCS Ellipse Center
(cons 11 (trans (mapcar '(lambda ( v ) (* v (cadr rl))) (cadr av)) ent 0)) ;; WCS Major Axis Endpoint from Center
(cons 40 (apply '/ rl)) ;; minor/major ratio
)
)
)
)
;; Matrix Determinant (Upper Triangular Form) - ElpanovEvgeniy
;; Args: m - nxn matrix
(defun detm ( m / d )
(cond
( (null m) 1)
( (and (zerop (caar m))
(setq d (car (vl-member-if-not (function (lambda ( a ) (zerop (car a)))) (cdr m))))
)
(detm (cons (mapcar '+ (car m) d) (cdr m)))
)
( (zerop (caar m)) 0)
( (* (caar m)
(detm
(mapcar
(function
(lambda ( a / d ) (setq d (/ (car a) (float (caar m))))
(mapcar
(function
(lambda ( b c ) (- b (* c d)))
)
(cdr a) (cdar m)
)
)
)
(cdr m)
)
)
)
)
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Quadratic Solution - Lee Mac
;; Args: a,b,c - coefficients of ax^2 + bx + c = 0
(defun quad ( a b c / d r )
(if (<= 0 (setq d (- (* b b) (* 4.0 a c))))
(progn
(setq r (sqrt d))
(list (/ (+ (- b) r) (* 2.0 a)) (/ (- (- b) r) (* 2.0 a)))
)
)
)
;; Point -> Ellipse Parameter - Lee Mac
;; Returns the ellipse parameter for the given point
;; dxf - Ellipse DXF data (DXF groups 10, 11, 40, 210)
;; pnt - WCS Point on Ellipse
;; Uses relationship: ratio*tan(param) = tan(angle)
(defun LM:point->param ( dxf pnt / ang ocs )
(setq ocs (cdr (assoc 210 dxf))
ang (- (angle (trans (cdr (assoc 10 dxf)) 0 ocs) (trans pnt 0 ocs))
(angle '(0.0 0.0) (trans (cdr (assoc 11 dxf)) 0 ocs))
)
)
(atan (sin ang) (* (cdr (assoc 40 dxf)) (cos ang)))
)
