(setq s3 (sqrt 3.0)) (defun c:KOCHPYRAMID () (setq t1 '(0 0 0) t2 '(1 0 0) t3 (list 0.5 (/ s3 2.0) 0) t4 (list 0.5 (/ 1.0 (* 2 s3)) (/ s3 2.0)) ) (command "3dface" t1 t3 t2 "" "") (command "3dface" t1 t2 t4 "" "") (command "3dface" t1 t4 t3 "" "") (command "3dface" t2 t3 t4 "" "") (setq number 4) (newthing t1 t3 t2 number (/ s3 2.0)) (newthing t1 t2 t4 number (/ s3 2.0)) (newthing t3 t1 t4 number (/ s3 2.0)) (newthing t3 t4 t2 number (/ s3 2.0)) ) (defun newthing (p1 p2 p3 n height / p4 p4proj) ;going to try to use cross product and calculate new p4 instead of using UCS ;note that p4proj is the average of p1 p2 & p3 (cond ((< n 0) nil)(t (setq sum (mapcar '+ p1 p2 p3) p4proj (mapcar '/ sum '(3.0 3.0 3.0)) u (mapcar '- p2 p1) v (mapcar '- p3 p1) cp (crossprod u v) magnitude-of-cp (distance cp '(0 0 0)) unit-normal (mapcar '/ cp (list magnitude-of-cp magnitude-of-cp magnitude-of-cp)) height-vector (mapcar '* unit-normal (list height height height)) p4 (mapcar '+ p4proj height-vector) ) ;shrink it abount center of base [p4proj] (setq p1 (avpoint p1 p4proj) p2 (avpoint p2 p4proj) p3 (avpoint p3 p4proj) p4 (avpoint p4 p4proj)) ;draw faces (command "3dface" p2 p4 p3 "" "") (command "3dface" p1 p2 p4 "" "") (command "3dface" p1 p4 p3 "" "") ;here we will recur (newthing p1 p3 p2 (1- n) (/ height 2.0) ) (newthing p1 p2 p4 (1- n) (/ height 2.0) ) (newthing p3 p1 p4 (1- n) (/ height 2.0) ) (newthing p3 p4 p2 (1- n) (/ height 2.0) ) ))) ;;;;;;;;the functions below facillitate the finding of a normal direction to a plane (defun det (a d b c)(- (* a d)(* b c))) (defun crossprod (u v) (list (det (cadr u)(caddr v) (caddr u)(cadr v)) (- (det (car u)(caddr v) (caddr u)(car v))) (det (car u)(cadr v) (cadr u)(car v)) )) ;;;;;;;the function below returns the midpoint of its arguments. (defun avpoint (p q)(mapcar '/ (mapcar '+ p q) '(2.0 2.0 2.0)))