(prompt "\nDoubling the Cube by AutoCAD - APOLLONIUS.LSP")
(prompt "\nCommands:  TEST  TEST_2 APOLLONIUS  ")
(prompt "\nCommands:  MAKE_WMF  ")
(prompt "\n           ")
;----------------------------------------------------------
;;
;;	APOLLONIUS.LSP
;;    Doubling the cube
;; 	by Takaya Iwamoto   
;;	
;;      
;;	This scheme can be applied to get any cube root.
;;	The exmple here is for cube root of 2.
;;
;;					;Test --- one at a time
(defun c:test ()

  (setup_apollo)	;;setup
  (disp_pline 2.5)	;;initial display
  (while (setq pnt_temp	(getpoint
		  "\nPick a point on the positive X-axis. Hit return key to quit"))
    (setq pnt_x (car pnt_temp))
    (entdel line_ent)
    (disp_pline pnt_x)
	(show_status)
   
  )
  (result_display)
  (command "_.zoom" "_E")
  (command "_.regen")
  (reset_sysvar)
);TEST
;;
;;
					;Test_2-- Continuous pick
(defun c:test_2 ()
  (setup_apollo)	;;setup
  (disp_pline 2.5)	;;initial display
  (setq	answer
	 (getpoint
	   "Place the cursor near the positive X-axis, 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_x (car(cadr key)))
    (entdel line_ent)
    (disp_pline pnt_x)
    (show_status)
  )					;while
   (result_display)
  (command "_.zoom" "_E")
  (command "_.regen")
   (reset_sysvar)
);TEST_2
;;;
;;;		;APOLLONIUS		zoom & regen is done automatically
;;;
;;;main routine :::   zoom & regen is done automatically
(defun c:apollonius()
	(setup_apollo)		;;setup
  	(disp_pline 2.5)	;;initial display
		(mark_point pnt_g -2   0. "G0" chr_size)
		(mark_point pnt_f 0. -1.1 "F0" chr_size)
	(setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
	(setq flag "GO" split_win "NO")
	(alert "Move the cursor near point F0 ,
		\nthen click your left mouse to begin moving along the X-axis.\n
		\nTry to place line F0-G0 passing through point D.\n
		\nLook at status window(below command line Window) for the distance\n
		\nbetween the line FG and this point D.
		\nThe process continues until this distance is less than 1.e-9

		\nHit return key to terminate." )
	(setq answer (getpoint "\nPress left mouse for automatic zooming and regen."))
	
	(while (= flag "GO")
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_x (car(cadr key)))
    		(entdel line_ent)
		
    		(disp_pline pnt_x)
		(show_status)
				
	);inner while loop
	;;;after the 2-nd round,work with 2 viewports.
		;(if (= split_win "NO") (command "_.vports" "2" "_v"))
	(if (= split_win "NO") 
		(progn
			(command "_.vports" "3" "_A")
			(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_d pnt_f )
		(setq split_win "YES")
	);outer while loop
	(command "_.vports" "_SI" )	;;;single view port
	(result_display)
	
	(command "_.zoom" "_EXTENT")
	(reset_sysvar)
);APOLLONIUS
;;
;;;
;;;CONVERGE
;;;
;;;check the convergence comparing the radius and line segment OL
(defun CONVERGE( / result)
	(setq pnt_int (inters pnt_a pnt_d pnt_g pnt_f nil)
		diff_length (distance pnt_int pnt_d)
	)
	(if (< diff_length criteria) (setq result T) (setq result nil))
);CONVERGE
;;;
;;;ZOOM_REGEN
;;;
(defun ZOOM_REGEN(pnt_target pnt_move)
	;;;Target point
	(setq vscale (/ vscale 4.))	;;;focus on the target point
	(setvar "CVPORT" 2)		
	(command "_.zoom" "_ce" pnt_target vscale)
	(command "_.regen")
	;;;Mouse control point
	(setq vscale (/ vscale 4.))	;;;focus on the control point
	(setvar "CVPORT" 3)		
	(command "_.zoom" "_ce" pnt_move vscale)
	(command "_.regen")
);ZOOM_REGEN
;;;
;;;SHOW_STATUS
;;; show the distance between tip and the horizontal line
(defun SHOW_STATUS( /  result)
	(setq pnt_int (inters pnt_a pnt_d pnt_g pnt_f nil)
		diff_length (distance pnt_int pnt_d)
	)
	(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_c pnt_g)
	(make_line_1 "layer3" 3 pnt_b pnt_f)
	;(make_line_1 "layer4" 4 pnt_a pnt_c)

	(setq 	result (strcat "dist = " (rtos diff_length 2 12)))
	;(grtext -1 result)
	(make_point "0" 0 pnt_g "G" 3 chr_size)
  	(make_point "0" 0 pnt_f "F" 4 chr_size)
	(setq len_ab 2.0
		len_bf (distance pnt_b pnt_f)
		len_cg (distance pnt_c pnt_g)
		len_ac 1.0
		cube_bf (expt len_bf 3)
		pnt_ff pnt_f
		pnt_gf pnt_g
	)
	(setq   
		line_1  "Result of Apollonius"
		line_2  "BF**3 = AB / AC"
		line_3  (strcat "BF        = " (rtos len_bf 2 12))
		line_31         "(Exact  =  1.259921049895)"
		line_4  (strcat "BF**3    = " (rtos cube_bf 2 10))
		line_5          "AB / AC = 2.0  (Given)"
	)
	(textdisplay  line_1   '(3.00   2.00)  0.150 0)
	(textdisplay  line_2   '(3.35   1.75)  0.100 0)
	(textdisplay  line_3   '(3.35   1.50)  0.100 0)
	(textdisplay  line_31  '(3.35   1.25)  0.100 0)
	(textdisplay  line_4   '(3.35   0.75)  0.100 0)
	(textdisplay  line_5   '(3.35   0.50)  0.100 0)
	
);RESULT_DISPLAY
;;;
;;SETUP_APOLLO
(defun setup_apollo()
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -1)
  (setup_sysvar)
  (setq	
	pnt_a '(0 0)
	pnt_b '(2 0)
	pnt_c '(0 1)
	pnt_d '(2 1)
	pnt_e '(1 0.5)
	pnt_k '(1 0)
	x_left '(-3 0)
	x_right '(4.0 0)
	y_up   '(0 3.0)
	y_down '(0 -2.5)
	chr_size 0.100
	criteria 1.e-9
	cuberoot_2 (expt 2.0 (/ 1. 3.))
  )

  (make_line_1 "0" 8 pnt_a x_right)
  (make_line_1 "0" 8 pnt_a y_up)
  (make_line_1 "0" 8 pnt_a pnt_d)
  (make_line_1 "0" 8 pnt_b pnt_d)
  (make_line_1 "0" 8 pnt_c pnt_d)
  (make_line_1 "0" 8 pnt_c pnt_b)
  (make_line_1 "0" 8 pnt_e pnt_k)
  (setvar "CECOLOR" "green")
	(command "_.line" pnt_a pnt_c "")
	(line_text pnt_a pnt_c 0 "1.0" chr_size -0.65 -0.55)
	
  (setvar "CECOLOR" "2")
	(command "_.line" pnt_a pnt_b "")
	(line_text pnt_a pnt_b 0 "2.0" chr_size -1. -2.25)
  (setvar "CECOLOR" "BYLAYER")

  (make_arc_cbe "0" 8 pnt_e pnt_b pnt_c)
  (regapp "my_point")
  (make_point "0" 0 pnt_a "A" 4 chr_size)
  (make_point "0" 0 pnt_b "B" 4 chr_size)
  (make_point "0" 0 pnt_c "C" 3 chr_size)
  (make_point "0" 0 pnt_d "D" 1 chr_size)
  (make_point "0" 0 pnt_e "E" 4 chr_size)
  (make_point "0" 0 pnt_k "K" 4 chr_size)
;;;insert precision_meter
	;block insert prec_meter.dwg 
	(setq ins_pnt '(0.5 -0.75) meter_scale 0.50 
		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 createdmake_wmf

  
  (command "_.zoom" "_EXTENT")
  (command "_.regen")
 
);SETUP_APOLLO
;;;
;;
;;DISP_PLINE
(defun disp_pline(temp_x)
  (setq fx temp_x
	pnt_f (list fx 0)
	len_ef (distance pnt_e pnt_f)
	gy (+ (sqrt (- (* len_ef len_ef) 1)) 0.5)
	pnt_g (list 0 gy)
  )
	
    (command "_.pline" pnt_f "_Arc" "_CE" pnt_e pnt_g "_L" pnt_f pnt_e pnt_g "")
	(setq line_ent (entlast))
    
);DISP_PLINE
;;
;;;
;;MAKE_WMF
;;;make windows meta file
(defun c:MAKE_WMF()
	(setup_apollo)
	(make_line_1 "layer1" 1 pnt_a pnt_b)
	
	(make_line_1 "layer4" 4 pnt_a pnt_c)
	;(setq nstep (getint "\nHow many steps:"))
	(setq 	nstep 10 step 0
		x_start 2.5 x_end 3.259921
		x_inc (/ (- x_end x_start)  nstep)
	)
	;(setq answer (getpoint "\nPress left mouse to begin."))
	
	(while (<=  step nstep)
		(setq x_val (+ x_start (* x_inc step)))
		(disp_pline x_val)
		(command "_.delay" 500)
		(command "_.export"  (strcat "apollo_" (itoa step) ".wmf") "_all" ""  )
		(setq step (1+ step))
		(entdel line_ent)
		(show_status)
		(command "_.delay" 1000)
	); while loop
	(disp_pline x_val)
	(make_line_1 "layer2" 2 pnt_c pnt_g)
	(make_line_1 "layer3" 3 pnt_b pnt_f)
		(make_point "0" 0 pnt_g "G" 3 chr_size)
  		(make_point "0" 0 pnt_f "F" 4 chr_size)
		(make_point "0" 0 pnt_h "H" 2 chr_size)
	(command "_.export"  (strcat "apollo_" (itoa step) ".wmf") "_all" ""  )
	(reset_sysvar)

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