(prompt "\nDoubling the Cube by AutoCAD - ABE_DELIAN.LSP")
(prompt "\nCommands:  TEST  TEST_2 ABE_DELIAN  ")
(prompt "\nCommands:  MAKE_WMF  ")
(prompt "\n           ")
;----------------------------------------------------------
;;
;;	ABE_DELIAN.LSP
;;    Doubling the cube by Hisashi Abe ("Amazing Origami")
;; 	coded by Takaya Iwamoto   
;;	based on vp3_template.lsp	3 view ports
;;      
;;	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_Abe)	;;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_Abe)	;;setup
  (disp_pline 1.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
;;;
;;;		;ABE_DELIAN		zoom & regen is done automatically
;;;
;;;main routine :::   zoom & regen is done automatically
(defun c:ABE_DELIAN()
	(setup_Abe)		;;setup
  	(disp_pline 1.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 on the line DG.
		\nthen click your left mouse to begin moving along the line.\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 3 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_q pnt_pp )
		(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_s pnt_q pnt_h pnt_k nil)
		diff_length (distance pnt_int pnt_q)
	)
	(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_s pnt_q pnt_h pnt_k nil)
		diff_length (distance pnt_int pnt_q)
	)
	;(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_org pnt_mid)
	(make_line_1 "layer3" 3 pnt_org pnt_m)
	;(make_line_1 "layer4" 4 pnt_a pnt_c)

	;(setq 	result (strcat "dist = " (rtos diff_length 2 12)))
	;(grtext -1 result)
	(mark_id  pnt_mid "N" 2  chr_size )
  (mark_id  pnt_cd "C'" 1  chr_size )
  (mark_id  pnt_pp "P" 1  chr_size )
  (mark_id  pnt_q "Q" 1  chr_size )
  (mark_id  pnt_s "S" 3  chr_size )
  (mark_id  pnt_t "T" 1  chr_size )
  (mark_id  pnt_m "M" 2  chr_size )
	
);RESULT_DISPLAY
;;;
;;SETUP_ABE
(defun setup_abe()
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -3)
  (setup_sysvar)
  (setq	pnt_org '(0 0)
	pnt_a '(-2 0)
	pnt_b '(0 -1)
	pnt_c '(-2 -1)
	pnt_d '(-2 1)
	pnt_e '(3.5 -1)
	pnt_f '(3.5 0)
	pnt_g '(3.5 1)
	pnt_h '(2 -1)
	pnt_i '(-2 4.5)
	pnt_j '(0 4.5)
	pnt_k '(2 4.5)
	pnt_l '(3.5 4.5)
	
	chr_size 0.25
	criteria 1.e-9
	cuberoot_2 (expt 2.0 (/ 1. 3.))
  )
  (make_pt "0" 0 pnt_a)
  (make_pt "0" 0 pnt_b)
  (make_pt "0" 0 pnt_org)
  (make_pt "0" 0 pnt_c)
  
  (mark_id  pnt_a "A" 3  chr_size )
  (mark_id  pnt_b "B" 4  chr_size )
  (mark_id  pnt_c "C" 3  chr_size )
  (mark_id  pnt_d "D" 3  chr_size )
  (mark_id  pnt_e "E" 1  chr_size )
  (mark_id  pnt_f "F" 1  chr_size )
  (mark_id  pnt_g "G" 1  chr_size )
  (mark_id  pnt_h "H" 4  chr_size )
  (mark_id  pnt_i "I" 3  chr_size )
  (mark_id  pnt_j "J" 1  chr_size )
  (mark_id  pnt_k "K" 1  chr_size )
  (mark_id  pnt_l "L" 1  chr_size )
  (mark_id  pnt_org "O" 1 chr_size)

  (make_line_1 "0" 0 pnt_c pnt_i)
  (make_line_1 "0" 0 pnt_c pnt_e)
  (make_line_1 "0" 8 pnt_b pnt_j)
  (make_line_1 "0" 8 pnt_a pnt_f)
  (make_line_1 "0" 8 pnt_d pnt_g)
  (make_line_1 "0" 8 pnt_h pnt_k)
  (make_line_1 "0" 0 pnt_i pnt_l)
  (make_line_1 "0" 0 pnt_l pnt_e)

  
  ;(setvar "CECOLOR" "green")
;	(command "_.line" pnt_b pnt_org "")
;	(line_text pnt_b pnt_org 0 "1.0" chr_size -0.10 -0.85)
;	
 ; (setvar "CECOLOR" "2")
;	(command "_.line" pnt_a pnt_org "")
;	(line_text pnt_a pnt_org 0 "2.0" chr_size -1. 0.25)
;  (setvar "CECOLOR" "BYLAYER")

  
;;;insert precision_meter
	;block insert prec_meter.dwg 
	(setq ins_pnt '(-1 -2.25) meter_scale 1.0 
		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" "_E")
  (command "_.regen")
 
);SETUP_ABE
;;;
;;
;;DISP_PLINE
(defun disp_pline(temp_x /  pnt_1 pnt_2 alpha beta dist_as )
  (setq pnt_pp (list temp_x 1.0)
	pnt_mid (list (* 0.5 temp_x) 0 )
  )
  (make_line_1 "0" 0 pnt_b pnt_pp)
	(setq temp_line (entlast))
  (command "_.rotate" temp_line "" pnt_mid 90.)
  (setq pnt_1 (cdr (assoc 10 (entget (entlast))))
	pnt_2 (cdr (assoc 11 (entget (entlast))))
  )
  (setq pnt_s (inters pnt_1 pnt_2 pnt_c pnt_i nil)
	pnt_t (inters pnt_1 pnt_2 pnt_c pnt_e nil)
	alpha (abs (- (angle pnt_s pnt_t) (* pi 1.5)))
	beta (- (* 0.5 pi) alpha)
	dist_as (distance pnt_s pnt_a)
	pnt_m (pld pnt_s pnt_t (* dist_as (sin beta)))
	pnt_q (plt pnt_a pnt_m 2.0)
	pnt_cd (pld pnt_q pnt_s -1.0)
  )
	(entdel temp_line)
    (command "_.pline" pnt_a pnt_m pnt_s pnt_q pnt_m pnt_mid pnt_pp pnt_q
			pnt_cd pnt_t pnt_mid pnt_b "")
	(setq line_ent (entlast))
    
);DISP_PLINE
;;
;;;
;;MAKE_anim_jpg
;;;make jpg files for animation
(defun c:MAKE_anim_jpg()
	(setup_abe)
	(make_jpg)
	;(setq nstep (getint "\nHow many steps:"))
	(setq 	nstep 10 step 0
		x_start 1.5 x_end 2.519842
		x_inc (/ (- x_end x_start)  nstep)
	)
		
	(while (<=  step nstep)
		(setq x_val (+ x_start (* x_inc step)))
		(disp_pline x_val)
		(command "_.delay" 500)
		(make_jpg)
		(setq step (1+ step))
		(entdel line_ent)
		(show_status)
		(make_jpg)
		(command "_.delay" 1000)
	); while loop
	(disp_pline x_val)
	(make_jpg)
	(result_display)
	(make_jpg)
	(reset_sysvar)

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