(prompt "\nDoubling the Cube by AutoCAD - EUDOXUS.LSP")
(prompt "\nCommands:  TEST_1  TEST_2  EUDOXUS_DELIAN Draw_Eudoxus_curve ")
(prompt "\nCommands:  DIVIDE_ANGLE  ")
(prompt "\n           ")
;----------------------------------------------------------
;;
;;	EUDOXUS.LSP
;;    Finding the intersection of cone, torus & cylinder by Eudoxus
;;    variation of Archytas's approach
;;
;;	by Takaya Iwamoto	updated Dec 14, 2006
;;;List of executables
;;;	test_1			pick the location on line BF by mouse
;;;	test_2			continuous pick the location on line BF by mouse
;;;	Eudoxus_DELIAN			semi-automatic zooming to find the intersection
;;;	Draw_Eudoxus_curve	Draw the intersection curve
;;
;;;	test_1					
(defun c:test_1 ()

  (setup_eudoxus)	;;setup
  (disp_pline 0.5)	;;initial display
  (while (setq pnt_temp	(getpoint
		  "\nPick a point on the line BF. Hit return key to quit"))
    (setq pnt_y (cadr pnt_temp))
    (entdel line_ent)
    (disp_pline pnt_y)
  )
  (reset_sysvar)
);TEST
;;
;;
;;;	test_2	continuous pick				
(defun c:test_2 ()
  (setup_eudoxus)	;;setup
  (disp_pline 0.5)	;;initial display
  (setq	answer
	 (getpoint
	   "Place the cursor near the line BF, then press left mouse to start.\n
	Press left mouse or return key to terminate."
	 )
  )

;;; while loop to pick a point continuously

  (while (and (setq key (grread T)) (= (car key) 5))
    (setq pnt_y (cadr(cadr key)))
    (entdel line_ent)
    (disp_pline pnt_y)
   
  )					;while
   (reset_sysvar)
);TEST_2
;;
;;;
;;;
;;;EUDOXUS
;;;
;;;main routine :::   zoom & regen is done automatically
(defun c:EUDOXUS_DELIAN()
	(setup_eudoxus)		;;setup
  	(disp_pline 0.5)	;;initial display
	
	(setq flag "GO" split_win "NO")
	(alert "Move the cursor near the line BF,
		\nthen click your left mouse to begin moving along the line BF.\n
		\nHit return key to terminate." )
	(setq answer (getpoint "\nPress left mouse for automatic zooming and regen."))
	(make_jpg)
	(while (= flag "GO")
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_y (cadr(cadr key)))
    		(entdel line_ent)
		(entdel pnt_ent)
    		(disp_pline pnt_y)
		(show_status)
				
	);inner while loop
	;;;after the 2-nd round,work with 3 viewports.
		;(if (= split_win "NO") (command "_.vports" "2" "v"))
	(if (= split_win "NO") 
			(progn
				(command "_.vports" "3" "_L")
				(setvar "CVPORT" 2)
				(command "_.zoom" "_E")
				(setvar "CVPORT" 3)
				(command "_.zoom" "_E")
				(setvar "CVPORT" 4)
				(command "_.zoom" "_E")
		)
	)
	;;;;convergence criteria check
		(if (= (converge) T) (setq flag "STOP"))
	;;;;zoom and regen automatically for 2 viewports
		(zoom_regen pnt_new pnt_g )
		(setq split_win "YES")
		;(make_jpg)
	);outer while loop
	(command "_.vports" "SI" )	;;;single view port
	(result_display)
	
	(command "_.zoom" "_EXTENT")
	(make_jpg)
	(reset_sysvar)
);Eudoxus_delian
;;
;;;
;;;CONVERGE
;;;
;;;check the convergence comparing the radius and line segment OL
(defun CONVERGE( / result)
	(setq diff_length (abs (- (distance pnt_o pnt_new) ref_rad)))
	(if (< diff_length criteria) (setq result T) (setq result nil))
);CONVERGE
;;;
;;;ZOOM_REGEN
;;;
(defun ZOOM_REGEN(pnt_target pnt_move)
	;;;Target point
	(setq pnt_on_rad (pld pnt_o pnt_target ref_rad)
		ref_len (* 2 (distance pnt_on_rad pnt_target))
	)
;;;focus on the target point
	(setvar "CVPORT" 3)
	(command "_.regen")		
	(command "_.zoom" "ce" pnt_on_rad ref_len)
	(command "_.regen")

	;;;Mouse control point
;;;focus on the control point
	(setvar "CVPORT" 4)		
	(command "_.zoom" "ce" pnt_move (* 1.5 ref_len))
	(command "_.regen")
	(make_jpg)
);ZOOM_REGEN
;;;
;;;SHOW_STATUS
;;; show the distance between tip and the horizontal line
(defun SHOW_STATUS( /  result)
	(setq diff_length (abs (- (distance pnt_o pnt_new) ref_rad)))
	(setq 	result (strcat "dist = " (rtos diff_length 2 12)))
	(move_bar diff_length meter_scale)
	;(grtext -1 result)
);SHOW_STATUS
;;;
;;;
;;;RESULT_DISPLAY
;;; show the distance between tip and the horizontal line
(defun RESULT_DISPLAY( /  result)
	(make_line_1 "layer1" 1 pnt_a pnt_b)
	(make_line_1 "layer2" 2 pnt_a pnt_new)
	(make_line_1 "layer3" 3 pnt_a pnt_c)

	(setq diff_length (abs (- (distance pnt_o pnt_new) ref_rad)))
	(setq 	result (strcat "dist = " (rtos diff_length 2 12)))
	;(grtext -1 result)
	(make_point "0" 0 pnt_g "G" 1 chr_size)
  	(make_point "0" 0 pnt_new "L" 1 chr_size)
	(setq len_ab 1.0
		len_al (distance pnt_a pnt_new)
		len_ac 2.0
		cube_al (expt len_al 3)
	)
	
	(setq
		line_1  "Result"
		line_2  "AL**3 = AC / AB"
		line_3  (strcat "AL        = " (rtos len_al 2 10))
		line_31         "(Exact  = 1.259921049895)"
		line_4  (strcat "AL**3    = " (rtos cube_al 2 10))
		line_5          "AC / AB = 2.0  (Given)"
	
	)
	(textdisplay  line_1 '(1.0 0.75) 0.090 0)
	(textdisplay  line_2   '(0.85 0.60) 0.075 0)
	(textdisplay  line_3   '(0.90 0.50) 0.05 0)
	(textdisplay  line_31  '(0.90 0.40) 0.05 0)
	(textdisplay  line_4 '(0.90 0.25) 0.05 0)
	(textdisplay  line_5 '(0.90 0.10) 0.05 0)
	
);RESULT_DISPLAY
;;;
;;SETUP_EUDOXUS
(defun setup_eudoxus()
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -1)
  (setup_sysvar)
  (setq	const_a	   (/ 2.0 pi)
	sqrt_3 (sqrt 3.0)
	pnt_a '(0 0)
	pnt_c '(2 0)
	pnt_b (list 0.5 (/ sqrt_3 2.0))
	pnt_f '(0.5 0)
	pnt_o '(1 0)
	chr_size 0.075
	ref_rad 1.0
	criteria 1.e-7
  )

  (make_line_1 "0" 8 pnt_a pnt_c)
  (make_line_1 "0" 8 pnt_b pnt_f)
  (make_arc_cbe "0" 8 pnt_o pnt_c pnt_a)
  (regapp "my_point")
  (make_point "0" 0 pnt_o "O" 4 chr_size)
  (make_point "0" 0 pnt_a "A" 4 chr_size)
  (make_point "0" 0 pnt_b "B" 3 chr_size)
  (make_point "0" 0 pnt_c "C" 4 chr_size)
  (make_point "0" 0 pnt_f  "F" 4 chr_size)
 
  (setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
	
;;;insert precision_meter
	;block insert prec_meter.dwg 
	(setq ins_pnt '(0.3 -0.5) meter_scale 0.40 
		m_x (car ins_pnt) m_y (cadr ins_pnt)
		pm_factor (* 0.25 (/ 1. (log 10.)))
	)
	(my_block_insert "prec_meter" ins_pnt meter_scale)
	;display initial bar
	(my_block_insert "prec_bar" ins_pnt meter_scale)
	(setq old_bar (entlast))	;;;prec_bar just created
  (command "_.zoom" "_EXTENT")
  (command "_.regen")
  (setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
	(setq v3scale vscale
		v4scale vscale
	)
  ;(setvar "OSMODE" 8)

);SETUP_EUDOXUS
;;;
;;
;;DISP_PLINE
(defun disp_pline(temp_y)
  (setq temp_rad (distance pnt_a (setq pnt_g (list 0.5 temp_y)))
	pnt_h (list temp_rad 0)
	pnt_hup (list temp_rad 1.0)
	pnt_new (inters pnt_a pnt_g pnt_h pnt_hup nil)
    )
    (command "_.pline" pnt_a pnt_new pnt_h "A" "CE" pnt_a pnt_g "")
	(setq line_ent (entlast))
    (make_pt "0" 2 pnt_new)
	(setq pnt_ent (entlast))
    
);DISP_PLINE
;;
;;Draw Eudoxus curve
;;;					
(defun c:draw_Eudoxus_curve ()
  	(setup_sysvar)
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -1)
	(setq pnt_org '(1 0)
		pnt_a '(0 0)
		pnt_c '(2 0)
		pnt_b (list 0.5 (* 0.5 (sqrt 3.)))
		pnt_f '(0.5 0)
		;nstep 640
		;dy 0.001
		step 1
		pnt_l_old pnt_f
		chr_size 0.1
	)
	(setq dy (getreal "\nIncrement in y-direction (def = 0.01)"))
	(if (= dy nil) (setq dy 0.01))
	(setq nstep (getint "\nNumber of steps (def = 63)"))
	(if (= nstep nil) (setq nstep 63))

;;;draw given lines & circle.
	(command "_.arc" "_C" pnt_org pnt_c pnt_a)
	(make_line_1 "0" 8 pnt_a pnt_b)
	(make_line_1 "0" 8 pnt_a pnt_c)
	(make_line_1 "0" 8 pnt_b pnt_f)
	(textdisplay "A" (shift_pnt pnt_a (list 0 -0.11)) chr_size 0.)
	(textdisplay "B" (shift_pnt pnt_b (list 0 0.05)) chr_size 0.)
	(textdisplay "C" (shift_pnt pnt_c (list -0.1 -0.11)) chr_size 0.)
	(textdisplay "F" (shift_pnt pnt_f (list 0 -0.11)) chr_size 0.)
	(make_line_1 "0" 8 pnt_a pnt_f)
		(setq line_ent (entlast))
	(command "_.zoom" "_E")
	(command "_.regen")
	(make_jpg)
	(alert "\nStart drawing curve")
;;;
	(repeat nstep
		(entdel line_ent)
		(setq pnt_g (list 0.5 (* step dy))
			len_ag (distance pnt_a pnt_g)
			pnt_h (list len_ag 0)
			pnt_hh (list len_ag 1.1)
			pnt_l_new (inters pnt_a pnt_g pnt_h pnt_hh nil)
		)
		(make_line_1 "0" 2 pnt_l_old pnt_l_new)
		 (command "_.pline" pnt_a pnt_l_new pnt_h "A" "CE" pnt_a pnt_l_new "")
		(setq line_ent (entlast))
		
		(command "_.delay" 10)
		(setq pnt_l_old pnt_l_new
			step (1+ step)
		)
		(if (= (rem step 5) 0) (make_jpg) )
		
	)
	(reset_sysvar)	
)
;;;
;;--------------------------------------------------------------------------
(princ)