;******************************************************************************************* ;* Dodeca-Spidroball, by Paul Nylander, bugman123.com, 7/29/10 ;******************************************************************************************* ;Converts Polygon into AutoCAD's Triangle Elements, only works for convex polygons ;(TriangulateElem '(1 2 3 4 5 6 7 8 9 10)) -> '((1 2 -3) (-1 3 -4) (-1 4 -5) (-1 5 -6) (-1 6 -7) (-1 7 -8) (-1 8 -9) (-1 9 10)) (defun TriangulateElem (elem / n i i0 i1 i2 elems) (setq n (length elem)) (if (= n 3) (list elem) (progn (setq i0 (car elem) i1 (caddr elem) elems (list (list i0 (cadr elem) (- i1))) i 3) (while (< i (1- n)) (setq i2 (nth i elem) elems (append elems (list (list (- i0) i1 (- i2)))) i1 i2 i (1+ i))) (append elems (list (list (- i0) i1 (last elem)))) ));i );d (defun mesh (nodes elems1 / elems2 nnode nelem elem) (setq elems2 (apply 'append (mapcar 'TriangulateElem elems1))); introduces AutoCAD's negative index notation (setq nnode (length nodes) nelem (length elems2)) (entmake (list '(0 . "POLYLINE") '(70 . 64) (cons 71 nnode) (cons 72 nelem))) (foreach p nodes (entmake (list '(0 . "VERTEX") (cons 10 p) '(70 . 192)))) (foreach elem elems2 (entmake (list '(0 . "VERTEX") '(10 0.0 0.0 0.0) '(70 . 128) (cons 71 (car elem)) (cons 72 (cadr elem)) (cons 73 (caddr elem)) (cons 74 (- (abs (car elem)))) )));f (entmake '((0 . "SEQEND"))) );d ;Basic Functions (defun ² (x) (* x x)) (defun tan (x) (/ (sin x) (cos x))) (defun acos (x) (cond ((= x 0) (/ pi 2)) ((<= -1 x 0) (- pi (atan (abs (/ (sqrt (- 1 (² x))) x))))) ((<= 0 x 1) (atan (sqrt (- 1 (² x))) x)) ));d (defun dot (p1 p2) (apply '+ (mapcar '* p1 p2))); dot product ;3×3 Matrix Functions (defun transpose (A) (apply 'mapcar (cons 'list A))) (defun add (x1 x2 / t1 t2) (setq t1 (listp x1) t2 (listp x2)) (cond ((and t1 t2) (mapcar '+ x1 x2)) (t1 (mapcar '(lambda (x) (+ x x2)) x1)) ));d (defun mult (x1 x2 / dim1 dim2 x y z) (setq dim1 (if (listp x1) (if (listp (car x1)) 2 1) 0)) (setq dim2 (if (listp x2) (if (listp (car x2)) 2 1) 0)) (cond ((= dim1 dim2 0) (* x1 x2)) ((and (= dim1 1) (= dim2 0)) (mapcar '(lambda (x) (* x x2)) x1)) ((and (= dim1 2) (= dim2 0)) (mapcar '(lambda (ai) (mapcar '(lambda (aij) (* aij x2)) ai)) x1)) ((and (= dim1 2) (= dim2 1)) (mapcar '(lambda (ai) (dot ai x2)) x1)) ((= dim1 dim2 2) (transpose (mapcar '(lambda (Bj) (mapcar '(lambda (Ai) (dot Ai Bj)) x1)) (transpose x2)))) );c );d (defun ApplyTranslation (p0 plist) (mapcar '(lambda (p) (add p0 p)) plist)) (defun ApplyMatrix (R plist) (mapcar '(lambda (p) (mult R p)) plist)) (defun Rx (theta / s c) (setq s (sin theta) c (cos theta)) (list '(1.0 0.0 0.0) (list 0.0 c (- s)) (list 0.0 s c))) (defun Ry (theta / s c) (setq s (sin theta) c (cos theta)) (list (list c 0.0 s) '(0.0 1.0 0.0) (list (- s) 0.0 c))) (defun Rz (theta / s c) (setq s (sin theta) c (cos theta)) (list (list c (- s) 0.0) (list s c 0.0) '(0.0 0.0 1.0))) (defun EulerRotationMatrix (phi theta psi) (mult (mult (Rz psi) (Ry theta)) (Rz phi))); uses Mathematica's RotateShape notation ;Calculations (setq nArm 5 n (* 2 nArm) alpha (acos (/ (sqrt 5) -5)); dihedral angle = 116.56505117707799° a (² (sin (/ pi n))) b (tan (/ alpha 2)) dz (/ (* a b) (sqrt (+ (* a (² b)) 1))) r (sqrt (- 1 (/ (² dz) a))) z0 (+ (* r b (cos (/ pi nArm))) dz) dtheta (acos (/ (+ 1 (* 2 (sqrt 3)) (/ 1 (- (/ (² dz) a) 1))) 4)); not sure if this is right scale (/ 2.0 3); not sure if this is right Rtrans (mult (Rz dtheta) scale) );s ;Calculate Spidron Mesh (setq depth 8 nodes nil i 0) (repeat n (setq theta (/ (* i pi) nArm)) (setq nodes (append nodes (list (list (* r (cos theta)) (* r (sin theta)) (* (- (* 2 (rem i 2)) 1) dz))))) (setq i (1+ i)) );r (setq i 0) (repeat depth (setq j 0) (repeat n (setq nodes (append nodes (list (mult Rtrans (nth (+ (* n i) j) nodes)))) j (1+ j))) (setq i (1+ i)) );r (setq elems nil i 0) (repeat depth (setq j 1) (repeat n (setq elems (append elems (list (add (list j (1+ (rem j n)) (+ j n)) (* i n)) (add (list (1+ j) (+ j n) (1+ (rem (+ j n) (* 2 n)))) (* i n)) )));s (setq j (1+ j)) );r (setq i (1+ i)) );r ;Create Dodeca-Spidroball (setq nodes (ApplyTranslation (list 0 0 z0) nodes)) (mesh (ApplyMatrix (EulerRotationMatrix 0 0 0) nodes) elems) (mesh (ApplyMatrix (EulerRotationMatrix 0 pi 0) nodes) elems) (setq theta 0.0) (repeat 5 (mesh (ApplyMatrix (EulerRotationMatrix (* 0.2 pi) alpha theta) nodes) elems) (mesh (ApplyMatrix (EulerRotationMatrix 0 (- pi alpha) (+ theta (* 0.2 pi))) nodes) elems) (setq theta (+ theta (* 0.4 pi))) );r