(prompt "\nAngle Trisection by AutoCAD - PAPPUS_HYPERBOLA.LSP")
(prompt "\nCommands:  TEST  TEST_2 PAPPUS_1 ")
(prompt "\nFunctions: (LOCATE)  (LOCATE_XY) (SETUP) ")
(prompt "\n           ")
;----------------------------------------------------------
;Draw a hyperbola for trisection 
;;;By Takaya Iwamoto   Feb 12, 2000
;;;Jan 20, 2006  PAPPUS_1.LSP was renamed Pappus_Hyperbola.lsp
;;;PAPPUS_1.LSP
;;;
;;;TEST
;;;main trial routine
(defun c:test()
	(setup)		;setup parameters
	(alert "\nPlace the cursor at the starting point")
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_temp (cadr key)) 
		(locate pnt_temp)
		(make_pt "0" 2 pnt_newr)
	);inner while loop
	(make_line_1 "0" 4 pnt_org (polar pnt_org (dtr 60) 10))
	(make_line_1 "0" 4 pnt_org (polar pnt_org (dtr -60) 10))
	(reset_sysvar)
	
);TEST
;;;
;;;
;;;TEST_2
;;;main trial routine
(defun c:test_2()
	(setup)		;setup parameters
	
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_temp (cadr key)) 
		(locate pnt_temp)
		(make_pt "0" 2 pnt_newr)
	);inner while loop
	(make_line_1 "0" 4 pnt_org (polar pnt_org (dtr 60) 10))
	(make_line_1 "0" 4 pnt_org (polar pnt_org (dtr -60) 10))
	(reset_sysvar)
	
);TEST_2
;;;
;;;main trial routine
(defun c:pappus_1()
	(setup_pappus)		;setup parameters
	
	(command "_.point" (setq pnt_start  (getpoint "\nInput start value for y: ")) ) 
	(setq y_start (cadr pnt_start))
	(command "_.point" (setq pnt_end  (getpoint "\nInput end value for y: ")) )
	(setq y_end (cadr pnt_end))
	(setq y_step (getreal "\nstep value in y-direction(def = 0.1): "))

	(if (= y_step nil) (setq y_step 0.01))
	(if (> y_start y_end) (setq y_s y_end y_e y_start ) (setq y_s y_start y_e y_end))
	(setq 	y_value  y_s
		pnt_old (list 0 y_s)
		step 0
	)
	(while (<= y_value y_e )
		(locate_xy y_value)
		;(make_pt "0" 0 pnt_new)
		(if (= step 0) (setq step 1) (make_line_1 "layer2" 2 pnt_old pnt_new))
		(setq pnt_old pnt_new)
		(setq y_value (+ y_value y_step))
	);inner while loop
	;(make_line_1 "0" 4 pnt_org (polar pnt_org (dtr 60) c_value))
	;(make_line_1 "0" 4 pnt_org (polar pnt_org (dtr -60) c_value))
	(reset_sysvar)
	
);PAPPUS_1
;;;
;;;

;;;
;;;LOCATE
;;;compute distance from the focus and divide that value by the eccentricity
;;;to get the x-value
;;;
(defun locate(pnt_temp / x_temp y_temp a_1 a2 a_3
			new_xr )

	(setq x_temp (car pnt_temp)
		y_temp (cadr pnt_temp)
		a_1 (* 4 c_sqr)
		a_2 (* 3.0 (* y_temp y_temp))
		a_3 (/ (sqrt (+ a_1 a_2)) 3.0)
		new_xr (+ (- third_c) a_3)
		pnt_newr (list new_xr y_temp)
	)
);LOCATE
;;;
;;;
;;;LOCATE_XY
;;;compute distance from the focus and divide that value by the eccentricity
;;;to get the x-value
;;;
(defun locate_xy(y_value / x_value  a_1 a2 a_3 )

	(setq 	a_1 (* 4 c_sqr)
		a_2 (* 3.0 (* y_value y_value))
		a_3 (/ (sqrt (+ a_1 a_2)) 3.0)
		x_value (+ (- third_c) a_3)
		pnt_new (list x_value y_value)
	)
);LOCATE_XY
;;;
;;;
;;;SETUP
;;; setup
(defun SETUP()
	(setup_sysvar)
	;(set_layer)	;define layers
	(set_txstyle "arial")
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -3)
	(setq c_value (getreal "\nInput semi-chord length(def = 3): "))
		(if (= c_value nil) (setq c_value 3.))
	(setq 	third_c (/ c_value 3.0)
		c_sqr (* c_value c_value)
		pnt_ref (list third_c 0)
		pnt_foc (list c_value 0)
		pnt_f2 (list (- c_value) 0)
		pnt_org (list (- third_c) 0)
		x_right (list (* 1.1 c_value) 0)
		x_left  (list (* 1.1 (- c_value)) 0)
		y_up  (list 0  (* 0.5 c_value))
		y_down (list 0 (- c_value))
	)
	(make_line_1 "0" 0 x_left  x_right)
	(make_line_1 "0" 0 y_down   y_up)
	(command "_.zoom" "e") 
	
	(regapp "my_point")
	(make_point "0" 0  pnt_ref  "A" 3 0.20)
	(make_point "0" 0 pnt_foc "F" 1 0.20)

);SETUP
;;;
;;;SETUP_PAPPUS
;;; setup
(defun SETUP_PAPPUS()
	(setup_sysvar)
	;(set_layer)	;define layers
	(set_txstyle "arial")
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -3)
	
	(setq 	c_value 3.
		third_c (/ c_value 3.0)
		c_sqr (* c_value c_value)
		pnt_ref (list third_c 0)
		pnt_f1 (list c_value 0)
		pnt_f2 (list (- c_value) 0)
		;pnt_org (list (- third_c) 0)
		x_right (list (* 1.1 c_value) 0)
		x_left  (list (* 1.1 (- c_value)) 0)
		y_up  (list 0   c_value)
		y_down (list 0 (- (* 0.75 c_value)))
	)
	
	(make_line_1 "0" 0 x_left  x_right)
	(make_line_1 "0" 0 y_down   y_up)
	
	
	(regapp "my_point")
	(make_point "0" 0  pnt_ref  "A" 3 0.20)
	(make_point "0" 0 pnt_f1 "F1" 1 0.20)
	(make_point "0" 0 pnt_f2 "F2" 1 0.20)
	
	(command "_.zoom" "_e") 
	(command "_.regen")

	(setq pnt_org (getpoint pnt_f1 "\nDefine a point O"))
	(make_line_1 "0" 8 pnt_org pnt_f1)
	(make_line_1 "0" 8 pnt_org pnt_f2)
	
	(command "_.arc" "C" pnt_org pnt_f1 pnt_f2)



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