+ Reply to Thread
Page 2 of 4 FirstFirst 1 2 3 4 LastLast
Results 11 to 20 of 33

Thread: geodesic dome

  1. #11
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    Registered forum members do not see this ad.

    Here are geodesic-octa.lsp and geodesic-tetra.lsp orientated like in MAX...

    Octa :
    Code:
    (defun faceseg (p1 p2 p3 seg / 3DF 3DFACES 3DFI 3DFV D K N P12 P12V P30 P30V P30O P31 P31V V12)
      (setq d (/ (distance p1 p2) (float seg)))
      (setq k 0)
      (setq v12 (mapcar '* (list d d d) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))
      (repeat seg
        (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p12 (mapcar '+ p31 v12))
        (setq 3df (list p30 p31 p12))
        (setq 3dfaces (cons 3df 3dfaces))
        (setq n 0)
        (repeat (- k 1)
          (setq p30v (mapcar '+ p30 (mapcar '* (list (setq n (1+ n)) n n) v12)))
          (setq p31v (mapcar '+ p31 (mapcar '* (list n n n) v12)))
          (setq p12v (mapcar '+ p12 (mapcar '* (list n n n) v12)))
          (setq p30o (mapcar '+ p30 (mapcar '* (list (- n 1) (- n 1) (- n 1)) v12)))
          (setq 3dfv (list p30v p31v p12v))
          (setq 3dfi (list p30o p31v p30v))
          (setq 3dfaces (cons 3dfv 3dfaces))
          (setq 3dfaces (cons 3dfi 3dfaces))
        )
      )
      3dfaces
    )
    (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P)
      (foreach 3df 3dfaces
        (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df))
        (setq p1p (mapcar '* (list rad rad rad) (mapcar '/ p1 (list (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1)))))
        (setq p2p (mapcar '* (list rad rad rad) (mapcar '/ p2 (list (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2)))))
        (setq p3p (mapcar '* (list rad rad rad) (mapcar '/ p3 (list (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3)))))
        (setq 3dfp (list p1p p2p p3p))
        (setq 3dfacesp (cons 3dfp 3dfacesp))
      )
      3dfacesp
    )
    (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 :
    Code:
    (defun faceseg (p1 p2 p3 seg / 3DF 3DFACES 3DFI 3DFV D K N P12 P12V P30 P30V P30O P31 P31V V12)
      (setq d (/ (distance p1 p2) (float seg)))
      (setq k 0)
      (setq v12 (mapcar '* (list d d d) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))
      (repeat seg
        (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p12 (mapcar '+ p31 v12))
        (setq 3df (list p30 p31 p12))
        (setq 3dfaces (cons 3df 3dfaces))
        (setq n 0)
        (repeat (- k 1)
          (setq p30v (mapcar '+ p30 (mapcar '* (list (setq n (1+ n)) n n) v12)))
          (setq p31v (mapcar '+ p31 (mapcar '* (list n n n) v12)))
          (setq p12v (mapcar '+ p12 (mapcar '* (list n n n) v12)))
          (setq p30o (mapcar '+ p30 (mapcar '* (list (- n 1) (- n 1) (- n 1)) v12)))
          (setq 3dfv (list p30v p31v p12v))
          (setq 3dfi (list p30o p31v p30v))
          (setq 3dfaces (cons 3dfv 3dfaces))
          (setq 3dfaces (cons 3dfi 3dfaces))
        )
      )
      3dfaces
    )
    (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P)
      (foreach 3df 3dfaces
        (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df))
        (setq p1p (mapcar '* (list rad rad rad) (mapcar '/ p1 (list (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1)))))
        (setq p2p (mapcar '* (list rad rad rad) (mapcar '/ p2 (list (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2)))))
        (setq p3p (mapcar '* (list rad rad rad) (mapcar '/ p3 (list (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3)))))
        (setq 3dfp (list p1p p2p p3p))
        (setq 3dfacesp (cons 3dfp 3dfacesp))
      )
      3dfacesp
    )
    (defun c:geodesic-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.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  2. #12
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    More orientations of base primitive - now just for icosahedron and octahedron...

    Icosa :
    Code:
    (defun faceseg (p1 p2 p3 seg / 3DF 3DFACES 3DFI 3DFV D K N P12 P12V P30 P30V P30O P31 P31V V12)
      (setq d (/ (distance p1 p2) (float seg)))
      (setq k 0)
      (setq v12 (mapcar '* (list d d d) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))
      (repeat seg
        (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p12 (mapcar '+ p31 v12))
        (setq 3df (list p30 p31 p12))
        (setq 3dfaces (cons 3df 3dfaces))
        (setq n 0)
        (repeat (- k 1)
          (setq p30v (mapcar '+ p30 (mapcar '* (list (setq n (1+ n)) n n) v12)))
          (setq p31v (mapcar '+ p31 (mapcar '* (list n n n) v12)))
          (setq p12v (mapcar '+ p12 (mapcar '* (list n n n) v12)))
          (setq p30o (mapcar '+ p30 (mapcar '* (list (- n 1) (- n 1) (- n 1)) v12)))
          (setq 3dfv (list p30v p31v p12v))
          (setq 3dfi (list p30o p31v p30v))
          (setq 3dfaces (cons 3dfv 3dfaces))
          (setq 3dfaces (cons 3dfi 3dfaces))
        )
      )
      3dfaces
    )
    
    (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P)
      (foreach 3df 3dfaces
        (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df))
        (setq p1p (mapcar '* (list rad rad rad) (mapcar '/ p1 (list (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1)))))
        (setq p2p (mapcar '* (list rad rad rad) (mapcar '/ p2 (list (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2)))))
        (setq p3p (mapcar '* (list rad rad rad) (mapcar '/ p3 (list (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3)))))
        (setq 3dfp (list p1p p2p p3p))
        (setq 3dfacesp (cons 3dfp 3dfacesp))
      )
      3dfacesp
    )
    
    ;; Vector Cross Product - Lee Mac
    ;; Args: u,v - vectors in R^3
    
    (defun v^v ( u v )
      (list
        (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
        (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
      )
    )
    
    ;; Unit Vector - Lee Mac
    ;; Args: v - vector in R^n
    
    (defun unit ( v )
      ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
    )
    
    ;; Vector x Scalar - Lee Mac
    ;; Args: v - vector in R^n, s - real scalar
    
    (defun vxs ( v s )
      (mapcar '(lambda ( n ) (* n s)) v)
    )
    
    ;; Vector Norm - Lee Mac
    ;; Args: v - vector in R^n
    
    (defun norm ( v )
      (sqrt (apply '+ (mapcar '* v v)))
    )
    
    (defun prptp ( pt1 pt2 pt3 pt / pt1w pt2w pt3w ptw u v n ptn pt1n pt4n )
      (if (and pt1 pt2 pt3 pt)
          (progn
            (setq pt1w (trans pt1 1 0)
                  pt2w (trans pt2 1 0)
                  pt3w (trans pt3 1 0)
                  ptw  (trans pt 1 0)
            )
            (setq u (mapcar '- pt2w pt1w))
            (setq v (mapcar '- pt3w pt1w))
            (setq n (unit (V^V u v)))
            (setq ptn (trans ptw 0 n))
            (setq pt1n (trans pt1w 0 n))
            (setq pt4n (list (car ptn) (cadr ptn) (caddr pt1n)))
          )
      )
      (trans pt4n n 0)
    )
    
    (defun c:geodesic-icosa ( / PP1 PP2 PP3 PP4 PP5 PP6 PP7 PP8 PP9 PP10 PP11 PP12 ALLFACES ICOSAF1 ICOSAF10 ICOSAF11 ICOSAF12 ICOSAF13 ICOSAF14 ICOSAF15 ICOSAF16 ICOSAF17 ICOSAF18 ICOSAF19 ICOSAF2 ICOSAF20 ICOSAF3 ICOSAF4 ICOSAF5 ICOSAF6 ICOSAF7 ICOSAF8 ICOSAF9 M PT PTICOSALST PTICOSALSTN R RAD SEG TAO TAO3)
      (setq tao (/ (+ (sqrt 5.0) 1.0) 2.0))
      (setq tao3 (sqrt 3.0))
      (setq pticosalst (list 
                         (setq pp1 (list 0.0 (/ (* tao3 2.0) 3.0) (sqrt (- (expt tao 2) (/ 1.0 3.0))))) 
                         (setq pp2 (list -1.0 (/ (- tao3) 3.0) (sqrt (- (expt tao 2) (/ 1.0 3.0))))) 
                         (setq pp3 (list 1.0 (/ (- tao3) 3.0) (sqrt (- (expt tao 2) (/ 1.0 3.0))))) 
                         (setq pp4 (list 0.0 (/ (* tao3 2.0) -3.0) (- (sqrt (- (expt tao 2) (/ 1.0 3.0)))))) 
                         (setq pp5 (list 1.0 (/ tao3 3.0) (- (sqrt (- (expt tao 2) (/ 1.0 3.0)))))) 
                         (setq pp6 (list -1.0 (/ tao3 3.0) (- (sqrt (- (expt tao 2) (/ 1.0 3.0))))))
                         (setq pp7 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp1 pp2 pp6 '(0.0 0.0 0.0))))
                         (setq pp8 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp2 pp6 pp4 '(0.0 0.0 0.0))))
                         (setq pp9 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp2 pp4 pp3 '(0.0 0.0 0.0))))
                         (setq pp10 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp3 pp4 pp5 '(0.0 0.0 0.0))))
                         (setq pp11 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp3 pp1 pp5 '(0.0 0.0 0.0))))
                         (setq pp12 (mapcar '* (list (sqrt 5.0) (sqrt 5.0) (sqrt 5.0)) (prptp pp1 pp5 pp6 '(0.0 0.0 0.0))))
                       )
      )
      (setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : "))
      (setq r (distance '(0.0 0.0 0.0) (car pticosalst)))
      (setq m (/ rad r))
      (setq pticosalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) pticosalst))
      (initget 6)
      (setq seg (getint "\nInput number of face segmentation per edge of icosahedron : "))
      (setq icosaf1 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 1 pticosalstn) (nth 2 pticosalstn) seg) rad))
      (setq icosaf2 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 11 pticosalstn) (nth 6 pticosalstn) seg) rad))
      (setq icosaf3 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 1 pticosalstn) (nth 6 pticosalstn) seg) rad))
      (setq icosaf4 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 6 pticosalstn) (nth 7 pticosalstn) seg) rad))
      (setq icosaf5 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 7 pticosalstn) (nth 8 pticosalstn) seg) rad))
      (setq icosaf6 (projfaces2sph (faceseg (nth 1 pticosalstn) (nth 2 pticosalstn) (nth 8 pticosalstn) seg) rad))
      (setq icosaf7 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 8 pticosalstn) (nth 9 pticosalstn) seg) rad))
      (setq icosaf8 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 9 pticosalstn) (nth 10 pticosalstn) seg) rad))
      (setq icosaf9 (projfaces2sph (faceseg (nth 2 pticosalstn) (nth 10 pticosalstn) (nth 0 pticosalstn) seg) rad))
      (setq icosaf10 (projfaces2sph (faceseg (nth 0 pticosalstn) (nth 10 pticosalstn) (nth 11 pticosalstn) seg) rad))
      (setq icosaf11 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 4 pticosalstn) (nth 5 pticosalstn) seg) rad))
      (setq icosaf12 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 7 pticosalstn) (nth 8 pticosalstn) seg) rad))
      (setq icosaf13 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 8 pticosalstn) (nth 9 pticosalstn) seg) rad))
      (setq icosaf14 (projfaces2sph (faceseg (nth 3 pticosalstn) (nth 4 pticosalstn) (nth 9 pticosalstn) seg) rad))
      (setq icosaf15 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 9 pticosalstn) (nth 10 pticosalstn) seg) rad))
      (setq icosaf16 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 10 pticosalstn) (nth 11 pticosalstn) seg) rad))
      (setq icosaf17 (projfaces2sph (faceseg (nth 4 pticosalstn) (nth 5 pticosalstn) (nth 11 pticosalstn) seg) rad))
      (setq icosaf18 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 11 pticosalstn) (nth 6 pticosalstn) seg) rad))
      (setq icosaf19 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 6 pticosalstn) (nth 7 pticosalstn) seg) rad))
      (setq icosaf20 (projfaces2sph (faceseg (nth 5 pticosalstn) (nth 7 pticosalstn) (nth 3 pticosalstn) seg) rad))
      (setq allfaces (append icosaf1 icosaf2 icosaf3 icosaf4 icosaf5 icosaf6 icosaf7 icosaf8 icosaf9 icosaf10 icosaf11 icosaf12 icosaf13 icosaf14 icosaf15 icosaf16 icosaf17 icosaf18 icosaf19 icosaf20))
      (foreach face allfaces
        (entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (caddr face))))
      )
      (princ)
    )
    Octa :
    Code:
    (defun faceseg (p1 p2 p3 seg / 3DF 3DFACES 3DFI 3DFV D K N P12 P12V P30 P30V P30O P31 P31V V12)
      (setq d (/ (distance p1 p2) (float seg)))
      (setq k 0)
      (setq v12 (mapcar '* (list d d d) (mapcar '/ (mapcar '- p2 p1) (list (distance p1 p2) (distance p1 p2) (distance p1 p2)))))
      (repeat seg
        (setq p30 (mapcar '+ p3 (mapcar '* (list (* d (float k)) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p31 (mapcar '+ p3 (mapcar '* (list (* d (float (setq k (1+ k)))) (* d (float k)) (* d (float k))) (mapcar '/ (mapcar '- p1 p3) (list (distance p1 p3) (distance p1 p3) (distance p1 p3))))))
        (setq p12 (mapcar '+ p31 v12))
        (setq 3df (list p30 p31 p12))
        (setq 3dfaces (cons 3df 3dfaces))
        (setq n 0)
        (repeat (- k 1)
          (setq p30v (mapcar '+ p30 (mapcar '* (list (setq n (1+ n)) n n) v12)))
          (setq p31v (mapcar '+ p31 (mapcar '* (list n n n) v12)))
          (setq p12v (mapcar '+ p12 (mapcar '* (list n n n) v12)))
          (setq p30o (mapcar '+ p30 (mapcar '* (list (- n 1) (- n 1) (- n 1)) v12)))
          (setq 3dfv (list p30v p31v p12v))
          (setq 3dfi (list p30o p31v p30v))
          (setq 3dfaces (cons 3dfv 3dfaces))
          (setq 3dfaces (cons 3dfi 3dfaces))
        )
      )
      3dfaces
    )
    
    (defun projfaces2sph (3dfaces rad / 3DFACESP 3DFP P1 P1P P2 P2P P3 P3P)
      (foreach 3df 3dfaces
        (setq p1 (car 3df) p2 (cadr 3df) p3 (caddr 3df))
        (setq p1p (mapcar '* (list rad rad rad) (mapcar '/ p1 (list (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1) (distance '(0.0 0.0 0.0) p1)))))
        (setq p2p (mapcar '* (list rad rad rad) (mapcar '/ p2 (list (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2) (distance '(0.0 0.0 0.0) p2)))))
        (setq p3p (mapcar '* (list rad rad rad) (mapcar '/ p3 (list (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3) (distance '(0.0 0.0 0.0) p3)))))
        (setq 3dfp (list p1p p2p p3p))
        (setq 3dfacesp (cons 3dfp 3dfacesp))
      )
      3dfacesp
    )
    
    (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.

    EDIT : My mistake - corrected - CAD is OK...
    Last edited by marko_ribar; 28th Apr 2012 at 06:47 pm.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  3. #13
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    And here is geodesic-cube.lsp...
    Warning : 3dfaces are 4 non-coplanar points, except for segmentation 1 witch is actually cube...

    Code:
    (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.)

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  4. #14
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    And here is geodesic-dodeca.lsp

    orientation 1 :

    Code:
    (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.
    Last edited by marko_ribar; 1st May 2012 at 06:28 am.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  5. #15
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    orientation 2 :

    Code:
    (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.
    Last edited by marko_ribar; 1st May 2012 at 06:29 am.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  6. #16
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    orientation 3 :

    Code:
    (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...
    Last edited by marko_ribar; 1st May 2012 at 06:29 am.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  7. #17
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    I just couldn't resist to do it and for soccer ball (icosidodecahedron)... So geodesic-icosidodeca.lsp is finished

    orientation 1 :

    subfunctions :
    Code:
    (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.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  8. #18
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    orientation 1 :

    main function :
    Code:
    (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.
    Last edited by marko_ribar; 2nd May 2012 at 06:34 am.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  9. #19
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    orientation 2 :

    subfunctions :
    Code:
    (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.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  10. #20
    Senior Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2012
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    338

    Default

    Registered forum members do not see this ad.

    orientation 2 :

    main function :
    Code:
    (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.
    Last edited by marko_ribar; 2nd May 2012 at 06:34 am.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

Similar Threads

  1. How to build 4v geodesic dome in autocad 2012?
    By kingviser in forum AutoCAD 3D Modelling & Rendering
    Replies: 12
    Last Post: 31st Aug 2012, 06:58 pm
  2. easy way to make a geodesic dome
    By 64lesabre in forum AutoCAD 3D Modelling & Rendering
    Replies: 6
    Last Post: 10th Aug 2012, 11:38 am
  3. Need Help With Geodesic Dome
    By brian nguyen in forum AutoCAD 3D Modelling & Rendering
    Replies: 8
    Last Post: 21st May 2010, 06:28 pm
  4. geodesic dome
    By sagaro in forum AutoLISP, Visual LISP & DCL
    Replies: 2
    Last Post: 26th Jan 2010, 07:16 am
  5. skylight detail for a geodesic dome
    By micks_27986 in forum AutoCAD 3D Modelling & Rendering
    Replies: 4
    Last Post: 10th Feb 2009, 03:07 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts