Topic: conic sections in plan view

[ribarm]

When angle of section plane reaches half of main angle of cone (parallel referenced plane that goes through cone apex reaches contour edge of cone) - ellipse should be broken into parabolic spline, section ellipse goes out of visible screen, why?
Can I make parabolic section visible, or further more hyperbolic, after special case of ellipse brake?... For now I haven't included splines in cosideration :

EDIT : (modified code) I've found where was my mistake and I corrected it, but now I am having trouble creating spline with entmakex. Any help will be wonderful...

EDIT : (final modification of code) I gave up from entmakexing spline. Just created spline with standard "_.SPLINE" command. I hope you'll be satisfied with final result...

Code: [Select]

(defun tan (x)
  (/ (sin x) (cos x))
)

(defun nor ( v )
  (polar '(0 0 0) (+ (angle '(0 0 0) v) (/ PI 2)) 1.0)
)

(defun cixli ( c r a b / ab cp pp p d h p1 p2 ptl )
  (setq ab (mapcar '- b a))
  (setq cp (nor ab))
  (setq pp (mapcar '+ c cp))
  (setq p (inters a b c pp nil))
  (setq d (distance c p))
  (setq h (sqrt (max 0 (- (* r r) (* d d)))))
  (setq p1 (polar p (angle a b) h))
  (setq p2 (polar p (angle b a) h))
  (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
  ptl
)

(defun sectionel ( ce h r a / o or1 or2 oa pta1 pta2 ptce ptcev ptcep pta1v pta1p ael ptceor ptceorv ptcixli ptb bel ceel )
  (setq o (polar ce (- (/ PI 2)) h))
  (setq or1 (polar o 0.0 r))
  (setq or2 (polar o PI r))
  (setq oa (polar o (* (/ PI 180) a) 1.0))
  (setq pta1 (inters ce or1 o oa nil))
  (setq pta2 (inters ce or2 o oa nil))
  (setq ptce (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pta1 pta2) (list 2.0 2.0 2.0)))
  (setq ptcev (polar ptce (/ PI 2) 1.0))
  (setq ptcep (inters o or1 ptce ptcev nil))
  (setq pta1v (polar pta1 (- (/ PI 2)) 1.0))
  (setq pta1p (inters o or1 pta1 pta1v nil))
  (setq ael (distance ptcep pta1p))
  (setq ptceor (inters ce ptce o or1 nil))
  (setq ptceorv (polar ptceor (- (/ PI 2)) 1.0))
  (setq ptcixli (car (cixli o r ptceor ptceorv)))
  (setq ptb (inters o ptcixli ptce ptcev nil))
  (setq bel (distance ptb ptcep))
  (setq ceel (polar ptcep (/ PI 2) h))
  (setq ceel (polar ce (+ aa PI) (distance ce ceel)))
  (list ceel ael bel)
)

(defun sectionspl ( ce h r a / o or1 oa pta1 ptce ptcev ptcep pta1v pta1p asp ptceor ptceorv ptcixli ptb bsp cesp )
  (setq o (polar ce (- (/ PI 2)) h))
  (setq or1 (polar o 0.0 r))
  (setq oa (polar o (* (/ PI 180) a) 1.0))
  (setq pta1 (inters ce or1 o oa nil))
  (setq ptce o)
  (setq ptcev (polar ptce (- (/ PI 2)) 1.0))
  (setq ptcep o)
  (setq pta1v (polar pta1 (- (/ PI 2)) 1.0))
  (setq pta1p (inters o or1 pta1 pta1v nil))
  (setq asp (distance ptcep pta1p))
  (setq ptceor o)
  (setq ptceorv (polar ptceor (- (/ PI 2)) 1.0))
  (setq ptcixli (car (cixli o r ptceor ptceorv)))
  (setq ptb ptcixli)
  (setq bsp (distance ptb ptcep))
  (setq cesp (polar ptcep (/ PI 2) h))
  (setq cesp (polar ce (+ aa PI) (distance ce cesp)))
  (list cesp asp bsp)
)

(defun c:conics ( / A AA ANG ANGR ANGX CE CMDE CI CIA G H LOOP R )
  (setq loop T)
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (initget 6)
  (setq ang (getreal "\nInput central angle of main edges of cone in decimal degrees : "))
  (setq angx (/ (- 180.0 ang) 2))
  (setq angr (* (/ PI 180) ang))
  (setq ce (getpoint "\nPick center of cone"))
  (setq a 0.0)
  (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 ce) (cons 40 0.0)) ))
  (while loop
    (setq g (grread T))
    (if (= (car g) 5)
      (progn
      (if (equal ce (cadr g) 1e-8) (setq r 1e-4) (setq r (distance ce (cadr g))))
      (if (eq (cdr (assoc 0 (entget ci))) "CIRCLE") (entmod (subst (cons 40 r) (assoc 40 (entget ci)) (entget ci))) )
      (setq h (/ r (tan (/ angr 2))))
      (setq aa (angle ce (cadr g)))
      (prompt "\n<+> incease angle of slice plane by 0.1 degree; <-> decrease angle of slice plane by 0.1 degree; <Space> reset angle of slice plane")
      (prompt "\nDepth of slice plane is : ")(princ h)(prompt "; Angle of slice plane is : ")(princ a)
      )
    )
    (if (= (car g) 2)
      (progn
      (if (= (cadr g) 32) (setq a 0.0) )
      (if (= (cadr g) 43) (setq a (+ a 0.1)) )
      (if (= (cadr g) 45) (setq a (- a 0.1)) )
      (prompt "\n<+> incease angle of slice plane by 0.1 degree; <-> decrease angle of slice plane by 0.1 degree; <Space> reset angle of slice plane")
      (prompt "\nDepth of slice plane is : ")(princ h)(prompt "; Angle of slice plane is : ")(princ a)
      (if (= a 0.0) (progn (entdel ci) (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 ce) (cons 40 r)) )) ))
      (if (< 0.0 a angx) (progn (entdel ci) (setq ci (entmakex (list (cons 0 "ELLIPSE") (cons 100 "AcDbEntity") (cons 100 "AcDbEllipse") (cons 10 (car (sectionel ce h r a))) (cons 11 (polar '(0.0 0.0 0.0) aa (cadr (sectionel ce h r a)))) (cons 40 (/ (caddr (sectionel ce h r a)) (cadr (sectionel ce h r a))) ) (cons 41 0.0) (cons 42 (* 2 PI)) (cons 210 (list 0 0 1)) ))) ))
      (if (>= a angx) (progn (entdel ci) (vl-cmdf "_.SPLINE" (polar (car (sectionspl ce h r a)) (+ aa (/ PI 2)) (caddr (sectionspl ce h r a))) (polar (car (sectionspl ce h r a)) aa (cadr (sectionspl ce h r a))) (polar (car (sectionspl ce h r a)) (- aa (/ PI 2)) (caddr (sectionspl ce h r a))) "" "" "") (setq ci (entlast)) ))
      )
    )
    (if (= (car g) 3) (setq loop nil))
  )
  (setvar 'cmdecho cmde)
(princ)
)

Best regards, M.R.

[Stefan]

Hi Marko
You may find some sample here http://www.theswamp.org/index.php?topic=39567.msg452337#msg452337.
To draw a 2nd degree curve as a spline:
- use CV method
- set degree to 2
- change points weight to fit your needs
Using entmake:

Code: [Select]

(0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0)
(70 . 12) ;4 - rational; 8 - planar
(71 . 2) ;degree
(72 . 6) ;number of knots
(73 . 3) ;Number of control points
(74 . 0) ;Number of fit points - always 0 for parabola and hyperbola
(42 . 1.0e-010) (43 . 1.0e-010) ;Control-point tolerance
(40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0) ;Knot value.
(10 x1 y1 0.0) ;vertex
(41 . w1) ;Weight of vertex  (w1=1.0 for parabola and hyperbola)
(10 x2 y2 0.0) ;vertex
(41 . w2) ;Weight of vertex  (w2=1.0 for parabola)
(10 x3 y3 0.0) ;vertex
(41 . w3) ;Weight of vertex  (w3=1.0 for parabola and hyperbola)
See attachment for some sample and explanations.

[ribarm]

Thanks Stefan for your reply, but I don't quite know how to modify now my code :
(if (= a angx) => parabola
(if (> a angx) => hyperbola
These 2 degree curves I've made with 3 known points 2 end points and 1 apex point... If you can modify my code to entmakex exactly parabola and hyperbola, then the code would be perfect... For now I am satisfied with this "_.SPLINE" command...

Thanks anyway, M.R.

[Stefan]

Hi Marko
I'm at work right now.
Soon as I can, I'll try to do the math...
Cheers

[ribarm]

It seems when having more fit points, instead of spline more precisely represent hyperbola and parabola, it always draws curve 3 rd degree instead of 2 nd degree (parabola, hyperbola). This is probably because I don't know how to entmakex spline only with control points, instead of fit points... I used your explanation of DXF codes for entmakex SPLINE objects, but in the end I had to change from (10 x1 y1 0.0) to (11 x1 y1 0.0) and so on... It wouldn't make anything without this intervention, beside this (71 . 2) is after entmakex always (71 . 3)... So here is my extended version of code, and if you know how can this be corrected, please help... :

Code: [Select]

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
  (list
    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
    (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
    (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  )
)

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
  ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
  (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
  (sqrt (apply '+ (mapcar '* v v)))
)

(defun transptucs ( pt pt1 pt2 pt3 / u v n uu vv ptt pt1u ptx pty ptz )
  (setq u (mapcar '- pt2 pt1))
  (setq v (mapcar '- pt3 pt1))
  (setq n (unit (v^v u v)))
  (setq uu (unit u))
  (setq vv (unit v))
  (setq ptt (trans pt 0 n))
  (setq pt1u (trans pt1 0 n))
  (setq ptz (caddr (mapcar '- ptt pt1u)))
  (setq ptt (trans pt 0 uu))
  (setq pt1u (trans pt1 0 uu))
  (setq ptx (caddr (mapcar '- ptt pt1u)))
  (setq ptt (trans pt 0 vv))
  (setq pt1u (trans pt1 0 vv))
  (setq pty (caddr (mapcar '- ptt pt1u)))
  (list ptx pty ptz)
)

(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 tan ( x )
  (/ (sin x) (cos x))
)

(defun nor ( v )
  (polar '(0 0 0) (+ (angle '(0 0 0) v) (/ PI 2)) 1.0)
)

(defun cixli ( c r a b / ab cp pp p d h p1 p2 ptl )
  (setq ab (mapcar '- b a))
  (setq cp (nor ab))
  (setq pp (mapcar '+ c cp))
  (setq p (inters a b c pp nil))
  (setq d (distance c p))
  (setq h (sqrt (max 0 (- (* r r) (* d d)))))
  (setq p1 (polar p (angle a b) h))
  (setq p2 (polar p (angle b a) h))
  (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
  ptl
)

(defun sectionel ( ce h r a / o or1 or2 oa pta1 pta2 ptce ptcev ptcep pta1v pta1p ael ptceor ptceorv ptcixli ptb bel ceel )
  (setq o (polar ce (- (/ PI 2)) h))
  (setq or1 (polar o 0.0 r))
  (setq or2 (polar o PI r))
  (setq oa (polar o (* (/ PI 180) a) 1.0))
  (setq pta1 (inters ce or1 o oa nil))
  (setq pta2 (inters ce or2 o oa nil))
  (setq ptce (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pta1 pta2) (list 2.0 2.0 2.0)))
  (setq ptcev (polar ptce (/ PI 2) 1.0))
  (setq ptcep (inters o or1 ptce ptcev nil))
  (setq pta1v (polar pta1 (- (/ PI 2)) 1.0))
  (setq pta1p (inters o or1 pta1 pta1v nil))
  (setq ael (distance ptcep pta1p))
  (setq ptceor (inters ce ptce o or1 nil))
  (setq ptceorv (polar ptceor (- (/ PI 2)) 1.0))
  (setq ptcixli (car (cixli o r ptceor ptceorv)))
  (setq ptb (inters o ptcixli ptce ptcev nil))
  (setq bel (distance ptb ptcep))
  (setq ceel (polar ptcep (/ PI 2) h))
  (setq ceel (polar ce (+ aa PI) (distance ce ceel)))
  (list ceel ael bel)
)

(defun sectionspl ( ce h r a angx / o oo oov oop ooo oood or1 or2 oa pta1 pta2 ptce ptcev ptcep pta1v pta1p asp ptceor ptceorv ptcixli ptb bsp cesp )
  (setq o (polar ce (- (/ PI 2)) h))
  (setq or1 (polar o 0.0 r))
  (setq or2 (polar o PI r))
  (setq oa (polar o (* (/ PI 180) a) 1.0))
  (setq pta1 (inters ce or1 o oa nil))
  (if (> (- a angx) 1e-8) (setq pta2 (inters ce or2 o oa nil)) )
  (if pta2 (setq oo (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pta1 pta2) (list 2.0 2.0 2.0))) )
  (if oo (setq oov (polar oo (- (/ PI 2)) 1.0)) )
  (if (and oo oov) (setq oop (inters o or1 oo oov nil)) )
  (if oop (setq ooo (polar oop (/ PI 2) h)) )
  (setq ptce o)
  (setq ptcev (polar ptce (- (/ PI 2)) 1.0))
  (setq ptcep o)
  (setq pta1v (polar pta1 (- (/ PI 2)) 1.0))
  (setq pta1p (inters o or1 pta1 pta1v nil))
  (setq asp (distance ptcep pta1p))
  (setq ptceor o)
  (setq ptceorv (polar ptceor (- (/ PI 2)) 1.0))
  (setq ptcixli (car (cixli o r ptceor ptceorv)))
  (setq ptb ptcixli)
  (setq bsp (distance ptb ptcep))
  (setq cesp (polar ptcep (/ PI 2) h))
  (setq cesp (polar ce (+ aa PI) (distance ce cesp)))
  (if ooo (setq oood (distance cesp ooo)) )
  (if ooo (list cesp asp bsp oood) (list cesp asp bsp) )
)

(defun hypermake ( pt1 ptt pt2 o / pt1t pt2t pttt ot kk kka kkah cixli1 cixli2 kkp kkk bbc pt11x pt11y pt11t pt22t pt111x pt111y pt111t pt222t aa bb )
  (setq aa (distance ptt o))
  (setq pt1t (transptucs pt1 o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt2t (transptucs pt2 o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pttt (transptucs ptt o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq ot (transptucs o o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq kk (inters pt1t (polar pt1t (angle pttt ot) 1.0) ot (polar ot (angle pt2t pt1t) 1.0) nil))
  (setq kka (polar kk (angle pt2t pt1t) aa))
  (setq kkah (polar kka (+ (angle pt2t pt1t) (/ PI 2)) 1.0))
  (setq cixli1 (car (cixli kk (distance kk pt1t) kka kkah)))
  (setq cixli2 (cadr (cixli kk (distance kk pt1t) kka kkah)))
  (if (< (distance cixli1 pt1t) (distance cixli2 pt1t)) (setq kkp cixli1) (setq kkp cixli2) )
  (setq kkk (polar kkp (angle pt1t pt2t) aa))
  (setq bbc (inters ot kkk pttt (polar pttt (angle pt1t pt2t) 1.0) nil))
;  (setq bb (abs (sqrt (/ (expt (* (cadr pt1t) aa) 2) (- (expt (car pt1t) 2) (* aa aa))))))
  (setq bb (distance pttt bbc))
  (setq pt11x (* (car pt1t) 2))
  (setq pt11y (+ (sqrt (* (* bb bb) (/ (- (expt pt11x 2) (* aa aa)) (* aa aa))))))
  (setq pt22y (- (sqrt (* (* bb bb) (/ (- (expt pt11x 2) (* aa aa)) (* aa aa))))))
  (setq pt11t (list pt11x pt11y 0.0))
  (setq pt22t (list pt11x pt22y 0.0))
  (setq pt111x (* (car pt1t) 4))
  (setq pt111y (+ (sqrt (* (* bb bb) (/ (- (expt pt111x 2) (* aa aa)) (* aa aa))))))
  (setq pt222y (- (sqrt (* (* bb bb) (/ (- (expt pt111x 2) (* aa aa)) (* aa aa))))))
  (setq pt111t (list pt111x pt111y 0.0))
  (setq pt222t (list pt111x pt222y 0.0))
  (setq pt11 (transptwcs pt11t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt22 (transptwcs pt22t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt111 (transptwcs pt111t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt222 (transptwcs pt222t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 7) (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 11 pt111) (cons 41 1.0) (cons 11 pt11) (cons 41 1.0) (cons 11 pt1) (cons 41 1.0) (cons 11 ptt) (cons 41 1.0) (cons 11 pt2) (cons 41 1.0) (cons 11 pt22) (cons 41 1.0) (cons 11 pt222) (cons 41 1.0)) ))
)

(defun parabmake ( pt1 ptt pt2 / pt11 pt22 pt111 pt222)
(defun ptpar (pt1 ptt pt2 / pt12m dpt12m t12 t1122 p11 p22 pp12 pt11 pt22 )
  (setq pt12m (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pt1 pt2) (list 2.0 2.0 2.0)))
  (setq dpt12m (distance pt12m ptt))
  (setq t12 (polar ptt (- (angle pt2 pt1) (/ PI 2)) dpt12m))
  (setq t1122 (polar ptt (- (angle pt2 pt1) (/ PI 2)) (* dpt12m 4)))
  (setq p11 (polar t12 (angle t12 pt1) (* 1.5 (distance t12 pt1))))
  (setq p22 (polar t12 (angle t12 pt2) (* 1.5 (distance t12 pt2))))
  (setq pp12 (polar ptt (+ (angle pt2 pt1) (/ PI 2)) (* dpt12m 4)))
  (setq pt11 (inters pp12 (polar pp12 (angle pt2 pt1) 1.0) t1122 p11 nil))
  (setq pt22 (inters pp12 (polar pp12 (angle pt1 pt2) 1.0) t1122 p22 nil))
  (list pt11 pt22)
)
  (setq pt11 (car (ptpar pt1 ptt pt2)))
  (setq pt22 (cadr (ptpar pt1 ptt pt2)))
  (setq pt111 (car (ptpar pt11 ptt pt22)))
  (setq pt222 (cadr (ptpar pt11 ptt pt22)))
  (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (70 . 12) (71 . 2) (72 . 6) (73 . 7) (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 11 pt111) (cons 41 1.0) (cons 11 pt11) (cons 41 1.0) (cons 11 pt1) (cons 41 1.0) (cons 11 ptt) (cons 41 1.0) (cons 11 pt2) (cons 41 1.0) (cons 11 pt22) (cons 41 1.0) (cons 11 pt222) (cons 41 1.0)) ))
)

(defun c:conics ( / A AA ANG ANGR ANGX CE CMDE CI CIA G H LOOP OSM R )
  (setq loop T)
  (setq osm (getvar 'osmode))
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (initget 6)
  (setq ang (getreal "\nInput central angle of main edges of cone in decimal degrees : "))
  (setq angx (/ (- 180 ang) 2))
  (setq angr (* (/ PI 180) ang))
  (setq ce (getpoint "\nPick center of cone"))
  (setq a 0.0)
  (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 ce) (cons 40 0.0)) ))
  (while loop
    (setq g (grread T))
    (if (= (car g) 5)
      (progn
      (if (equal ce (cadr g) 1e-8) (setq r 1e-4) (setq r (distance ce (cadr g))))
      (if (and ci (eq (cdr (assoc 0 (entget ci))) "CIRCLE")) (entmod (subst (cons 40 r) (assoc 40 (entget ci)) (entget ci))) )
      (setq h (/ r (tan (/ angr 2))))
      (setq aa (angle ce (cadr g)))
      (prompt "\n<+> incease angle of slice plane by 0.1 degree; <-> decrease angle of slice plane by 0.1 degree; <Space> reset angle of slice plane")
      (prompt "\nDepth of slice plane is : ")(princ h)(prompt "; Angle of slice plane is : ")(princ a)
      )
    )
    (if (= (car g) 2)
      (progn
      (if (= (cadr g) 32) (setq a 0.0) )
      (if (= (cadr g) 43) (setq a (+ a 0.1)) )
      (if (= (cadr g) 45) (setq a (- a 0.1)) )
      (prompt "\n<+> incease angle of slice plane by 0.1 degree; <-> decrease angle of slice plane by 0.1 degree; <Space> reset angle of slice plane")
      (prompt "\nDepth of slice plane is : ")(princ h)(prompt "; Angle of slice plane is : ")(princ a)
      (if (= a 0.0) (progn (entdel ci) (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 ce) (cons 40 r)) )) ))
      (if (< 0.0 a angx) (progn (entdel ci) (setq ci (entmakex (list (cons 0 "ELLIPSE") (cons 100 "AcDbEntity") (cons 100 "AcDbEllipse") (cons 10 (car (sectionel ce h r a))) (cons 11 (polar '(0.0 0.0 0.0) aa (cadr (sectionel ce h r a)))) (cons 40 (/ (caddr (sectionel ce h r a)) (cadr (sectionel ce h r a))) ) (cons 41 0.0) (cons 42 (* 2 PI)) (cons 210 (list 0 0 1)) ))) ))
      (if (equal a angx 1e-8) (progn (entdel ci) (parabmake (polar (car (sectionspl ce h r a angx)) (+ aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) aa (cadr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) (- aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) ) (setq ci (entlast)) ))
      (if (> (- a angx) 1e-8) (progn (entdel ci) (hypermake (polar (car (sectionspl ce h r a angx)) (+ aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) aa (cadr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) (- aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) aa (cadddr (sectionspl ce h r a angx))) ) (setq ci (entlast)) ))
      )
    )
    (if (= (car g) 3) (setq loop nil))
  )
  (setvar 'cmdecho cmde)
  (setvar 'osmode osm)
(princ)
)

Sincerely, M.R.

[ribarm]

I've solved the problem with help of Stefan's pdf... Thank you Stefan again... Here is my final result :

Code: [Select]

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
  (list
    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
    (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
    (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  )
)

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
  ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
  (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
  (sqrt (apply '+ (mapcar '* v v)))
)

(defun transptucs ( pt pt1 pt2 pt3 / u v n uu vv ptt pt1u ptx pty ptz )
  (setq u (mapcar '- pt2 pt1))
  (setq v (mapcar '- pt3 pt1))
  (setq n (unit (v^v u v)))
  (setq uu (unit u))
  (setq vv (unit v))
  (setq ptt (trans pt 0 n))
  (setq pt1u (trans pt1 0 n))
  (setq ptz (caddr (mapcar '- ptt pt1u)))
  (setq ptt (trans pt 0 uu))
  (setq pt1u (trans pt1 0 uu))
  (setq ptx (caddr (mapcar '- ptt pt1u)))
  (setq ptt (trans pt 0 vv))
  (setq pt1u (trans pt1 0 vv))
  (setq pty (caddr (mapcar '- ptt pt1u)))
  (list ptx pty ptz)
)

(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 tan (x)
  (/ (sin x) (cos x))
)

(defun nor ( v )
  (polar '(0 0 0) (+ (angle '(0 0 0) v) (/ PI 2)) 1.0)
)

(defun cixli ( c r a b / ab cp pp p d h p1 p2 ptl )
  (setq ab (mapcar '- b a))
  (setq cp (nor ab))
  (setq pp (mapcar '+ c cp))
  (setq p (inters a b c pp nil))
  (setq d (distance c p))
  (setq h (sqrt (max 0 (- (* r r) (* d d)))))
  (setq p1 (polar p (angle a b) h))
  (setq p2 (polar p (angle b a) h))
  (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
  ptl
)

(defun sectionel ( ce h r a / o or1 or2 oa pta1 pta2 ptce ptcev ptcep pta1v pta1p ael ptceor ptceorv ptcixli ptb bel ceel )
  (setq o (polar ce (- (/ PI 2)) h))
  (setq or1 (polar o 0.0 r))
  (setq or2 (polar o PI r))
  (setq oa (polar o (* (/ PI 180) a) 1.0))
  (setq pta1 (inters ce or1 o oa nil))
  (setq pta2 (inters ce or2 o oa nil))
  (setq ptce (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pta1 pta2) (list 2.0 2.0 2.0)))
  (setq ptcev (polar ptce (/ PI 2) 1.0))
  (setq ptcep (inters o or1 ptce ptcev nil))
  (setq pta1v (polar pta1 (- (/ PI 2)) 1.0))
  (setq pta1p (inters o or1 pta1 pta1v nil))
  (setq ael (distance ptcep pta1p))
  (setq ptceor (inters ce ptce o or1 nil))
  (setq ptceorv (polar ptceor (- (/ PI 2)) 1.0))
  (setq ptcixli (car (cixli o r ptceor ptceorv)))
  (setq ptb (inters o ptcixli ptce ptcev nil))
  (setq bel (distance ptb ptcep))
  (setq ceel (polar ptcep (/ PI 2) h))
  (setq ceel (polar ce (+ aa PI) (distance ce ceel)))
  (list ceel ael bel)
)

(defun sectionspl ( ce h r a angx / o oo oov oop ooo oood or1 or2 oa pta1 pta2 ptce ptcev ptcep pta1v pta1p asp ptceor ptceorv ptcixli ptb bsp cesp )
  (setq o (polar ce (- (/ PI 2)) h))
  (setq or1 (polar o 0.0 r))
  (setq or2 (polar o PI r))
  (setq oa (polar o (* (/ PI 180) a) 1.0))
  (setq pta1 (inters ce or1 o oa nil))
  (if (> (- a angx) 1e-8) (setq pta2 (inters ce or2 o oa nil)) )
  (if pta2 (setq oo (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pta1 pta2) (list 2.0 2.0 2.0))) )
  (if oo (setq oov (polar oo (- (/ PI 2)) 1.0)) )
  (if (and oo oov) (setq oop (inters o or1 oo oov nil)) )
  (if oop (setq ooo (polar oop (/ PI 2) h)) )
  (setq ptce o)
  (setq ptcev (polar ptce (- (/ PI 2)) 1.0))
  (setq ptcep o)
  (setq pta1v (polar pta1 (- (/ PI 2)) 1.0))
  (setq pta1p (inters o or1 pta1 pta1v nil))
  (setq asp (distance ptcep pta1p))
  (setq ptceor o)
  (setq ptceorv (polar ptceor (- (/ PI 2)) 1.0))
  (setq ptcixli (car (cixli o r ptceor ptceorv)))
  (setq ptb ptcixli)
  (setq bsp (distance ptb ptcep))
  (setq cesp (polar ptcep (/ PI 2) h))
  (setq cesp (polar ce (+ aa PI) (distance ce cesp)))
  (if ooo (setq oood (distance cesp ooo)) )
  (if ooo (list cesp asp bsp oood) (list cesp asp bsp) )
)

(defun hypermake ( pt1 ptt pt2 o aa / pttcv weightcv pt1t pt2t pttt ot kk kka kkah cixli1 cixli2 kkp kkk bbc pt11x pt11y pt11t pt22t pt111x pt111y pt111t pt222t aaa bbb )
  (setq aaa (distance ptt o))
  (setq pt1t (transptucs pt1 o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt2t (transptucs pt2 o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pttt (transptucs ptt o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq ot (transptucs o o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq kk (inters pt1t (polar pt1t (angle pttt ot) 1.0) ot (polar ot (angle pt2t pt1t) 1.0) nil))
  (setq kka (polar kk (angle pt2t pt1t) aaa))
  (setq kkah (polar kka (+ (angle pt2t pt1t) (/ PI 2)) 1.0))
  (setq cixli1 (car (cixli kk (distance kk pt1t) kka kkah)))
  (setq cixli2 (cadr (cixli kk (distance kk pt1t) kka kkah)))
  (if (< (distance cixli1 pt1t) (distance cixli2 pt1t)) (setq kkp cixli1) (setq kkp cixli2) )
  (setq kkk (polar kkp (angle pt1t pt2t) aaa))
  (setq bbc (inters ot kkk pttt (polar pttt (angle pt1t pt2t) 1.0) nil))
;  (setq bbb (abs (sqrt (/ (expt (* (cadr pt1t) aaa) 2) (- (expt (car pt1t) 2) (* aaa aaa))))))
  (setq bbb (distance pttt bbc))
  (setq pt11x (* (car pt1t) 2))
  (setq pt11y (+ (sqrt (* (* bbb bbb) (/ (- (expt pt11x 2) (* aaa aaa)) (* aaa aaa))))))
  (setq pt22y (- (sqrt (* (* bbb bbb) (/ (- (expt pt11x 2) (* aaa aaa)) (* aaa aaa))))))
  (setq pt11t (list pt11x pt11y 0.0))
  (setq pt22t (list pt11x pt22y 0.0))
  (setq pt111x (* (car pt1t) 4))
  (setq pt111y (+ (sqrt (* (* bbb bbb) (/ (- (expt pt111x 2) (* aaa aaa)) (* aaa aaa))))))
  (setq pt222y (- (sqrt (* (* bbb bbb) (/ (- (expt pt111x 2) (* aaa aaa)) (* aaa aaa))))))
  (setq pt111t (list pt111x pt111y 0.0))
  (setq pt222t (list pt111x pt222y 0.0))
  (setq pt11 (transptwcs pt11t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt22 (transptwcs pt22t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt111 (transptwcs pt111t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq pt222 (transptwcs pt222t o (polar o (angle ptt o) 1.0) (polar o (angle pt2 pt1) 1.0)))
  (setq weightcv (/ (- (abs (car pt111t)) aaa) (- aaa (/ (* aaa aaa) (abs (car pt111t))))))
  (setq pttcv (polar ptt aa (- aaa (/ (* aaa aaa) (abs (car pt111t))))))
  (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (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 pt111) (cons 41 1.0) (cons 10 pttcv) (cons 41 weightcv) (cons 10 pt222) (cons 41 1.0)) ))
)

(defun parabmake ( pt1 ptt pt2 / pttcv pt11 pt22 pt111 pt222)
(defun ptpar (pt1 ptt pt2 / pt12m dpt12m t12 t1122 p11 p22 pp12 pt11 pt22 )
  (setq pt12m (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pt1 pt2) (list 2.0 2.0 2.0)))
  (setq dpt12m (distance pt12m ptt))
  (setq t12 (polar ptt (- (angle pt2 pt1) (/ PI 2)) dpt12m))
  (setq t1122 (polar ptt (- (angle pt2 pt1) (/ PI 2)) (* dpt12m 4)))
  (setq p11 (polar t12 (angle t12 pt1) (* 1.5 (distance t12 pt1))))
  (setq p22 (polar t12 (angle t12 pt2) (* 1.5 (distance t12 pt2))))
  (setq pp12 (polar ptt (+ (angle pt2 pt1) (/ PI 2)) (* dpt12m 4)))
  (setq pt11 (inters pp12 (polar pp12 (angle pt2 pt1) 1.0) t1122 p11 nil))
  (setq pt22 (inters pp12 (polar pp12 (angle pt1 pt2) 1.0) t1122 p22 nil))
  (list pt11 pt22)
)
  (setq pt11 (car (ptpar pt1 ptt pt2)))
  (setq pt22 (cadr (ptpar pt1 ptt pt2)))
  (setq pt111 (car (ptpar pt11 ptt pt22)))
  (setq pt222 (cadr (ptpar pt11 ptt pt22)))
  (setq pttcv (polar ptt aa (distance ptt (mapcar '/ (mapcar '(lambda ( a b ) (+ a b)) pt111 pt222) (list 2.0 2.0 2.0)))))
  (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (210 0.0 0.0 1.0) (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 pt111) (cons 41 1.0) (cons 10 pttcv) (cons 41 1.0) (cons 10 pt222) (cons 41 1.0)) ))
)

(defun c:conics ( / A AA ANG ANGR ANGX CE CMDE CI CIA G H LOOP OSM R )
  (setq loop T)
  (setq osm (getvar 'osmode))
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (initget 6)
  (setq ang (getreal "\nInput central angle of main edges of cone in decimal degrees : "))
  (setq angx (/ (- 180 ang) 2))
  (setq angr (* (/ PI 180) ang))
  (setq ce (getpoint "\nPick center of cone"))
  (setq a 0.0)
  (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 ce) (cons 40 0.0)) ))
  (while loop
    (setq g (grread T))
    (if (= (car g) 5)
      (progn
      (if (equal ce (cadr g) 1e-8) (setq r 1e-4) (setq r (distance ce (cadr g))))
      (if (and ci (eq (cdr (assoc 0 (entget ci))) "CIRCLE")) (entmod (subst (cons 40 r) (assoc 40 (entget ci)) (entget ci))) )
      (setq h (/ r (tan (/ angr 2))))
      (setq aa (angle ce (cadr g)))
      (prompt "\n<+> incease angle of slice plane by 0.1 degree; <-> decrease angle of slice plane by 0.1 degree; <Space> reset angle of slice plane")
      (prompt "\nDepth of slice plane is : ")(princ h)(prompt "; Angle of slice plane is : ")(princ a)
      )
    )
    (if (= (car g) 2)
      (progn
      (if (= (cadr g) 32) (setq a 0.0) )
      (if (= (cadr g) 43) (setq a (+ a 0.1)) )
      (if (= (cadr g) 45) (setq a (- a 0.1)) )
      (prompt "\n<+> incease angle of slice plane by 0.1 degree; <-> decrease angle of slice plane by 0.1 degree; <Space> reset angle of slice plane")
      (prompt "\nDepth of slice plane is : ")(princ h)(prompt "; Angle of slice plane is : ")(princ a)
      (if (= a 0.0) (progn (entdel ci) (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 ce) (cons 40 r)) )) ))
      (if (< 0.0 a angx) (progn (entdel ci) (setq ci (entmakex (list (cons 0 "ELLIPSE") (cons 100 "AcDbEntity") (cons 100 "AcDbEllipse") (cons 10 (car (sectionel ce h r a))) (cons 11 (polar '(0.0 0.0 0.0) aa (cadr (sectionel ce h r a)))) (cons 40 (/ (caddr (sectionel ce h r a)) (cadr (sectionel ce h r a))) ) (cons 41 0.0) (cons 42 (* 2 PI)) (cons 210 (list 0 0 1)) ))) ))
      (if (equal a angx 1e-8) (progn (entdel ci) (parabmake (polar (car (sectionspl ce h r a angx)) (+ aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) aa (cadr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) (- aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) ) (setq ci (entlast)) ))
      (if (> (- a angx) 1e-8) (progn (entdel ci) (hypermake (polar (car (sectionspl ce h r a angx)) (+ aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) aa (cadr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) (- aa (/ PI 2)) (caddr (sectionspl ce h r a angx))) (polar (car (sectionspl ce h r a angx)) aa (cadddr (sectionspl ce h r a angx))) aa) (setq ci (entlast)) ))
      )
    )
    (if (= (car g) 3) (setq loop nil))
  )
  (setvar 'cmdecho cmde)
  (setvar 'osmode osm)
(princ)
)

Regards, M.R.