(prompt "\nSOlar Eclipse Model in ACAD - SOLAR_ECLIPSE.LSP")
(prompt "\nCommands:  CASE_1 ")
(prompt "\nFunctions: (SETUP_SOLAR_ECLIPSE) (SETUP_SOLAR_ECLIPSE1) (SETUP_SOLAR_ECLIPSE2) ")
(prompt "\nFunctions: (shadow_line) (full_shade) (half_shade)")
(prompt "\n           ")
;----------------------------------------------------------
;
;;;**********************************************************
;;;	Copyright July 2006	Takaya Iwamoto
;;;**********************************************************
;;;By Takaya Iwamoto   May 05, 2005
;;;SOLAR_ECLIPSE.LSP
;;;	Solar Eclipse Model simulation by ACAD
;;;
;;;CASE_1	Widest darkness area 
;;;main trial routine
(defun c:CASE_1()
	(setup_solar_eclipse)		;setup parameters
	(alert "\nDraw shadow limiting lines")
	(shadow_line)
	(alert "\nshow full & half shade")
	(full_shade)
	(half_shade)
	(earth_shade)
;;;
	(alert "\nshow the full & half shade area ")
;;;set Earth as the current viewport
	(setvar "CVPORT" 4)
	(command "_.shademode" "_o")
	(command "_.shade")
;;;vpoint	39466.6783,0.0000,18666.3487
	
);TEST
;;;
;;;SETUP_ECLIPSE_S
;;;setup for ECLIPSE_S Model 
(defun setup_ECLIPSE_S()
	(setup_sysvar)
	(setvar "SURFTAB1" 36)
	(setvar "SURFTAB2" 36)
	(setvar "FACETRES" 10)
	;(setvar "PDMODE" 32)
	(setq sun_rad 6.95e5 moon_rad 1.734e3 Earth_rad 6.378e3
		sun_dist 1.496e8 moon_dist 3.844e5
		earth_ctr '(0 0 0) sun_ctr (list sun_dist 0 0)
		moon_ctr (list  moon_dist 0 0)
	)
	(make_pt "0" 1 moon_ctr)
 	(make_pt "0" 2 sun_ctr)
	(make_pt "0" 5 earth_ctr)
	(command "_.sphere" moon_ctr moon_rad)
		(setq moon (entlast))
	(command "_.sphere" sun_ctr sun_rad)
		(setq sun (entlast))
	(command "_.sphere" earth_ctr earth_rad)
		(setq earth (entlast))
		
	(make_line_1 "0" 8 earth_ctr sun_ctr)
		
	(command "_.zoom" "_EXTENT" )
	;(command "_.shade")
	(command "_.regen")
	
);SETUP_eclipse_s
;;;
;;;
;;;SETUP_ECLIPSE_S
;;;setup for ECLIPSE_S Model 
(defun setup_test()
	(setup_sysvar)
	(setvar "SURFTAB1" 36)
	(setvar "SURFTAB2" 36)
	(setvar "FACETRES" 10)
	;(setvar "PDMODE" 32)
	(setq sun_rad 6.95e5 moon_rad 1.734e3 Earth_rad 6.378e3
		sun_dist 1.496e8 moon_dist 3.844e5
		earth_ctr '(0 0 0) sun_ctr (list sun_dist 0 0)
		moon_ctr (list  moon_dist 0 0)
	)
	(make_pt "0" 1 moon_ctr)
 	(make_pt "0" 2 sun_ctr)
	(make_pt "0" 5 earth_ctr)
	(command "_.sphere" moon_ctr moon_rad)
		(setq moon (entlast))
	;(command "_.sphere" sun_ctr sun_rad)
	;	(setq sun (entlast))
	(command "_.sphere" earth_ctr earth_rad)
		(setq earth (entlast))
		
	(make_line_1 "0" 8 earth_ctr sun_ctr)

	;;;define UCS named UCS_Sun
	(setq sun_x (list sun_dist 0 sun_rad) 
		sun_y (list sun_dist sun_rad sun_rad)
	)
	
	(alert "\ndefine UCS named UCS_Sun\n
		Used to defined point lights at Sun")
	(command "_.ucs" "_New" "3point" sun_ctr sun_x sun_y)
	(command "_.ucsicon" "_ON")
	(command "_.ucs" "_Save" "UCS_Sun")
	(command "_.ucs" "_Restore" "UCS_Sun")

	(make_circle_1 "0" 2 sun_ctr sun_rad)
		(setq sun_disk (entlast))
	(command "_.ucs" "_World")

		
	(command "_.zoom" "_EXTENT" )
	;(command "_.shade")
	(command "_.regen")
	
);SETUP_ARISTARCHUS
;;;
;;;
;;;SETUP_ECLIPSE1
;;;setup for ECLIPSE1 
(defun setup_solar_eclipse1()
	(setup_sysvar)
	(setvar "SURFTAB1" 36)
	(setvar "SURFTAB2" 36)
	(setvar "FACETRES" 10)			;ACAD Max resolution
	(command "_.viewres" "_N" 20000)	;ACAD MAx resolution 
	;(setvar "PDMODE" 32)
	(setq sun_rad 6.95e5 moon_rad 1.734e3 Earth_rad 6.378e3
		sun_dist 1.496e8 moon_dist 3.844e5
		earth_ctr '(0 0 0) sun_ctr (list sun_dist 0 0)
		moon_ctr (list  moon_dist 0 0)
		equator (list Earth_rad 0 0)
		sun_top (list 1.49597e8 6.9499e5 0)
		sun_bottom (list 1.49597e8 -6.9499e5 0)
		sun_left (list 1.49597e8 0 6.9499e5 )
		sun_right (list 1.49597e8 0 -6.9499e5 )
	)
	(make_pt "0" 1 moon_ctr)
 	(make_pt "0" 2 sun_ctr)
	(make_pt "0" 5 earth_ctr)
	(make_pt "0" 0 equator)
		(setq shadow_ctr (entlast))
	(make_circle_1 "0" 1 moon_ctr moon_rad)
		(setq moon (entlast))
	(make_circle_1 "0" 2 sun_ctr sun_rad)
		(setq sun (entlast))
	(make_circle_1 "0" 5 earth_ctr earth_rad)
		(setq earth (entlast))
		
	(make_line_1 "0" 8 earth_ctr sun_ctr)
			
	(command "_.zoom" "_EXTENT" )
	;(command "_.shade")
	(command "_.regen")
	;;;split into 2 view ports
	(command "_.vports" 2 "_Horizontal")
	(command "_.zoom" "_Extent")
	(setvar "CVPORT" 3)
	(command "_.vports" 3 "_Vertical")
	(command "_.zoom" "_Object" sun "")	;;;Sun
	(command "_.regen")

	(setvar "CVPORT" 4)	;;;Earth
	(command "_.zoom" "_Object" earth "")
	(command "_.regen")

	(setvar "CVPORT" 5)	;;;Moon
	(command "_.zoom" "_Object" moon "")
	(command "_.regen")
);SETUP_TEST2
;;;
;;;
;;;SETUP_SOLAR_ECLIPSE
;;;setup for SOLAR ECLIPSE 
(defun setup_solar_eclipse()
	(setup_sysvar)
	(setvar "SURFTAB1" 36)
	(setvar "SURFTAB2" 36)
	(setvar "FACETRES" 10)			;ACAD Max resolution
	(command "_.viewres" "_N" 20000)	;ACAD MAx resolution 
	;(setvar "PDMODE" 32)
	(setq sun_rad 6.95e5 moon_rad 1.734e3 Earth_rad 6.378e3
		sun_dist 1.52e8 moon_dist 3.567e5
		earth_ctr '(0 0 0 ) sun_ctr (list sun_dist 0 0)
		moon_ctr (list  moon_dist 0 0)
		equator (list Earth_rad 0 0)
		sun_top (list sun_dist sun_rad 0)
		sun_bottom (list sun_dist (- sun_rad) 0)
		sun_left (list sun_dist 0 sun_rad )
		sun_right (list sun_dist 0 (- sun_rad) )
	)
	(make_pt "0" 1 moon_ctr)
 	(make_pt "0" 2 sun_ctr)
	(make_pt "0" 5 earth_ctr)
	(make_pt "0" 0 equator)
		(setq shadow_ctr (entlast))
	(make_circle_1 "0" 1 moon_ctr moon_rad)
		(setq moon (entlast))
	(make_circle_1 "0" 2 sun_ctr sun_rad)
		(setq sun (entlast))
	(make_circle_1 "0" 5 earth_ctr earth_rad)
		(setq earth (entlast))
		
	(make_line_1 "0" 8 earth_ctr sun_ctr)
		(setq center_line (entlast))
			
	(command "_.zoom" "_EXTENT" )
	;(command "_.shade")
	(command "_.regen")
	;;;split into 2 view ports
	(command "_.vports" 2 "_Horizontal")
	(command "_.zoom" "_Extent")
	(setvar "CVPORT" 3)
	(command "_.vports" 3 "_Vertical")
	(command "_.zoom" "_Object" sun "")	;;;Sun
	(command "_.regen")

	(setvar "CVPORT" 4)	;;;Earth
	(command "_.zoom" "_Object" earth "")
	(command "_.regen")

	(setvar "CVPORT" 5)	;;;Moon
	(command "_.zoom" "_Object" moon "")
	(command "_.regen")
);SETUP_TEST2
;;;
;;;SHADOW_TEST		;;add moon as a sphere to see a shadow on the earth by Sun's point lights
;;;			;;defined at 4 quad points on the sun's rim.
;;;			;;These points are used to define point lights later in LIGHT command.
;;;
(defun shadow_test()
	(setvar "CECOLOR" "red")
	(command "_.sphere" moon_ctr moon_rad)
		(setq moon_sphere (entlast))
	;(command "_.sphere" sun_ctr sun_rad)
	;	(setq sun_sphere (entlast))
	;(command "_.sphere" earth_ctr earth_rad)
	;	(setq earth_sphere (entlast))
	;;;make a reference points for sun's point light source 
	(setvar "CECOLOR" "yellow")
	(make_pt "0" 0 sun_top)
	(make_pt "0" 0 sun_bottom)
	(make_pt "0" 0 sun_left)
	(make_pt "0" 0 sun_right)
	(setvar "PDMODE" 32)
	(setvar "CECOLOR" "BYLAYER")

);shadow_test
;;;
;;;shadow_line
;;;
(defun shadow_line()
	(setq earth_top (list 0 earth_rad ) earth_bottom (list 0 (- earth_rad) )
		moon_top (list moon_dist moon_rad )
		moon_bottom (list moon_dist (- moon_rad) )
	)
	;(make_line_1 "0" 8 earth_top earth_bottom)
	;	(setq earth_axis (entlast))
;;draw lines to define moon shadows
	;;extend two lines to earth_line and find out intersection points
	(setq full_shade_top (inters earth_top earth_bottom sun_top moon_top nil)
		 full_shade_bottom (inters earth_top earth_bottom sun_bottom moon_bottom nil)
		half_shade_bottom (inters earth_top earth_bottom sun_top moon_bottom nil)
		half_shade_top (inters earth_top earth_bottom sun_bottom moon_top nil)

	)
	(setvar "CECOLOR" "red")
;;;full shade boundary lines
;;;line1	top line	line2	bottom line
	(command "_.pline" sun_top moon_top full_shade_top "")
		(setq full_shade_line1 (entlast))
	(command "_.pline" sun_bottom moon_bottom full_shade_bottom "")
		(setq full_shade_line2 (entlast))
	
	(setvar "CECOLOR" "green")
;;;half shade boundary lines
;;;line1	bottom line	line2	top line
	(command "_pline" sun_top moon_bottom half_shade_bottom "")
		(setq half_shade_line1 (entlast))
	(command "_pline" sun_bottom moon_top half_shade_top "")
		(setq half_shade_line2 (entlast))
	(setvar "CECOLOR" "BYLAYER")
;;;find out the end of the shade boundary lines using trim command
	(alert "\nTrim shade lines at the earth's surface")
	;;TD-DO-LIST--->how to do trim automatically here.
	(command "_.trim" earth "" full_shade_line1 full_shade_line2
				   half_shade_line1 half_shade_line2	 "") 
					

);;;
;;;
;;;full_shade
;;;
(defun full_shade()
	(setvar "CECOLOR" "250")
	;(alert "\nPick a point to define the limit of full shade")
	;(setq pnt_fs (getpoint "\nPick intersection of sun-light and earth's surface"))
;;;pnt_fs is the last point of the pline entity full_shade_line1
;;;first reverse (entget full_shade_line1),then use (assoc 10 ...) to extract pnt_fs
	(setq pnt_fs (cdr (assoc 10 (reverse (entget full_shade_line1))))) 
	(setq base_fs (list (car pnt_fs) 0))
	;;draw a polyline for ful_shade area
	(command "_.pline" equator "_arc" "_CE" earth_ctr pnt_fs "_Line" base_fs "_CL")
	(command "_.revolve" (entlast) "" "_Object" center_line "360")
	(setvar "CECOLOR" "BYLAYER")
		
);;;full_shade		
;;;
;;;
;;;half_shade
;;;
(defun half_shade()
	(setvar "CECOLOR" "251")
	;(alert "\nPick a point to define the limit of partial shade")
	;(setq pnt_hs (getpoint "\nPick intersection of sun-light and earth's surface"))
;;;pnt_hs is the last point of the pline entity half_shade_line2
;;;first reverse (entget half_shade_line2),then use (assoc 10 ...) to extract pnt_hs
	(setq pnt_hs (cdr (assoc 10 (reverse (entget half_shade_line2))))) 
	(setq base_hs (list (car pnt_hs) 0))
	;;draw a polyline for partial_shade area
	(command "_.pline" pnt_fs "_arc" "_CE" earth_ctr pnt_hs "_Line" base_hs base_fs "_CL")
	(command "_.revolve" (entlast) "" "_Object" center_line "360")
	(setvar "CECOLOR" "BYLAYER")
		
);;;half_shade		
;;;
;;;
(defun earth_shade()
	(setvar "CECOLOR" "140")
	;(alert "\nPick a point to define the limit of partial shade")
	;(setq pnt_hs (getpoint "\nPick intersection of sun-light and earth's surface"))
;;;pnt_hs is the last point of the pline entity half_shade_line2
;;;first reverse (entget half_shade_line2),then use (assoc 10 ...) to extract pnt_hs
	(setq pnt_hs (cdr (assoc 10 (reverse (entget half_shade_line2))))) 
	(setq base_hs (list (car pnt_hs) 0))
	;;draw a polyline for partial_shade area
	(command "_.pline" pnt_hs "_arc" "_CE" earth_ctr earth_top "_Line" earth_ctr base_hs "_CL")
	(command "_.revolve" (entlast) "" "_Object" center_line "360")
	(setvar "CECOLOR" "BYLAYER")
		
);;;earth_shade		
;;;
(princ)