zohayb Posted April 19, 2012 Posted April 19, 2012 Hi, I was trying to create a routine to make a geodesic dome through lisp,as i am a beginner need some guidance for how to go about it so far i have managed to this what i have uploaded but i have realized that this is not the right way.geodasic 16042012.lsp Quote
Bill Tillman Posted April 19, 2012 Posted April 19, 2012 (edited) This is totally do-able as almost all geodesic domes can be reduced to mathematical equations. But it's a lot trickier than you'd first think. I did some research into this in the last year and it's a real challenge. But there are solutions I've seen and there were more than one. Have fun and good luck. Edited April 28, 2012 by Bill Tillman Quote
marko_ribar Posted April 22, 2012 Posted April 22, 2012 (edited) Here, I've followed this link and made this code... It's geodesic sphere based on icosahedron divisions... (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-icosa ( / 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) (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0)) (setq pticosalst (list (list 1.0 tao 0.0) (list -1.0 tao 0.0) (list 1.0 (- tao) 0.0) (list -1.0 (- tao) 0.0) (list 0.0 1.0 tao) (list 0.0 -1.0 tao) (list 0.0 1.0 (- tao)) (list 0.0 -1.0 (- tao)) (list tao 0.0 1.0) (list (- tao) 0.0 1.0) (list tao 0.0 -1.0) (list (- tao) 0.0 -1.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 4 pticosalstn) seg) rad)) (setq icosaf2 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 4 pticosalstn) (nth 9 pticosalstn) seg) rad)) (setq icosaf3 (projfaces2sph (faceseg (nth 9 pticosalstn) (nth 4 pticosalstn) (nth 5 pticosalstn) seg) rad)) (setq icosaf4 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 4 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf5 (projfaces2sph (faceseg (nth 8 pticosalstn) (nth 4 pticosalstn) (nth 0 pticosalstn) seg) rad)) (setq icosaf6 (projfaces2sph (faceseg (nth 9 pticosalstn) (nth 5 pticosalstn) (nth 3 pticosalstn) seg) rad)) (setq icosaf7 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 5 pticosalstn) (nth 2 pticosalstn) seg) rad)) (setq icosaf8 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 5 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf9 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 1 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf10 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 11 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf11 (projfaces2sph (faceseg (nth 11 pticosalstn) (nth 7 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf12 (projfaces2sph (faceseg (nth 7 pticosalstn) (nth 10 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf13 (projfaces2sph (faceseg (nth 10 pticosalstn) (nth 0 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf14 (projfaces2sph (faceseg (nth 11 pticosalstn) (nth 3 pticosalstn) (nth 7 pticosalstn) seg) rad)) (setq icosaf15 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 2 pticosalstn) (nth 7 pticosalstn) seg) rad)) (setq icosaf16 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 7 pticosalstn) (nth 10 pticosalstn) seg) rad)) (setq icosaf17 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 9 pticosalstn) (nth 11 pticosalstn) seg) rad)) (setq icosaf18 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 9 pticosalstn) (nth 11 pticosalstn) seg) rad)) (setq icosaf19 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 8 pticosalstn) (nth 10 pticosalstn) seg) rad)) (setq icosaf20 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 8 pticosalstn) (nth 10 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) ) Hope you'll like it... Regards, M.R. Edited April 23, 2012 by marko_ribar Quote
marko_ribar Posted April 23, 2012 Posted April 23, 2012 Here are codes based on octahedron and tetrahedron... (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 TAO) (setq tao (sqrt 2.0)) (setq ptoctalst (list (list -1.0 -1.0 0.0) (list 1.0 -1.0 0.0) (list 1.0 1.0 0.0) (list -1.0 1.0 0.0) (list 0.0 0.0 tao) (list 0.0 0.0 (- tao)) ) ) (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 4 ptoctalstn) seg) rad)) (setq octaf2 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 2 ptoctalstn) (nth 4 ptoctalstn) seg) rad)) (setq octaf3 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 3 ptoctalstn) (nth 4 ptoctalstn) seg) rad)) (setq octaf4 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 3 ptoctalstn) (nth 4 ptoctalstn) seg) rad)) (setq octaf5 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 1 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf6 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 2 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf7 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 3 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf8 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 3 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) ) (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-tetra ( / ALLFACES M PT PTTETRALST PTTETRALSTN R RAD SEG TETRAF1 TETRAF2 TETRAF3 TETRAF4) (setq pttetralst (list (list -1.0 -1.0 -1.0) (list 1.0 -1.0 1.0) (list 1.0 1.0 -1.0) (list -1.0 1.0 1.0) ) ) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car pttetralst))) (setq m (/ rad r)) (setq pttetralstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) pttetralst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of tetrahedron : ")) (setq tetraf1 (projfaces2sph (faceseg (nth 0 pttetralstn) (nth 1 pttetralstn) (nth 2 pttetralstn) seg) rad)) (setq tetraf2 (projfaces2sph (faceseg (nth 1 pttetralstn) (nth 2 pttetralstn) (nth 3 pttetralstn) seg) rad)) (setq tetraf3 (projfaces2sph (faceseg (nth 2 pttetralstn) (nth 3 pttetralstn) (nth 0 pttetralstn) seg) rad)) (setq tetraf4 (projfaces2sph (faceseg (nth 3 pttetralstn) (nth 0 pttetralstn) (nth 1 pttetralstn) seg) rad)) (setq allfaces (append tetraf1 tetraf2 tetraf3 tetraf4)) (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, Marko Ribar, d.i.a. (architect) Quote
CM Hew Posted April 24, 2012 Posted April 24, 2012 Marko, Very Interesting. I did a trial run using the lisp and here is the result for both Icosa and Octa (five divisions) Enjoy trying out the lisp. Thanks Quote
marko_ribar Posted April 24, 2012 Posted April 24, 2012 Note that if you really want to create objects with each edge equal, triangles of tetra, octa and icosa shouldn't be divided by it's edge divisions, but you'll have to project center of each triangle to sphere and connect these new vertices - so tetrahedron would transform to its inverse tetrahedron (4 sides becomes 4 vertices), octahedron to cube (8 sides becomes 8 vertices of new cube that will have now 6 sides - so if you project again centers of these sides you'll get back 6 vertices of octahedron) - these two are complements and if you transform icosahedron (20 sides becomes 20 vertices), it'll transform to dodecahedron that has 12 sides exactly as number of vertices of icosahedron - these two are complements... Still my interpolation of icosa, octa and tetra isn't quite as expected as it's straight projection on sphere all vertices made from net of divisions of main equal sided triangles... Compared with MAX geospheres and there were different results... So here you have my versions as explained from above linked article, and eventually if you have 3DS MAX you'll have its built-in algorithm for these Fullers geospheres... M.R. Quote
zohayb Posted April 26, 2012 Author Posted April 26, 2012 Hi, YOUR HELP IS MUCH APPRECIATED BUT AS I AM A BEGINNER AND AM HAVING REALLY HARD TIME UNDERSTANDING YOUR CODES CAN YOU PLEASE WRITE DOWN pseudo code of some thing to explain how it is down,anyway i have done this if you can have a look and tell me if there is any possible lead from here. cheers for help. geodasic for retake 2342012.lsp Quote
marko_ribar Posted April 27, 2012 Posted April 27, 2012 I don't know what are you trying to accomplish... You already have built-in command AI_DOME for making dome mesh object... Or simply type 3D at command prompt and you'll get all surface based object primitives... As for explanation of my codes, I simply translated what's written in above link article ab geodesic sphere - followed steps... Only part that I was struggling is part of division of main triangle of base object - sub-function and making correct list of new divided triangles... Projecting these triangles on sphere was easy part using (mapcar) function... Also difficult part was that I had to inspect all vertexes (especially for icosahedron) and write down correct 3 point combination for main faces of icosahedron - has 20 of them as you can see from the code... If you still want to make the code that will imitate AI_DOME command I suggest that you use (polar) function and try to make one segment of dome and after that use array - polar command to make arrayed copies of this segment... For finding points of every next upper 3dface use (polar (cenx ceny (R*sin(A))) B (R*cos(A))) where A is angle in vertical elevation and B angle in horizontal elevation - top view, cenx and ceny coordinates of center of dome (R*sin(A)) - z coordinate of center and R main radius of dome... M.R. Quote
marko_ribar Posted April 28, 2012 Posted April 28, 2012 Here is geodesic-icosa.lsp with witch you can cut sphere to make dome hemisphere if segmentation is even number... Orientation of main icosahedron changed - now is aligned with 3ds MAX version - again there are differences between MAX and this code as with MAX there are equal lengths along arcs over main edges and along arcs over 1 direction of net division of main triangle (horizontal divisions)... This my version is pure projection of net divisions of triangles onto geodesic sphere - all lengths are different but main divisions that are to be projected are equal just like it's shown in posted link with tutorial... (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 tg (a) (/ (sin a) (cos a)) ) (defun c:geodesic-icosa ( / 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) (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0)) (setq pticosalst (list (list 0.0 0.0 (sqrt (+ (expt tao 2) 1.0))) (list (* tao (+ (tg (/ pi 10.0)) (tg (/ pi 5.0)))) 0.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (* tao (tg (/ pi 10.0))) tao (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ (- 1.0) (tg (/ pi 5.0))) 1.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ (- 1.0) (tg (/ pi 5.0))) -1.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (* tao (tg (/ pi 10.0))) (- tao) (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ 1.0 (tg (/ pi 5.0))) 1.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (tg (/ pi 10.0))) tao (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (+ (tg (/ pi 10.0)) (tg (/ pi 5.0)))) 0.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (tg (/ pi 10.0))) (- tao) (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (/ 1.0 (tg (/ pi 5.0))) -1.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list 0.0 0.0 (- (sqrt (+ (expt tao 2) 1.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 2 pticosalstn) (nth 3 pticosalstn) seg) rad)) (setq icosaf3 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 3 pticosalstn) (nth 4 pticosalstn) seg) rad)) (setq icosaf4 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 4 pticosalstn) (nth 5 pticosalstn) seg) rad)) (setq icosaf5 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 5 pticosalstn) (nth 1 pticosalstn) seg) rad)) (setq icosaf6 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 2 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf7 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 6 pticosalstn) (nth 7 pticosalstn) seg) rad)) (setq icosaf8 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 3 pticosalstn) (nth 7 pticosalstn) seg) rad)) (setq icosaf9 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 7 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf10 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 4 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf11 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 5 pticosalstn) (nth 9 pticosalstn) seg) rad)) (setq icosaf12 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 8 pticosalstn) (nth 9 pticosalstn) seg) rad)) (setq icosaf13 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 9 pticosalstn) (nth 10 pticosalstn) seg) rad)) (setq icosaf14 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 1 pticosalstn) (nth 10 pticosalstn) seg) rad)) (setq icosaf15 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 10 pticosalstn) (nth 6 pticosalstn) seg) rad)) (setq icosaf16 (projfaces2sph (faceseg (nth 11 pticosalstn) (nth 6 pticosalstn) (nth 7 pticosalstn) seg) rad)) (setq icosaf17 (projfaces2sph (faceseg (nth 11 pticosalstn) (nth 7 pticosalstn) (nth 8 pticosalstn) seg) rad)) (setq icosaf18 (projfaces2sph (faceseg (nth 11 pticosalstn) (nth 8 pticosalstn) (nth 9 pticosalstn) seg) rad)) (setq icosaf19 (projfaces2sph (faceseg (nth 11 pticosalstn) (nth 9 pticosalstn) (nth 10 pticosalstn) seg) rad)) (setq icosaf20 (projfaces2sph (faceseg (nth 11 pticosalstn) (nth 10 pticosalstn) (nth 6 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) ) M.R. Quote
marko_ribar Posted April 28, 2012 Posted April 28, 2012 Here are differences between these codes and MAX algorithm... See attached *.dwg files... M.R. Tschus... geosph-icosa-4.DWG geosph-octa-6.DWG Quote
marko_ribar Posted April 28, 2012 Posted April 28, 2012 Here are geodesic-octa.lsp and geodesic-tetra.lsp orientated like in MAX... Octa : (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 TAO) (setq tao (sqrt 2.0)) (setq ptoctalst (list (list 0.0 tao 0.0) (list (- tao) 0.0 0.0) (list 0.0 (- tao) 0.0) (list tao 0.0 0.0) (list 0.0 0.0 tao) (list 0.0 0.0 (- tao)) ) ) (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 4 ptoctalstn) seg) rad)) (setq octaf2 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 2 ptoctalstn) (nth 4 ptoctalstn) seg) rad)) (setq octaf3 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 3 ptoctalstn) (nth 4 ptoctalstn) seg) rad)) (setq octaf4 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 3 ptoctalstn) (nth 4 ptoctalstn) seg) rad)) (setq octaf5 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 1 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf6 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 2 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf7 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 3 ptoctalstn) (nth 5 ptoctalstn) seg) rad)) (setq octaf8 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 3 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) ) Tetra : (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-tetra ( / TAO2 TAO3 ALLFACES M PT PTTETRALST PTTETRALSTN R RAD SEG TETRAF1 TETRAF2 TETRAF3 TETRAF4) (setq tao2 (sqrt 2.0) tao3 (sqrt 3.0)) (setq pttetralst (list (list 0.0 0.0 (/ tao3 2.0)) (list 0.0 (/ tao2 tao3) (/ tao3 (- 6.0))) (list (/ tao2 (- 2.0)) (/ (- 1.0) (* tao2 tao3)) (/ tao3 (- 6.0))) (list (/ tao2 2.0) (/ (- 1.0) (* tao2 tao3)) (/ tao3 (- 6.0))) ) ) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car pttetralst))) (setq m (/ rad r)) (setq pttetralstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) pttetralst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of tetrahedron : ")) (setq tetraf1 (projfaces2sph (faceseg (nth 0 pttetralstn) (nth 1 pttetralstn) (nth 2 pttetralstn) seg) rad)) (setq tetraf2 (projfaces2sph (faceseg (nth 1 pttetralstn) (nth 2 pttetralstn) (nth 3 pttetralstn) seg) rad)) (setq tetraf3 (projfaces2sph (faceseg (nth 2 pttetralstn) (nth 3 pttetralstn) (nth 0 pttetralstn) seg) rad)) (setq tetraf4 (projfaces2sph (faceseg (nth 3 pttetralstn) (nth 0 pttetralstn) (nth 1 pttetralstn) seg) rad)) (setq allfaces (append tetraf1 tetraf2 tetraf3 tetraf4)) (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) ) Tschus, M.R. Quote
marko_ribar Posted April 28, 2012 Posted April 28, 2012 (edited) More orientations of base primitive - now just for icosahedron and octahedron... Icosa : (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) ) Octa : (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) ) Regards, M.R. :)8)8) EDIT : My mistake - corrected - CAD is OK... Edited April 28, 2012 by marko_ribar Quote
marko_ribar Posted April 30, 2012 Posted April 30, 2012 And here is geodesic-cube.lsp... Warning : 3dfaces are 4 non-coplanar points, except for segmentation 1 witch is actually cube... (defun faceseg (p1 p2 p3 p4 seg / 3DF 3DFACES 3DFV D K N P10 P10V P20 P20V P30 P30V P40 P40V V14) (setq d (/ (distance p1 p2) (float seg))) (setq k 0) (setq v14 (mapcar '* (list d d d) (mapcar '/ (mapcar '- p4 p1) (list (distance p1 p4) (distance p1 p4) (distance p1 p4))))) (repeat seg (setq p10 (mapcar '+ p1 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (setq p20 (mapcar '+ p1 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (setq p30 (mapcar '+ p20 v14)) (setq p40 (mapcar '+ p10 v14)) (setq 3df (list p10 p20 p30 p40)) (setq 3dfaces (cons 3df 3dfaces)) (setq n 0) (repeat (- seg 1) (setq p10v (mapcar '+ p10 (mapcar '* (list (setq n (1+ n)) n n) v14))) (setq p20v (mapcar '+ p20 (mapcar '* (list n n n) v14))) (setq p30v (mapcar '+ p30 (mapcar '* (list n n n) v14))) (setq p40v (mapcar '+ p40 (mapcar '* (list n n n) v14))) (setq 3dfv (list p10v p20v p30v p40v)) (setq 3dfaces (cons 3dfv 3dfaces)) ) ) 3dfaces ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P P4 P4P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df) p4 (cadddr 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 p4p (mapcar '* (list rad rad rad) (mapcar '/ p4 (list (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4))))) (setq 3dfp (list p1p p2p p3p p4p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) (defun c:geodesic-cube ( / ALLFACES CUBEF1 CUBEF2 CUBEF3 CUBEF4 CUBEF5 CUBEF6 M PT PTCUBELST PTCUBELSTN R RAD SEG) (setq ptcubelst (list (list -1.0 -1.0 -1.0) (list 1.0 -1.0 -1.0) (list 1.0 1.0 -1.0) (list -1.0 1.0 -1.0) (list -1.0 -1.0 1.0) (list 1.0 -1.0 1.0) (list 1.0 1.0 1.0) (list -1.0 1.0 1.0) ) ) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car ptcubelst))) (setq m (/ rad r)) (setq ptcubelstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) ptcubelst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of cube : ")) (setq cubef1 (projfaces2sph (faceseg (nth 0 ptcubelstn) (nth 1 ptcubelstn) (nth 2 ptcubelstn) (nth 3 ptcubelstn) seg) rad)) (setq cubef2 (projfaces2sph (faceseg (nth 0 ptcubelstn) (nth 1 ptcubelstn) (nth 5 ptcubelstn) (nth 4 ptcubelstn) seg) rad)) (setq cubef3 (projfaces2sph (faceseg (nth 1 ptcubelstn) (nth 2 ptcubelstn) (nth 6 ptcubelstn) (nth 5 ptcubelstn) seg) rad)) (setq cubef4 (projfaces2sph (faceseg (nth 2 ptcubelstn) (nth 3 ptcubelstn) (nth 7 ptcubelstn) (nth 6 ptcubelstn) seg) rad)) (setq cubef5 (projfaces2sph (faceseg (nth 3 ptcubelstn) (nth 0 ptcubelstn) (nth 4 ptcubelstn) (nth 7 ptcubelstn) seg) rad)) (setq cubef6 (projfaces2sph (faceseg (nth 4 ptcubelstn) (nth 5 ptcubelstn) (nth 6 ptcubelstn) (nth 7 ptcubelstn) seg) rad)) (setq allfaces (append cubef1 cubef2 cubef3 cubef4 cubef5 cubef6)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (cadddr face)))) ) (princ) ) Sincerely, M.R. (arch.) Quote
marko_ribar Posted April 30, 2012 Posted April 30, 2012 (edited) And here is geodesic-dodeca.lsp orientation 1 : (defun faceseg (p1 p2 p3 p4 p5 seg / 3DF CE D K P1N P10 P11 P12 P13 P2N P20 P21 P22 P23 P3N P30 P31 P32 P33 P4N P40 P41 P42 P43 P5N P50 P51 P52 P53 V1C V2C V3C V4C V5C) (setq d (/ (distance p1 p2) (float seg))) (setq ce (cen5gon p1 p2 p3 p4 p5)) (setq k 0) (repeat seg (setq p10 (mapcar '+ p1 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (setq p11 (mapcar '+ p1 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (if (eq seg 1) (setq p12 ce p13 p12) (progn (setq v1c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))))) (if (eq k seg) (progn (setq p12 (mapcar '+ p10 v1c)) (setq p13 p10)) (progn (setq p12 (mapcar '+ p11 v1c)) (setq p13 (mapcar '+ p10 v1c)))) (if (eq k 1) (setq p1n p12 p13 p10) (setq p13 (mapcar '+ p10 v1c))) ) ) (setq 3df (list p10 p11 p12 p13)) (setq 3dfaces (cons 3df 3dfaces)) (setq p20 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (setq p21 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (if (eq seg 1) (setq p22 ce p23 p22) (progn (setq v2c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p2 p3))))) (if (eq k seg) (progn (setq p22 (mapcar '+ p20 v2c)) (setq p23 p20)) (progn (setq p22 (mapcar '+ p21 v2c)) (setq p23 (mapcar '+ p20 v2c)))) (if (eq k 1) (setq p2n p22 p23 p20) (setq p23 (mapcar '+ p20 v2c))) ) ) (setq 3df (list p20 p21 p22 p23)) (setq 3dfaces (cons 3df 3dfaces)) (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (if (eq seg 1) (setq p32 ce p33 p32) (progn (setq v3c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p3 p4))))) (if (eq k seg) (progn (setq p32 (mapcar '+ p30 v3c)) (setq p33 p30)) (progn (setq p32 (mapcar '+ p31 v3c)) (setq p33 (mapcar '+ p30 v3c)))) (if (eq k 1) (setq p3n p32 p33 p30) (setq p33 (mapcar '+ p30 v3c))) ) ) (setq 3df (list p30 p31 p32 p33)) (setq 3dfaces (cons 3df 3dfaces)) (setq p40 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (setq p41 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (if (eq seg 1) (setq p42 ce p43 p42) (progn (setq v4c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p4 p5))))) (if (eq k seg) (progn (setq p42 (mapcar '+ p40 v4c)) (setq p43 p40)) (progn (setq p42 (mapcar '+ p41 v4c)) (setq p43 (mapcar '+ p40 v4c)))) (if (eq k 1) (setq p4n p42 p43 p40) (setq p43 (mapcar '+ p40 v4c))) ) ) (setq 3df (list p40 p41 p42 p43)) (setq 3dfaces (cons 3df 3dfaces)) (setq p50 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (setq p51 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (if (eq seg 1) (setq p52 ce p53 p52) (progn (setq v5c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p5))))) (if (eq k seg) (progn (setq p52 (mapcar '+ p50 v5c)) (setq p53 p50)) (progn (setq p52 (mapcar '+ p51 v5c)) (setq p53 (mapcar '+ p50 v5c)))) (if (eq k 1) (setq p5n p52 p53 p50) (setq p53 (mapcar '+ p50 v5c))) ) ) (setq 3df (list p50 p51 p52 p53)) (setq 3dfaces (cons 3df 3dfaces)) ) (if (> seg 2) (faceseg p1n p2n p3n p4n p5n (- seg 2))) 3dfaces ) (defun cen5gon (p1 p2 p3 p4 p5) (mapcar '(lambda (p1 p2 p3 p4 p5) (/ (+ p1 p2 p3 p4 p5) 5.0)) p1 p2 p3 p4 p5) ) (defun tg (a) (/ (sin a) (cos a)) ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P P4 P4P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df) p4 (cadddr 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 p4p (mapcar '* (list rad rad rad) (mapcar '/ p4 (list (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4))))) (setq 3dfp (list p1p p2p p3p p4p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) (defun projpt2sph (pt rad) (mapcar '* (list rad rad rad) (mapcar '/ pt (list (distance '(0.0 0.0 0.0) pt) (distance '(0.0 0.0 0.0) pt) (distance '(0.0 0.0 0.0) pt)))) ) ;; 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-dodeca ( / ALLFACES DODECAF1 DODECAF10 DODECAF11 DODECAF12 DODECAF2 DODECAF3 DODECAF4 DODECAF5 DODECAF6 DODECAF7 DODECAF8 DODECAF9 ICOSAF1 ICOSAF10 ICOSAF11 ICOSAF12 ICOSAF13 ICOSAF14 ICOSAF15 ICOSAF16 ICOSAF17 ICOSAF18 ICOSAF19 ICOSAF2 ICOSAF20 ICOSAF3 ICOSAF4 ICOSAF5 ICOSAF6 ICOSAF7 ICOSAF8 ICOSAF9 M PT PTDODECALST PTDODECALSTN PTICOSALST R RAD SEG TAO) (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0)) (setq pticosalst (list (list 1.0 tao 0.0) (list -1.0 tao 0.0) (list 1.0 (- tao) 0.0) (list -1.0 (- tao) 0.0) (list 0.0 1.0 tao) (list 0.0 -1.0 tao) (list 0.0 1.0 (- tao)) (list 0.0 -1.0 (- tao)) (list tao 0.0 1.0) (list (- tao) 0.0 1.0) (list tao 0.0 -1.0) (list (- tao) 0.0 -1.0) ) ) (setq icosaf1 (projpt2sph (prptp (nth 0 pticosalst) (nth 1 pticosalst) (nth 4 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf2 (projpt2sph (prptp (nth 1 pticosalst) (nth 4 pticosalst) (nth 9 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf3 (projpt2sph (prptp (nth 9 pticosalst) (nth 4 pticosalst) (nth 5 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf4 (projpt2sph (prptp (nth 5 pticosalst) (nth 4 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf5 (projpt2sph (prptp (nth 8 pticosalst) (nth 4 pticosalst) (nth 0 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf6 (projpt2sph (prptp (nth 9 pticosalst) (nth 5 pticosalst) (nth 3 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf7 (projpt2sph (prptp (nth 3 pticosalst) (nth 5 pticosalst) (nth 2 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf8 (projpt2sph (prptp (nth 2 pticosalst) (nth 5 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf9 (projpt2sph (prptp (nth 0 pticosalst) (nth 1 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf10 (projpt2sph (prptp (nth 1 pticosalst) (nth 11 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf11 (projpt2sph (prptp (nth 11 pticosalst) (nth 7 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf12 (projpt2sph (prptp (nth 7 pticosalst) (nth 10 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf13 (projpt2sph (prptp (nth 10 pticosalst) (nth 0 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf14 (projpt2sph (prptp (nth 11 pticosalst) (nth 3 pticosalst) (nth 7 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf15 (projpt2sph (prptp (nth 3 pticosalst) (nth 2 pticosalst) (nth 7 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf16 (projpt2sph (prptp (nth 2 pticosalst) (nth 7 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf17 (projpt2sph (prptp (nth 1 pticosalst) (nth 9 pticosalst) (nth 11 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf18 (projpt2sph (prptp (nth 3 pticosalst) (nth 9 pticosalst) (nth 11 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf19 (projpt2sph (prptp (nth 2 pticosalst) (nth 8 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf20 (projpt2sph (prptp (nth 0 pticosalst) (nth 8 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq ptdodecalst (list icosaf1 icosaf2 icosaf3 icosaf4 icosaf5 icosaf6 icosaf7 icosaf8 icosaf9 icosaf10 icosaf11 icosaf12 icosaf13 icosaf14 icosaf15 icosaf16 icosaf17 icosaf18 icosaf19 icosaf20)) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car ptdodecalst))) (setq m (/ rad r)) (setq ptdodecalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) ptdodecalst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of dodecahedron : ")) (setq dodecaf1 (projfaces2sph (faceseg (nth 0 ptdodecalstn) (nth 1 ptdodecalstn) (nth 2 ptdodecalstn) (nth 3 ptdodecalstn) (nth 4 ptdodecalstn) seg) rad)) (setq dodecaf2 (projfaces2sph (faceseg (nth 1 ptdodecalstn) (nth 2 ptdodecalstn) (nth 5 ptdodecalstn) (nth 17 ptdodecalstn) (nth 16 ptdodecalstn) seg) rad)) (setq dodecaf3 (projfaces2sph (faceseg (nth 2 ptdodecalstn) (nth 3 ptdodecalstn) (nth 7 ptdodecalstn) (nth 6 ptdodecalstn) (nth 5 ptdodecalstn) seg) rad)) (setq dodecaf4 (projfaces2sph (faceseg (nth 5 ptdodecalstn) (nth 6 ptdodecalstn) (nth 14 ptdodecalstn) (nth 13 ptdodecalstn) (nth 17 ptdodecalstn) seg) rad)) (setq dodecaf5 (projfaces2sph (faceseg (nth 16 ptdodecalstn) (nth 17 ptdodecalstn) (nth 13 ptdodecalstn) (nth 10 ptdodecalstn) (nth 9 ptdodecalstn) seg) rad)) (setq dodecaf6 (projfaces2sph (faceseg (nth 0 ptdodecalstn) (nth 1 ptdodecalstn) (nth 16 ptdodecalstn) (nth 9 ptdodecalstn) (nth 8 ptdodecalstn) seg) rad)) (setq dodecaf7 (projfaces2sph (faceseg (nth 8 ptdodecalstn) (nth 9 ptdodecalstn) (nth 10 ptdodecalstn) (nth 11 ptdodecalstn) (nth 12 ptdodecalstn) seg) rad)) (setq dodecaf8 (projfaces2sph (faceseg (nth 0 ptdodecalstn) (nth 8 ptdodecalstn) (nth 12 ptdodecalstn) (nth 19 ptdodecalstn) (nth 4 ptdodecalstn) seg) rad)) (setq dodecaf9 (projfaces2sph (faceseg (nth 19 ptdodecalstn) (nth 12 ptdodecalstn) (nth 11 ptdodecalstn) (nth 15 ptdodecalstn) (nth 18 ptdodecalstn) seg) rad)) (setq dodecaf10 (projfaces2sph (faceseg (nth 10 ptdodecalstn) (nth 11 ptdodecalstn) (nth 15 ptdodecalstn) (nth 14 ptdodecalstn) (nth 13 ptdodecalstn) seg) rad)) (setq dodecaf11 (projfaces2sph (faceseg (nth 6 ptdodecalstn) (nth 7 ptdodecalstn) (nth 18 ptdodecalstn) (nth 15 ptdodecalstn) (nth 14 ptdodecalstn) seg) rad)) (setq dodecaf12 (projfaces2sph (faceseg (nth 3 ptdodecalstn) (nth 4 ptdodecalstn) (nth 19 ptdodecalstn) (nth 18 ptdodecalstn) (nth 7 ptdodecalstn) seg) rad)) (setq allfaces (append dodecaf1 dodecaf2 dodecaf3 dodecaf4 dodecaf5 dodecaf6 dodecaf7 dodecaf8 dodecaf9 dodecaf10 dodecaf11 dodecaf12)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (cadddr face)))) ) (setq 3dfaces nil) (princ) ) M.R. Edited May 1, 2012 by marko_ribar Quote
marko_ribar Posted April 30, 2012 Posted April 30, 2012 (edited) orientation 2 : (defun faceseg (p1 p2 p3 p4 p5 seg / 3DF CE D K P1N P10 P11 P12 P13 P2N P20 P21 P22 P23 P3N P30 P31 P32 P33 P4N P40 P41 P42 P43 P5N P50 P51 P52 P53 V1C V2C V3C V4C V5C) (setq d (/ (distance p1 p2) (float seg))) (setq ce (cen5gon p1 p2 p3 p4 p5)) (setq k 0) (repeat seg (setq p10 (mapcar '+ p1 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (setq p11 (mapcar '+ p1 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (if (eq seg 1) (setq p12 ce p13 p12) (progn (setq v1c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))))) (if (eq k seg) (progn (setq p12 (mapcar '+ p10 v1c)) (setq p13 p10)) (progn (setq p12 (mapcar '+ p11 v1c)) (setq p13 (mapcar '+ p10 v1c)))) (if (eq k 1) (setq p1n p12 p13 p10) (setq p13 (mapcar '+ p10 v1c))) ) ) (setq 3df (list p10 p11 p12 p13)) (setq 3dfaces (cons 3df 3dfaces)) (setq p20 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (setq p21 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (if (eq seg 1) (setq p22 ce p23 p22) (progn (setq v2c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p2 p3))))) (if (eq k seg) (progn (setq p22 (mapcar '+ p20 v2c)) (setq p23 p20)) (progn (setq p22 (mapcar '+ p21 v2c)) (setq p23 (mapcar '+ p20 v2c)))) (if (eq k 1) (setq p2n p22 p23 p20) (setq p23 (mapcar '+ p20 v2c))) ) ) (setq 3df (list p20 p21 p22 p23)) (setq 3dfaces (cons 3df 3dfaces)) (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (if (eq seg 1) (setq p32 ce p33 p32) (progn (setq v3c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p3 p4))))) (if (eq k seg) (progn (setq p32 (mapcar '+ p30 v3c)) (setq p33 p30)) (progn (setq p32 (mapcar '+ p31 v3c)) (setq p33 (mapcar '+ p30 v3c)))) (if (eq k 1) (setq p3n p32 p33 p30) (setq p33 (mapcar '+ p30 v3c))) ) ) (setq 3df (list p30 p31 p32 p33)) (setq 3dfaces (cons 3df 3dfaces)) (setq p40 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (setq p41 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (if (eq seg 1) (setq p42 ce p43 p42) (progn (setq v4c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p4 p5))))) (if (eq k seg) (progn (setq p42 (mapcar '+ p40 v4c)) (setq p43 p40)) (progn (setq p42 (mapcar '+ p41 v4c)) (setq p43 (mapcar '+ p40 v4c)))) (if (eq k 1) (setq p4n p42 p43 p40) (setq p43 (mapcar '+ p40 v4c))) ) ) (setq 3df (list p40 p41 p42 p43)) (setq 3dfaces (cons 3df 3dfaces)) (setq p50 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (setq p51 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (if (eq seg 1) (setq p52 ce p53 p52) (progn (setq v5c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p5))))) (if (eq k seg) (progn (setq p52 (mapcar '+ p50 v5c)) (setq p53 p50)) (progn (setq p52 (mapcar '+ p51 v5c)) (setq p53 (mapcar '+ p50 v5c)))) (if (eq k 1) (setq p5n p52 p53 p50) (setq p53 (mapcar '+ p50 v5c))) ) ) (setq 3df (list p50 p51 p52 p53)) (setq 3dfaces (cons 3df 3dfaces)) ) (if (> seg 2) (faceseg p1n p2n p3n p4n p5n (- seg 2))) 3dfaces ) (defun cen5gon (p1 p2 p3 p4 p5) (mapcar '(lambda (p1 p2 p3 p4 p5) (/ (+ p1 p2 p3 p4 p5) 5.0)) p1 p2 p3 p4 p5) ) (defun tg (a) (/ (sin a) (cos a)) ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P P4 P4P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df) p4 (cadddr 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 p4p (mapcar '* (list rad rad rad) (mapcar '/ p4 (list (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4))))) (setq 3dfp (list p1p p2p p3p p4p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) (defun projpt2sph (pt rad) (mapcar '* (list rad rad rad) (mapcar '/ pt (list (distance '(0.0 0.0 0.0) pt) (distance '(0.0 0.0 0.0) pt) (distance '(0.0 0.0 0.0) pt)))) ) ;; 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-dodeca ( / ALLFACES DODECAF1 DODECAF10 DODECAF11 DODECAF12 DODECAF2 DODECAF3 DODECAF4 DODECAF5 DODECAF6 DODECAF7 DODECAF8 DODECAF9 ICOSAF1 ICOSAF10 ICOSAF11 ICOSAF12 ICOSAF13 ICOSAF14 ICOSAF15 ICOSAF16 ICOSAF17 ICOSAF18 ICOSAF19 ICOSAF2 ICOSAF20 ICOSAF3 ICOSAF4 ICOSAF5 ICOSAF6 ICOSAF7 ICOSAF8 ICOSAF9 M PT PTDODECALST PTDODECALSTN PTICOSALST R RAD SEG TAO) (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0)) (setq pticosalst (list (list 0.0 0.0 (sqrt (+ (expt tao 2) 1.0))) (list (* tao (+ (tg (/ pi 10.0)) (tg (/ pi 5.0)))) 0.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (* tao (tg (/ pi 10.0))) tao (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ (- 1.0) (tg (/ pi 5.0))) 1.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ (- 1.0) (tg (/ pi 5.0))) -1.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (* tao (tg (/ pi 10.0))) (- tao) (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ 1.0 (tg (/ pi 5.0))) 1.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (tg (/ pi 10.0))) tao (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (+ (tg (/ pi 10.0)) (tg (/ pi 5.0)))) 0.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (tg (/ pi 10.0))) (- tao) (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (/ 1.0 (tg (/ pi 5.0))) -1.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list 0.0 0.0 (- (sqrt (+ (expt tao 2) 1.0)))) ) ) (setq icosaf1 (projpt2sph (prptp (nth 0 pticosalst) (nth 1 pticosalst) (nth 2 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf2 (projpt2sph (prptp (nth 0 pticosalst) (nth 2 pticosalst) (nth 3 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf3 (projpt2sph (prptp (nth 0 pticosalst) (nth 3 pticosalst) (nth 4 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf4 (projpt2sph (prptp (nth 0 pticosalst) (nth 4 pticosalst) (nth 5 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf5 (projpt2sph (prptp (nth 0 pticosalst) (nth 5 pticosalst) (nth 1 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf6 (projpt2sph (prptp (nth 1 pticosalst) (nth 2 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf7 (projpt2sph (prptp (nth 2 pticosalst) (nth 6 pticosalst) (nth 7 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf8 (projpt2sph (prptp (nth 2 pticosalst) (nth 3 pticosalst) (nth 7 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf9 (projpt2sph (prptp (nth 3 pticosalst) (nth 7 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf10 (projpt2sph (prptp (nth 3 pticosalst) (nth 4 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf11 (projpt2sph (prptp (nth 4 pticosalst) (nth 5 pticosalst) (nth 9 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf12 (projpt2sph (prptp (nth 4 pticosalst) (nth 8 pticosalst) (nth 9 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf13 (projpt2sph (prptp (nth 5 pticosalst) (nth 9 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf14 (projpt2sph (prptp (nth 5 pticosalst) (nth 1 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf15 (projpt2sph (prptp (nth 1 pticosalst) (nth 10 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf16 (projpt2sph (prptp (nth 11 pticosalst) (nth 6 pticosalst) (nth 7 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf17 (projpt2sph (prptp (nth 11 pticosalst) (nth 7 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf18 (projpt2sph (prptp (nth 11 pticosalst) (nth 8 pticosalst) (nth 9 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf19 (projpt2sph (prptp (nth 11 pticosalst) (nth 9 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf20 (projpt2sph (prptp (nth 11 pticosalst) (nth 10 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq ptdodecalst (list icosaf1 icosaf2 icosaf3 icosaf4 icosaf5 icosaf6 icosaf7 icosaf8 icosaf9 icosaf10 icosaf11 icosaf12 icosaf13 icosaf14 icosaf15 icosaf16 icosaf17 icosaf18 icosaf19 icosaf20)) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car ptdodecalst))) (setq m (/ rad r)) (setq ptdodecalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) ptdodecalst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of dodecahedron : ")) (setq dodecaf1 (projfaces2sph (faceseg (nth 0 ptdodecalstn) (nth 1 ptdodecalstn) (nth 2 ptdodecalstn) (nth 3 ptdodecalstn) (nth 4 ptdodecalstn) seg) rad)) (setq dodecaf2 (projfaces2sph (faceseg (nth 1 ptdodecalstn) (nth 0 ptdodecalstn) (nth 5 ptdodecalstn) (nth 6 ptdodecalstn) (nth 7 ptdodecalstn) seg) rad)) (setq dodecaf3 (projfaces2sph (faceseg (nth 2 ptdodecalstn) (nth 1 ptdodecalstn) (nth 7 ptdodecalstn) (nth 8 ptdodecalstn) (nth 9 ptdodecalstn) seg) rad)) (setq dodecaf4 (projfaces2sph (faceseg (nth 3 ptdodecalstn) (nth 2 ptdodecalstn) (nth 9 ptdodecalstn) (nth 11 ptdodecalstn) (nth 10 ptdodecalstn) seg) rad)) (setq dodecaf5 (projfaces2sph (faceseg (nth 4 ptdodecalstn) (nth 3 ptdodecalstn) (nth 10 ptdodecalstn) (nth 12 ptdodecalstn) (nth 13 ptdodecalstn) seg) rad)) (setq dodecaf6 (projfaces2sph (faceseg (nth 0 ptdodecalstn) (nth 4 ptdodecalstn) (nth 13 ptdodecalstn) (nth 14 ptdodecalstn) (nth 5 ptdodecalstn) seg) rad)) (setq dodecaf7 (projfaces2sph (faceseg (nth 12 ptdodecalstn) (nth 13 ptdodecalstn) (nth 14 ptdodecalstn) (nth 19 ptdodecalstn) (nth 18 ptdodecalstn) seg) rad)) (setq dodecaf8 (projfaces2sph (faceseg (nth 12 ptdodecalstn) (nth 10 ptdodecalstn) (nth 11 ptdodecalstn) (nth 17 ptdodecalstn) (nth 18 ptdodecalstn) seg) rad)) (setq dodecaf9 (projfaces2sph (faceseg (nth 11 ptdodecalstn) (nth 9 ptdodecalstn) (nth 8 ptdodecalstn) (nth 16 ptdodecalstn) (nth 17 ptdodecalstn) seg) rad)) (setq dodecaf10 (projfaces2sph (faceseg (nth 8 ptdodecalstn) (nth 7 ptdodecalstn) (nth 6 ptdodecalstn) (nth 15 ptdodecalstn) (nth 16 ptdodecalstn) seg) rad)) (setq dodecaf11 (projfaces2sph (faceseg (nth 6 ptdodecalstn) (nth 5 ptdodecalstn) (nth 14 ptdodecalstn) (nth 19 ptdodecalstn) (nth 15 ptdodecalstn) seg) rad)) (setq dodecaf12 (projfaces2sph (faceseg (nth 15 ptdodecalstn) (nth 16 ptdodecalstn) (nth 17 ptdodecalstn) (nth 18 ptdodecalstn) (nth 19 ptdodecalstn) seg) rad)) (setq allfaces (append dodecaf1 dodecaf2 dodecaf3 dodecaf4 dodecaf5 dodecaf6 dodecaf7 dodecaf8 dodecaf9 dodecaf10 dodecaf11 dodecaf12)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (cadddr face)))) ) (setq 3dfaces nil) (princ) ) M.R. Edited May 1, 2012 by marko_ribar Quote
marko_ribar Posted April 30, 2012 Posted April 30, 2012 (edited) orientation 3 : (defun faceseg (p1 p2 p3 p4 p5 seg / 3DF CE D K P1N P10 P11 P12 P13 P2N P20 P21 P22 P23 P3N P30 P31 P32 P33 P4N P40 P41 P42 P43 P5N P50 P51 P52 P53 V1C V2C V3C V4C V5C) (setq d (/ (distance p1 p2) (float seg))) (setq ce (cen5gon p1 p2 p3 p4 p5)) (setq k 0) (repeat seg (setq p10 (mapcar '+ p1 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (setq p11 (mapcar '+ p1 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (if (eq seg 1) (setq p12 ce p13 p12) (progn (setq v1c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))))) (if (eq k seg) (progn (setq p12 (mapcar '+ p10 v1c)) (setq p13 p10)) (progn (setq p12 (mapcar '+ p11 v1c)) (setq p13 (mapcar '+ p10 v1c)))) (if (eq k 1) (setq p1n p12 p13 p10) (setq p13 (mapcar '+ p10 v1c))) ) ) (setq 3df (list p10 p11 p12 p13)) (setq 3dfaces (cons 3df 3dfaces)) (setq p20 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (setq p21 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (if (eq seg 1) (setq p22 ce p23 p22) (progn (setq v2c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p2 p3))))) (if (eq k seg) (progn (setq p22 (mapcar '+ p20 v2c)) (setq p23 p20)) (progn (setq p22 (mapcar '+ p21 v2c)) (setq p23 (mapcar '+ p20 v2c)))) (if (eq k 1) (setq p2n p22 p23 p20) (setq p23 (mapcar '+ p20 v2c))) ) ) (setq 3df (list p20 p21 p22 p23)) (setq 3dfaces (cons 3df 3dfaces)) (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (if (eq seg 1) (setq p32 ce p33 p32) (progn (setq v3c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p3 p4))))) (if (eq k seg) (progn (setq p32 (mapcar '+ p30 v3c)) (setq p33 p30)) (progn (setq p32 (mapcar '+ p31 v3c)) (setq p33 (mapcar '+ p30 v3c)))) (if (eq k 1) (setq p3n p32 p33 p30) (setq p33 (mapcar '+ p30 v3c))) ) ) (setq 3df (list p30 p31 p32 p33)) (setq 3dfaces (cons 3df 3dfaces)) (setq p40 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (setq p41 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (if (eq seg 1) (setq p42 ce p43 p42) (progn (setq v4c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p4 p5))))) (if (eq k seg) (progn (setq p42 (mapcar '+ p40 v4c)) (setq p43 p40)) (progn (setq p42 (mapcar '+ p41 v4c)) (setq p43 (mapcar '+ p40 v4c)))) (if (eq k 1) (setq p4n p42 p43 p40) (setq p43 (mapcar '+ p40 v4c))) ) ) (setq 3df (list p40 p41 p42 p43)) (setq 3dfaces (cons 3df 3dfaces)) (setq p50 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (setq p51 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (if (eq seg 1) (setq p52 ce p53 p52) (progn (setq v5c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p5))))) (if (eq k seg) (progn (setq p52 (mapcar '+ p50 v5c)) (setq p53 p50)) (progn (setq p52 (mapcar '+ p51 v5c)) (setq p53 (mapcar '+ p50 v5c)))) (if (eq k 1) (setq p5n p52 p53 p50) (setq p53 (mapcar '+ p50 v5c))) ) ) (setq 3df (list p50 p51 p52 p53)) (setq 3dfaces (cons 3df 3dfaces)) ) (if (> seg 2) (faceseg p1n p2n p3n p4n p5n (- seg 2))) 3dfaces ) (defun cen5gon (p1 p2 p3 p4 p5) (mapcar '(lambda (p1 p2 p3 p4 p5) (/ (+ p1 p2 p3 p4 p5) 5.0)) p1 p2 p3 p4 p5) ) (defun tg (a) (/ (sin a) (cos a)) ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P P4 P4P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df) p4 (cadddr 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 p4p (mapcar '* (list rad rad rad) (mapcar '/ p4 (list (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4))))) (setq 3dfp (list p1p p2p p3p p4p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) (defun projpt2sph (pt rad) (mapcar '* (list rad rad rad) (mapcar '/ pt (list (distance '(0.0 0.0 0.0) pt) (distance '(0.0 0.0 0.0) pt) (distance '(0.0 0.0 0.0) pt)))) ) ;; 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-dodeca ( / ALLFACES PP1 PP2 PP3 PP4 PP5 PP6 PP7 PP8 PP9 PP10 PP11 PP12 DODECAF1 DODECAF10 DODECAF11 DODECAF12 DODECAF2 DODECAF3 DODECAF4 DODECAF5 DODECAF6 DODECAF7 DODECAF8 DODECAF9 ICOSAF1 ICOSAF10 ICOSAF11 ICOSAF12 ICOSAF13 ICOSAF14 ICOSAF15 ICOSAF16 ICOSAF17 ICOSAF18 ICOSAF19 ICOSAF2 ICOSAF20 ICOSAF3 ICOSAF4 ICOSAF5 ICOSAF6 ICOSAF7 ICOSAF8 ICOSAF9 M PT PTDODECALST PTDODECALSTN PTICOSALST 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 icosaf1 (projpt2sph (prptp (nth 0 pticosalst) (nth 1 pticosalst) (nth 2 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf2 (projpt2sph (prptp (nth 0 pticosalst) (nth 11 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf3 (projpt2sph (prptp (nth 0 pticosalst) (nth 1 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf4 (projpt2sph (prptp (nth 1 pticosalst) (nth 6 pticosalst) (nth 7 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf5 (projpt2sph (prptp (nth 1 pticosalst) (nth 7 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf6 (projpt2sph (prptp (nth 1 pticosalst) (nth 2 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf7 (projpt2sph (prptp (nth 2 pticosalst) (nth 8 pticosalst) (nth 9 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf8 (projpt2sph (prptp (nth 2 pticosalst) (nth 9 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf9 (projpt2sph (prptp (nth 2 pticosalst) (nth 10 pticosalst) (nth 0 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf10 (projpt2sph (prptp (nth 0 pticosalst) (nth 10 pticosalst) (nth 11 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf11 (projpt2sph (prptp (nth 3 pticosalst) (nth 4 pticosalst) (nth 5 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf12 (projpt2sph (prptp (nth 3 pticosalst) (nth 7 pticosalst) (nth 8 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf13 (projpt2sph (prptp (nth 3 pticosalst) (nth 8 pticosalst) (nth 9 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf14 (projpt2sph (prptp (nth 3 pticosalst) (nth 4 pticosalst) (nth 9 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf15 (projpt2sph (prptp (nth 4 pticosalst) (nth 9 pticosalst) (nth 10 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf16 (projpt2sph (prptp (nth 4 pticosalst) (nth 10 pticosalst) (nth 11 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf17 (projpt2sph (prptp (nth 4 pticosalst) (nth 5 pticosalst) (nth 11 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf18 (projpt2sph (prptp (nth 5 pticosalst) (nth 11 pticosalst) (nth 6 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf19 (projpt2sph (prptp (nth 5 pticosalst) (nth 6 pticosalst) (nth 7 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq icosaf20 (projpt2sph (prptp (nth 5 pticosalst) (nth 7 pticosalst) (nth 3 pticosalst) '(0.0 0.0 0.0)) 1.0)) (setq ptdodecalst (list icosaf1 icosaf2 icosaf3 icosaf4 icosaf5 icosaf6 icosaf7 icosaf8 icosaf9 icosaf10 icosaf11 icosaf12 icosaf13 icosaf14 icosaf15 icosaf16 icosaf17 icosaf18 icosaf19 icosaf20)) (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : ")) (setq r (distance '(0.0 0.0 0.0) (car ptdodecalst))) (setq m (/ rad r)) (setq ptdodecalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) ptdodecalst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of dodecahedron : ")) (setq dodecaf1 (projfaces2sph (faceseg (nth 0 ptdodecalstn) (nth 2 ptdodecalstn) (nth 3 ptdodecalstn) (nth 4 ptdodecalstn) (nth 5 ptdodecalstn) seg) rad)) (setq dodecaf2 (projfaces2sph (faceseg (nth 0 ptdodecalstn) (nth 5 ptdodecalstn) (nth 6 ptdodecalstn) (nth 7 ptdodecalstn) (nth 8 ptdodecalstn) seg) rad)) (setq dodecaf3 (projfaces2sph (faceseg (nth 2 ptdodecalstn) (nth 0 ptdodecalstn) (nth 8 ptdodecalstn) (nth 9 ptdodecalstn) (nth 1 ptdodecalstn) seg) rad)) (setq dodecaf4 (projfaces2sph (faceseg (nth 1 ptdodecalstn) (nth 2 ptdodecalstn) (nth 3 ptdodecalstn) (nth 18 ptdodecalstn) (nth 17 ptdodecalstn) seg) rad)) (setq dodecaf5 (projfaces2sph (faceseg (nth 4 ptdodecalstn) (nth 3 ptdodecalstn) (nth 18 ptdodecalstn) (nth 19 ptdodecalstn) (nth 11 ptdodecalstn) seg) rad)) (setq dodecaf6 (projfaces2sph (faceseg (nth 6 ptdodecalstn) (nth 5 ptdodecalstn) (nth 4 ptdodecalstn) (nth 11 ptdodecalstn) (nth 12 ptdodecalstn) seg) rad)) (setq dodecaf7 (projfaces2sph (faceseg (nth 7 ptdodecalstn) (nth 6 ptdodecalstn) (nth 12 ptdodecalstn) (nth 13 ptdodecalstn) (nth 14 ptdodecalstn) seg) rad)) (setq dodecaf8 (projfaces2sph (faceseg (nth 9 ptdodecalstn) (nth 8 ptdodecalstn) (nth 7 ptdodecalstn) (nth 14 ptdodecalstn) (nth 15 ptdodecalstn) seg) rad)) (setq dodecaf9 (projfaces2sph (faceseg (nth 1 ptdodecalstn) (nth 9 ptdodecalstn) (nth 15 ptdodecalstn) (nth 16 ptdodecalstn) (nth 17 ptdodecalstn) seg) rad)) (setq dodecaf10 (projfaces2sph (faceseg (nth 16 ptdodecalstn) (nth 17 ptdodecalstn) (nth 18 ptdodecalstn) (nth 19 ptdodecalstn) (nth 10 ptdodecalstn) seg) rad)) (setq dodecaf11 (projfaces2sph (faceseg (nth 13 ptdodecalstn) (nth 14 ptdodecalstn) (nth 15 ptdodecalstn) (nth 16 ptdodecalstn) (nth 10 ptdodecalstn) seg) rad)) (setq dodecaf12 (projfaces2sph (faceseg (nth 13 ptdodecalstn) (nth 12 ptdodecalstn) (nth 11 ptdodecalstn) (nth 19 ptdodecalstn) (nth 10 ptdodecalstn) seg) rad)) (setq allfaces (append dodecaf1 dodecaf2 dodecaf3 dodecaf4 dodecaf5 dodecaf6 dodecaf7 dodecaf8 dodecaf9 dodecaf10 dodecaf11 dodecaf12)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (cadddr face)))) ) (setq 3dfaces nil) (princ) ) M.R. I think that's all ab geodesic spheres... :)8)8) Edited May 1, 2012 by marko_ribar Quote
marko_ribar Posted May 1, 2012 Posted May 1, 2012 I just couldn't resist to do it and for soccer ball (icosidodecahedron)... So geodesic-icosidodeca.lsp is finished orientation 1 : subfunctions : (defun faceseg3 (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 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 p12v)) (setq 3dfi (list p30o p31v p30v p30v)) (setq 3dfaces (cons 3dfv 3dfaces)) (setq 3dfaces (cons 3dfi 3dfaces)) ) ) 3dfaces ) (defun faceseg5 (p1 p2 p3 p4 p5 seg / 3DF CE D K P1N P10 P11 P12 P13 P2N P20 P21 P22 P23 P3N P30 P31 P32 P33 P4N P40 P41 P42 P43 P5N P50 P51 P52 P53 V1C V2C V3C V4C V5C) (setq d (/ (distance p1 p2) (float seg))) (setq ce (cen5gon p1 p2 p3 p4 p5)) (setq k 0) (repeat seg (setq p10 (mapcar '+ p1 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (setq p11 (mapcar '+ p1 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (if (eq seg 1) (setq p12 ce p13 p12) (progn (setq v1c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))))) (if (eq k seg) (progn (setq p12 (mapcar '+ p10 v1c)) (setq p13 p10)) (progn (setq p12 (mapcar '+ p11 v1c)) (setq p13 (mapcar '+ p10 v1c)))) (if (eq k 1) (setq p1n p12 p13 p10) (setq p13 (mapcar '+ p10 v1c))) ) ) (setq 3df (list p10 p11 p12 p13)) (setq 3dfaces (cons 3df 3dfaces)) (setq p20 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (setq p21 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (if (eq seg 1) (setq p22 ce p23 p22) (progn (setq v2c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p2 p3))))) (if (eq k seg) (progn (setq p22 (mapcar '+ p20 v2c)) (setq p23 p20)) (progn (setq p22 (mapcar '+ p21 v2c)) (setq p23 (mapcar '+ p20 v2c)))) (if (eq k 1) (setq p2n p22 p23 p20) (setq p23 (mapcar '+ p20 v2c))) ) ) (setq 3df (list p20 p21 p22 p23)) (setq 3dfaces (cons 3df 3dfaces)) (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (if (eq seg 1) (setq p32 ce p33 p32) (progn (setq v3c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p3 p4))))) (if (eq k seg) (progn (setq p32 (mapcar '+ p30 v3c)) (setq p33 p30)) (progn (setq p32 (mapcar '+ p31 v3c)) (setq p33 (mapcar '+ p30 v3c)))) (if (eq k 1) (setq p3n p32 p33 p30) (setq p33 (mapcar '+ p30 v3c))) ) ) (setq 3df (list p30 p31 p32 p33)) (setq 3dfaces (cons 3df 3dfaces)) (setq p40 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (setq p41 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (if (eq seg 1) (setq p42 ce p43 p42) (progn (setq v4c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p4 p5))))) (if (eq k seg) (progn (setq p42 (mapcar '+ p40 v4c)) (setq p43 p40)) (progn (setq p42 (mapcar '+ p41 v4c)) (setq p43 (mapcar '+ p40 v4c)))) (if (eq k 1) (setq p4n p42 p43 p40) (setq p43 (mapcar '+ p40 v4c))) ) ) (setq 3df (list p40 p41 p42 p43)) (setq 3dfaces (cons 3df 3dfaces)) (setq p50 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (setq p51 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (if (eq seg 1) (setq p52 ce p53 p52) (progn (setq v5c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p5))))) (if (eq k seg) (progn (setq p52 (mapcar '+ p50 v5c)) (setq p53 p50)) (progn (setq p52 (mapcar '+ p51 v5c)) (setq p53 (mapcar '+ p50 v5c)))) (if (eq k 1) (setq p5n p52 p53 p50) (setq p53 (mapcar '+ p50 v5c))) ) ) (setq 3df (list p50 p51 p52 p53)) (setq 3dfaces (cons 3df 3dfaces)) ) (if (> seg 2) (faceseg5 p1n p2n p3n p4n p5n (- seg 2))) 3dfaces ) (defun cen5gon (p1 p2 p3 p4 p5) (mapcar '(lambda (p1 p2 p3 p4 p5) (/ (+ p1 p2 p3 p4 p5) 5.0)) p1 p2 p3 p4 p5) ) (defun tg (a) (/ (sin a) (cos a)) ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P P4 P4P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df) p4 (cadddr 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 p4p (mapcar '* (list rad rad rad) (mapcar '/ p4 (list (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4))))) (setq 3dfp (list p1p p2p p3p p4p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) ;; 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 mid (p1 p2) (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2) ) M.R. Quote
marko_ribar Posted May 1, 2012 Posted May 1, 2012 (edited) orientation 1 : main function : (defun c:geodesic-icosidodeca ( / ALLFACES DODECAF1 DODECAF10 DODECAF11 DODECAF12 DODECAF2 DODECAF3 DODECAF4 DODECAF5 DODECAF6 DODECAF7 DODECAF8 DODECAF9 ICOSAF1 ICOSAF10 ICOSAF11 ICOSAF12 ICOSAF13 ICOSAF14 ICOSAF15 ICOSAF16 ICOSAF17 ICOSAF18 ICOSAF19 ICOSAF2 ICOSAF20 ICOSAF3 ICOSAF4 ICOSAF5 ICOSAF6 ICOSAF7 ICOSAF8 ICOSAF9 M PT PTICOSALST PTICOSIDODECALST PTICOSIDODECALSTN R RAD SEG TAO) (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0)) (setq pticosalst (list (list 1.0 tao 0.0) (list -1.0 tao 0.0) (list 1.0 (- tao) 0.0) (list -1.0 (- tao) 0.0) (list 0.0 1.0 tao) (list 0.0 -1.0 tao) (list 0.0 1.0 (- tao)) (list 0.0 -1.0 (- tao)) (list tao 0.0 1.0) (list (- tao) 0.0 1.0) (list tao 0.0 -1.0) (list (- tao) 0.0 -1.0) ) ) (setq pticosidodecalst (list (mid (nth 0 pticosalst) (nth 1 pticosalst)) (mid (nth 0 pticosalst) (nth 4 pticosalst)) (mid (nth 0 pticosalst) (nth 6 pticosalst)) (mid (nth 0 pticosalst) (nth 8 pticosalst)) (mid (nth 0 pticosalst) (nth 10 pticosalst)) (mid (nth 1 pticosalst) (nth 4 pticosalst)) (mid (nth 1 pticosalst) (nth 6 pticosalst)) (mid (nth 1 pticosalst) (nth 9 pticosalst)) (mid (nth 1 pticosalst) (nth 11 pticosalst)) (mid (nth 2 pticosalst) (nth 3 pticosalst)) (mid (nth 2 pticosalst) (nth 5 pticosalst)) (mid (nth 2 pticosalst) (nth 7 pticosalst)) (mid (nth 2 pticosalst) (nth 8 pticosalst)) (mid (nth 2 pticosalst) (nth 10 pticosalst)) (mid (nth 3 pticosalst) (nth 5 pticosalst)) (mid (nth 3 pticosalst) (nth 7 pticosalst)) (mid (nth 3 pticosalst) (nth 9 pticosalst)) (mid (nth 3 pticosalst) (nth 11 pticosalst)) (mid (nth 4 pticosalst) (nth 5 pticosalst)) (mid (nth 4 pticosalst) (nth 8 pticosalst)) (mid (nth 4 pticosalst) (nth 9 pticosalst)) (mid (nth 5 pticosalst) (nth 8 pticosalst)) (mid (nth 5 pticosalst) (nth 9 pticosalst)) (mid (nth 6 pticosalst) (nth 7 pticosalst)) (mid (nth 6 pticosalst) (nth 10 pticosalst)) (mid (nth 6 pticosalst) (nth 11 pticosalst)) (mid (nth 7 pticosalst) (nth 10 pticosalst)) (mid (nth 7 pticosalst) (nth 11 pticosalst)) (mid (nth 8 pticosalst) (nth 10 pticosalst)) (mid (nth 9 pticosalst) (nth 11 pticosalst)) ) ) (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 pticosidodecalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) pticosidodecalst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of icosidodecahedron : ")) (setq icosaf1 (projfaces2sph (faceseg3 (nth 0 pticosidodecalstn) (nth 1 pticosidodecalstn) (nth 5 pticosidodecalstn) seg) rad)) (setq icosaf2 (projfaces2sph (faceseg3 (nth 1 pticosidodecalstn) (nth 3 pticosidodecalstn) (nth 19 pticosidodecalstn) seg) rad)) (setq icosaf3 (projfaces2sph (faceseg3 (nth 19 pticosidodecalstn) (nth 21 pticosidodecalstn) (nth 18 pticosidodecalstn) seg) rad)) (setq icosaf4 (projfaces2sph (faceseg3 (nth 18 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 20 pticosidodecalstn) seg) rad)) (setq icosaf5 (projfaces2sph (faceseg3 (nth 20 pticosidodecalstn) (nth 5 pticosidodecalstn) (nth 7 pticosidodecalstn) seg) rad)) (setq icosaf6 (projfaces2sph (faceseg3 (nth 7 pticosidodecalstn) (nth 8 pticosidodecalstn) (nth 29 pticosidodecalstn) seg) rad)) (setq icosaf7 (projfaces2sph (faceseg3 (nth 29 pticosidodecalstn) (nth 16 pticosidodecalstn) (nth 17 pticosidodecalstn) seg) rad)) (setq icosaf8 (projfaces2sph (faceseg3 (nth 16 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 14 pticosidodecalstn) seg) rad)) (setq icosaf9 (projfaces2sph (faceseg3 (nth 14 pticosidodecalstn) (nth 9 pticosidodecalstn) (nth 10 pticosidodecalstn) seg) rad)) (setq icosaf10 (projfaces2sph (faceseg3 (nth 10 pticosidodecalstn) (nth 12 pticosidodecalstn) (nth 21 pticosidodecalstn) seg) rad)) (setq icosaf11 (projfaces2sph (faceseg3 (nth 12 pticosidodecalstn) (nth 13 pticosidodecalstn) (nth 28 pticosidodecalstn) seg) rad)) (setq icosaf12 (projfaces2sph (faceseg3 (nth 28 pticosidodecalstn) (nth 3 pticosidodecalstn) (nth 4 pticosidodecalstn) seg) rad)) (setq icosaf13 (projfaces2sph (faceseg3 (nth 4 pticosidodecalstn) (nth 2 pticosidodecalstn) (nth 24 pticosidodecalstn) seg) rad)) (setq icosaf14 (projfaces2sph (faceseg3 (nth 2 pticosidodecalstn) (nth 0 pticosidodecalstn) (nth 6 pticosidodecalstn) seg) rad)) (setq icosaf15 (projfaces2sph (faceseg3 (nth 6 pticosidodecalstn) (nth 8 pticosidodecalstn) (nth 25 pticosidodecalstn) seg) rad)) (setq icosaf16 (projfaces2sph (faceseg3 (nth 25 pticosidodecalstn) (nth 27 pticosidodecalstn) (nth 23 pticosidodecalstn) seg) rad)) (setq icosaf17 (projfaces2sph (faceseg3 (nth 27 pticosidodecalstn) (nth 17 pticosidodecalstn) (nth 15 pticosidodecalstn) seg) rad)) (setq icosaf18 (projfaces2sph (faceseg3 (nth 15 pticosidodecalstn) (nth 9 pticosidodecalstn) (nth 11 pticosidodecalstn) seg) rad)) (setq icosaf19 (projfaces2sph (faceseg3 (nth 11 pticosidodecalstn) (nth 13 pticosidodecalstn) (nth 26 pticosidodecalstn) seg) rad)) (setq icosaf20 (projfaces2sph (faceseg3 (nth 26 pticosidodecalstn) (nth 23 pticosidodecalstn) (nth 24 pticosidodecalstn) seg) rad)) (setq dodecaf1 (projfaces2sph (faceseg5 (nth 0 pticosidodecalstn) (nth 1 pticosidodecalstn) (nth 3 pticosidodecalstn) (nth 4 pticosidodecalstn) (nth 2 pticosidodecalstn) seg) rad)) (setq dodecaf2 (projfaces2sph (faceseg5 (nth 2 pticosidodecalstn) (nth 6 pticosidodecalstn) (nth 25 pticosidodecalstn) (nth 23 pticosidodecalstn) (nth 24 pticosidodecalstn) seg) rad)) (setq dodecaf3 (projfaces2sph (faceseg5 (nth 11 pticosidodecalstn) (nth 15 pticosidodecalstn) (nth 27 pticosidodecalstn) (nth 23 pticosidodecalstn) (nth 26 pticosidodecalstn) seg) rad)) (setq dodecaf4 (projfaces2sph (faceseg5 (nth 8 pticosidodecalstn) (nth 29 pticosidodecalstn) (nth 17 pticosidodecalstn) (nth 27 pticosidodecalstn) (nth 25 pticosidodecalstn) seg) rad)) (setq dodecaf5 (projfaces2sph (faceseg5 (nth 0 pticosidodecalstn) (nth 5 pticosidodecalstn) (nth 7 pticosidodecalstn) (nth 8 pticosidodecalstn) (nth 6 pticosidodecalstn) seg) rad)) (setq dodecaf6 (projfaces2sph (faceseg5 (nth 9 pticosidodecalstn) (nth 15 pticosidodecalstn) (nth 17 pticosidodecalstn) (nth 16 pticosidodecalstn) (nth 14 pticosidodecalstn) seg) rad)) (setq dodecaf7 (projfaces2sph (faceseg5 (nth 9 pticosidodecalstn) (nth 10 pticosidodecalstn) (nth 12 pticosidodecalstn) (nth 13 pticosidodecalstn) (nth 11 pticosidodecalstn) seg) rad)) (setq dodecaf8 (projfaces2sph (faceseg5 (nth 4 pticosidodecalstn) (nth 24 pticosidodecalstn) (nth 26 pticosidodecalstn) (nth 13 pticosidodecalstn) (nth 28 pticosidodecalstn) seg) rad)) (setq dodecaf9 (projfaces2sph (faceseg5 (nth 3 pticosidodecalstn) (nth 19 pticosidodecalstn) (nth 21 pticosidodecalstn) (nth 12 pticosidodecalstn) (nth 28 pticosidodecalstn) seg) rad)) (setq dodecaf10 (projfaces2sph (faceseg5 (nth 1 pticosidodecalstn) (nth 5 pticosidodecalstn) (nth 20 pticosidodecalstn) (nth 18 pticosidodecalstn) (nth 19 pticosidodecalstn) seg) rad)) (setq dodecaf11 (projfaces2sph (faceseg5 (nth 7 pticosidodecalstn) (nth 20 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 16 pticosidodecalstn) (nth 29 pticosidodecalstn) seg) rad)) (setq dodecaf12 (projfaces2sph (faceseg5 (nth 10 pticosidodecalstn) (nth 14 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 18 pticosidodecalstn) (nth 21 pticosidodecalstn) 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 dodecaf1 dodecaf2 dodecaf3 dodecaf4 dodecaf5 dodecaf6 dodecaf7 dodecaf8 dodecaf9 dodecaf10 dodecaf11 dodecaf12)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (cadddr face)))) ) (setq 3dfaces nil) (princ) ) M.R. Edited May 2, 2012 by marko_ribar Quote
marko_ribar Posted May 1, 2012 Posted May 1, 2012 orientation 2 : subfunctions : (defun faceseg3 (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 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 p12v)) (setq 3dfi (list p30o p31v p30v p30v)) (setq 3dfaces (cons 3dfv 3dfaces)) (setq 3dfaces (cons 3dfi 3dfaces)) ) ) 3dfaces ) (defun faceseg5 (p1 p2 p3 p4 p5 seg / 3DF CE D K P1N P10 P11 P12 P13 P2N P20 P21 P22 P23 P3N P30 P31 P32 P33 P4N P40 P41 P42 P43 P5N P50 P51 P52 P53 V1C V2C V3C V4C V5C) (setq d (/ (distance p1 p2) (float seg))) (setq ce (cen5gon p1 p2 p3 p4 p5)) (setq k 0) (repeat seg (setq p10 (mapcar '+ p1 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (setq p11 (mapcar '+ p1 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))) (if (eq seg 1) (setq p12 ce p13 p12) (progn (setq v1c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))))) (if (eq k seg) (progn (setq p12 (mapcar '+ p10 v1c)) (setq p13 p10)) (progn (setq p12 (mapcar '+ p11 v1c)) (setq p13 (mapcar '+ p10 v1c)))) (if (eq k 1) (setq p1n p12 p13 p10) (setq p13 (mapcar '+ p10 v1c))) ) ) (setq 3df (list p10 p11 p12 p13)) (setq 3dfaces (cons 3df 3dfaces)) (setq p20 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (setq p21 (mapcar '+ p2 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p3 p2) (list (distance p2 p3) (distance p2 p3) (distance p2 p3)))))) (if (eq seg 1) (setq p22 ce p23 p22) (progn (setq v2c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p2 p3))))) (if (eq k seg) (progn (setq p22 (mapcar '+ p20 v2c)) (setq p23 p20)) (progn (setq p22 (mapcar '+ p21 v2c)) (setq p23 (mapcar '+ p20 v2c)))) (if (eq k 1) (setq p2n p22 p23 p20) (setq p23 (mapcar '+ p20 v2c))) ) ) (setq 3df (list p20 p21 p22 p23)) (setq 3dfaces (cons 3df 3dfaces)) (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p4 p3) (list (distance p3 p4) (distance p3 p4) (distance p3 p4)))))) (if (eq seg 1) (setq p32 ce p33 p32) (progn (setq v3c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p3 p4))))) (if (eq k seg) (progn (setq p32 (mapcar '+ p30 v3c)) (setq p33 p30)) (progn (setq p32 (mapcar '+ p31 v3c)) (setq p33 (mapcar '+ p30 v3c)))) (if (eq k 1) (setq p3n p32 p33 p30) (setq p33 (mapcar '+ p30 v3c))) ) ) (setq 3df (list p30 p31 p32 p33)) (setq 3dfaces (cons 3df 3dfaces)) (setq p40 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (setq p41 (mapcar '+ p4 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p5 p4) (list (distance p4 p5) (distance p4 p5) (distance p4 p5)))))) (if (eq seg 1) (setq p42 ce p43 p42) (progn (setq v4c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p4 p5))))) (if (eq k seg) (progn (setq p42 (mapcar '+ p40 v4c)) (setq p43 p40)) (progn (setq p42 (mapcar '+ p41 v4c)) (setq p43 (mapcar '+ p40 v4c)))) (if (eq k 1) (setq p4n p42 p43 p40) (setq p43 (mapcar '+ p40 v4c))) ) ) (setq 3df (list p40 p41 p42 p43)) (setq 3dfaces (cons 3df 3dfaces)) (setq p50 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1- k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (setq p51 (mapcar '+ p5 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p5) (list (distance p5 p1) (distance p5 p1) (distance p5 p1)))))) (if (eq seg 1) (setq p52 ce p53 p52) (progn (setq v5c (mapcar '* (list (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0))) (/ d (tg (/ pi 5.0)))) (unit (mapcar '- ce (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p5))))) (if (eq k seg) (progn (setq p52 (mapcar '+ p50 v5c)) (setq p53 p50)) (progn (setq p52 (mapcar '+ p51 v5c)) (setq p53 (mapcar '+ p50 v5c)))) (if (eq k 1) (setq p5n p52 p53 p50) (setq p53 (mapcar '+ p50 v5c))) ) ) (setq 3df (list p50 p51 p52 p53)) (setq 3dfaces (cons 3df 3dfaces)) ) (if (> seg 2) (faceseg5 p1n p2n p3n p4n p5n (- seg 2))) 3dfaces ) (defun cen5gon (p1 p2 p3 p4 p5) (mapcar '(lambda (p1 p2 p3 p4 p5) (/ (+ p1 p2 p3 p4 p5) 5.0)) p1 p2 p3 p4 p5) ) (defun tg (a) (/ (sin a) (cos a)) ) (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P P4 P4P) (foreach 3df 3dfaces (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df) p4 (cadddr 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 p4p (mapcar '* (list rad rad rad) (mapcar '/ p4 (list (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4) (distance '(0.0 0.0 0.0) p4))))) (setq 3dfp (list p1p p2p p3p p4p)) (setq 3dfacesp (cons 3dfp 3dfacesp)) ) 3dfacesp ) ;; 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 mid (p1 p2) (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2) ) M.R. Quote
marko_ribar Posted May 1, 2012 Posted May 1, 2012 (edited) orientation 2 : main function : (defun c:geodesic-icosidodeca ( / ALLFACES DODECAF1 DODECAF10 DODECAF11 DODECAF12 DODECAF2 DODECAF3 DODECAF4 DODECAF5 DODECAF6 DODECAF7 DODECAF8 DODECAF9 ICOSAF1 ICOSAF10 ICOSAF11 ICOSAF12 ICOSAF13 ICOSAF14 ICOSAF15 ICOSAF16 ICOSAF17 ICOSAF18 ICOSAF19 ICOSAF2 ICOSAF20 ICOSAF3 ICOSAF4 ICOSAF5 ICOSAF6 ICOSAF7 ICOSAF8 ICOSAF9 M PT PTICOSALST PTICOSIDODECALST PTICOSIDODECALSTN R RAD SEG TAO) (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0)) (setq pticosalst (list (list 0.0 0.0 (sqrt (+ (expt tao 2) 1.0))) (list (* tao (+ (tg (/ pi 10.0)) (tg (/ pi 5.0)))) 0.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (* tao (tg (/ pi 10.0))) tao (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ (- 1.0) (tg (/ pi 5.0))) 1.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ (- 1.0) (tg (/ pi 5.0))) -1.0 (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (* tao (tg (/ pi 10.0))) (- tao) (/ tao (sqrt (+ (expt tao 2) 1.0)))) (list (/ 1.0 (tg (/ pi 5.0))) 1.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (tg (/ pi 10.0))) tao (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (+ (tg (/ pi 10.0)) (tg (/ pi 5.0)))) 0.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (* (- tao) (tg (/ pi 10.0))) (- tao) (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list (/ 1.0 (tg (/ pi 5.0))) -1.0 (/ (- tao) (sqrt (+ (expt tao 2) 1.0)))) (list 0.0 0.0 (- (sqrt (+ (expt tao 2) 1.0)))) ) ) (setq pticosidodecalst (list (mid (nth 0 pticosalst) (nth 1 pticosalst)) (mid (nth 0 pticosalst) (nth 2 pticosalst)) (mid (nth 0 pticosalst) (nth 3 pticosalst)) (mid (nth 0 pticosalst) (nth 4 pticosalst)) (mid (nth 0 pticosalst) (nth 5 pticosalst)) (mid (nth 1 pticosalst) (nth 2 pticosalst)) (mid (nth 2 pticosalst) (nth 3 pticosalst)) (mid (nth 3 pticosalst) (nth 4 pticosalst)) (mid (nth 4 pticosalst) (nth 5 pticosalst)) (mid (nth 5 pticosalst) (nth 1 pticosalst)) (mid (nth 1 pticosalst) (nth 6 pticosalst)) (mid (nth 2 pticosalst) (nth 6 pticosalst)) (mid (nth 2 pticosalst) (nth 7 pticosalst)) (mid (nth 3 pticosalst) (nth 7 pticosalst)) (mid (nth 3 pticosalst) (nth 8 pticosalst)) (mid (nth 4 pticosalst) (nth 8 pticosalst)) (mid (nth 4 pticosalst) (nth 9 pticosalst)) (mid (nth 5 pticosalst) (nth 9 pticosalst)) (mid (nth 5 pticosalst) (nth 10 pticosalst)) (mid (nth 1 pticosalst) (nth 10 pticosalst)) (mid (nth 10 pticosalst) (nth 6 pticosalst)) (mid (nth 6 pticosalst) (nth 7 pticosalst)) (mid (nth 7 pticosalst) (nth 8 pticosalst)) (mid (nth 8 pticosalst) (nth 9 pticosalst)) (mid (nth 9 pticosalst) (nth 10 pticosalst)) (mid (nth 10 pticosalst) (nth 11 pticosalst)) (mid (nth 6 pticosalst) (nth 11 pticosalst)) (mid (nth 7 pticosalst) (nth 11 pticosalst)) (mid (nth 8 pticosalst) (nth 11 pticosalst)) (mid (nth 9 pticosalst) (nth 11 pticosalst)) ) ) (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 pticosidodecalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) pticosidodecalst)) (initget 6) (setq seg (getint "\nInput number of face segmentation per edge of icosidodecahedron : ")) (setq icosaf1 (projfaces2sph (faceseg3 (nth 0 pticosidodecalstn) (nth 1 pticosidodecalstn) (nth 5 pticosidodecalstn) seg) rad)) (setq icosaf2 (projfaces2sph (faceseg3 (nth 1 pticosidodecalstn) (nth 2 pticosidodecalstn) (nth 6 pticosidodecalstn) seg) rad)) (setq icosaf3 (projfaces2sph (faceseg3 (nth 2 pticosidodecalstn) (nth 3 pticosidodecalstn) (nth 7 pticosidodecalstn) seg) rad)) (setq icosaf4 (projfaces2sph (faceseg3 (nth 3 pticosidodecalstn) (nth 4 pticosidodecalstn) (nth 8 pticosidodecalstn) seg) rad)) (setq icosaf5 (projfaces2sph (faceseg3 (nth 4 pticosidodecalstn) (nth 0 pticosidodecalstn) (nth 9 pticosidodecalstn) seg) rad)) (setq icosaf6 (projfaces2sph (faceseg3 (nth 5 pticosidodecalstn) (nth 10 pticosidodecalstn) (nth 11 pticosidodecalstn) seg) rad)) (setq icosaf7 (projfaces2sph (faceseg3 (nth 6 pticosidodecalstn) (nth 12 pticosidodecalstn) (nth 13 pticosidodecalstn) seg) rad)) (setq icosaf8 (projfaces2sph (faceseg3 (nth 7 pticosidodecalstn) (nth 14 pticosidodecalstn) (nth 15 pticosidodecalstn) seg) rad)) (setq icosaf9 (projfaces2sph (faceseg3 (nth 8 pticosidodecalstn) (nth 16 pticosidodecalstn) (nth 17 pticosidodecalstn) seg) rad)) (setq icosaf10 (projfaces2sph (faceseg3 (nth 9 pticosidodecalstn) (nth 18 pticosidodecalstn) (nth 19 pticosidodecalstn) seg) rad)) (setq icosaf11 (projfaces2sph (faceseg3 (nth 19 pticosidodecalstn) (nth 10 pticosidodecalstn) (nth 20 pticosidodecalstn) seg) rad)) (setq icosaf12 (projfaces2sph (faceseg3 (nth 11 pticosidodecalstn) (nth 12 pticosidodecalstn) (nth 21 pticosidodecalstn) seg) rad)) (setq icosaf13 (projfaces2sph (faceseg3 (nth 13 pticosidodecalstn) (nth 14 pticosidodecalstn) (nth 22 pticosidodecalstn) seg) rad)) (setq icosaf14 (projfaces2sph (faceseg3 (nth 15 pticosidodecalstn) (nth 16 pticosidodecalstn) (nth 23 pticosidodecalstn) seg) rad)) (setq icosaf15 (projfaces2sph (faceseg3 (nth 17 pticosidodecalstn) (nth 18 pticosidodecalstn) (nth 24 pticosidodecalstn) seg) rad)) (setq icosaf16 (projfaces2sph (faceseg3 (nth 20 pticosidodecalstn) (nth 25 pticosidodecalstn) (nth 26 pticosidodecalstn) seg) rad)) (setq icosaf17 (projfaces2sph (faceseg3 (nth 21 pticosidodecalstn) (nth 26 pticosidodecalstn) (nth 27 pticosidodecalstn) seg) rad)) (setq icosaf18 (projfaces2sph (faceseg3 (nth 22 pticosidodecalstn) (nth 27 pticosidodecalstn) (nth 28 pticosidodecalstn) seg) rad)) (setq icosaf19 (projfaces2sph (faceseg3 (nth 23 pticosidodecalstn) (nth 28 pticosidodecalstn) (nth 29 pticosidodecalstn) seg) rad)) (setq icosaf20 (projfaces2sph (faceseg3 (nth 24 pticosidodecalstn) (nth 29 pticosidodecalstn) (nth 25 pticosidodecalstn) seg) rad)) (setq dodecaf1 (projfaces2sph (faceseg5 (nth 1 pticosidodecalstn) (nth 2 pticosidodecalstn) (nth 3 pticosidodecalstn) (nth 4 pticosidodecalstn) (nth 0 pticosidodecalstn) seg) rad)) (setq dodecaf2 (projfaces2sph (faceseg5 (nth 5 pticosidodecalstn) (nth 0 pticosidodecalstn) (nth 9 pticosidodecalstn) (nth 19 pticosidodecalstn) (nth 10 pticosidodecalstn) seg) rad)) (setq dodecaf3 (projfaces2sph (faceseg5 (nth 5 pticosidodecalstn) (nth 1 pticosidodecalstn) (nth 6 pticosidodecalstn) (nth 12 pticosidodecalstn) (nth 11 pticosidodecalstn) seg) rad)) (setq dodecaf4 (projfaces2sph (faceseg5 (nth 2 pticosidodecalstn) (nth 6 pticosidodecalstn) (nth 13 pticosidodecalstn) (nth 14 pticosidodecalstn) (nth 7 pticosidodecalstn) seg) rad)) (setq dodecaf5 (projfaces2sph (faceseg5 (nth 3 pticosidodecalstn) (nth 7 pticosidodecalstn) (nth 15 pticosidodecalstn) (nth 16 pticosidodecalstn) (nth 8 pticosidodecalstn) seg) rad)) (setq dodecaf6 (projfaces2sph (faceseg5 (nth 4 pticosidodecalstn) (nth 8 pticosidodecalstn) (nth 17 pticosidodecalstn) (nth 18 pticosidodecalstn) (nth 9 pticosidodecalstn) seg) rad)) (setq dodecaf7 (projfaces2sph (faceseg5 (nth 10 pticosidodecalstn) (nth 20 pticosidodecalstn) (nth 26 pticosidodecalstn) (nth 21 pticosidodecalstn) (nth 11 pticosidodecalstn) seg) rad)) (setq dodecaf8 (projfaces2sph (faceseg5 (nth 12 pticosidodecalstn) (nth 21 pticosidodecalstn) (nth 27 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 13 pticosidodecalstn) seg) rad)) (setq dodecaf9 (projfaces2sph (faceseg5 (nth 14 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 28 pticosidodecalstn) (nth 23 pticosidodecalstn) (nth 15 pticosidodecalstn) seg) rad)) (setq dodecaf10 (projfaces2sph (faceseg5 (nth 16 pticosidodecalstn) (nth 17 pticosidodecalstn) (nth 24 pticosidodecalstn) (nth 29 pticosidodecalstn) (nth 23 pticosidodecalstn) seg) rad)) (setq dodecaf11 (projfaces2sph (faceseg5 (nth 18 pticosidodecalstn) (nth 19 pticosidodecalstn) (nth 20 pticosidodecalstn) (nth 25 pticosidodecalstn) (nth 24 pticosidodecalstn) seg) rad)) (setq dodecaf12 (projfaces2sph (faceseg5 (nth 25 pticosidodecalstn) (nth 26 pticosidodecalstn) (nth 27 pticosidodecalstn) (nth 28 pticosidodecalstn) (nth 29 pticosidodecalstn) 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 dodecaf1 dodecaf2 dodecaf3 dodecaf4 dodecaf5 dodecaf6 dodecaf7 dodecaf8 dodecaf9 dodecaf10 dodecaf11 dodecaf12)) (foreach face allfaces (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (cadddr face)))) ) (setq 3dfaces nil) (princ) ) M.R. Edited May 2, 2012 by marko_ribar Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.