Topic: project ellipse to UCS - or convert ellipse to spline - help

[ribarm]

Who can help me to make code for projecting ellipse on some relative UCS... I've done in the past similar thing with SPLINES, so if it's too complicated then please if possible point me how to convert ellipse to spline object, but with ellipse I mean all 3d ellipses and 3d elliptic arcs (dxf0 "ELLIPSE") in any orientation... I've tried through vla- functions, but no success... (I have problems understanding dxf41 and dxf42 of ellipse - it's probably start and end angle - but I don't know how to calculate them - if you know then I suppose you can entmod or entmake new one with the rest of parameters)... Here is what I have...

Code - Auto/Visual Lisp: [Select]

1. ;; Project Point onto Plane  -  Lee Mac
2. ;; Projects pt onto the plane defined by its origin and normal
3.  
4. (defun LM:ProjectPointToPlane ( pt org nm )
5.     (setq pt  (trans pt  0 nm)
6.           org (trans org 0 nm)
7.     )
8.     (trans (list (car pt) (cadr pt) (caddr org)) nm 0)
9. )
10.  
11. (defun unit ( v )
12.   (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
13. )
14.  
15. (defun c:ellpucs nil (c:ellprojonucs))
16. (defun c:ellprojonucs ( / org nor ss n ell ellA ce stp enp cep stpp enpp zd lina linb ap bp app bpp radiusratio m minorradius majorradius normal center startpoint endpoint majoraxis minoraxis )
17.   (vl-load-com)
18.   (prompt "\nSelect ellipse objects")
19.   (while (not ss)
20.     (setq ss (ssget "_:L" '((0 . "ELLIPSE"))))
21.   )
22.   (setq org (trans '(0.0 0.0 0.0) 1 0))
23.   (setq nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
24.   (repeat (setq n (sslength ss))
25.     (command "_.ucs" "w")
26.     (setq ell (ssname ss (setq n (1- n))))
27.     (setq ce (cdr (assoc 10 (entget ell))))
28.     (setq stp (vlax-curve-getstartpoint ell))
29.     (setq enp (vlax-curve-getendpoint ell))
30.     (setq cep (LM:ProjectPointToPlane ce org nor))
31.     (setq stpp (LM:ProjectPointToPlane stp org nor))
32.     (setq enpp (LM:ProjectPointToPlane enp org nor))
33.     (setq zd (cdr (assoc 210 (entget ell))))
34.     (command "_.ucs" "za" "" zd)
35.     (setq lina (entmakex (list '(0 . "LINE") (cons 10 ce) (cons 11 (mapcar '+ ce (trans '(1.0 0.0 0.0) 1 0))))))
36.     (setq linb (entmakex (list '(0 . "LINE") (cons 10 ce) (cons 11 (mapcar '+ ce (trans '(0.0 1.0 0.0) 1 0))))))
37.     (setq ap (vlax-invoke (setq ellA (vlax-ename->vla-object ell)) 'IntersectWith (vlax-ename->vla-object lina) acExtendBoth))
38.     (setq bp (vlax-invoke ellA 'IntersectWith (vlax-ename->vla-object linb) acExtendBoth))
39.     (setq ap (list (car ap) (cadr ap) (caddr ap)))
40.     (setq bp (list (car bp) (cadr bp) (caddr bp)))
41.     (entdel lina)
42.     (entdel linb)
43.     (setq app (LM:ProjectPointToPlane ap org nor))
44.     (setq bpp (LM:ProjectPointToPlane bp org nor))
45.     (command "_.ucs" "p")
46.     (setq radiusratio (/ (setq minorradius (distance cep bpp)) (setq majorradius (distance cep app))))
47.     (setq normal (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 2)) nor)))
48.     (setq center (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 2)) cep)))
49.     (setq endpoint (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 2)) enpp)))
50.     (setq startpoint (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 2)) stpp)))
51.     (setq majoraxis (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 2)) (unit (mapcar '- app cep)))))
52.     (setq minoraxis (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 2)) (unit (mapcar '- bpp cep)))))
53.     (if (>= radiusratio 1.0) (setq radiusratio (/ 1.0 radiusratio) m minorradius minorradius majorradius majorradius m))
54.     (vla-put-center ellA center)
55. ;    (vla-put-normal ellA normal)
56. ;    (vla-put-radiusratio ellA radiusratio)
57. ;    (vla-put-minorradius ellA minorradius)
58. ;    (vla-put-majorradius ellA majorradius)
59. ;    (vla-put-endpoint ellA endpoint)
60. ;    (vla-put-startpoint ellA startpoint)
61. ;    (vla-put-majoraxis ellA majoraxis)
62. ;    (vla-put-minoraxis ellA minoraxis)
63.     (vla-update ellA)
64.     (command "_.ucs" "p")
65.   )
66. (princ)
67. )
68. (princ "\nShortcut for c:ellprojonucs is c:ellpucs")
69. (princ)
70.  

M.R. Thanks in advance...

[ribarm]

I figured out how to convert to splines... I had similar code from my library that I modified :

Code - Auto/Visual Lisp: [Select]

1. (defun c:el2spl ( / CE CH DXF11 DXF40 EL ELSPL PTST SP1 SP1CV SP1EN SP1ST SP2 SP2CV SP2EN SP2ST SP3 SP3CV SP3EN SP3ST SP4 SP4CV SP4EN SP4ST SPSS SS STPT ENPT ) (vl-load-com)
2.   (vl-load-com)
3.   (setq ss (ssget "_:E:S:L" '((0 . "ELLIPSE"))))
4.   (setq el (ssname ss 0))
5.   (command "_.ucs" "e" el)
6.   (setq ce (cdr (assoc 10 (entget el))))
7.   (setq dxf11 (cdr (assoc 11 (entget el))))
8.   (setq dxf40 (cdr (assoc 40 (entget el))))
9.   (setq ptst (mapcar '+ ce dxf11))
10.   (setq ptst (trans ptst 0 1))
11.   (setq ce (trans ce 0 1))
12.   (setq sp1st ptst)
13.   (setq sp1en (polar ce (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
14.   (setq sp1cv (polar sp1st (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
15.   (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp1st 1 0)) (cons 41 1.0) (cons 10 (trans sp1cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp1en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
16.   (setq sp2st sp1en)
17.   (setq sp2en (polar ce (angle ptst ce) (distance ptst ce)))
18.   (setq sp2cv (polar sp2en (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
19.   (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp2st 1 0)) (cons 41 1.0) (cons 10 (trans sp2cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp2en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
20.   (setq sp3st sp2en)
21.   (setq sp3en (polar ce (- (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
22.   (setq sp3cv (polar sp3st (- (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
23.   (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp3st 1 0)) (cons 41 1.0) (cons 10 (trans sp3cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp3en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
24.   (setq sp4st sp3en)
25.   (setq sp4en sp1st)
26.   (setq sp4cv (polar sp4en (- (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
27.   (setq sp4 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp4st 1 0)) (cons 41 1.0) (cons 10 (trans sp4cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp4en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
28.   (setq spss (ssadd))
29.   (setq stpt (vlax-curve-getstartpoint el))
30.   (setq enpt (vlax-curve-getendpoint el))
31.   (command "_.ucs" "w")
32.   (cond
33.     ((vlax-curve-getparamatpoint sp1 stpt)
34.      (ssadd sp1 spss)
35.      (ssadd sp2 spss)
36.      (ssadd sp3 spss)
37.      (ssadd sp4 spss)
38.      (vl-cmdf "_.splinedit" sp1 "j" spss "" "")
39.      (setq elspl (entlast))
40.     )
41.     ((vlax-curve-getparamatpoint sp2 stpt)
42.      (ssadd sp2 spss)
43.      (ssadd sp3 spss)
44.      (ssadd sp4 spss)
45.      (ssadd sp1 spss)
46.      (vl-cmdf "_.splinedit" sp2 "j" spss "" "")
47.      (setq elspl (entlast))
48.     )
49.     ((vlax-curve-getparamatpoint sp3 stpt)
50.      (ssadd sp3 spss)
51.      (ssadd sp4 spss)
52.      (ssadd sp1 spss)
53.      (ssadd sp2 spss)
54.      (vl-cmdf "_.splinedit" sp3 "j" spss "" "")
55.      (setq elspl (entlast))
56.     )
57.     ((vlax-curve-getparamatpoint sp4 stpt)
58.      (ssadd sp4 spss)
59.      (ssadd sp1 spss)
60.      (ssadd sp2 spss)
61.      (ssadd sp3 spss)
62.      (vl-cmdf "_.splinedit" sp4 "j" spss "" "")
63.      (setq elspl (entlast))
64.     )
65.   )
66.   (command "_.break" elspl stpt enpt)
67.   (entdel el)
68.   (command "_.ucs" "p")
69.   (command "_.ucs" "p")
70. (princ)
71. )
72.  

Still if there is a way, I would like to transform ellipses...

Here is my code for spline projection on UCS...

Code - Auto/Visual Lisp: [Select]

1. ;; Project Point onto Plane  -  Lee Mac
2. ;; Projects pt onto the plane defined by its origin and normal
3.  
4. (defun LM:ProjectPointToPlane ( pt org nm )
5.     (setq pt  (trans pt  0 nm)
6.           org (trans org 0 nm)
7.     )
8.     (trans (list (car pt) (cadr pt) (caddr org)) nm 0)
9. )
10.  
11. (defun c:splpucs nil (c:splineprojonucs))
12. (defun c:splineprojonucs ( / or nor ss spl splA coords coordsn fcoords fcoordsn ptx pty ptz pt ptu coordsnvar fcoordsnvar )
13.   (vl-load-com)
14.   (prompt "\nSelect SPLINE objects")
15.   (while (not ss)
16.     (setq ss (ssget "_:L" '((0 . "SPLINE"))))
17.   )
18.   (setq or (trans '(0.0 0.0 0.0) 1 0))
19.   (setq nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
20.   (repeat (setq n (sslength ss))
21.     (setq spl (ssname ss (setq n (1- n))))
22.     (setq splA (vlax-ename->vla-object spl))
23.     (setq coords (vlax-safearray->list (vlax-variant-value (vla-get-ControlPoints splA))))
24.     (if (/= (vla-get-NumberOfFitPoints splA) 0)
25.       (setq fcoords (vlax-safearray->list (vlax-variant-value (vla-get-FitPoints splA))))
26.     )
27.     (setq coordsn '())
28.     (repeat (/ (length coords) 3)
29.       (setq ptx (car coords))
30.       (setq pty (cadr coords))
31.       (setq ptz (caddr coords))
32.       (setq pt (list ptx pty ptz))
33.       (setq ptu (LM:ProjectPointToPlane pt or nor))
34.       (setq coords (cdddr coords))
35.       (setq coordsn (append coordsn ptu))
36.     )
37.     (setq coordsnvar (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (- (length coordsn) 1))) coordsn)))
38.     (vla-put-ControlPoints splA coordsnvar)
39.     (if (/= (vla-get-NumberOfFitPoints splA) 0)
40.       (progn
41.         (setq fcoordsn '())
42.         (repeat (/ (length fcoords) 3)
43.           (setq ptx (car fcoords))
44.           (setq pty (cadr fcoords))
45.           (setq ptz (caddr fcoords))
46.           (setq pt (list ptx pty ptz))
47.           (setq ptu (LM:ProjectPointToPlane pt or nor))
48.           (setq fcoords (cdddr fcoords))
49.           (setq fcoordsn (append fcoordsn ptu))
50.         )
51.         (setq fcoordsnvar (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (- (length fcoordsn) 1))) fcoordsn)))
52.         (vla-put-FitPoints splA fcoordsnvar)
53.       )
54.     )
55.   )    
56. (princ)
57. )
58. (princ "\nShortcut for c:splineprojonucs is c:splpucs")
59. (princ)
60.  

Hope this will now help to someone...

[ribarm]

This is what I discovered :

When used SPLPUCS on spline obtained from ellipse, you should convert 2nd degree spline to 3rd degree, and change knot parametrisation to uniform... Only then spline will be processed to be projected on some relative UCS correctly...

If someone knows any better way, please reply...

[Stefan]

Marko
I tested your lisp just after writing my own.
I noticed that my program works different than yours, but I will post it anyway.

Code - Auto/Visual Lisp: [Select]

1. ;project a curve on current XY plan
2. ;Stefan M. 20.10.2012
3.  
4. (defun c:test (/ *error* acDoc ss i e en q1 q2 a pc f pe ps w)
5.  
6.   (vla-StartUndoMark (setq acDoc (vla-get-activeDocument (vlax-get-acad-object))))
7.  
8.   (defun *error* (msg)
9.     (if
10.       (and msg (not (eq msg "Function cancelled")))
11.       (princ (strcat "\nError: " msg))
12.       )
13.     (vla-EndUndoMark acDoc)
14.     )
15.  
16.   (if
17.     (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,SPLINE"))))
18.     (repeat (setq i (sslength ss))
19.       (setq e (ssname ss (setq i (1- i))))
20.       (if (eq (cdr (assoc 0 (setq en (entget e)))) "SPLINE")
21.         (project_on_XY (entmakex (vl-remove-if '(lambda (x) (member (car x) '(-1 5 330 67 410 8 210 62 11))) en)))
22.         (progn
23.           (setq q1 (vlax-curve-GetStartParam e)
24.                 q2 (vlax-curve-GetEndParam e)
25.                 a  (/ (- (vlax-curve-GetEndParam e) (vlax-curve-GetStartParam e)) 3.0) ; a - parameter interval... and angle - :)
26.                 pc  (mapcar                              ; pc - points on contur
27.                      (function
28.                        (lambda (p)
29.                         (vlax-curve-GetPointAtParam e p)
30.                          )
31.                        )
32.                      (list q1 (+ q1 a) (- q2 a) q2)
33.                      )
34.                 f  (mapcar                               ; f - first deriv on pc
35.                      (function
36.                        (lambda (p)
37.                          (vlax-curve-GetFirstDeriv e p)
38.                          )
39.                        )
40.                      (list q1 (+ q1 a) (- q2 a) q2)
41.                      )
42.                 pe  (mapcar                              ; pe - extra control points for spline construction
43.                       (function
44.                         (lambda (p1 p2 d1 d2)
45.                           (inters p1 (mapcar '+ p1 d1)
46.                                   p2 (mapcar '+ p2 d2)
47.                                   nil
48.                                   )
49.                           )
50.                         )
51.                       pc (cdr pc) f (cdr f)
52.                       )
53.                 ps  (list (car pc) (car pe) (cadr pc) (cadr pe) (caddr pc) (caddr pe) (cadddr pc)) ; ps - control points for spline
54.                 w   (list 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0)  ; weights for spline
55.                 )
56.           (project_on_XY (make_spline (points ps w)))
57.           )
58.         )
59.       )
60.     )
61.   (*error* nil)
62.   (princ)
63.   )
64.          
65. (defun make_spline (pts)
66.   (entmakex
67.         (append
68.           '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")
69.              (70 . 4) (71 . 2) (72 . 10) (73 . 7) (74 . 0)
70.              (42 . 1.0e-010) (43 . 1.0e-010)
71.              (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0)
72.              (40 . 2.0) (40 . 2.0) (40 . 3.0) (40 . 3.0) (40 . 3.0))
73.           pts
74.           )
75.         )
76.   )
77.          
78. (defun points (p w)
79.   (apply 'append (mapcar '(lambda (a b) (list (cons 10 a) (cons 41 b))) p w))
80. )
81. ; project on current XY plane
82. ; Simply replace z coordinates - 0.0
83. (defun project_on_XY (en)
84.   (entmod
85.     (mapcar
86.       (function
87.         (lambda (x / p)
88.           (if (member (car x) '(10 11))
89.             (progn
90.               (setq p (trans (cdr x) 0 1))
91.               (cons (car x) (trans (list (car p) (cadr p) 0) 1 0))
92.               )
93.             x
94.             )
95.           )
96.         )
97.       (entget en)
98.       )
99.     )
100.   )

EDIT: fixed for pre 2012 acad

[ribarm]

I've tested it and it works perfectly... Stefan, thank you very much, your code is even better than I posted (projected ellipse is 2nd degree spline object)... Thank you so much...

M.R.

[Stefan]

You're welcome Marko. I'm glad you like it.

[Stefan]

First version works on Acad2012. For some reasons, in older releases, the splines created for arcs are closed, even if dxf code for closed splines is not set.
Another bug is projection of a usual spline. It just not follow the shape of original one.
I fixed these bugs. Code updated in previous post.

[ribarm]

Hi Stefan, thanks once again... I've checked for arcs in A2009 and it works, as with 3rd degree planar splines... However, if someone have some problems, I've found in my library this one for converting circles and arcs to ellipses and elliptical arcs...

Code - Auto/Visual Lisp: [Select]

1. (defun c:ciarc2ell ( / ss n ent entl zd dxf10 rad dxf11 dxf41 dxf42 )
2.   (command "_.ucs" "w")
3.   (prompt "\nSelect arc and circle objects")
4.   (while (not ss)
5.     (setq ss (ssget "_:L" '((0 . "CIRCLE,ARC"))))
6.   )
7.   (repeat (setq n (sslength ss))
8.     (setq ent (ssname ss (setq n (1- n))))
9.     (setq entl (entget ent))
10.     (setq zd (cdr (assoc 210 entl)))
11.     (command "_.ucs" "za" "" zd)
12.     (if (eq (cdr (assoc 0 entl)) "CIRCLE")
13.       (progn
14.         (setq dxf10 (cons 10 (trans (cdr (assoc 10 entl)) 1 0)))
15.         (setq rad (cdr (assoc 40 entl)))
16.         (setq dxf11 (cons 11 (trans (list rad 0.0 0.0) 1 0)))
17.         (entmake (list
18.                    '(0 . "ELLIPSE")
19.                    '(100 . "AcDbEntity")
20.                    '(100 . "AcDbEllipse")
21.                    dxf10
22.                    dxf11
23.                    (cons 210 zd)
24.                    '(40 . 1.0)
25.                    '(41 . 0.0)
26.                    (cons 42 (* 2.0 pi))
27.                  )
28.         )
29.         (entdel ent)
30.       )
31.       (progn
32.         (setq dxf10 (cons 10 (trans (cdr (assoc 10 entl)) 1 0)))
33.         (setq rad (cdr (assoc 40 entl)))
34.         (setq dxf11 (cons 11 (trans (list rad 0.0 0.0) 1 0)))
35.         (setq dxf41 (cons 41 (cdr (assoc 50 entl))))
36.         (setq dxf42 (cons 42 (cdr (assoc 51 entl))))
37.         (entmake (list
38.                    '(0 . "ELLIPSE")
39.                    '(100 . "AcDbEntity")
40.                    '(100 . "AcDbEllipse")
41.                    dxf10
42.                    dxf11
43.                    (cons 210 zd)
44.                    '(40 . 1.0)
45.                    dxf41
46.                    dxf42
47.                  )
48.         )
49.         (entdel ent)
50.       )
51.     )
52.     (command "_.ucs" "p")
53.   )
54.   (princ)
55. )
56.  

Regards, and thanks, M.R.

[ribarm]

I've pulled out this topic to find out that when ellipse is to be projected on some relative UCS, projected curve is not another ellipse, but curve close to ellipse... You can check this out with this code :

Code - Auto/Visual Lisp: [Select]

1. ;; Project Point onto Plane  -  Lee Mac
2. ;; Projects pt onto the plane defined by its origin and normal
3.  
4. (defun LM:ProjectPointToPlane ( pt org nm )
5.    (setq pt  (trans pt  0 nm)
6.          org (trans org 0 nm)
7.    )
8.    (trans (list (car pt) (cadr pt) (caddr org)) nm 0)
9. )
10.  
11. (defun unit ( v )
12.   (mapcar '(lambda (x) (/ x (distance '(0.0 0.0 0.0) v))) v)
13. )
14.  
15. (defun v^v ( u v )
16.   (list
17.     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
18.     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
19.     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
20.   )
21. )
22.  
23. (defun c:ellpucs nil (c:ellprojonucs))
24. (defun c:ellprojonucs ( / A AP APT APTP B BA-RATIO BA-RATIOP BP BPT BPTP CE CEP ELL N NOR ORG SS ZD ZDP )
25.   (prompt "\nSelect ellipse objects")
26.   (while (not ss)
27.     (setq ss (ssget "_:L" '((0 . "ELLIPSE"))))
28.   )
29.   (setq org (trans '(0.0 0.0 0.0) 1 0))
30.   (setq nor (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))
31.   (repeat (setq n (sslength ss))
32.     (setq ell (ssname ss (setq n (1- n))))
33.     (setq ce (cdr (assoc 10 (entget ell))))
34.     (setq zd (cdr (assoc 210 (entget ell))))
35.     (setq ba-ratio (cdr (assoc 40 (entget ell))))
36.     (setq apt (mapcar '+ ce (cdr (assoc 11 (entget ell)))))
37.     (setq a (distance ce apt))
38.     (setq b (* ba-ratio a))
39.     (setq bpt (mapcar '+ ce (mapcar '* (list b b b) (unit (v^v zd (unit (cdr (assoc 11 (entget ell)))))))))
40.    
41.     (setq cep (LM:ProjectPointToPlane ce org nor))
42.     (setq aptp (LM:ProjectPointToPlane apt org nor))
43.     (setq bptp (LM:ProjectPointToPlane bpt org nor))
44.     (setq zdp nor)
45.     (setq ap (distance cep aptp))
46.     (setq bp (distance cep bptp))
47.     (setq ba-ratiop (/ bp ap))
48.     (if (>= ba-ratiop 1.0) (setq ba-ratiop (/ 1.0 ba-ratiop) aptp bptp))
49.    
50.     (entmake
51.       (list
52.         '(0 . "ELLIPSE")
53.         '(100 . "AcDbEntity")
54.         '(100 . "AcDbEllipse")
55.         (cons 10 cep)
56.         (cons 11 (mapcar '- aptp cep))
57.         (cons 210 zdp)
58.         (cons 40 ba-ratiop)
59.         (assoc 41 (entget ell))
60.         (assoc 42 (entget ell))
61.       )
62.     )
63.    
64.   )
65. (princ)
66. )
67. (princ "\nShortcut for c:ellprojonucs is c:ellpucs")
68. (princ)
69.  

M.R.

[ribarm]

Still I was wrong... When ellipse in 3d space is to be projected on some relative UCS, projection is again ellipse (2nd degree curve)... You can forget ab my previous code and position some UCS, then make block from ellipse with base point - UCS origin (0.0 0.0 0.0), and then change Z scale property from property palette (ctrl+1) to be 0.0 - this isn't totally allowed, but you can set it to 1e-99... After that you just explode block and result is projected ellipse object - so ellipse transforms to ellipse...

Code - Auto/Visual Lisp: [Select]

1. (defun c:ellpucs nil (c:ellprojonucs))
2. (defun c:ellprojonucs ( / ELL ELLBLA ELLBLANAME N SS )
3.   (vl-load-com)
4.   (prompt "\nSelect ellipse objects")
5.   (while (not ss)
6.     (setq ss (ssget "_:L" '((0 . "ELLIPSE"))))
7.   )
8.   (repeat (setq n (sslength ss))
9.     (setq ell (ssname ss (setq n (1- n))))
10.     (command "_.copybase" "0,0,0" ell "")
11.     (command "_.pasteblock" "0,0,0")
12.     (setq ellblA (vlax-ename->vla-object (entlast)))
13.     (setq ellblAname (vla-get-effectivename ellblA))
14.     (vla-put-Zeffectivescalefactor ellblA 1e-99)
15.     (vla-explode ellblA)
16.     (vla-delete ellblA)
17.     (command "_.-purge" "b" ellblAname "n")
18.   )
19. (princ)
20. )
21. (princ "\nShortcut for c:ellprojonucs is c:ellpucs")
22. (princ)
23.  

Regards, M.R.

[highflyingbird]

A little complicated!Here is my code,you will check it.
main code:

Code - Auto/Visual Lisp: [Select]

1. ;;;=====================================================
2. ;;;highflybird  2012.11.1                              
3. ;;;Function: Given an ellipse (or ellipse arc),        
4. ;;;          Draw the projection ellipse to UCS.        
5. ;;;Argument: ellipse entity                            
6. ;;;Return: the projection ellipse                      
7. ;;;=====================================================
8. (defun Mat:Ellipse-Projection-on-UCS (ellipse /
9.                                       dxf OrgCen major ratio an1 an2 normal Org-A Org-B minor OrgPtA OrgPtB OrgPtC ANG ORGMAT
10.                                       OrgPt1 OrgPt2 PrjPt1 PrjPt2 PrjPtA PrjPtB PrjPtC PrjCen ret Prj-A Prj-B ent obj)
11.   (setq dxf    (entget ellipse))
12.   (setq OrgCen (cdr (assoc 10 dxf)))
13.   (setq major  (cdr (assoc 11 dxf)))
14.   (setq ratio  (cdr (assoc 40 dxf)))
15.   (setq Normal (cdr (assoc 210 dxf)))
16.  
17.   (setq Org-A  (distance major '(0 0 0)))               ;original the length of major axis
18.   (setq Org-B  (* Org-A ratio))                         ;original the length of minor axis
19.   (setq minor  (mat:v^v Normal (Mat:unit major)))
20.   (setq minor  (mat:vxs minor Org-B))
21.   (setq OrgPtA (mapcar '+ OrgCen major))
22.   (setq OrgPtB (mapcar '+ OrgCen minor))
23.   (setq OrgMat (Mat:Get3PMatrix OrgCen OrgPtA OrgPtB))  ;the transformation matrix of this 3d ellipse
24.   (setq OrgPtC (list (* Org-A 0.6) (* Org-B 0.8) 0))    ;3^2+4^2=5^2  :-)
25.   (setq OrgPtC (MAT:mxp (cadr OrgMat) OrgPtC))          ;transformate this point to WCS
26.   (setq OrgPt1 (vlax-curve-getStartPoint ellipse))      ;here can be calculated by the StartAngle
27.   (setq OrgPt2 (vlax-curve-getEndPoint ellipse))        ;here can be calculatedby the EndAngle
28.  
29.   (mapcar
30.     (function
31.       (lambda (x y / p)
32.         (setq p (trans y 0 1))
33.         (set x (list (car p) (cadr p) 0))
34.       )
35.     )
36.     (quote (PrjPt1 PrjPt2 PrjCen PrjPtA PrjPtB PrjPtC))
37.     (list OrgPt1 OrgPt2 OrgCen OrgPtA OrgPtB OrgPtC)
38.   )
39.  
40.   (setq ret (Mat:C3P-Ellipse PrjCen PrjPtA PrjPtB PrjPtC))
41.   (setq Prj-A (cadr ret))                               ;projection major axis
42.   (setq Prj-B (caddr ret))                              ;projection minor axis
43.   (setq ang (cadddr ret))                               ;projection rotation angle
44.   (setq an1 (Mat:GetEllipseAngle PrjPt1 PrjCen Prj-A Prj-B ang))        ;StartAngle
45.   (setq an2 (Mat:GetEllipseAngle PrjPt2 PrjCen Prj-A Prj-B ang))        ;EndAngle
46.   (setq ent (Make-Ellipse PrjCen Prj-A Prj-B ang an1 an2))
47.   (setq obj (vlax-ename->vla-object ent))
48.   (vla-TransformBy obj (vlax-tmatrix (Mat:W2U)))        ;transformate it to UCS
49.   ent
50. )

.
See the full version in attachment.
Thanks for any advice.

[highflyingbird]

Notice that: my program is to make an ellipse entity,not a spline.
reference here:
http://www.theswamp.org/index.php?topic=42073.0
http://www.theswamp.org/index.php?topic=42767.0

[highflyingbird]

I simplified my code.

Code - Auto/Visual Lisp: [Select]

1. (defun Mat:Ellipse-Projection-on-UCS (ellipse / dxf Cen0 an1 an2 ANG PtA0 PtB0 PtC0 PtS0 PtE0
2.                                                 PtS1 PtE1 PtA1 PtB1 PtC1 Cen1 ret A1 B1 ent obj)
3.   (setq dxf  (entget ellipse))
4.   (setq Cen0 (cdr (assoc 10 dxf)))
5.   (setq PtA0 (vlax-curve-getPointAtParam ellipse 0))    ;Original major axis
6.   (setq PtB0 (vlax-curve-getPointAtParam ellipse (/ pi 2)))     ;Original minor axis
7.   (setq PtC0 (vlax-curve-getPointAtParam ellipse 1))
8.  
9.   (setq PtS0 (vlax-curve-getStartPoint ellipse))        ;here can be calculated by the StartAngle
10.   (setq PtE0 (vlax-curve-getEndPoint ellipse))          ;here can be calculatedby the EndAngle
11.  
12.   (mapcar
13.     (function
14.       (lambda (x y / p)
15.         (setq p (trans y 0 1))
16.         (set x (list (car p) (cadr p) 0))
17.       )
18.     )
19.     (quote (PtS1 PtE1 Cen1 PtA1 PtB1 PtC1))
20.     (list PtS0 PtE0 Cen0 PtA0 PtB0 PtC0)                ;project these points to UCS
21.   )
22.   (setq ret (Mat:C3P-Ellipse Cen1 PtA1 PtB1 PtC1))
23.   (setq A1  (cadr ret))                                 ;major axis of projection
24.   (setq B1  (caddr ret))                                ;minor axis of projection
25.   (setq ang (cadddr ret))                               ;rotation angle of projection
26.   (setq an1 (Mat:GetEllipseAngle PtS1 Cen1 A1 B1 ang))  ;StartAngle
27.   (setq an2 (Mat:GetEllipseAngle PtE1 Cen1 A1 B1 ang))  ;EndAngle
28.   (setq ent (Make-Ellipse Cen1 A1 B1 ang an1 an2))      
29.   (setq obj (vlax-ename->vla-object ent))
30.   (vla-TransformBy obj (vlax-tmatrix (Mat:W2U)))        ;transformate it to UCS
31.   ent
32. )

I used vlax-curve-... to replace the matrix algorithm.

[highflyingbird]

Post a dwg for test: