Jump to content

geodesic dome

zohayb

By zohayb
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

marko_ribar Veteran

marko_ribar

Posted
Posted

orientation 3 :

 

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
)
;; 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 mid (p1 p2)
 (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2)
)

 

M.R.

  • Replies 36
  • Created
  • Last Reply

Top Posters In This Topic

  • marko_ribar

    28

  • Bill Tillman

    2

  • zohayb

    2

  • CM Hew

    1

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

orientation 3 :

 

main function :

(defun c:geodesic-icosidodeca ( / PP1 PP2 PP3 PP4 PP5 PP6 PP7 PP8 PP9 PP10 PP11 PP12 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 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 pticosidodecalst (list
                          (mid (nth 0 pticosalst) (nth 1 pticosalst))
                          (mid (nth 1 pticosalst) (nth 2 pticosalst))
                          (mid (nth 2 pticosalst) (nth 0 pticosalst))
                          (mid (nth 0 pticosalst) (nth 6 pticosalst))
                          (mid (nth 1 pticosalst) (nth 6 pticosalst))
                          (mid (nth 1 pticosalst) (nth 7 pticosalst))
                          (mid (nth 1 pticosalst) (nth 8 pticosalst))
                          (mid (nth 2 pticosalst) (nth 8 pticosalst))
                          (mid (nth 2 pticosalst) (nth 9 pticosalst))
                          (mid (nth 2 pticosalst) (nth 10 pticosalst))
                          (mid (nth 0 pticosalst) (nth 10 pticosalst))
                          (mid (nth 0 pticosalst) (nth 11 pticosalst))
                          (mid (nth 11 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 11 pticosalst) (nth 5 pticosalst))
                          (mid (nth 6 pticosalst) (nth 5 pticosalst))
                          (mid (nth 5 pticosalst) (nth 7 pticosalst))
                          (mid (nth 7 pticosalst) (nth 3 pticosalst))
                          (mid (nth 3 pticosalst) (nth 8 pticosalst))
                          (mid (nth 9 pticosalst) (nth 3 pticosalst))
                          (mid (nth 4 pticosalst) (nth 9 pticosalst))
                          (mid (nth 10 pticosalst) (nth 4 pticosalst))
                          (mid (nth 4 pticosalst) (nth 11 pticosalst))
                          (mid (nth 4 pticosalst) (nth 5 pticosalst))
                          (mid (nth 5 pticosalst) (nth 3 pticosalst))
                          (mid (nth 3 pticosalst) (nth 4 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 2 pticosidodecalstn) seg) rad))
 (setq icosaf2 (projfaces2sph (faceseg3 (nth 0 pticosidodecalstn) (nth 3 pticosidodecalstn) (nth 4 pticosidodecalstn) seg) rad))
 (setq icosaf3 (projfaces2sph (faceseg3 (nth 1 pticosidodecalstn) (nth 6 pticosidodecalstn) (nth 7 pticosidodecalstn) seg) rad))
 (setq icosaf4 (projfaces2sph (faceseg3 (nth 2 pticosidodecalstn) (nth 9 pticosidodecalstn) (nth 10 pticosidodecalstn) seg) rad))
 (setq icosaf5 (projfaces2sph (faceseg3 (nth 10 pticosidodecalstn) (nth 11 pticosidodecalstn) (nth 17 pticosidodecalstn) seg) rad))
 (setq icosaf6 (projfaces2sph (faceseg3 (nth 3 pticosidodecalstn) (nth 11 pticosidodecalstn) (nth 12 pticosidodecalstn) seg) rad))
 (setq icosaf7 (projfaces2sph (faceseg3 (nth 4 pticosidodecalstn) (nth 5 pticosidodecalstn) (nth 13 pticosidodecalstn) seg) rad))
 (setq icosaf8 (projfaces2sph (faceseg3 (nth 5 pticosidodecalstn) (nth 6 pticosidodecalstn) (nth 14 pticosidodecalstn) seg) rad))
 (setq icosaf9 (projfaces2sph (faceseg3 (nth 7 pticosidodecalstn) (nth 8 pticosidodecalstn) (nth 15 pticosidodecalstn) seg) rad))
 (setq icosaf10 (projfaces2sph (faceseg3 (nth 8 pticosidodecalstn) (nth 9 pticosidodecalstn) (nth 16 pticosidodecalstn) seg) rad))
 (setq icosaf11 (projfaces2sph (faceseg3 (nth 12 pticosidodecalstn) (nth 18 pticosidodecalstn) (nth 19 pticosidodecalstn) seg) rad))
 (setq icosaf12 (projfaces2sph (faceseg3 (nth 13 pticosidodecalstn) (nth 19 pticosidodecalstn) (nth 20 pticosidodecalstn) seg) rad))
 (setq icosaf13 (projfaces2sph (faceseg3 (nth 14 pticosidodecalstn) (nth 21 pticosidodecalstn) (nth 22 pticosidodecalstn) seg) rad))
 (setq icosaf14 (projfaces2sph (faceseg3 (nth 15 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 23 pticosidodecalstn) seg) rad))
 (setq icosaf15 (projfaces2sph (faceseg3 (nth 16 pticosidodecalstn) (nth 24 pticosidodecalstn) (nth 25 pticosidodecalstn) seg) rad))
 (setq icosaf16 (projfaces2sph (faceseg3 (nth 17 pticosidodecalstn) (nth 25 pticosidodecalstn) (nth 26 pticosidodecalstn) seg) rad))
 (setq icosaf17 (projfaces2sph (faceseg3 (nth 18 pticosidodecalstn) (nth 26 pticosidodecalstn) (nth 27 pticosidodecalstn) seg) rad))
 (setq icosaf18 (projfaces2sph (faceseg3 (nth 20 pticosidodecalstn) (nth 21 pticosidodecalstn) (nth 28 pticosidodecalstn) seg) rad))
 (setq icosaf19 (projfaces2sph (faceseg3 (nth 23 pticosidodecalstn) (nth 24 pticosidodecalstn) (nth 29 pticosidodecalstn) seg) rad))
 (setq icosaf20 (projfaces2sph (faceseg3 (nth 27 pticosidodecalstn) (nth 28 pticosidodecalstn) (nth 29 pticosidodecalstn) seg) rad))
 (setq dodecaf1 (projfaces2sph (faceseg5 (nth 0 pticosidodecalstn) (nth 2 pticosidodecalstn) (nth 10 pticosidodecalstn) (nth 11 pticosidodecalstn) (nth 3 pticosidodecalstn) seg) rad))
 (setq dodecaf2 (projfaces2sph (faceseg5 (nth 0 pticosidodecalstn) (nth 1 pticosidodecalstn) (nth 6 pticosidodecalstn) (nth 5 pticosidodecalstn) (nth 4 pticosidodecalstn) seg) rad))
 (setq dodecaf3 (projfaces2sph (faceseg5 (nth 1 pticosidodecalstn) (nth 2 pticosidodecalstn) (nth 9 pticosidodecalstn) (nth 8 pticosidodecalstn) (nth 7 pticosidodecalstn) seg) rad))
 (setq dodecaf4 (projfaces2sph (faceseg5 (nth 21 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 23 pticosidodecalstn) (nth 29 pticosidodecalstn) (nth 28 pticosidodecalstn) seg) rad))
 (setq dodecaf5 (projfaces2sph (faceseg5 (nth 24 pticosidodecalstn) (nth 25 pticosidodecalstn) (nth 26 pticosidodecalstn) (nth 27 pticosidodecalstn) (nth 29 pticosidodecalstn) seg) rad))
 (setq dodecaf6 (projfaces2sph (faceseg5 (nth 18 pticosidodecalstn) (nth 19 pticosidodecalstn) (nth 20 pticosidodecalstn) (nth 28 pticosidodecalstn) (nth 27 pticosidodecalstn) seg) rad))
 (setq dodecaf7 (projfaces2sph (faceseg5 (nth 3 pticosidodecalstn) (nth 4 pticosidodecalstn) (nth 13 pticosidodecalstn) (nth 19 pticosidodecalstn) (nth 12 pticosidodecalstn) seg) rad))
 (setq dodecaf8 (projfaces2sph (faceseg5 (nth 13 pticosidodecalstn) (nth 5 pticosidodecalstn) (nth 14 pticosidodecalstn) (nth 21 pticosidodecalstn) (nth 20 pticosidodecalstn) seg) rad))
 (setq dodecaf9 (projfaces2sph (faceseg5 (nth 6 pticosidodecalstn) (nth 7 pticosidodecalstn) (nth 15 pticosidodecalstn) (nth 22 pticosidodecalstn) (nth 14 pticosidodecalstn) seg) rad))
 (setq dodecaf10 (projfaces2sph (faceseg5 (nth 15 pticosidodecalstn) (nth 8 pticosidodecalstn) (nth 16 pticosidodecalstn) (nth 24 pticosidodecalstn) (nth 23 pticosidodecalstn) seg) rad))
 (setq dodecaf11 (projfaces2sph (faceseg5 (nth 9 pticosidodecalstn) (nth 10 pticosidodecalstn) (nth 17 pticosidodecalstn) (nth 25 pticosidodecalstn) (nth 16 pticosidodecalstn) seg) rad))
 (setq dodecaf12 (projfaces2sph (faceseg5 (nth 11 pticosidodecalstn) (nth 12 pticosidodecalstn) (nth 18 pticosidodecalstn) (nth 26 pticosidodecalstn) (nth 17 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.

 

P.S. Hopefully this is last known platonic primitive based on interpolation of icosa or dodeca hedrons... Truncated icosa and dodeca hedrons are also with equal edges and points lie also on sphere, but their side polygons are more complex than triangle and 5 sided-polygon, so it isn't advicable to consider them in this process... And snub dodecahedron is very complicated even to draw like 3D SOLID as some vertexes can't be exactly computed with CAD... (look into my videos on youtube and you'll see how complex snub dodecahedron is so it's also skipped from this process)...

 

Regards, M.R.

:)

Edited by marko_ribar
marko_ribar Veteran

marko_ribar

Posted
Posted

Just attached *.jpg of icosidodecahedron geosphere dome for THE END...

 

M.R.

icosidodeca geosphere dome.jpg

marko_ribar Veteran

marko_ribar

Posted
Posted

It seems that I not intenderly skipped one... It's geodesic-cubeocta.lsp

 

(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 faceseg4 (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-cubeocta ( / ALLFACES CUBEF1 CUBEF2 CUBEF3 CUBEF4 CUBEF5 CUBEF6 OCTAF1 OCTAF2 OCTAF3 OCTAF4 OCTAF5 OCTAF6 OCTAF7 OCTAF8 M PT PTCUBEOCTALST PTCUBEOCTALSTN R RAD SEG)
 (setq ptcubeoctalst (list 
                       (list 1.0 0.0 1.0) (list 0.0 1.0 1.0) (list -1.0 0.0 1.0) (list 0.0 -1.0 1.0)
                       (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 1.0 0.0 -1.0) (list 0.0 1.0 -1.0) (list -1.0 0.0 -1.0) (list 0.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 ptcubeoctalst)))
 (setq m (/ rad r))
 (setq ptcubeoctalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) ptcubeoctalst))
 (initget 6)
 (setq seg (getint "\nInput number of face segmentation per edge of cubeoctahedron : "))
 (setq octaf1 (projfaces2sph (faceseg3 (nth 0 ptcubeoctalstn) (nth 1 ptcubeoctalstn) (nth 4 ptcubeoctalstn) seg) rad))
 (setq octaf2 (projfaces2sph (faceseg3 (nth 1 ptcubeoctalstn) (nth 2 ptcubeoctalstn) (nth 5 ptcubeoctalstn) seg) rad))
 (setq octaf3 (projfaces2sph (faceseg3 (nth 2 ptcubeoctalstn) (nth 3 ptcubeoctalstn) (nth 6 ptcubeoctalstn) seg) rad))
 (setq octaf4 (projfaces2sph (faceseg3 (nth 3 ptcubeoctalstn) (nth 0 ptcubeoctalstn) (nth 7 ptcubeoctalstn) seg) rad))
 (setq octaf5 (projfaces2sph (faceseg3 (nth 4 ptcubeoctalstn) (nth 8 ptcubeoctalstn) (nth 9 ptcubeoctalstn) seg) rad))
 (setq octaf6 (projfaces2sph (faceseg3 (nth 5 ptcubeoctalstn) (nth 9 ptcubeoctalstn) (nth 10 ptcubeoctalstn) seg) rad))
 (setq octaf7 (projfaces2sph (faceseg3 (nth 6 ptcubeoctalstn) (nth 10 ptcubeoctalstn) (nth 11 ptcubeoctalstn) seg) rad))
 (setq octaf8 (projfaces2sph (faceseg3 (nth 7 ptcubeoctalstn) (nth 11 ptcubeoctalstn) (nth 8 ptcubeoctalstn) seg) rad))
 (setq cubef1 (projfaces2sph (faceseg4 (nth 0 ptcubeoctalstn) (nth 1 ptcubeoctalstn) (nth 2 ptcubeoctalstn) (nth 3 ptcubeoctalstn) seg) rad))
 (setq cubef2 (projfaces2sph (faceseg4 (nth 0 ptcubeoctalstn) (nth 4 ptcubeoctalstn) (nth 8 ptcubeoctalstn) (nth 7 ptcubeoctalstn) seg) rad))
 (setq cubef3 (projfaces2sph (faceseg4 (nth 1 ptcubeoctalstn) (nth 4 ptcubeoctalstn) (nth 9 ptcubeoctalstn) (nth 5 ptcubeoctalstn) seg) rad))
 (setq cubef4 (projfaces2sph (faceseg4 (nth 2 ptcubeoctalstn) (nth 5 ptcubeoctalstn) (nth 10 ptcubeoctalstn) (nth 6 ptcubeoctalstn) seg) rad))
 (setq cubef5 (projfaces2sph (faceseg4 (nth 3 ptcubeoctalstn) (nth 6 ptcubeoctalstn) (nth 11 ptcubeoctalstn) (nth 7 ptcubeoctalstn) seg) rad))
 (setq cubef6 (projfaces2sph (faceseg4 (nth 8 ptcubeoctalstn) (nth 9 ptcubeoctalstn) (nth 10 ptcubeoctalstn) (nth 11 ptcubeoctalstn) seg) rad))
 (setq allfaces (append cubef1 cubef2 cubef3 cubef4 cubef5 cubef6 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 (cadddr face))))
 )
 (princ)
)

 

ENJOY.

M.R.

cubeocta geosphere.jpg

marko_ribar Veteran

marko_ribar

Posted
Posted

I'll try to attach pictures of all posted codes with segmentation 24...

 

Tschus, M.R.

ENJOY

 

PART 1 :

01-TETRA.jpg

02-TETRA.jpg

03-CUBE.jpg

04-CUBE.jpg

05-CUBEOCTA.jpg

06-CUBEOCTA.jpg

07-OCTA.jpg

08-OCTA.jpg

09-OCTA.jpg

10-ICOSA.jpg

11-ICOSA.jpg

12-ICOSA.jpg

marko_ribar Veteran

marko_ribar

Posted
Posted

Part 2 :

 

M.r.

Enjoy

13-DODECA.jpg

14-DODECA.jpg

15-DODECA.jpg

16-ICOSIDODECA.jpg

17-ICOSIDODECA.jpg

18-ICOSIDODECA.jpg

SLW210 Grand Master

SLW210

Posted
Posted

Neat!

 

I might give these a try when time allows. :thumbsup:

 

Thanks!!

  • 3 weeks later...
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

I was on vacation where in the meanwhile I've finished all main polyhedron variants with all orienatations, with their truncated references and with variants with all triangular faces... Included snub dodecahedron as well...

 

Sincerely, Marko Ribar, d.i.a. (architect)

ENJOY...

GEODESIC SPHERES.ZIP

Edited by marko_ribar
  • 4 weeks later...
marko_ribar Veteran

marko_ribar

Posted
Posted

Routines updated - removed duplicated faces (there were 3 downloads till now) - no need to overkill after execution...

 

Regards, M.R. (arch.)

marko_ribar Veteran

marko_ribar

Posted
Posted

However, I just realized that version I posted above may be too slow if segmentation is large, so still I decided to post faster version but with duplicated faces (no way you can get both fast and correct) - here you have to overkill duplicate faces if you want, for what I strongly recommend that you don't - you'll just loose time, though I didn't checked - maybe this method is faster than with using my above posted variant...

 

Regards, M.R. (arch.)

GEODESIC SPHERES - FASTER BUT DUPLICATE FACES.ZIP

marko_ribar Veteran

marko_ribar

Posted
Posted

Yes, I've checked it's faster to do overkill after execution, so recommended version is my latest faster...

 

M.R.

Bill Tillman Grand Master

Bill Tillman

Posted
Posted

Hey Marko_Ribar,

 

You've got some really cool stuff there. Long time back I started studying domes and what it takes to break one down mathematically. I understood most of it but confess that your knowledge on the subject dwarfs mine. I have one question. What is your background in domes, is it just a hobby like mine or do you work with them often?

 

A friend of mine in the DFW area used to live in a very large geodesic dome house out near one of the lakes in the region. It had three levels in it, four if you count the basement, and was very spacious. The original owner also built a 3 level outdoor deck around it which had more square footage than most people's houses. It was a real show place.

  • 4 years later...
MikeP Proficient

MikeP

Posted
Posted

So Im bringing back the dead here. I would like to understand these better. I just need a 2v geo dome. Which one do I use? I need a half sphere dome.

marko_ribar Veteran

marko_ribar

Posted
Posted

I am not sure what 2v geo dome is, but short code for dome with latitude and longitude segmentation is quite simple :

 

(defun c:3dfdome ( / make3df o r n m k z p1 p2 p3 p4 )

 (defun make3df ( p1 p2 p3 p4 )
   (entmake
     (list
       '(0 . "3DFACE")
       (cons 10 p1)
       (cons 11 p2)
       (cons 12 p3)
       (cons 13 p4)
     )
   )
 )

 (setq o (getpoint "\nPick or specify center of dome : "))
 (initget 7)
 (setq r (getdist o "\nPick or specify radius of dome : "))
 (initget 7)
 (setq n (getint "\nSpecify number of segments in plan view (must be greater than 2) : "))
 (while (< n 3)
   (prompt "\nSpecified number invalid... Number must be greater than 2 : ")
   (initget 7)
   (setq n (getint))
 )
 (initget 7)
 (setq m (getint "\nSpecify number of segments along half arc of elevation view : "))
 (setq k -1)
 (repeat n
   (setq k (1+ k))
   (setq z -1)
   (repeat m
     (setq z (1+ z))
     (setq p1 (polar (list (car o) (cadr o) (+ (caddr o) (* r (sin (* z (/ (* 0.5 pi) m)))))) (* k (/ (* 2 pi) n)) (* r (cos (* z (/ (* 0.5 pi) m))))))
     (setq p2 (polar (list (car o) (cadr o) (+ (caddr o) (* r (sin (* z (/ (* 0.5 pi) m)))))) (* (1+ k) (/ (* 2 pi) n)) (* r (cos (* z (/ (* 0.5 pi) m))))))
     (setq p3 (polar (list (car o) (cadr o) (+ (caddr o) (* r (sin (* (1+ z) (/ (* 0.5 pi) m)))))) (* (1+ k) (/ (* 2 pi) n)) (* r (cos (* (1+ z) (/ (* 0.5 pi) m))))))
     (setq p4 (polar (list (car o) (cadr o) (+ (caddr o) (* r (sin (* (1+ z) (/ (* 0.5 pi) m)))))) (* k (/ (* 2 pi) n)) (* r (cos (* (1+ z) (/ (* 0.5 pi) m))))))
     (make3df (trans p1 1 0) (trans p2 1 0) (trans p3 1 0) (trans p4 1 0))
   )
 )
 (princ)
)

HTH., M.R.

ReMark Grand Master

ReMark

Posted
Posted

There are different classes of geodesic domes. 2V just happens to be one of them. From a website called "byexample" comes this description:

 

"A 2V geodesic dome is comprised of only two different sized triangles and therefore has a relatively simple construction pattern. It has fewer over all triangles than the 3V and 4V geodesic domes."

 

And this:

 

"The more complex the network of triangles, the more spherical the geodesic dome and the higher the class number."

 

Unfortunately your dome lisp does not meet the requirements of a geodesic dome.

  • 4 years later...
Letocad Newbie

Letocad

Posted
Posted

Guys i just want to say thank you to all of you, great work with that code!

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...