(prompt "\nAngle Trisection (H.Abe) by AutoCAD - ABET.LSP")
(prompt "\nCommands:  ABET_1 ABET_2 ABET_3 ABET_4 ABET_5")
(prompt "\nFunctions: (SETUP)(SEL_CORNER)(ABET_SETUP)(IS_VALID)(GET_VALUE)(RESET)")
(prompt "\n           (DISPLAY_RESULT)(FINISH)(INIT_DISPLAY)(DRAW_CURVE_2)(POST_PROC)")
(prompt "\n           (FINISH_3)(ABET_SETUP_4)(DRAW_CURVE_3)(DEF_ANGLE)(DEF_CARP_SQR)")
(prompt "\n           (DEF_TOMAHAWK)")
;----------------------------------------------------------
;;;	Coded by Takaya Iwamoto
;;origami utility routine   12-11-99
;;;  abet.lsp
;;;* Trisection by Abe Hisashi
;;;  Execution
;;;  abet_1
;;;  abet_2
;;;  abet_3
;;;  abet_4
;;;  abet_5	for block insertion   Carp_sqr  & Tomahawk
;;;
(defun c:ABET_1()
	(setup_abeh)
	
	(sel_corner)
	(abet_setup)
	(command "_.line" '(0 0) '(1 0) "")		;dummy
	(command "_.layer" "_set" "layer8" "")
	(alert "\nLeft-click your mouse along the line GH.\n Hit return key or click Right mouse to quit")
	(while  (setq pnt_tmp (getpoint"\nLeft-click your mouse along the line GH. \nHit return key or Right Mouse to quit"))
	;;;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 pnt_tmp)	
		  (display_result)
		);;end of PROGN
	   );;end of if loop
	);;end of while loop
	(command "_.layer" "_set" "0" "")
	(finish)
	(reset_sysvar)
);ABET_1
;;;
(defun c:ABET_2()
	(setup_abeh)
	(sel_corner)
	(abet_setup)
	(command "_.line" '(0 0) '(1 0) "")		;dummy
	(init_display)				;initial display
	(alert "Press left mouse to start.\n Mouse click will stop the execution.
		\nMove the mouse until the red point lies on the blue line.")
	(setq answer (getpoint "\nPress left mouse to start."))
	(command "_.layer" "_set" "layer8" "")

	(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 pnt_tmp)	
		  (display_result)
		)
	   )
	)
	(command "_.layer" "_set" "0" "")
	(finish)
	(reset_sysvar)
);ABET_2
;;
;;;abet_3 use the locus curve
(defun c:ABET_3()
	(setup_abeh)
	
	(abet_setup)
	(draw_curve_2)
	(post_proc)
	(finish_3)

);ABET_3
;;;abet_4 use the predrawn locus curve
(defun c:ABET_4()
	(setup_abeh)
	
	(abet_setup_4)
	(draw_curve_3)
	(def_angle)
	(post_proc)	;;;end_pnt is the intersection point
			;;;point_s is the final point on line GH
			;;;
	(finish_3)		;;display the resulting angle
	
);ABET_4

