More orientations of base primitive - now just for icosahedron and octahedron...
Icosa :
Octa :Code:(defun faceseg (p1 p2 p3 seg / 3DF 3DFACES 3DFI 3DFV D K N P12 P12V P30 P30V P30O P31 P31V V12) (setq d (/ (distance p1 p2) (float seg))) (setq k 0) (setq v12 (mapcar '* (list d d d) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2))))) (repeat seg (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3)))))) (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3)))))) (setq p12 (mapcar '+ p31 v12)) (setq 3df (list p30 p31 p12)) (setq 3dfaces (cons 3df 3dfaces)) (setq n 0) (repeat (- k 1) (setq p30v (mapcar '+ p30 (mapcar '* (list (setq n (1+ n)) n n) v12))) (setq p31v (mapcar '+ p31 (mapcar '* (list n n n) v12))) (setq p12v (mapcar '+ p12 (mapcar '* (list n n n) v12))) (setq p30o (mapcar '+ p30 (mapcar '* (list (- n 1) (- n 1) (- n 1)) v12))) (setq 3dfv (list p30v p31v p12v)) (setq 3dfi (list p30o p31v p30v)) (setq 3dfaces (cons 3dfv 3dfaces)) (setq 3dfaces (cons 3dfi 3dfaces)) ) ) 3dfaces ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df)) (setq p1p (mapcar '* (list rad rad rad) (mapcar '/ p1 (list (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1))))) (setq p2p (mapcar '* (list rad rad rad) (mapcar '/ p2 (list (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2))))) (setq p3p (mapcar '* (list rad rad rad) (mapcar '/ p3 (list (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3))))) (setq 3dfp (list p1p p2p p3p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) ;; 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 prptp ( pt1 pt2 pt3 pt / pt1w pt2w pt3w ptw u v n ptn pt1n pt4n ) (if (and pt1 pt2 pt3 pt) (progn (setq pt1w (trans pt1 1 0) pt2w (trans pt2 1 0) pt3w (trans pt3 1 0) ptw (trans pt 1 0) ) (setq u (mapcar '- pt2w pt1w)) (setq v (mapcar '- pt3w pt1w)) (setq n (unit (V^V u v))) (setq ptn (trans ptw 0 n)) (setq pt1n (trans pt1w 0 n)) (setq pt4n (list (car ptn) (cadr ptn) (caddr pt1n))) ) ) (trans pt4n n 0) ) (defun c:geodesic-icosa ( / PP1 PP2 PP3 PP4 PP5 PP6 PP7 PP8 PP9 PP10 PP11 PP12 ALLFACES ICOSAF1 ICOSAF10 ICOSAF11 ICOSAF12 ICOSAF13 ICOSAF14 ICOSAF15 ICOSAF16 ICOSAF17 ICOSAF18 ICOSAF19 ICOSAF2 ICOSAF20 ICOSAF3 ICOSAF4 ICOSAF5 ICOSAF6 ICOSAF7 ICOSAF8 ICOSAF9 M PT PTICOSALST PTICOSALSTN R RAD SEG TAO TAO3) (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0)) (setq tao3 (sqrt 3.0)) (setq pticosalst (list (setq pp1 (list 0.0 (/ (* tao3 2.0) 3.0) (sqrt (- (expt tao 2) (/ 1.0 3.0))))) (setq pp2 (list -1.0 (/ (- tao3) 3.0) (sqrt (- (expt tao 2) (/ 1.0 3.0))))) (setq pp3 (list 1.0 (/ (- tao3) 3.0) (sqrt (- (expt tao 2) (/ 1.0 3.0))))) (setq pp4 (list 0.0 (/ (* tao3 2.0) -3.0) (- (sqrt (- (expt tao 2) (/ 1.0 3.0)))))) (setq pp5 (list 1.0 (/ tao3 3.0) (- (sqrt (- (expt tao 2) (/ 1.0 3.0)))))) (setq pp6 (list -1.0 (/ tao3 3.0) (- (sqrt (- (expt tao 2) (/ 1.0 3.0)))))) (setq pp7 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp1 pp2 pp6 '(0.0 0.0 0.0)))) (setq pp8 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp2 pp6 pp4 '(0.0 0.0 0.0)))) (setq pp9 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp2 pp4 pp3 '(0.0 0.0 0.0)))) (setq pp10 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp3 pp4 pp5 '(0.0 0.0 0.0)))) (setq pp11 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp3 pp1 pp5 '(0.0 0.0 0.0)))) (setq pp12 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp1 pp5 pp6 '(0.0 0.0 0.0)))) ) ) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car pticosalst))) (setq m (/ rad r)) (setq pticosalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) pticosalst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of icosahedron : ")) (setq icosaf1 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 1 pticosalstn) (nth 2 pticosalstn) seg) rad)) (setq icosaf2 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 11 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf3 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 1 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf4 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 6 pticosalstn) (nth 7 pticosalstn) seg) rad)) (setq icosaf5 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 7 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf6 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 2 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf7 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 8 pticosalstn) (nth 9 pticosalstn) seg) rad)) (setq icosaf8 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 9 pticosalstn) (nth 10 pticosalstn) seg) rad)) (setq icosaf9 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 10 pticosalstn) (nth 0 pticosalstn) seg) rad)) (setq icosaf10 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 10 pticosalstn) (nth 11 pticosalstn) seg) rad)) (setq icosaf11 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 4 pticosalstn) (nth 5 pticosalstn) seg) rad)) (setq icosaf12 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 7 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf13 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 8 pticosalstn) (nth 9 pticosalstn) seg) rad)) (setq icosaf14 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 4 pticosalstn) (nth 9 pticosalstn) seg) rad)) (setq icosaf15 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 9 pticosalstn) (nth 10 pticosalstn) seg) rad)) (setq icosaf16 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 10 pticosalstn) (nth 11 pticosalstn) seg) rad)) (setq icosaf17 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 5 pticosalstn) (nth 11 pticosalstn) seg) rad)) (setq icosaf18 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 11 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf19 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 6 pticosalstn) (nth 7 pticosalstn) seg) rad)) (setq icosaf20 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 7 pticosalstn) (nth 3 pticosalstn) seg) rad)) (setq allfaces (append icosaf1 icosaf2 icosaf3 icosaf4 icosaf5 icosaf6 icosaf7 icosaf8 icosaf9 icosaf10 icosaf11 icosaf12 icosaf13 icosaf14 icosaf15 icosaf16 icosaf17 icosaf18 icosaf19 icosaf20)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (caddr face)))) ) (princ) )
Regards, M.R.Code:(defun faceseg (p1 p2 p3 seg / 3DF 3DFACES 3DFI 3DFV D K N P12 P12V P30 P30V P30O P31 P31V V12) (setq d (/ (distance p1 p2) (float seg))) (setq k 0) (setq v12 (mapcar '* (list d d d) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2))))) (repeat seg (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3)))))) (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3)))))) (setq p12 (mapcar '+ p31 v12)) (setq 3df (list p30 p31 p12)) (setq 3dfaces (cons 3df 3dfaces)) (setq n 0) (repeat (- k 1) (setq p30v (mapcar '+ p30 (mapcar '* (list (setq n (1+ n)) n n) v12))) (setq p31v (mapcar '+ p31 (mapcar '* (list n n n) v12))) (setq p12v (mapcar '+ p12 (mapcar '* (list n n n) v12))) (setq p30o (mapcar '+ p30 (mapcar '* (list (- n 1) (- n 1) (- n 1)) v12))) (setq 3dfv (list p30v p31v p12v)) (setq 3dfi (list p30o p31v p30v)) (setq 3dfaces (cons 3dfv 3dfaces)) (setq 3dfaces (cons 3dfi 3dfaces)) ) ) 3dfaces ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df)) (setq p1p (mapcar '* (list rad rad rad) (mapcar '/ p1 (list (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1))))) (setq p2p (mapcar '* (list rad rad rad) (mapcar '/ p2 (list (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2))))) (setq p3p (mapcar '* (list rad rad rad) (mapcar '/ p3 (list (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3))))) (setq 3dfp (list p1p p2p p3p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) (defun c:geodesic-octa ( / ALLFACES M OCTAF1 OCTAF2 OCTAF3 OCTAF4 OCTAF5 OCTAF6 OCTAF7 OCTAF8 PT PTICOSALST PTOCTALST PTOCTALSTN R RAD SEG TAO2 TAO3) (setq tao2 (sqrt 2.0)) (setq tao3 (sqrt 3.0)) (setq ptoctalst (list (list 0.0 (/ (* tao3 2.0) 3.0) (/ tao2 tao3)) (list -1.0 (/ tao3 (- 3.0)) (/ tao2 tao3)) (list 1.0 (/ tao3 (- 3.0)) (/ tao2 tao3)) (list 0.0 (/ (* tao3 2.0) (- 3.0)) (/ (- tao2) tao3)) (list 1.0 (/ tao3 3.0) (/ (- tao2) tao3)) (list -1.0 (/ tao3 3.0) (/ (- tao2) tao3)) ) ) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car ptoctalst))) (setq m (/ rad r)) (setq ptoctalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) ptoctalst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of octahedron : ")) (setq octaf1 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 1 ptoctalstn) (nth 2 ptoctalstn) seg) rad)) (setq octaf2 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 4 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf3 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 1 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf4 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 5 ptoctalstn) (nth 3 ptoctalstn) seg) rad)) (setq octaf5 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 2 ptoctalstn) (nth 3 ptoctalstn) seg) rad)) (setq octaf6 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 3 ptoctalstn) (nth 4 ptoctalstn) seg) rad)) (setq octaf7 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 4 ptoctalstn) (nth 0 ptoctalstn) seg) rad)) (setq octaf8 (projfaces2sph (faceseg (nth 3 ptoctalstn) (nth 4 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq allfaces (append octaf1 octaf2 octaf3 octaf4 octaf5 octaf6 octaf7 octaf8)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (caddr face)))) ) (princ) )
EDIT : My mistake - corrected - CAD is OK...





Reply With Quote

Bookmarks