(setq s3 (sqrt 3.0) s2 (sqrt 2.0)) (defun c:siertet () (first) (setq firstpyr (entlast) restss (ssadd)) (rest1 5 t1 t2 t3 t4) (command "subtract" firstpyr "" restss "") ) (defun first () (command "box" '(0 0) "c" 1.0) ;(command "move" (entlast) "" '(0 0 0) '(0 0 -1));drop box dz=-1.0 (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)) (/ s2 s3)) tc (centroid4 t1 t2 t3 t4) ;(list 0.5 (/ 1.0 (* 2 s3)) (/ s2 s3 2.0));near centroid - NEED CENTROID - for tc ) (slicit t1 t2 t4 tc) (slicit t1 t3 t4 tc) (slicit t2 t3 t4 tc) ) (defun rest ()()) (defun rest1 (n t1 t2 t3 t4 / o1 o2 o3 o4 o5 o6 oc) (setq o1 (mp t1 t2) o2 (mp t2 t3) o3 (mp t3 t1) o4 (mp t1 t4) o5 (mp t2 t4) o6 (mp t3 t4) oc (centroid4 t1 t2 t3 t4) ) (command "box" t1 "c" (distance t1 t2 )) (slicit o1 o5 o4 oc) (slicit o1 o2 o5 oc) (slicit o2 o6 o5 oc) (slicit o2 o3 o6 oc) (slicit o3 o4 o6 oc) (slicit o3 o1 o4 oc) (slicit o4 o5 o6 oc) ;................. (ssadd (entlast) restss) (cond ((<= n 1)(princ " done ") nil) (t (rest1 (1- n) t1 o1 o3 o4) (rest1 (1- n) o1 t2 o2 o5) (rest1 (1- n) o3 o2 t3 o6) (rest1 (1- n) o4 o5 o6 t4) ) ) ) ;(defun c:t ()(c:siertet));quick alias (defun c:tt ()(rest1 2 t1 t2 t3 t4)) (defun c:t ()(c:siertet)) (defun mp (p q)(mapcar '/ (mapcar '+ p q) '(2.0 2.0 2.0)));centroid of 2 points (for midpoint of edge) (defun centroid4 (p1 p2 p3 p4 );centroid of 4 points (for center of tetrahedron) (mapcar '/ (mapcar '+ p1 p2 p3 p4) (list 4.0 4.0 4.0)) ) (defun centroid3 (p1 p2 p3);centroid of 3 points (for center of triangle) (mapcar '/ (mapcar '+ p1 p2 p3) (list 3.0 3.0 3.0)) ) (defun slicit (s1 s2 s3 keeppt) (command "slice" (entlast) "" s1 s2 s3 keeppt) ) ;;;(defun centroid ();works ;;; (setq sump '(0 0 0) n 0) ;;; (while ;;; (setq p (getpoint "\npik: ")) ;;; ;;; (setq sump (mapcar '+ p sump) n (1+ n )) ;;; ) ;;; (mapcar '/ sump (list n n n)) ;;; )