Here are codes based on octahedron and tetrahedron...
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 -1.0 -1.0 0.0) (list 1.0 -1.0 0.0) (list 1.0 1.0 0.0) (list -1.0 1.0 0.0)
(list 0.0 0.0 tao) (list 0.0 0.0 (- tao))
)
)
(setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : "))
(setq r (distance '(0.0 0.0 0.0) (car ptoctalst)))
(setq m (/ rad r))
(setq ptoctalstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) ptoctalst))
(initget 6)
(setq seg (getint "\nInput number of face segmentation per edge of octahedron : "))
(setq octaf1 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 1 ptoctalstn) (nth 4 ptoctalstn) seg) rad))
(setq octaf2 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 2 ptoctalstn) (nth 4 ptoctalstn) seg) rad))
(setq octaf3 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 3 ptoctalstn) (nth 4 ptoctalstn) seg) rad))
(setq octaf4 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 3 ptoctalstn) (nth 4 ptoctalstn) seg) rad))
(setq octaf5 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 1 ptoctalstn) (nth 5 ptoctalstn) seg) rad))
(setq octaf6 (projfaces2sph (faceseg (nth 1 ptoctalstn) (nth 2 ptoctalstn) (nth 5 ptoctalstn) seg) rad))
(setq octaf7 (projfaces2sph (faceseg (nth 2 ptoctalstn) (nth 3 ptoctalstn) (nth 5 ptoctalstn) seg) rad))
(setq octaf8 (projfaces2sph (faceseg (nth 0 ptoctalstn) (nth 3 ptoctalstn) (nth 5 ptoctalstn) seg) rad))
(setq allfaces (append octaf1 octaf2 octaf3 octaf4 octaf5 octaf6 octaf7 octaf8))
(foreach face allfaces
(entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (caddr face))))
)
(princ)
)
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 ( / ALLFACES M PT PTTETRALST PTTETRALSTN R RAD SEG TETRAF1 TETRAF2 TETRAF3 TETRAF4)
(setq pttetralst (list
(list -1.0 -1.0 -1.0) (list 1.0 -1.0 1.0) (list 1.0 1.0 -1.0) (list -1.0 1.0 1.0)
)
)
(setq rad (getdist '(0.0 0.0 0.0) "\nPick radius : "))
(setq r (distance '(0.0 0.0 0.0) (car pttetralst)))
(setq m (/ rad r))
(setq pttetralstn (mapcar '(lambda (pt) (list (* m (car pt)) (* m (cadr pt)) (* m (caddr pt)))) pttetralst))
(initget 6)
(setq seg (getint "\nInput number of face segmentation per edge of tetrahedron : "))
(setq tetraf1 (projfaces2sph (faceseg (nth 0 pttetralstn) (nth 1 pttetralstn) (nth 2 pttetralstn) seg) rad))
(setq tetraf2 (projfaces2sph (faceseg (nth 1 pttetralstn) (nth 2 pttetralstn) (nth 3 pttetralstn) seg) rad))
(setq tetraf3 (projfaces2sph (faceseg (nth 2 pttetralstn) (nth 3 pttetralstn) (nth 0 pttetralstn) seg) rad))
(setq tetraf4 (projfaces2sph (faceseg (nth 3 pttetralstn) (nth 0 pttetralstn) (nth 1 pttetralstn) seg) rad))
(setq allfaces (append tetraf1 tetraf2 tetraf3 tetraf4))
(foreach face allfaces
(entmake (list (cons 0 "3DFACE")(cons 10 (car face))(cons 11 (cadr face))(cons 12 (caddr face))(cons 13 (caddr face))))
)
(princ)
)
Regards, Marko Ribar, d.i.a. (architect)
Bookmarks