;;;abet_5 demonstrates that Carpenter's Square and Tomahawk are basically the same
;;;as Abetsune's origani method
(defun c:ABET_5()
	;;;define the block
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" 0.02)
	(def_carp_sqr 0.3)
	(def_tomahawk 0.3)

	(setup_abeh)
	
	(abet_setup_4)
	(draw_curve_3)
	(def_angle)
	(post_proc)	;;;end_pnt is the intersection point
			;;;point_s is the final point on line GH
			;;;
	(finish_3)		;;display the resulting angle
	(alert "Use  -insert  command to insert the block")
	
);ABET_5
;;;*  ;setup_abeh
;;;
(defun SETUP_ABEH()

	(setup_sysvar)
	;(set_layer)
	(set_txstyle "arial")
	(setq half_pi (* 0.5 pi))
	(setq point_a '(0 0)	point_b '(1 0)  point_c '(1 1)  point_d '(0 1)
		limit_r (sqrt 2.0)  	limit_l 0.0
		min_val 0.1
		corner_list (list point_a point_b point_c point_d)
		pnt_size 0.065
	)
	;(command "_.point" '(0.5 1.0))
	(command "_.layer" "_set" "layer8" "")
	(command "_.line" point_a point_b point_c point_d "_c" "")
	(command "_.layer" "_set" "0" "")
	(regapp "my_point")
	(make_point "0" 0 point_a  "A" 4 pnt_size)
	(make_point "0" 0 point_b  "B" 4 pnt_size)
	(make_point "0" 0 point_c  "C" 2 pnt_size)
	(make_point "0" 0 point_d  "D" 2 pnt_size)
	(command "_.zoom" "_EXTENT")
	;;;(command "_.zoom" "_scale" "7.5")
;; This is a temp scale for testing
	(command "_.zoom" "_scale" "5.0")
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" 0.02)
);SETUP_ABEH
;;
;;
(defun SEL_CORNER()
	(setq c_index 0
		ref_pnt point_a
	)
);SEL_CORNER
;;
(defun ABET_SETUP()
	(def_angle)
	(setq refline (getpoint "\nPick a point for a horizontal reference line:(EF)"))
	(setq y_1 (cadr refline)
		y_2 (* 0.5 y_1)
		pnt_y2 (list 0 y_2)
		pnt_y1 (list 0 y_1)
		pnt_y1r (list 1 y_1)
		pnt_y2r (list 1 y_2)
		mark_size 0.05
	)
	(make_line_1 "layer3" 3 pnt_y1 pnt_y1r)
	(make_line_1 "layer3" 3 pnt_y2 pnt_y2r)
	(make_point "0" 0 pnt_y1  "E" 3 pnt_size)
	(make_point "0" 0 pnt_y1r "F" 1 pnt_size)
	(make_point "0" 0 pnt_y2  "G" 3 pnt_size)
	(make_point "0" 0 pnt_y2r "H" 1 pnt_size)
);ABET_SETUP
;;;
;;;DEF_ANGLE
;;;
;specify the angle to be tri_sected
(defun DEF_ANGLE()
	
	(command "_.arc" "_ce" point_a point_b point_d)
	(setq temp_arc (entlast))
	(command "_.osnap" "_nearest")
	
	(alert "Select a point on the arc to define an angle")
	(setq pnt_a (getpoint point_a "\nDefine a point \"A\":"))
	(setq pnt_a (fac_on_line point_a pnt_a 1.25))
	(make_line_1 "layer4" 4 pnt_a point_a  )
	(setq def_line (entlast))
		
	(entdel temp_arc)
	
	
);DEF_ANGLE
;;
;;;
;;; 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))
);IS_VALID
;;;
;;;
;;;
(defun DISPLAY_RESULT()
	;(prin1 pattern)
	(if (= pattern 1)
		(progn
		(setq pnt_y1s (point_sym_line pt_30 pt_01 pnt_y1))
		(make_pt "0" 1 pnt_y1s)
		(command "_.pline" pt_30 point_s pt_01 point_1 point_2 point_3  
				  pt_30 pt_01 "")
		)
	)
	(if (= pattern 2)
		(progn
			(setq point_1s (point_sym_line pt_30 pt_12 point_1))
			(command "_.pline" pt_30 point_s point_1s pt_12 point_2 point_3 
				 pt_30 pt_12 "")
		)
	)
	(if (= pattern 3)
		(progn
			(setq pnt_y1s (point_sym_line pt_01 pt_23 pnt_y1))
			(make_pt "0" 1 pnt_y1s)
			(setq point_3s (point_sym_line pt_01 pt_23 point_3))
			(command "_.pline" pt_23 point_3s point_s pt_01 point_1 point_2 
				pt_23 pt_01 "")
		)
	)
	(if (= pattern 4)
		(progn
			(setq point_1s (point_sym_line pt_23 pt_30 point_1))
			(setq point_2s (point_sym_line pt_23 pt_30 point_2))
			(command "_.pline" pt_30 point_s point_1s point_2s pt_23 point_3 
				 pt_30 pt_23 "")
		)
	)
	(if (= pattern 5)
		(progn
			(setq point_1s (point_sym_line pt_12 pt_23 point_1))
			(setq point_3s (point_sym_line pt_12 pt_23 point_3))
			(command "_.pline" pt_23 point_3s point_s point_1s pt_12 point_2
				 pt_23 pt_12 "")
		)
	)
	(if (= pattern 6)
		(progn
			(setq point_2s (point_sym_line pt_01 pt_12 point_2))
			(setq point_3s (point_sym_line pt_01 pt_12 point_3))
			(command "_.pline" pt_12 point_2s point_3s point_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 a reference line y_2
	
);DISPLAY_RESULT
		
;compute translation & angle values from x_tmp
(defun GET_VALUE(pnt_tmp)
	(setq x_tmp (car pnt_tmp)
		pnt_tmp (list x_tmp y_2)
		point_s pnt_tmp
	)
	;;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 point_s 0.5 half_pi 3.0)
		pt_lhs (point_off_line ref_pnt point_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
;;;
(defun C:RESET()
	(entdel (entlast))
);RESET
;;;
;;;draw_curve in parametric form
;;;    x = t*( (t^2 - 3*m^2) / (t^2 + m^2) )
;;;    y = m*( (3*t^2 -m^2 ) / (t^2 + m^2) )
;;;       0 <= t 
(defun DRAW_CURVE_1()
	(setq t_start 0.0  t_end 2.75 )
	(setq t_step (getreal "\nInput parameter t  step in <0.1>:"))
  (if (<= t_step 0.0) (setq t_step 0.1))
	(setq t_old (- t_start t_step)
		pnt_old (list 0 (- y_2)) )
	
  (while (<= (setq t_new (+ t_old t_step)) t_end)
    (setq m_sqr (* y_2 y_2)
		t_sqr (* t_new t_new)
		denom (+ m_sqr t_sqr)
		x_num (* t_new (- t_sqr (* 3.0 m_sqr)) )
		y_num (* y_2 (- (* 3.0 t_sqr) m_sqr) )
		x_value (/ x_num denom)
		y_value (/ y_num denom)
		pnt_new (list x_value y_value)
    )
	
    	;;(make_pt "0" 1 pnt_new)
	(make_line_1 "0" 2 pnt_old pnt_new)
    	(setq t_old t_new
		pnt_old pnt_new)

  )
	(setq last_line (entlast))
);DRAW_CURVE_1
;;;	
;;;draw_curve in explicit  form
;;;
;;; x = m*(y/m - 2)*sqrt( (1 + y/m) / (3 - y/m) )
;;;      -m <= y < 3*m
(defun draw_curve_2()
	(setq y_start (- y_2)
		y_end (* 2.75 y_2)
		
	)
	(setq y_step (getreal "\nInput parameter t  step in <0.1>:"))
  (if (<= y_step 0.0) (setq y_step 0.1))
	(setq y_old (- y_start y_step)
		pnt_old (list 0 (- y_2)) )
	
  (while (<= (setq y_new (+ y_old y_step)) y_end)
    (setq yt (/ y_new y_2)
		num_1 (+ 1.0 yt)
		num_2 (- yt 2.0)
		denom (- 3.0 yt)
		x_value (* y_2 num_2 (sqrt ( /  num_1 denom)))
		y_value y_new
		pnt_new (list x_value y_value)
    )
	
    	;(make_pt "0" 1 pnt_new)
	(make_line_1 "layer5" 5 pnt_old pnt_new)
    	(setq y_old y_new
		pnt_old pnt_new)
  )
	(setq last_line (entlast))
);DRAW_CURVE_2

;;;
;;;draw_curve in explicit  form with parameter set as 0.001
;;;
;;; x = m*(y/m - 2)*sqrt( (1 + y/m) / (3 - y/m) )
;;;      -m <= y < 3*m
(defun draw_curve_3()
	(setq y_start (- y_2)
		y_end (* 2.75 y_2)
		
	)
	(setq y_step 0.001)
  (if (<= y_step 0.0) (setq y_step 0.1))
	(setq y_old (- y_start y_step)
		pnt_old (list 0 (- y_2)) )
	
  (while (<= (setq y_new (+ y_old y_step)) y_end)
    (setq yt (/ y_new y_2)
		num_1 (+ 1.0 yt)
		num_2 (- yt 2.0)
		denom (- 3.0 yt)
		x_value (* y_2 num_2 (sqrt ( /  num_1 denom)))
		y_value y_new
		pnt_new (list x_value y_value)
	)
	
    	;(make_pt "0" 1 pnt_new)
	(make_line_1 "layer5" 5 pnt_old pnt_new)
    	(setq y_old y_new
		pnt_old pnt_new)

    )
	(setq last_line (entlast))
);DRAW_CURVE_3

;;;
;;;
;;;
(defun POST_PROC()
	(command "_.layer" "_off" "layer8" "")

	(command "_.layer" "_off" "layer3" "")
	(command "_.layer" "_off" "layer4" "")
	;(command "_.layer" "_off" "layer8" "")

	(command "_.pedit" last_line "_Y" "_Join" "_all" "" "")
	(setq new_curve (entlast))

	(command "_.layer" "_on" "layer4" "")

	(command "_trim" new_curve "" pnt_a "")
	
	(alert "redisplay layer8 & layer3")
	(on_layer "layer8")
	(on_layer "layer3")
);POST_PROC
;;;
;;;usd only for abet_1 & abet_2 cases
(defun FINISH()
	(make_line_1 "layer4" 4 point_a point_s)
	(mark_angle point_b point_a pnt_y1s  0.30 "3f"  mark_size 1)
	(mark_angle point_b point_a point_s  0.20 "f" mark_size 1)
);FINISH
;;;
;;;usd only for abet_3 & abet_4 cases
(defun FINISH_3()
			;;get end point data for def_line entity
	(setq end_point (get_ent_data def_line 10)
		res_rad (distance point_a end_point)
		arc_start (list res_rad 0)
		x_s (sqrt (- (* res_rad res_rad) (* y_2 y_2)))
		point_s (list x_s y_2)
	)
	(command "_.arc" "CE" point_a arc_start end_point)
	
	(make_line_1 "layer4" 4 point_a point_s)
	(mark_angle point_b point_a end_point  0.30 "3f"  mark_size 1)
	(mark_angle point_b point_a point_s  0.20 "f" mark_size 1)
);FINISH_3
;;;
;;;
(defun C:RESET()
	(command "_erase" "all" "")
);RESET
;;;
(defun INIT_DISPLAY()
	
	(setq init_pos (list (* 0.5 (+ y_1 y_2)) y_2))
	(get_value init_pos)
	(display_result)
);INIT_DISPLAY
;;
(defun abet_setup_4()
	
	(setq y_1 0.6 y_2 0.3
		pnt_y2 (list 0 y_2)
		pnt_y1 (list 0 y_1)
		pnt_y1r (list 1 y_1)
		pnt_y2r (list 1 y_2)
		mark_size 0.05
	)
	(make_line_1 "layer3" 3 pnt_y1 pnt_y1r)
	(make_line_1 "layer3" 3 pnt_y2 pnt_y2r)
	(make_point "0" 0 pnt_y1  "E" 3 pnt_size)
	(make_point "0" 0 pnt_y1r "F" 1 pnt_size)
	(make_point "0" 0 pnt_y2  "G" 3 pnt_size)
	(make_point "0" 0 pnt_y2r "H" 1 pnt_size)
);
;define a block named "carp_sqr"
;this block will be used for trisection
;;;usage : (command "_insert" "carp_sqr" pnt_new 1.0 1.0 theta)
(defun def_carp_sqr(x / 
		pnt_1 pnt_2 pnt_3 pnt_4 pnt_5 pnt_6
		x2 x3 x4
		)
	
	(command "_.layer" "_set" "layer2" "")
	(setq x2 (* 2 x) x3 (* 3 x) x4 (* 4 x)
		pnt_1 (list (- x4) 0)
		pnt_2 '(0 0)
		pnt_3 (list 0 x3)
		pnt_4 (list (- x) x3)
		pnt_5 (list (- x) x)
		pnt_6 (list (- x4) x)
	)
	
	(command "_.pline" pnt_1 pnt_2 pnt_3 pnt_4 pnt_5 pnt_6 "_C")
	
	(make_pt "layer2" 2 (list 0 x2))
	(make_pt "layer2" 2 pnt_2)
	
	(command "_.zoom" "_EXTENT" )
	(alert "define this drawing as a block named \"Carp_sqr\"")

	(command "_.block" "carp_sqr" '(0 0) "_all" "")
	(command "_.layer" "_set" "0" "")
);DEF_CARP_SQR
;;;
;;;DEF_TOMAHAWK
;define a block named "tomahawk"
;this block will be used for trisection
;;;usage : (command "_insert" "tomahawk" pnt_new 1.0 1.0 theta)
(defun DEF_TOMAHAWK(x / 
		pnt_0 pnt_1 pnt_2 pnt_3 pnt_4 pnt_5
		pnt_6 pnt_7 pnt_8 pnt_9
		third_x x2 x4 )

	(command "_.layer" "_set" "layer6" "")
	(setq third_x (/ x 3.0) x2 (* 2 x) x4 (* 4 x) 
		pnt_0 '(0 0)
		pnt_1 (list 0 (- x))
		pnt_2 (list third_x (- x))
		pnt_3 (list third_x x2)
		pnt_4 (list 0 x2)
		pnt_5 (list 0 (+ x third_x) )
		pnt_6 (list (- x4) (+ x third_x))
		pnt_7 (list (- x4) x)
		pnt_8 (list 0 x)
		pnt_9 (list (- x) 0)
	)
	
	(command "_.pline"  pnt_2 pnt_3 pnt_4 pnt_5 pnt_6
			pnt_7 pnt_8 "arc" "ce" pnt_0 pnt_1 "L" "CL")
	(make_pt "layer6" 6 pnt_0)
	(make_pt "layer6" 6 pnt_4)
	
	(command "_.zoom" "_EXTENT" )
	(alert "Define this drawing as a block named \"Tomahawk\"")
	(command "_.block" "tomahawk" '(0 0) "_all" "")
	(command "_.layer" "_set" "0" "")
);DEF_TOMAHAWK

;;--------------------------------------------------------------------------
(princ)