;;origami utility routine   12-11-99
;;;  Haga_circle_sqr.lsp  copied Haga_Delian.lsp	Feb 19,2007
;;;* main routine
;;;polyline display
;;;
(defun c:test_1()
	(haga_setup)
	(corner_pt1_2_pt2 pnt_c pnt_b)
)
;;;
;;;:CORNER_2_PT1
;;;One of the corner to the selected point---displayed in polyline
(defun c:corner_2_pt1()
	(setq nstep (1+ nstep)
		layer_name (strcat "layer" (itoa nstep))
	)
	(setq ref_tmp (getpoint "\nSelect a corner point:")
		ref_pnt (osnap ref_tmp "end")
	)
	(sel_corner ref_pnt)
	(command "_.line" '(0 0) '(1 0) "")		;dummy
	(command "_.layer" "_set" layer_name "")
	(while (and (setq key (grread T)) (= (car key) 5))
    		(setq pnt_tmp (cadr key))
	;;;do process only if the point is within the valid zone
	;;;This will eliminate the case of no intersection
	   (if (is_valid pnt_tmp)
		(progn
		  (entdel (entlast))	;redraw
		  (get_value)	
		  (display_result)
		)
	   )
		(entdel pnt_ent)
	)
	(reset_sysvar)
);C:CORNER_2_PT1
;;;
;;;:CORNER_2_PT2
;;;Boundary hatch feature added
;;;One of the corner to the selected point---displayed in solid hatch
(defun c:CORNER_2_PT2()
	;(setvar "OSMODE" 8)	;;;temp fix 1-22-2006  T.iwamoto
	(setq nstep (1+ nstep)
		layer_name (strcat "layer" (itoa nstep))
	)
	(setq ref_tmp (getpoint "\nSelect a corner point:")
		ref_pnt (osnap ref_tmp "end")
	)
	(sel_corner ref_pnt)
	(command "_.layer" "_set" layer_name "")
	(while (and (setq key (grread T)) (= (car key) 5))
    		(setq pnt_tmp (cadr key))
    ;;;do process only if the point is within the valid zone
    ;;;This will eliminate the case of no intersection
    ;;;DO NOT CREATE ENTITY when the cursor is close to the corner
    ;;;because due to OSNAP, it tends to display zero area polylines.
	   (if (and (is_valid pnt_tmp) (> (distance pnt_tmp ref_pnt) 0.075))
		(progn
		  (if (/= hatch_1 nil) (entdel hatch_1))
		  (if (/= pline_1   nil) (entdel pline_1 ))
		  (get_value)	
		  (display_hatch)	;display pline & solid hatch
		)
	   );;;end of if loop
	;(command "_.delay" 1000)
		(if (/= pnt_ent nil) (entdel pnt_ent))
	)
	(finish)	;display the polyline
	(command "_.layer" "_set" "0" "")
	;(reset_sysvar)
);C::CORNER_2_PT2
;;;
;;;:CORNER_PT1_2_PT2
;;;move corner point pt1 to pt2;pt1 & pt2 given as arguments
;;;Boundary hatch feature added
;;;One of the corner to the selected point---displayed in solid hatch
(defun CORNER_PT1_2_PT2 (pt1 pt2 )

	(sel_corner pt1)
	(setq nstep (1+ nstep)
		layer_name (strcat "layer" (itoa nstep))
		ndiv 30
		inc (/ 1. ndiv)
		step 1
	)
	
	
	(command "_.layer" "_set" layer_name "")
	(repeat ndiv
		(setq pnt_tmp (plt pt1 pt2 (* inc step)))
    ;;;do process only if the point is within the valid zone
    ;;;This will eliminate the case of no intersection
    ;;;DO NOT CREATE ENTITY when the cursor is close to the corner
    ;;;because due to OSNAP, it tends to display zero area polylines.
	   (if  (is_valid pnt_tmp) 
		(progn
		  (if (/= hatch_1 nil) (entdel hatch_1))
		  (if (/= pline_1   nil) (entdel pline_1 ))
		  (get_value)	
		  (display_hatch)	;display pline & solid hatch
			;(command "_.delay" 75)
		(if (= (rem step 4) 0)  (make_jpg))
		)
	   );;;end of if loop
		(if (/= pnt_ent nil) (entdel pnt_ent))
	(setq step (1+ step))
	(command "_.delay" 75)
	);;;end of repeat loop
	(finish)	;display the polyline
	(make_jpg)
	(command "_.layer" "_set" "0" "")
	
);CORNER_PT1_2_PT2
;;;
;;;
;;;HAGA_1	Haga's theorem #1
;;;
(defun C:HAGA_1()
	(setup)
	(command "_.point" '(0.5 1.0))
	;(setvar "OSMODE" 8)
	(c:corner_2_pt2)
	(setvar "OSMODE" 8)
	(setq	layer_name (strcat "layer" (itoa (1+ nstep)) ))
		
	(command "_.layer" "_set" layer_name "")
	(div_bet_pts pnt_a pnt_d 8)
	(div_bet_pts pnt_b pnt_c 3)
	(div_bet_pts pnt_s pnt_1s 6)
	(div_bet_pts pnt_b pnt_c 8)
	(div_bet_pts pt_30 pnt_s 5)
	(div_bet_pts pnt_d pnt_s 4)
	(setq nstep 0)
);C:HAGA_1
;;;
;;;HAGA_2	Haga's theorem #2
;;;
(defun C:HAGA_2()
	(setup)
	(command "_.point" '(0.5 1.0))
	(c:corner_2_pt2)
	
	(setq	layer_name (strcat "layer" (itoa (1+ nstep)) ))
		
	(command "_.layer" "_set" layer_name "")
	(div_bet_pts pnt_a pnt_d 8)
	(div_bet_pts pnt_b pnt_c 3)
	(div_bet_pts pnt_s pnt_1s 6)
	(div_bet_pts pnt_b pnt_c 8)
	(div_bet_pts pt_30 pnt_s 5)
	(div_bet_pts pnt_d pnt_s 4)
	(setq nstep 0)
);C:HAGA_2
;;;
;;;Use 3DFACE entity instead of polyline & hatch
(defun c:test5()
	(setq nstep (1+ nstep)
		layer_name (strcat "layer" (itoa nstep))
	)
	(setq ref_tmp (getpoint "\nSelect a corner point:")
		ref_pnt (osnap ref_tmp "end")
	)
	(sel_corner)
	(command "_.layer" "_set" layer_name "")
	(while (and (setq key (grread T)) (= (car key) 5))
    		(setq pnt_tmp (cadr key))
    ;;;do process only if the point is within the valid zone
    ;;;This will eliminate the case of no intersection
    ;;;DO NOT CREATE ENTITY when the cursor is close to the corner
    ;;;because due to OSNAP, it tends to display zero area polylines.
	   (if (and (is_valid pnt_tmp) (> (distance pnt_tmp ref_pnt) 0.075))
		(progn
		  (if (/= 3dface_1 nil) (entdel 3dface_1))
		  
		  (get_value)	
		  (display_3dface)	;display 3dface
		)
	   );;;end of if loop
		(if (/= pnt_ent nil) (entdel pnt_ent))
	)
	;(finish)	;display the polyline
	(reset_sysvar)
);C:TEST5
;;;*  ;setup
;;;
(defun haga_setup()
	(setup_sysvar)
	
	(setq half_pi (* 0.5 pi))
	(setq pnt_a '(0 0)
		pnt_b '(1 0)
		pnt_c '(1 1)
		pnt_d '(0 1)
		limit_r (sqrt 2.0)
		limit_l 0.0
		min_val 0.1
		corner_list (list pnt_a pnt_b pnt_c pnt_d)
		chr_size 0.1
		nstep 0
	)
	(command "_.line" pnt_a pnt_b pnt_c pnt_d "_c" )
	(command "_.point" pnt_a "")(command "_.point" pnt_b "")
	(command "_.point" pnt_c "")(command "_.point" pnt_d "")
 
	(command "_.zoom" "_Extent")

	
	;; Show node numbering
	
	(mark_point  pnt_a  -1  -1   "A"  chr_size)
	(mark_point  pnt_b  0.5 -1   "B"  chr_size)
	(mark_point  pnt_c  0.5  0   "C"  chr_size)
	(mark_point  pnt_d  -1   0   "D"  chr_size)
;; This is a temp scale for testing
	(command "_.zoom" "_Extent" )
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -3)
;; Set the boundary hatch pattern to "_solid"
	(command "_.bhatch" "_P" "_Solid" "")
);HAGA_SETUP
;;
;;
(defun SEL_CORNER(ref_pnt / dist_a dist_b dist_c dist_d)
	
	(setq dist_a (distance pnt_a ref_pnt)
		dist_b (distance pnt_b ref_pnt)
		dist_c (distance pnt_c ref_pnt)
		dist_d (distance pnt_d ref_pnt)
	)
	(if (< dist_a min_val) (setq c_index 0))
	(if (< dist_b min_val) (setq c_index 1))
	(if (< dist_c min_val) (setq c_index 2))
	(if (< dist_d min_val) (setq c_index 3))
	(prin1 c_index)
	
);SEL_CORNER
;;
;;;
;;; Check if the point picked is valid
;;;
(defun is_valid(pt_test / 
		dist_00 dist_10 dist_11
		bool_00 bool_10 bool_11
		bool_all
	       )
	(setq cpl_1 (rem (+ c_index 1) 4)
		cpl_2 (rem (+ c_index 2) 4)
		cpl_3 (rem (+ c_index 3) 4)
	)
	(setq point_1 (nth cpl_1 corner_list )
		point_2 (nth cpl_2 corner_list )
		point_3 (nth cpl_3 corner_list )
	)
	(setq dist_00 (distance point_1 pt_test)
		dist_11 (distance point_3 pt_test)
		dist_10 (distance point_2 pt_test)
	)
	(setq bool_00 (<= dist_00 1.0)
		bool_11 (<= dist_11 1.0)
		bool_10 (<= dist_10 (sqrt 2.0))
	)
	(setq bool_all (or bool_00 bool_10 bool_11))
)
;;;
;;;Do the finishing touch by color filling the paper--front and back
(defun finish()
	(entdel hatch_1)
	(setq hatch_1 nil)	;;;reset hatch_1 to nil so that there is no hatch.
	(setq pline_1  nil)	;;;reset pline_1 in order to keep the polyline on the screen
)
	
;;;
;;;DISPLAY_RESULT
;;;
(defun DISPLAY_RESULT()
	(if (= pattern 1)
		(command "_.pline" pt_30 pnt_s pt_01 point_1 point_2 point_3  
				  pt_30 pt_01 "")
	)
	(if (= pattern 2)
		(progn
			(setq pnt_1s (point_sym_line pt_30 pt_12 point_1))
			(command "_.pline" pt_30 pnt_s pnt_1s pt_12 point_2 point_3 
				 pt_30 pt_12 "")
		)
	)
	(if (= pattern 3)
		(progn
			(setq pnt_3s (point_sym_line pt_01 pt_23 point_3))
			(command "_.pline" pt_23 pnt_3s pnt_s pt_01 point_1 point_2 
				pt_23 pt_01 "")
		)
	)
	(if (= pattern 4)
		(progn
			(setq pnt_1s (point_sym_line pt_23 pt_30 point_1))
			(setq pnt_2s (point_sym_line pt_23 pt_30 point_2))
			(command "_.pline" pt_30 pnt_s pnt_1s pnt_2s pt_23 point_3 
				 pt_30 pt_23 "")
		)
	)
	(if (= pattern 5)
		(progn
			(setq pnt_1s (point_sym_line pt_12 pt_23 point_1))
			(setq pnt_3s (point_sym_line pt_12 pt_23 point_3))
			(command "_.pline" pt_23 pnt_3s pnt_s pnt_1s pt_12 point_2
				 pt_23 pt_12 "")
		)
	)
	(if (= pattern 6)
		(progn
			(setq pnt_2s (point_sym_line pt_01 pt_12 point_2))
			(setq pnt_3s (point_sym_line pt_01 pt_12 point_3))
			(command "_.pline" pt_12 pnt_2s pnt_3s pnt_s pt_01 point_1 
				 pt_12 pt_01 "")
		)
	)
	;;;Since we do valid point check this will never happen, but in case:
	(if (= pattern -1) (prin1 "Out of range"))
);DISPLAY_RESULT
;;;
;;;
;;;DISPLAY_HATCH
;;;
(defun DISPLAY_HATCH()
	(if (= pattern 1)
		(progn
			(command "_.pline" pt_30 pt_01 pnt_s "C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
	(if (= pattern 2)
		(progn
			(setq pnt_1s (point_sym_line pt_30 pt_12 point_1))

			(command "_.pline" pt_30 pt_12 pnt_1s pnt_s "C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
	(if (= pattern 3)
		(progn
			(setq pnt_3s (point_sym_line pt_01 pt_23 point_3))

			(command "_.pline" pt_23 pnt_3s pnt_s pt_01 "_C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
	(if (= pattern 4)
		(progn
			(setq pnt_1s (point_sym_line pt_23 pt_30 point_1))
			(setq pnt_2s (point_sym_line pt_23 pt_30 point_2))

			(command "_.pline" pt_30 pt_23 pnt_2s pnt_1s pnt_s "_C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
	(if (= pattern 5)
		(progn
			(setq pnt_1s (point_sym_line pt_12 pt_23 point_1))
			(setq pnt_3s (point_sym_line pt_12 pt_23 point_3))

			(command "_.pline" pt_23 pnt_3s pnt_s pnt_1s pt_12 "_C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
	(if (= pattern 6)
		(progn
			(setq pnt_2s (point_sym_line pt_01 pt_12 point_2))
			(setq pnt_3s (point_sym_line pt_01 pt_12 point_3))

			(command "_.pline" pt_12 pnt_2s pnt_3s pnt_s pt_01 "_C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
	;;;Since we do valid point check this will never happen, but in case:
	(if (= pattern -1) (prin1 "Out of range"))
);DISPLAY_HATCH

;;;
;;;DISPLAY_3DFACE
;;;
(defun DISPLAY_3DFACE()
	(if (= pattern 1)
		(progn
			(command "_.3dface" pt_30 pt_01 pnt_s pt_30 "")
			(setq 3dface_1 (entlast))
		)
	)
	(if (= pattern 2)
		(progn
			(setq pnt_1s (point_sym_line pt_30 pt_12 point_1))
			(command "_.3dface" pt_30 pt_12 pnt_1s pnt_s pt_30"")
			(setq 3dface_1 (entlast))
		)
	)
	(if (= pattern 3)
		(progn
			(setq pnt_3s (point_sym_line pt_01 pt_23 point_3))

			(command "_.3dface" pt_23 pnt_3s pnt_s pt_01 pt_23 "")
			(setq 3dface_1 (entlast))
		)
	)
	(if (= pattern 4)
		(progn
			(setq pnt_1s (point_sym_line pt_23 pt_30 point_1))
			(setq pnt_2s (point_sym_line pt_23 pt_30 point_2))
		
			(command "_.3dface" point_3 pt_30 pt_23 point_3 "")
			(setq 3dface_1 (entlast))
		)
	)
	(if (= pattern 5)
		(progn
			(setq pnt_1s (point_sym_line pt_12 pt_23 point_1))
			(setq pnt_3s (point_sym_line pt_12 pt_23 point_3))
			
			(command "_.3dface" point_2 pt_23 pt_12 point_2 "")
			(setq 3dface_1 (entlast))
		)
	)
	(if (= pattern 6)
		(progn
			(setq pnt_2s (point_sym_line pt_01 pt_12 point_2))
			(setq pnt_3s (point_sym_line pt_01 pt_12 point_3))
			
			(command "_.3dface" point_1 pt_12 pt_01 point_1 "")
			(setq 3dface_1 (entlast))
		)
	)
	;;;Since we do valid point check this will never happen, but in case:
	(if (= pattern -1) (prin1 "Out of range"))
);DISPLAY_3DFACE
;;;
;;;		
;compute translation & angle values from x_tmp
(defun get_value()
	;;The following is needed for using grread with OSNAP
	(command "_.point" pnt_tmp)
	(setq pnt_ent (entlast))
	(setq pnt_s (cdr (assoc 10 (entget pnt_ent))))
	;;OSNAP correction
	;;create two end points TF & PF which intersect line SB at mid point
	;;pt_rhs is rhs of line BS ;pt_lhs is lhs of line BS
	(setq pt_rhs (point_off_line ref_pnt pnt_s 0.5 half_pi 3.0)
		pt_lhs (point_off_line ref_pnt pnt_s 0.5 (- half_pi) 3.0)
	)
	;;compute intersections
	(setq pt_01 (inters pt_rhs pt_lhs ref_pnt point_1)
		pt_12 (inters pt_rhs pt_lhs point_1 point_2)
		pt_23 (inters pt_rhs pt_lhs point_2 point_3)
		pt_30 (inters pt_rhs pt_lhs point_3 ref_pnt)
	)
	;;;determine the class by checking if pt_* is nil
	(if (and (= pt_12 nil) (= pt_23 nil)) (setq pattern 1))
	(if (and (= pt_01 nil) (= pt_23 nil)) (setq pattern 2))
	(if (and (= pt_30 nil) (= pt_12 nil)) (setq pattern 3))
	(if (and (= pt_01 nil) (= pt_12 nil)) (setq pattern 4))
	(if (and (= pt_30 nil) (= pt_01 nil)) (setq pattern 5))
	(if (and (= pt_23 nil) (= pt_30 nil)) (setq pattern 6))
	(if (and (= pt_01 nil) (= pt_12 nil) (= pt_23 nil) (= pt_30 nil)) (setq pattern -1))
);GET_VALUE
;;MAKE_WMF
;;;make windows meta file
(defun c:MAKE_WMF()
	(setq wmf_file (getstring "\nWMF file name ?:"))
	(setq target_pt (getpoint "\nTarget point: ")
		ref_pnt (getpoint "\nSeclected corner point:")
		vec_out (unit_vec ref_pnt target_pt)
		vec_len (car vec_out)
		unit_x (cadr vec_out)
		unit_y (caddr vec_out) 
		hatch_1 nil
		pline_1 nil
	)
	(sel_corner)	;;;define c_index value
	(setq nstep (getint "\nHow many steps:"))
	(setq 	step 1 )
	(setq answer (getpoint "\nPress left mouse to begin."))
	
	(while (<=  step nstep )
		(setq   pnt_tmp (nth_bet_pts ref_pnt target_pt nstep step))

	   (if (and (is_valid pnt_tmp) (> (distance pnt_tmp ref_pnt) 0.075))
		(progn
		  (if (/= hatch_1 nil) (entdel hatch_1))
		  (if (/= pline_1 nil) (entdel pline_1))
		  (get_value)	
		  (display_hatch)	;display pline & solid hatch
		)
	   );;;end of if loop
		(if (/= pnt_ent nil) (entdel pnt_ent))
		(command "_.export"  (strcat wmf_file "_" (itoa step) ".wmf") "_all" ""  )
		(setq step (1+ step))
		(setq resp (getint "\nContinue ?"))
	); while loop
	(finish)	;display the polyline
	(command "_.export"  (strcat wmf_file "_" (itoa step) ".wmf") "_all" ""  )
	(reset_sysvar)

);MAKE_WMF
;;;
;;;
;;;
(defun c:fixed_pt1()
	(setq nstep (1+ nstep)
		layer_name (strcat "layer" (itoa nstep))
	)
	(setq pnt_fix (getpoint "\nSelect a fix point:"))
	(setq ref_tmp (getpoint "\nSelect a corner point:")
		ref_pnt (osnap ref_tmp "end")
	)
	(sel_corner)
	(command "_.line" '(0 0) '(1 0) "")		;dummy
	(command "_.layer" "_set" layer_name "")
	(setq vec_len (distance pnt_fix ref_pnt))
	(while (and (setq key (grread T)) (= (car key) 5))
    		(setq pnt_tmp (cadr key))
		(setq temp_angle (angle pnt_fix pnt_tmp)
			pnt_tmp (polar pnt_fix temp_angle vec_len)
		)
		  (entdel (entlast))	;redraw
		  (get_value2)	
		  (display_result2)
		
		(entdel pnt_ent)
	)
	(reset_sysvar)
);C:FIXED_PT1
;;;
;;;Boundary hatch feature added
(defun c:fixed_pt2()
	(setq nstep (1+ nstep)
		layer_name (strcat "layer" (itoa nstep))
	)
	(setq pnt_fix (getpoint "\nSelect a fix point:"))
	;(setq ref_tmp (getpoint "\nSelect a corner point:")
	;	ref_pnt (osnap ref_tmp "end")
	;)
	(setq ref_pnt (getpoint "\nSelect a corner point:"))

	(sel_corner)
	(setq vec_len (distance pnt_fix ref_pnt))
	(command "_.layer" "_set" layer_name "")
	(while (and (setq key (grread T)) (= (car key) 5))
    		(setq pnt_tmp (cadr key))
    		(setq temp_angle (angle pnt_fix pnt_tmp)
			pnt_tmp (polar pnt_fix temp_angle vec_len)
		)
	  (if  (>  (distance pnt_tmp ref_pnt)  0.075 )
		(progn
		  (if (/= hatch_1 nil) (entdel hatch_1))
		  (if (/= pline_1   nil) (entdel pline_1 ))
		  (get_value2)	
		  (display_hatch2)	;display pline & solid hatch
		)
	   );;;end of if loop
		
		(if (/= pnt_ent nil) (entdel pnt_ent))
	)
	;(finish)	;display the polyline
	(reset_sysvar)
);C:FIXED_PT2
;;;
;;;*  ;setup2
;;;
(defun setup2()
	(setup_sysvar)
	;(set_layer)
	(setq half_pi (* 0.5 pi))
	(setq pnt_a '(0 0)
		pnt_b '(1 0)
		pnt_c '(1 1)
		pnt_d '(0 1)
		limit_r (sqrt 2.0)
		limit_l 0.0
		min_val 0.1
		corner_list (list pnt_a pnt_b pnt_c pnt_d)
		chr_size 0.1
		nstep 0
	)
	(command "_.line" pnt_a pnt_b pnt_c pnt_d "_c" )
	(command "_.zoom" "_Extent")

	(command "_.point" '(0.5 1.0))
	(command "_.point" '(0 0.75))
	;; Show node numbering
	
	(mark_point  pnt_a  -1  -1   "A"  chr_size)
	(mark_point  pnt_b  0.5 -1   "B"  chr_size)
	(mark_point  pnt_c  0.5  0   "C"  chr_size)
	(mark_point  pnt_d  -1   0   "D"  chr_size)
;; This is a temp scale for testing
	(command "_.zoom" "_Extent" )
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -3)
;; Set the boundary hatch pattern to "_solid"
	(command "_.bhatch" "_P" "_Solid" "")
);SETUP
;;
;;
;;;DISPLAY_RESULT2
;;;
(defun DISPLAY_RESULT2()
	(if (= pattern 1)
		(command "_.pline" pnt_fix pt_12 pnt_s pnt_fix "")
	)
	(if (= pattern 2)
		(progn
			(setq pnt_2s (point_sym_line pnt_fix pt_23 pnt_c))
			(command "_.pline" pnt_fix pt_23 pnt_2s pnt_s pnt_fix "")
		)
	)
	
);DISPLAY_RESULT2
;;;
;;;
;;;DISPLAY_HATCH2
;;;
(defun DISPLAY_HATCH2()
	(if (= pattern 1)
		(progn
			(command "_.pline" pnt_fix pt_12 pnt_s "_C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
	(if (= pattern 2)
		(progn
			(setq pnt_2s (point_sym_line pnt_fix pt_23 pnt_c))

			(command "_.pline" pnt_fix pt_23 pnt_2s pnt_s "_C")
			(setq pline_1 (entlast))
			(command "_.hatch" "_solid" pline_1 "")  
			(setq hatch_1 (entlast))
		)
	)
		
);DISPLAY_HATCH2


;;;
;;;GET_VALUE2	
;compute translation & angle values from x_tmp
(defun get_value2()
	;;The following is needed for using grread with OSNAP
	(command "_.point" pnt_tmp)
	(setq pnt_ent (entlast))
	(setq pnt_s (cdr (assoc 10 (entget pnt_ent))))
	;;OSNAP correction
	;;create two end points TF & PF which intersect line SB at mid point
	;;pt_rhs is rhs of line BS ;pt_lhs is lhs of line BS
	(setq pt_rhs (point_off_line ref_pnt pnt_s 0.5 (- half_pi) 3.0))
		
	;;compute intersections
	
	(setq pt_12 (inters pt_rhs pnt_fix pnt_b pnt_c)
		pt_23 (inters pt_rhs pnt_fix pnt_c pnt_d)
		
	)
	;;;determine the class by checking if pt_* is nil
	(if (/= pt_12 nil)  (setq pattern 1))
	(if (/= pt_23 nil)  (setq pattern 2))
	
);GET_VALUE2
;;;
;;;************************** Main Program *******************************
;;;Application #1  Squaring the circle
(defun C:Haga_circle_squaring()
	(haga_setup)
(make_jpg)
	(setq chrsize 0.05)
	;(setvar "OSMODE" 8)		;;;snap to the node
;;;step 1
	(command "_.point" '(0.5 0))
	(mark_point '(0.5 0) 0 -1.0 "1d" chrsize)
	(alert "\nSTEP:1\n\tMove the corner D to the mid-point on line AB")
	(setq ref_pnt pnt_d)
	(corner_pt1_2_pt2 pnt_d '(0.5 0))
(make_jpg)
	;(c:corner_2_pt2)
	(setq new_pt1 (inters pnt_b pnt_c pnt_s pnt_3s))
	(command "_.point" new_pt1)
	(mark_point new_pt1 0 -1.0 "2d" chrsize)
(make_jpg)
;;;step 2
	(alert "\nSTEP:2\n\tMove the corner D to the new point on line BC.\n
	the distance of this point from Corner-C is 1/3.")
	(setq ref_pnt pnt_d)
	(corner_pt1_2_pt2 pnt_d new_pt1)
(make_jpg)
	;(C:corner_2_pt2)
	(command "_.point" pt_12)
	(mark_point pt_12 0 -1.0 "3c" chrsize)
	(setq pt_12c pt_12)
(make_jpg)
;;;step 3
	(alert "\nSTEP:3\n\tMove the corner C to the new point(3) on line AB.\n
	The distance of this point from Corner-A is 2/9.")
	(setq ref_pnt pnt_c)
	(corner_pt1_2_pt2 pnt_c pt_12c)
(make_jpg)
	;(C:corner_2_pt2)
	(command "_.point" pt_30)
	(mark_point pt_30 0 -1.0 "4" chrsize)
(make_jpg)
;;;step 4
	(alert "\nThe newly created point on line BC is 16/81 from Corner-B.\n
		\nCreate a point at 2 * 16/81.")
	(setq pnt_5 (plt pnt_b pt_30 2.0))
	(command "_.point" pnt_5)
	(mark_point pnt_5 0 -1.0 "5a" chrsize)
(make_jpg)
	;(pt_extend pnt_b pt_30 2.0)
;;;step 5
	(alert "\nSTEP:5\n\tMove the corner A to the new point(5) on line BC.")
	;(C:corner_2_pt2)
	(setq ref_pnt pnt_a)
	(corner_pt1_2_pt2 pnt_a pnt_5)
(make_jpg)
	(setq new_pt2 (inters pnt_c pnt_d pnt_s pnt_3s))
	(command "_.point" new_pt2)
	(mark_point new_pt2 0 1.0 "6" chrsize)
(make_jpg)
;;;step 6
	(alert "nSTEP:6\n\tDefine a new point at 1/4 point from Corner-C to this new point(6)\n
			\n\tDistance of this point from Corner-C is  16 / 113\n
			\n\tThe length of D-A-B-C-E is 3.1415929204")
	(setq pnt_7 (plt pnt_c new_pt2 0.25))
	(command "_.point" pnt_7)
	;;;change layer back to "0"
	(command "_.layer" "_set" "0"  "")
	(setq pnt_e pnt_7)
	(mark_point pnt_e -0.05 0.1 "E" chr_size)
(make_jpg)
	(alert "The length of DABCE is the approximation of pi")
(if (/= (Yes_or_No "Want to proceed to next step ?") "_Y") (exit) )
	;(exit)
;;;***************************end of STEP 1 **********************************
;;;;;;;;;;;
	;;;create a point at (4 - pai) /4 from pnt_d
	;(pt_extend pnt_d pnt_e 0.25)
	(setq pnt_f (plt pnt_d pnt_e 0.25))
	(mark_point pnt_f -0.1 0.1 "F" chr_size)
	;;;drop a line from pnt_f perpendicular to Line AB 
	;;;to get pnt_g
	(command "_.point" (setq pnt_g (list (car pnt_f) 0)))
	(mark_point pnt_g -0.1 -1.1 "G" chr_size)
	;;;change layer (color)
	(command "_.layer" "_set" "layer10"  "")
	;;;Create 2 polyline entities to show the area enclosed by each hatching.
	(setvar "OSMODE" 0)
	;(command "_.pline" pnt_a pnt_g pnt_f pnt_d "_CL")
	;(setq left_pl (entlast))
	(command "_.pline" pnt_g pnt_b pnt_c pnt_f "_CL")
	(setq right_pl (entlast))
	;(command "_.hatch"  "ANSI37" "" "" left_pl "")
	(command "_.hatch"  "_Solid"  right_pl "")
	(setq hatch_rect (entlast))
	(command "area" "O" right_pl)
	(setq pai_by_4 (distance pnt_g pnt_b)
		pai_value (* 4 pai_by_4)
	)
	(setq res_str (strcat "\n\tRESULT\nThe area of the hatched rectangle is " 
				(rtos pai_by_4 2 10) 
				"\nPai value is " (rtos pai_value 2 10) ))
	(alert res_str)
;;;
	;(alert "\nErase these 2 hatches.")
	(alert "\nHide layer1 through 4")
	(command "_.layer" "_off" "layer1" "")
	(command "_.layer" "_off" "layer2" "")
	(command "_.layer" "_off" "layer3" "")
	(command "_.layer" "_off" "layer4" "")
	;;;; level = 10  case
	(if (= level 10) 
	(progn
		(alert "\nCreate an imaginary point on Line AB such that FG = HG")
		(command "_.point" (setq pnt_h (list (- (car pnt_g) 1.0)  0) ))
		(mark_point pnt_h -0.1 -1.1 "H" chr_size)
		(command "_.zoom" "E")
	));;;;end of if loop
	;(pt_extend pnt_a pnt_g 0.5)
	(setq pnt_k (plt pnt_a pnt_g 0.5))
	(mark_point pnt_k -0.1 -1.1 "K" chr_size)
;;;step 
	(alert "\n\tSTEP:9\nMove the Corner-B to line AD with Point K as a pivot.\n
		Select point K , then select corner B.")
	(setvar "OSMODE" 8)		;;;snap to the node
	(setq rx (distance pnt_k pnt_b)
		dx (distance pnt_a pnt_k)
		y_val (sqrt (- (* rx rx) (* dx dx)))
	)
	(entdel hatch_rect)
	(command "_.point" (list 0 y_val))

	(c:fixed_pt2)
	(setq out_len (cadr pnt_s)
		pnt_p pnt_s
		pnt_q (list out_len out_len)
		pnt_r (list out_len 0)
	)
	(entdel hatch_1)		;;;delete hatch 
	;;;change layer (color)
	(command "_.layer" "_set" "layer6"  "")
	(command "_.pline" pnt_a pnt_p pnt_q pnt_r "_CL")
	(setq final_pl (entlast))
	(command "_.hatch" "_solid" final_pl "")
	(setq final_hatch (entlast))
	(setq pl_center (inters pnt_a pnt_q pnt_p pnt_r))
	(command "_.point" pl_center)
	
	(alert "\nerase hatch ")
		(entdel final_hatch)
	(command "_.point" pnt_q)
	(command "_.point" pnt_r)
	(command "_.point" pnt_r)
	(command "_.layer" "_set" "0"  "")
	(mark_point pnt_p -1.1 -0.5 "P" chr_size)
	(mark_point pnt_q  0.1 -0.5 "Q" chr_size)
	(mark_point pnt_r -0.1 -1.1 "R" chr_size)
	(command "_.circle" '(0.5 0.5) 0.5)
	(setq circle_ent (entlast))
	(command "_.point" '(0.5 0.5))
	(command "_.copy" final_pl "" pl_center '(0.5 0.5) )
	(alert "\nSquare APQR has the same area as the circle ")
;;;step 7
);Haga_circle_squaring
;;;
;;;
(defun C:Haga_step_1()
	(haga_setup)
(make_jpg)
	(setq chrsize 0.05)
	;(setvar "OSMODE" 8)		;;;snap to the node
;;;step 1
	(command "_.point" '(0.5 0))
	(mark_point '(0.5 0) 0 -1.0 "1d" chrsize)
	(alert "\nSTEP:1\n\tMove the corner D to the mid-point on line AB")
	(setq ref_pnt pnt_d)
	(corner_pt1_2_pt2 pnt_d '(0.5 0))
(make_jpg)
	;(c:corner_2_pt2)
	(setq new_pt1 (inters pnt_b pnt_c pnt_s pnt_3s))
	(command "_.point" new_pt1)
	(mark_point new_pt1 0 -1.0 "2d" chrsize)
(make_jpg)
;;;step 2
	(alert "\nSTEP:2\n\tMove the corner D to the new point on line BC.\n
	the distance of this point from Corner-C is 1/3.")
	(setq ref_pnt pnt_d)
	(corner_pt1_2_pt2 pnt_d new_pt1)
(make_jpg)
	;(C:corner_2_pt2)
	(command "_.point" pt_12)
	(mark_point pt_12 0 -1.0 "3c" chrsize)
	(setq pt_12c pt_12)
(make_jpg)
;;;step 3
	(alert "\nSTEP:3\n\tMove the corner C to the new point(3) on line AB.\n
	The distance of this point from Corner-A is 2/9.")
	(setq ref_pnt pnt_c)
	(corner_pt1_2_pt2 pnt_c pt_12c)
(make_jpg)
	;(C:corner_2_pt2)
	(command "_.point" pt_30)
	(mark_point pt_30 0 -1.0 "4" chrsize)
(make_jpg)
;;;step 4
	(alert "\nThe newly created point on line BC is 16/81 from Corner-B.\n
		\nCreate a point at 2 * 16/81.")
	(setq pnt_5 (plt pnt_b pt_30 2.0))
	(command "_.point" pnt_5)
	(mark_point pnt_5 0 -1.0 "5a" chrsize)
(make_jpg)
	
;;;step 5
	(alert "\nSTEP:5\n\tMove the corner A to the new point(5) on line BC.")
	;(C:corner_2_pt2)
	(setq ref_pnt pnt_a)
	(corner_pt1_2_pt2 pnt_a pnt_5)
(make_jpg)
	(setq new_pt2 (inters pnt_c pnt_d pnt_s pnt_3s))
	(command "_.point" new_pt2)
	(mark_point new_pt2 0 1.0 "6" chrsize)
(make_jpg)
;;;step 6
	(alert "nSTEP:6\n\tDefine a new point at 1/4 point from Corner-C to this new point(6)\n
			\n\tDistance of this point from Corner-C is  16 / 113\n
			\n\tThe length of D-A-B-C-E is 3.1415929204")
	(setq pnt_7 (plt pnt_c new_pt2 0.25))
	(command "_.point" pnt_7)
	;;;change layer back to "0"
	(command "_.layer" "_set" "0"  "")
	(setq pnt_e pnt_7)
	(mark_point pnt_e -0.05 0.1 "E" chr_size)
(make_jpg)
	(alert "The length of DABCE is the approximation of pi")
	(reset_sysvar)
);;Haga_step_1
;;;
;;;
(defun C:Haga_step_2()
(make_jpg)
	(alert "\nHide layer1 through 4")
	(command "_.layer" "_off" "layer1" "")
	(command "_.layer" "_off" "layer2" "")
	(command "_.layer" "_off" "layer3" "")
	(command "_.layer" "_off" "layer4" "")
(make_jpg)
	;;;;;;;;;;;
	;;;create a point at (4 - pai) /4 from pnt_d
	(alert "\nCreate point F, 0.25 from D")
	;(pt_extend pnt_d pnt_e 0.25)
	(setq pnt_f (plt pnt_d pnt_e 0.25))
	(command "_.point" pnt_f)
	(mark_point pnt_f -0.1 0.1 "F" chr_size)
(make_jpg)
	;;;drop a line from pnt_f perpendicular to Line AB 
	;;;to get pnt_g
	(alert "\nFG is parallel to DA")
	(command "_.point" (setq pnt_g (list (car pnt_f) 0)))
	(mark_point pnt_g -0.1 -1.1 "G" chr_size)
(make_jpg)
	;;;change layer (color)
	(command "_.layer" "_set" "layer101"  "")
	;;;Create 2 polyline entities to show the area enclosed by each hatching.
	(setvar "OSMODE" 0)
	
	(command "_.pline" pnt_g pnt_b pnt_c pnt_f "_CL")
	(setq right_pl (entlast))
	
	(command "_.hatch"  "_Solid"  right_pl "")
(make_jpg)
		(setq hatch_rect (entlast))
	(command "area" "O" right_pl)
	(setq pai_by_4 (distance pnt_g pnt_b)
		pai_value (* 4 pai_by_4)
	)
	(setq res_str (strcat "\n\tRESULT\nThe area of the hatched rectangle is " 
				(rtos pai_by_4 2 10) 
				"\nPai value is " (rtos pai_value 2 10) ))
	(alert res_str)
	(reset_sysvar)
)
;;;
;;;
(defun C:Haga_step_3()
	(alert "\nPoint K is a mid point of AG")
	(setq pnt_k (plt pnt_a pnt_g 0.5))
	(command "_.point" pnt_k)
	(mark_point pnt_k -0.1 -1.1 "K" chr_size)
 
	(alert "\n\tMove the Corner-B to line AD with Point K as a pivot.\n
		This is equivalent to drawing a circle with radius KB.")
	
	(setq rx (distance pnt_k pnt_b)
		dx (distance pnt_a pnt_k)
		y_val (sqrt (- (* rx rx) (* dx dx)))
		pnt_h (list 0 y_val)
	)
	(entdel hatch_rect)
	(command "_.point" pnt_h)
	
	(setq ref_pnt pnt_b)
	(corner_pt1_2_pt2 pnt_b pnt_h)
	(setq out_len (cadr pnt_s)
		pnt_p pnt_s
		pnt_q (list out_len out_len 0)
		pnt_r (list out_len 0 0)
	)
	
	;;;change layer (color)
	(command "_.layer" "_set" "layer6"  "")
	(command "_.pline" pnt_a pnt_p pnt_q pnt_r "_CL")
	(setq final_pl (entlast))
	(command "_.hatch" "_solid" final_pl "")
	(setq final_hatch (entlast))
	
	(setq pl_center (inters pnt_a pnt_q pnt_p pnt_r))
	(command "_.point" pl_center)
	
	(alert "\nerase final_hatch ")
		(entdel final_hatch)
	(command "_.point" pnt_q)
	(command "_.point" pnt_r)
	(command "_.point" pnt_r)
	(command "_.layer" "_set" "0"  "")
	(mark_point pnt_p -1.1 -0.5 "P" chr_size)
	(mark_point pnt_q  0.1 -0.5 "Q" chr_size)
	(mark_point pnt_r -0.1 -1.1 "R" chr_size)
	(command "_.circle" '(0.5 0.5) 0.5)
	(setq circle_ent (entlast))
	(command "_.point" '(0.5 0.5))
	(alert "\nMove this square to the center.")
	(command "_.copy" final_pl "" pl_center '(0.5 0.5) )
	(alert "\nSquare APQR has the same area as the circle ")
	(reset_sysvar)
)
;;;
;;;
;;;
(defun c:test1()
	;(setq nstep (1+ nstep)
	;	layer_name (strcat "layer" (itoa nstep))
	;)
	(setq pnt_fix (getpoint "\nSelect a fix point:"))
	(setq ref_tmp (getpoint "\nSelect a corner point:")
		ref_pnt (osnap ref_tmp "end")
	)
	;(sel_corner)
	(command "_.line" '(0 0) '(1 0) "")		;dummy
	(command "_.layer" "_set" layer_name "")
	(setq vec_len (distance pnt_fix ref_pnt))
	(while (and (setq key (grread T)) (= (car key) 5))
    		(setq pnt_tmp (cadr key))
		(setq temp_angle (angle pnt_fix pnt_tmp)
			pnt_tmp (polar pnt_fix temp_angle vec_len)
		)
		  (entdel (entlast))	;redraw
		  (make_line_1 "0" 1 pnt_fix pnt_tmp)
	)
	(reset_sysvar)
);C:TEST1