geodesic dome

[marko_ribar]

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.

[marko_ribar]

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.

[marko_ribar]

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

M.R.

[marko_ribar]

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.

[marko_ribar]

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

Tschus, M.R.
ENJOY

PART 1 :

[marko_ribar]

Part 2 :

M.r.
Enjoy

[SLW210]

Neat!

I might give these a try when time allows.

Thanks!!

[marko_ribar]

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...

[marko_ribar]

And here are pictures of the same... Segmentation 16... Total 64 pictures...

http://dl.dropbox.com/u/71183043/GEO...20PICTURES.ZIP

Regards, M.R.

[marko_ribar]

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

Regards, M.R. (arch.)