;;Platonic Polyhedra
;;;polyhedra.lsp
;;;
;;;	by Takaya Iwamoto
;;;	Aug 1, 2008  
;;;
;;;	the following 5 types
;;;	Tetrahedron
;;;	Cube
;;;	Octahedron
;;;	Dodecahedron
;;;	Icosahedron
;;;
;;;
; Updates by CAD Studio - www.cadstudio.cz - www.cadforum.cz  (2013)

(defun SETUP_SYSVAR ()
 (setvar "cmdecho" 0)
)
(defun reset_sysvar ()
 (princ)
)
(defun MAKE_3DFACE (layer_name color_code pt_1 pt_2 pt_3 pt_4)

  (entmake (list (cons 0 "3DFACE")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 pt_1)
		 (cons 11 pt_2)
		 (cons 12 pt_3)
		 (cons 13 pt_4)
	   )
  )
  (entlast)
)
(defun ACOS (a)
  (atan (/ (sqrt (- 1.0 (* a a))) a))
)
(defun ASIN (a)
  (atan (/ a (sqrt (- 1.0 (* a a)))))
)
(defun RTD (a)
  (/ (* a 180.) pi)
)
;--------------------------------------------------------------

;;;*********** TETRA ************
(defun c:tetra()
	(setup_tetra)
	(make_tetra)
	(reset_sysvar)
);;;
;;;
;;;
(defun setup_tetra()
	(setup_sysvar)
	(plane_tetra)
);;;
;;;
(defun plane_tetra()
	(setq sqrt_3 (sqrt 3)
		one_third (/ 1. 3.)
		pnt_1 '(-1 0 0)
		pnt_2 '(0 0 0)
		pnt_3 '(1 0 0)
		pnt_4 (list -0.5 (* 0.5 sqrt_3) 0)
		pnt_5 (list 0.5 (* 0.5 sqrt_3) 0)
		pnt_6 (list 0 sqrt_3 0)
	)
	(make_3dface "0" 1 pnt_4 pnt_2 pnt_1 pnt_1)
		(setq 3dface_1 (entlast))
	(make_3dface "0" 2 pnt_2 pnt_5 pnt_3 pnt_3)
		(setq 3dface_2 (entlast))
	(make_3dface "0" 3 pnt_5 pnt_4 pnt_6 pnt_6)
		(setq 3dface_3 (entlast))
	(make_3dface "0" 0 pnt_2 pnt_4 pnt_5 pnt_5)
	(command "_.zoom" "_E")
	;(command "delay" 3000)
);;;
;;;
;;;
(defun make_tetra()
	(setq da (rtd (acos one_third))
		rot_plus (- 180 da)
	)
	(command "_vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nFold sections to form a terahedron")
	(command "_.rotate3d" 3dface_1 "" "2" pnt_2 pnt_4 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3dface_2 "" "2" pnt_5 pnt_2 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3dface_3 "" "2" pnt_4 pnt_5 rot_plus)
)
;;;
;;;	(set (read (strcat "pnt_" (itoa (1+ pnt_cnt)) )) pnt_cur)
;;;
;;;
;;;*********** TETRA ************
(defun c:tetra()
	(setup_tetra)
	(make_tetra)
	(reset_sysvar)
);;;
;;;
;;;
(defun setup_tetra()
	(setup_sysvar)
	(plane_tetra)
);;;
;;;
(defun plane_tetra()
	(setq sqrt_3 (sqrt 3)
		one_third (/ 1. 3.)
		pnt_1 '(-1 0 0)
		pnt_2 '(0 0 0)
		pnt_3 '(1 0 0)
		pnt_4 (list -0.5 (* 0.5 sqrt_3) 0)
		pnt_5 (list 0.5 (* 0.5 sqrt_3) 0)
		pnt_6 (list 0 sqrt_3 0)
	)
	(make_3dface "0" 1 pnt_4 pnt_2 pnt_1 pnt_1)
		(setq 3dface_1 (entlast))
	(make_3dface "0" 2 pnt_2 pnt_5 pnt_3 pnt_3)
		(setq 3dface_2 (entlast))
	(make_3dface "0" 3 pnt_5 pnt_4 pnt_6 pnt_6)
		(setq 3dface_3 (entlast))
	(make_3dface "0" 0 pnt_2 pnt_4 pnt_5 pnt_5)
	(command "_.zoom" "_E")
	;(command "delay" 3000)
);;;
;;;
;;;
(defun make_tetra()
	(setq da (rtd (acos one_third))
		rot_plus (- 180 da)
	)
	(command "_vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nFold sections to form a terahedron")
	(command "_.rotate3d" 3dface_1 "" "2" pnt_2 pnt_4 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3dface_2 "" "2" pnt_5 pnt_2 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3dface_3 "" "2" pnt_4 pnt_5 rot_plus)
)
;;;
;;;	(set (read (strcat "pnt_" (itoa (1+ pnt_cnt)) )) pnt_cur)
;;;
;;;
;;;*********** OCTA ************
;;;	---- octahedral ----
(defun c:octa()
	(setup_octa)
	(make_octa1)
	(make_octa2)
	(make_octa3)
	(reset_sysvar)
);;;
;;;
;;;
(defun setup_octa()
	(setup_sysvar)
	(plane_octa)
);;;
;;;
(defun plane_octa()
	(setq sqrt_3 (sqrt 3)
		half_sqrt3 (* 0.5 sqrt_3)
		one_third_sqrt3 (/ sqrt_3 3.)
		unit 1.0
		da (rtd (* 2 (acos one_third_sqrt3)))
		rot_plus (- 180 da)
	;;bottom
		pnt_1 (list (* 1.5 unit) (- half_sqrt3) 0.)
	;;first row
		pnt_2 '(0 0 0)
		pnt_3 (list unit 0 0)
		pnt_4 (list (* 2 unit) 0 0)
		pnt_5 (list (* 3 unit) 0 0)
	;;second row
		pnt_6 (list (* 0.5 unit) half_sqrt3 0)
		pnt_7 (list (* 1.5 unit) half_sqrt3 0)
		pnt_8 (list (* 2.5 unit) half_sqrt3 0)
		pnt_9 (list (* 3.5 unit) half_sqrt3 0)
	;;top
		pnt_10 (list (* 2 unit) sqrt_3 0)
	)
	(setq face_list 
	  (list (list pnt_4 pnt_3 pnt_1) 
		(list pnt_2 pnt_3 pnt_6) (list pnt_3 pnt_4 pnt_7) (list pnt_4 pnt_5 pnt_8)
		(list pnt_7 pnt_6 pnt_3) (list pnt_8 pnt_7 pnt_4) (list pnt_9 pnt_8 pnt_5)
		(list pnt_7 pnt_8 pnt_10)
		)
	)
	(setq cnt 0)
	(repeat 8
		(setq pset (nth cnt face_list)
			p1 (car pset)
			p2 (cadr pset)
			p3 (caddr pset)
			layer_name (strcat "layer" (itoa (1+ cnt)))
		)
		(make_3dface layer_name 256 p1 p2 p3 p3)
			(setq 3dface_cur (entlast))
		(set (read (strcat "3df_" (itoa (1+ cnt)) )) 3dface_cur)	
		(setq cnt (1+ cnt))
	);;; end of repeat loop
	(command "_.zoom" "_E")

);;;
;;;
;;;
(defun make_octa1()
	;(command "vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nFold sections to form a half octahedron")
	(command "_.rotate3d" 3df_1 "" "2" pnt_4 pnt_3 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_2 "" "2" pnt_3 pnt_6 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_2 3df_5 "" "2" pnt_3 pnt_7 rot_plus)
)
;;;
;;;
(defun make_octa2()
	;(command "vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nRepeat the similar process fro the remaining half")
	(command "_.rotate3d" 3df_7 "" "2" pnt_8 pnt_5 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_8 "" "2" pnt_7 pnt_8 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_4 3df_7 "" "2" pnt_8 pnt_4 rot_plus)
)
;;;
;;;
(defun make_octa3()
	;(command "vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nRotate one half to form a complete octahedron")
	(command "_.rotate3d" 3df_1 3df_2 3df_3 3df_5  "" "2" pnt_4 pnt_7 rot_plus)
)
;;;
;;;
;;;
;;;*********** ICOSA ************
;;;	---- icosahedron ----
(defun c:icosa()
	(setup_icosa)
	(make_icosa1)
	(make_icosa2)
	(make_icosa3)
	(make_icosa4)
	(command "_.zoom" "_E")
	(reset_sysvar)
);;;
;;;
;;;
(defun setup_icosa()
	(setup_sysvar)
	(plane_icosa)
);;;
;;;
(defun plane_icosa()
	(setq 	x_unit 1.0
		y_unit (* 0.5 (sqrt 3))
		da (rtd (- pi (asin (/ 2. 3.))))
		rot_plus (- 180 da)
	)
;;define pnt_1 through pnt_22
	;;first 1 - 5 & 18 - 22 (top & bottom)
	(setq y_top (* 3 y_unit)
		y_bot 0.
		cnt 1
	)
	(repeat 5
		(setq p_top (list  (* cnt x_unit) y_top 0)
			p_bot (list (* (- (float cnt) 0.5) x_unit) y_bot 0)
		)
		(set (read (strcat "pnt_" (itoa cnt) )) p_bot)
		(set (read (strcat "pnt_" (itoa (+ 17 cnt)) )) p_top)
		(setq cnt (1+ cnt)) 
	);;end of repeat
;;define pnt_6 through pnt_17
	;;two groups 6 - 11 & 12 - 17 (top & bottom)
	(setq y_top (* 2 y_unit)
		y_bot y_unit
		cnt 1
	)
	(repeat 6
		(setq p_top (list  (* (- (float cnt) 0.5) x_unit) y_top 0)
			p_bot (list (* (1- cnt) x_unit) y_bot 0)
		)
		(set (read (strcat "pnt_" (itoa (+ 5 cnt))) )  p_bot) 
		(set (read (strcat "pnt_" (itoa (+ 11 cnt))) ) p_top) 
		(setq cnt (1+ cnt)) 
	);;end of repeat
;;define triangle list	
	(setq face_list 
	  (list (list pnt_7 pnt_6 pnt_1) (list pnt_8 pnt_7 pnt_2)
		(list pnt_9 pnt_8 pnt_3) (list pnt_10 pnt_9 pnt_4)  
		(list pnt_11 pnt_10 pnt_5) 	;;bottom row 
		(list pnt_6 pnt_7 pnt_12) (list pnt_7 pnt_8 pnt_13) 
		(list pnt_8 pnt_9 pnt_14) (list pnt_9 pnt_10 pnt_15) 
		(list pnt_10 pnt_11 pnt_16) 	;;second row  
		(list pnt_13 pnt_12 pnt_7) (list pnt_14 pnt_13 pnt_8) 
		(list pnt_15 pnt_14 pnt_9) (list pnt_16 pnt_15 pnt_10) 
		(list pnt_17 pnt_16 pnt_11)	;;third row 
		(list pnt_12 pnt_13 pnt_18) (list pnt_13 pnt_14 pnt_19)  
		(list pnt_14 pnt_15 pnt_20) (list pnt_15 pnt_16 pnt_21) 
		(list pnt_16 pnt_17 pnt_22)	;;top row 
	  )
	);;;end of face_list definition
	(setq cnt 0)
	(repeat 20
		(setq pset (nth cnt face_list)
			p1 (car pset)
			p2 (cadr pset)
			p3 (caddr pset)
			layer_name (strcat "layer" (itoa (1+ cnt)))
		)
		(make_3dface layer_name 256 p1 p2 p3 p3)
			(setq 3dface_cur (entlast))
		(set (read (strcat "3df_" (itoa (1+ cnt)) )) 3dface_cur)	
		(setq cnt (1+ cnt))
	);;; end of repeat loop
	(command "_.zoom" "_E")

);;;
;;;
;;;
(defun make_icosa1()
	;(command "vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nFold top and bottom row ")
	(command "_.rotate3d" 3df_1 3df_2 3df_3 3df_4 3df_5  ""
				 "2" pnt_11 pnt_6 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_16 3df_17 3df_18 3df_19 3df_20  ""
				 "2" pnt_12 pnt_17 rot_plus)
		(command "_delay" 1500)
)
;;;
;;;
(defun make_icosa2()
	;(command "vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nRepeat the similar process for the remaining half")
	(command "_.rotate3d" 3df_15 3df_20 "" "2" pnt_16 pnt_11 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_5 3df_10 3df_15 3df_20  "" "2" pnt_16 pnt_10 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_5 3df_10 3df_15 3df_20 3df_14 3df_19 
		  "" "2" pnt_15 pnt_10 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_5 3df_10 3df_15 3df_20 3df_14 3df_19 3df_4 3df_9 
		  "" "2" pnt_15 pnt_9 rot_plus)
		(command "_delay" 1500)
)
;;;
;;;
(defun make_icosa3()
	;(command "vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nRepeat the similar process for the remaining half")
	(command "_.rotate3d" 3df_1 3df_6  
				"" "2" pnt_7 pnt_12 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_1 3df_6 3df_11 3df_16  
				"" "2" pnt_7 pnt_13 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_1 3df_6 3df_11 3df_16  3df_2 3df_7
				 
		  "" "2" pnt_8 pnt_13 rot_plus)
		(command "_delay" 1500)
	;(command "_.rotate3d" 3df_5 3df_10 3df_15 3df_20 3df_14 3df_19 3df_4 3df_9
				
	;	  "" "2" pnt_15 pnt_9 rot_plus)
		(command "_delay" 1500)
)
;;;
;;;
(defun make_icosa4()
	;(command "vpoint" '(0.5631  -0.6512  3.2948) )
		(alert "\nRotate one half to form a complete octahedron")
	(command "_.rotate3d" 3df_5 3df_10 3df_15 3df_20 3df_14 3df_19 3df_4 3df_9
				3df_13 3df_18
				 
		  "" "2" pnt_14 pnt_9 rot_plus)
		(command "_delay" 1500)
	(command "_.rotate3d" 3df_1 3df_6 3df_11 3df_16  3df_2 3df_7 
				3df_12 3df_17
				 
		  "" "2" pnt_8 pnt_14 rot_plus)
		(command "_delay" 1500)
)
;;;
;;;
;;;RECOVER_PNT
;;;
(defun recover_pnt()
;;3DF_1
	(setq 	pnt_1 (cdr (assoc 12 (entget 3df_1))))
	
;;3DF_6  ... 10
	(setq 	pnt_6 (cdr (assoc 10 (entget 3df_6)))
		pnt_7 (cdr (assoc 10 (entget 3df_7)))
		pnt_8 (cdr (assoc 10 (entget 3df_8)))
		pnt_9 (cdr (assoc 10 (entget 3df_9)))
		pnt_10 (cdr (assoc 10 (entget 3df_10)))


		pnt_12 (cdr (assoc 12 (entget 3df_6)))
		pnt_13 (cdr (assoc 12 (entget 3df_7)))
		pnt_14 (cdr (assoc 12 (entget 3df_8)))
		pnt_15 (cdr (assoc 12 (entget 3df_9)))
		pnt_16 (cdr (assoc 12 (entget 3df_10)))
	)
;;3DF_16
	(setq 	pnt_18 (cdr (assoc 12 (entget 3df_16))))

);;;
;;;MAKE_PNTLIST
;;;
(defun c:make_pntlist()
	(setq icosa_pt
		(list pnt_1 
			pnt_6 pnt_7 pnt_8 pnt_9 pnt_10
			pnt_12 pnt_13 pnt_14 pnt_15 pnt_16
			pnt_18
		)
	)
);;;
;;;
(princ "\nPlatonic polyhedra: TETRA, OCTA, ICOSA commands loaded.")
(princ)