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

  (setup_heron)	;;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)
  (reset_sysvar)
);TEST
;;
;;
					;Test_2-- Continuous pick
(defun c:test_2 ()
  (setup_heron)	;;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)
  )
   (result_display)					;while
   (reset_sysvar)
);TEST_2
;;
;;;
;;;
;;;		;HERON		zoom & regen is done automatically
;;;
;;;main routine :::   zoom & regen is done automatically
(defun c:HERON()
	(setup_heron)		;;setup
  	(disp_pline 2.5)	;;initial display
	(setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
	(setq flag "GO" split_win "NO")
	(alert "Move the cursor outside the semi-circle along the X-axis,
		\nthen click your left mouse to begin moving along the X-axis.\n
		\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 3 viewports.
		(if (= split_win "NO") (command "_.vports" "2" "h"))
	;;;;convergence criteria check
		(if (= (converge) T) (setq flag "STOP"))
	;;;;zoom and regen automatically for the mouse control point
		(zoom_regen pnt_f )
		(setq split_win "YES")
	);outer while loop
	(command "_.vports" "SI" )	;;;single view port
	(result_display)
	(command "_.zoom" "_EXTENT")
	(command "_.regen")
	(reset_sysvar)
);HERON
;;
;;;
;;;CONVERGE
;;;
;;;check the convergence comparing the length of 2 line segments
(defun CONVERGE()
	(setq dist_ef (distance pnt_e pnt_f)
		dist_eg (distance pnt_e pnt_g)
		diff_dist (- dist_ef dist_eg)
		diff_length (abs diff_dist)
	)
	(if (< diff_length criteria) (setq result T) (setq result nil))

);CONVERGE
;;;
;;;ZOOM_REGEN
;;;
(defun ZOOM_REGEN(pnt_move)
	;;;Mouse control point
	(setq vscale (/ vscale 10.))	;;;focus on the control point
	(command "_.zoom" "ce" pnt_move vscale)
	;mark the point in either red or blue for identification
	(if (< diff_dist 0) (make_pt "layer1" 1 pnt_f) (make_pt "layer5" 5 pnt_f))
	(command "_.regen")
);ZOOM_REGEN
;;;
;;;SHOW_STATUS
;;; show the distance between tip and the horizontal line
(defun SHOW_STATUS( /  result)
	
	(setq dist_ef (distance pnt_e pnt_f)
		dist_eg (distance pnt_e pnt_g)
		diff_dist (abs (- dist_ef dist_eg))
	)
	(setq 	result (strcat "dist = " (rtos diff_dist 2 12)))
	(move_bar diff_dist 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 Heron"
		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   '(2.00   2.35)  0.150 0)
	(textdisplay  line_2   '(2.25   2.10)  0.100 0)
	(textdisplay  line_3   '(2.25   1.85)  0.100 0)
	(textdisplay  line_31  '(2.25   1.60)  0.100 0)
	(textdisplay  line_4   '(2.35   1.20)  0.100 0)
	(textdisplay  line_5   '(2.35   0.95)  0.100 0)
	(command "_.zoom" "_e")
	(command "_.regen")
	
);RESULT_DISPLAY
;;;
;;SETUP_HERON
(defun setup_heron()
  (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)

  (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 created
  
  (command "_.zoom" "_EXTENT")
  (command "_.regen")
 
);SETUP_HERON
;;;
;;
;;DISP_PLINE
(defun disp_pline(temp_x)
  (setq fx temp_x
	pnt_f (list fx 0)
	gy (/ fx (- fx 2))
	pnt_g (list 0 gy)
  )
	
    (command "_.pline" pnt_f pnt_g pnt_e "CL")
	(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)
		(setq dist_abs (abs (- (distance pnt_g pnt_h) (distance pnt_f pnt_d)))  )
		(move_bar dist_abs meter_scale)
		(command "export"  (strcat "heron_" (itoa step) ".wmf") "all" ""  )
		(setq step (1+ step))
		(command "_.delay" 500)
		(entdel line_ent)
	); 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 "heron_" (itoa step) ".wmf") "all" ""  )
	(reset_sysvar)

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