;****************************************;
;* This is btl_create.lsp program 	*;
;* Completely compiled on 02/26/99      *;
;* Last Change time 02/26/99		*;
;* ZX Mold Ltd    Xy.Liao		*;
;****************************************;
;********************************* Main function start **********************************;
(defun btl_create(/	mat_n	sc_n	unit_n	ver_n	dcl_id	os_old	btl_num	btl_sel
			nam1	sca1	filn1	uni1	num1	shf1	sh1	vers1
			mat1	dat1	shr1	nam	sca 	filn	nui	num
			shf	sh	vers	mat	dat	shr	btl_1	a0
			a1	a2	a3	a4	UR	NextPt 	dwg_name name_len )
;-----------------------------------------
;shut off command echo and set undo mark
;-----------------------------------------
  (setvar "cmdecho" 0)
  (command "undo" "be")
;-----------------------------------------
;save old system variable
;-----------------------------------------
  (setq os_old (getvar "osmode"))
  (setq la_old (getvar "clayer"))
  (setq pw_old (getvar "plinewid"))
  (setq st_old (getvar "textstyle"))
;-----------------------------------------
;Initializing
;-----------------------------------------
  (ini_useri2)
  (if (not (tblsearch "layer" "mxb"))
    (command "_.layer" "_new" "mxb" "_color" "red" "mxb" "_ltype" "continuous" "mxb" "")
    (command "_.layer" "thaw" "mxb" "on" "mxb" "unlock" "mxb" "")
  )
  (setvar "clayer" "mxb")
  (setvar "plinewid" 0)
  (setvar "osmode" 0)
  (load "ini_btl")
  (ini_btl)
;-----------------------------------------
  (setq dcl_id (load_dialog "DwgHead"))
  (if (not (new_dialog "btldlg" dcl_id))
	(exit)
  )
  (setq if_on 1)
  (while (= 1 if_on)
	(ini_dia_b)
	(action_tile "B_MAT_VAL" "(click_mat)")
	(action_tile "B_UNIT" "(click_share)")
	(action_tile "B_SC" "(click_share)")
	(action_tile "B_VER" "(click_share)")
	;(action_tite "B_MACHINE" "(click_share)")
	(action_tile "accept" "(get_all_b) (done_dialog 2)")
	(action_tile "cancel" "(done_dialog 3)")
	(setq what_next (start_dialog))
	(cond
	   ((= 2 what_next)
		(inspt_get)
		(setq if_on 0)
	   )
	   ((= 3 what_next)
		(command "undo" "b")
		(setq if_on 0)
 	   )
	)
  )
  (ac_lxy_set)
  (command "undo" "e")
  (prin1)
)

(defun lib_b(item_n)
  (cond
	((= 1 item_n)
	 '("" "ZN" "PVC85%%d" "PVC90%%D" "PVC75%%D" "PVC65%%D" "PC" "POM" "GPPS" "KÁÏ"
	   "PP" "ABS" "HIPS" "PS" "PA")
	)
	((= 2 item_n)
	 '("" "0.004" "0.004" "0.004" "0.015" "0.020" "0.006" "0.020" "0.005" "0.005" 
	   "0.020" "0.006" "0.004" "0.005" "0.015")
	)
	((= 3 item_n)
	 '("4:1" "3:1" "2:1" "1.5:1" "1:1" "1:1.5" "1:2" "1:3" "1:4" "")
	)
	((= 4 item_n)
	 '("MM" "INCH" "")
	)
	((= 5 item_n)
	 '("A" "B" "C" "D" "E" "F" "G" "H")
	)
  )
)


(defun ini_list(list_name table_name)
  (start_list list_name)
  (mapcar 'add_list table_name)
  (end_list)
)

(defun ini_dia_b()
  (if btl_num
    (progn
      (setq nam1  (nth 1 btl_1)
	    sca1  (nth 2 btl_1)
	    filn1 (nth 3 btl_1)
	    uni1  (nth 4 btl_1)
	    num1  (nth 5 btl_1)
	    shf1  (nth 6 btl_1)
	    sh1   (nth 7 btl_1)
	    vers1 (nth 8 btl_1)
	    mat1  (nth 9 btl_1)
	    dat1  (nth 10 btl_1)
	    shr1  (nth 11 btl_1)
	   fileno1 (nth 12 btl_1)
	   machine1 (nth 13 btl_1)
      )
      (setq mat_n  (if (xh_get mat1 (lib_b 1))
	             (xh_get mat1 (lib_b 1))
		     -1)
      )
      (setq sc_n   (if (xh_get sca1 (lib_b 3))
		     (xh_get sca1 (lib_b 3))
		     4)
      )
      (setq unit_n (if (xh_get uni1 (lib_b 4))
		     (xh_get uni1 (lib_b 4))
		     0)
      )
      (setq ver_n  (if (xh_get vers1 (lib_b 5))
		     (xh_get vers1 (lib_b 5))
		     0)
     
     )
    )
    (progn
      (setq mat_n  0
	    sc_n  4
	    unit_n 0
	    ver_n  0
			
      )
    )

  )
  (ini_list "B_MAT_VAL" (lib_b 1))
  (ini_list "B_SC" (lib_b 3))
  (ini_list "B_UNIT" (lib_b 4))
  (ini_list "B_VER" (lib_b 5))
	
  (set_tile "B_SC" (itoa sc_n))
  (set_tile "B_UNIT" (itoa unit_n))
  (set_tile "B_VER" (itoa ver_n))
  (if (not btl_1)
    (progn
      (set_tile "B_MAT" (nth mat_n (lib_b 1)))
      (set_tile "B_SHR" (nth mat_n (lib_b 2)))
			
      (setq date_val (itoa (fix (getvar "cdate"))))
      (set_tile "B_DATE" (strcat (substr date_val 1 4) 
				 "-" (substr date_val 5 2) 
				 "-" (substr date_val 7 2)))
      (set_tile "B_FILE" (strcat (lxy_trim (getvar "loginname")) "\\" 
				 (getvar "dwgprefix") 
				 (getvar "dwgname")))
     
	(setq name_len (strlen (getvar "dwgname")))
	(set_tile "B_FILENO" (strcase (strcat "EDA-DMD-" (substr (getvar "dwgname") 1 (- name_len 4))
				"-" "1" "/" "1" "-" "A0-" "1"))
	)
	(set_tile "B_NUM" (substr (getvar "dwgname") 1 (- name_len 4)))
      (set_tile "B_SHF" "1")
      (set_tile "B_SH" "1")
    )
    (progn
      (if (= -1 mat_n)
	(progn
	  (set_tile "B_MAT" mat1)
	  (set_tile "B_SHR" shr1)
	)
        (progn
	  (set_tile "B_MAT" (nth mat_n (lib_b 1)))
	  (set_tile "B_SHR" (nth mat_n (lib_b 2)))
	)
      )
      (set_tile "B_NAME" nam1)
      (set_tile "B_SHF" shf1)
      (set_tile "B_SH"  sh1)
      (set_tile "B_DATE" dat1)
      (set_tile "B_FILE" filn1)
      (set_tile "B_FILENO" fileno1)
      (set_tile "B_MACHINE" machine1)	
      (set_tile "B_NUM" num1)
    )
  )
)

(defun get_all_b()
  (setq mat (get_tile "B_MAT"))
  (if (= -1 mat_n)
    (setq shr (get_tile "B_SHR"))
    (setq shr (nth mat_n (lib_b 2)))
  )
  (setq sca (nth sc_n (lib_b 3)))
  (setq uni (nth unit_n (lib_b 4)))
  (setq vers (nth ver_n (lib_b 5)))
  (setq machine (get_tile "B_MACHINE"))
  (setq dat (get_tile "B_DATE"))
  (setq filn (get_tile "B_FILE"))
  (setq filEno (get_tile "B_FILENO"))
  (setq shf (get_tile "B_SHF"))
  (setq sh (get_tile "B_SH"))
  (setq nam (get_tile "B_NAME"))
  (setq num (get_tile "B_NUM"))
  (setq a4 (get_tile "A4")
	a3 (get_tile "A3")
	a2 (get_tile "A2")
	a1 (get_tile "A1")
	a0 (get_tile "A0")
	UR (get_tile "USER")
  )
  (if (= "1" UR)
    (while (not NextPt)
      (setq NextPt (SetUserLenWid))
    )
  )
  (setq lat (get_tile "layout"))
)

(defun inspt_get( / inspt 	pt2		a		ent		ent_nam
		ent_sca		ent_filn	ent_uni		ent_num		ent_shf
		ent_sh		ent_shf		ent_mat		ent_dat		ent_shr)
  (if btl_num
    (progn
      (setq a 0)
      (foreach n btl_num
        (if (= num n)
	  (setq a (+ a 1))
        )
      )
      (setq shf (itoa (+ a 1)))
      (foreach n btl_sel
        (if (= num (nth (xh_get n btl_sel) btl_num))
	  (progn 
	    (setq sh (itoa a))
	    (setq a (- a 1))
	    (setq ent      (handent n)
		  ent_nam  (entnext ent)
		  ent_sca  (entnext ent_nam)
		  ent_filn (entnext ent_sca)
		  ent_uni  (entnext ent_filn)
	 	  ent_num  (entnext ent_uni)
		  ent_shf  (entnext ent_num)
		  ent_sh   (entnext ent_shf)
		  ent_vers (entnext ent_sh)
		  ent_mat  (entnext ent_vers)
		  ent_dat  (entnext ent_mat)
		  ent_shr  (entnext ent_dat)
            )
	    (mod_ent ent_nam nam)
	    (mod_ent ent_sca sca)
	    (mod_ent ent_filn filn)
	    (mod_ent ent_uni uni)
	    (mod_ent ent_shf shf)
	    (mod_ent ent_sh sh)
	    (mod_ent ent_vers vers)
	    (mod_ent ent_mat mat)
	    (mod_ent ent_dat dat)
	    (mod_ent ent_shr shr)
	  )
        )
      )
    )
  )
  (setq inspt (getpoint "\nPlease pick a point:"))
  (setq sh shf)
  (setq old_var (getvar "attdia")) 
  (setvar "attdia" 0)
  (command "insert" "btl_btl.dwg" inspt "" "" "" nam sca filn uni num shf sh vers mat dat shr fileno machine)
  (setvar "attdia" old_var)
  (cond 
    ((= "1" lat)
      (cond
	((= "1" a4)
	  (setq pt2 (polar (polar inspt pi 287) (* pi 0.5) 200))
	  (DrawSubFlag inspt pt2 6 4)
	)
	((= "1" a3)
	  (setq pt2 (polar (polar inspt pi 400) (* pi 0.5) 277))
	  (DrawSubFlag inspt pt2 8 6)
	)
	((= "1" a2)
	  (setq pt2 (polar (polar inspt pi 574) (* pi 0.5) 400))
	  (DrawSubFlag inspt pt2 8 8)
	)
	((= "1" a1)
	  (setq pt2 (polar (polar inspt pi 800) (* pi 0.5) 554))
	  (DrawSubFlag inspt pt2 16 8)
	)
	((= "1" a0)
	  (setq pt2 (polar (polar inspt pi 1148) (* pi 0.5) 800))
	  (DrawSubFlag inspt pt2 16 16)
	)
      )
    )
    ((= "0" lat)
      (cond
	((= "1" a4)
	  (setq pt2 (polar (polar inspt pi 200) (* pi 0.5) 287))
	  (DrawSubFlag inspt pt2 4 6)
	)
	((= "1" a3)
	  (setq pt2 (polar (polar inspt pi 277) (* pi 0.5) 400))
	  (DrawSubFlag inspt pt2 6 8)
	)
	((= "1" a2)
	  (setq pt2 (polar (polar inspt pi 400) (* pi 0.5) 574))
	  (DrawSubFlag inspt pt2 8 8)
	)
	((= "1" a1)
	  (setq pt2 (polar (polar inspt pi 554) (* pi 0.5) 800))
	  (DrawSubFlag inspt pt2 8 16)
	)
	((= "1" a0)
	  (setq pt2 (polar (polar inspt pi 800) (* pi 0.5) 1148))
	  (DrawSubFlag inspt pt2 16 16)
	)
      )
    )
  )
  (if (= "1" UR)
    (progn
      (setq pt2 (list (- (car inspt) (car NextPt)) (+ (cadr inspt) (cadr NextPt))))
      (DrawSubFlag inspt pt2 (* 2 (fix (/ (car NextPt) 120))) (* 2 (fix (/ (cadr NextPt) 120))))
    )
  )
  (if pt2
    (command "_rectang" inspt pt2
	     "insert"   "Review" (polar pt2 0 (- (car inspt) (car pt2))) "" "" ""
	     "zoom" "e")
  )
)

(defun click_mat()
  (setq mat_n (atoi (get_tile "B_MAT_VAL")))
  (set_tile "B_MAT" (nth mat_n (lib_b 1)))
  (set_tile "B_SHR" (nth mat_n (lib_b 2)))
)

(defun click_share()
  (setq sc_n (atoi (get_tile "B_SC")))
  (setq unit_n (atoi (get_tile "B_UNIT")))
  (setq ver_n (atoi (get_tile "B_VER")))
  
)

;****************************************************;
;Modify attributes vlaue function
;****************************************************;
(defun mod_ent(ent_name mod_data / ent_data)
  (setq ent_data (entget ent_name))
  (setq ent_data (subst (cons 1 mod_data)
			(assoc 1 ent_data)
			ent_data)
  )
  (entmod ent_data)
  (entupd ent_name)
)
;****************** End of function ******************;

;*****************************************************;
;interact input drawing length and width by user
;*****************************************************;
(defun SetUserLenWid(/ ptur)
  (defun ret()
    (if (or (= 0.0 (atof (get_tile "LEN"))) (= 0.0 (atof (get_tile "WID"))))
      nil
      (list (atof (get_tile "LEN")) (atof (get_tile "WID")))
    )
  )
  (if (not (new_dialog "UserInput" dcl_id)) (exit))
  (action_tile "UROK" "(setq ptur (ret)) (done_dialog)")
  (start_dialog)
  ptur
)

;*****************************************************;
;Draw Arrow function
;*****************************************************;
(defun DrawArrow(StartPt L1 L2 W ANG / oldPW)
  (if (/= 'REAL (type L1))  (setq L1 5))
  (if (/= 'REAL (type L2))  (setq L2 3))
  (if (/= 'REAL (type W))   (setq W  2))
  (if (/= 'REAL (type ANG)) (setq ANG 0))
  (setq oldPW (getvar "plinewid"))
  (if (= 'LIST (type StartPt))
    (command "pline" StartPt "w" 0 W (polar StartPt ANG (- L1 L2)) "w" 0 "" (polar StartPt ANG L1) "")
  )
  (setvar "plinewid" oldPW)
)
;****************** End of function ******************;

;*****************************************************;
;Draw Subarea flag
;*****************************************************;
(defun DrawSubFlag(RightBottomPt LeftTopPt HorN VerN / i LTPt RBPt)
  (setq deltaX (/ (- (car RightBottomPt) (car LeftTopPt)) (float HorN))
	deltaY (/ (- (cadr LeftTopPt) (cadr RightBottomPt)) (float VerN)))
  (if (not (tblsearch "style" "MxbTxt"))
    (command "-style" "MxbTxt" "txt" "" 0.9 "" "" "" "")
    (setvar "textstyle" "MxbTxt")
  )
  (setq i 1)
  (while (< i HorN)
    (command "line" (polar LeftTopPt 0 (* i deltaX)) 
		    (polar (polar LeftTopPt 0 (* i deltaX)) (* pi 0.5) 5) "")
    (command "line" (polar RightBottomPt pi (* i deltaX)) 
		    (polar (polar RightBottomPt pi (* i deltaX)) (* pi 1.5) 5) "")
    (setq i (+ i 1))
  )
  (setq i 1)
  (while (<= i HorN)
    (command "text" "j" "mc" (polar (polar LeftTopPt 0 (* (- i 0.5) deltaX)) (* pi 0.5) 3) 4 0 (itoa i))
    (command "text" "j" "mc" (polar (polar RightBottomPt pi (* (+ 0.5 (- HorN i)) deltaX)) (* pi 1.5) 3) 4 0 (itoa i))
    (setq i (+ i 1))
  )
  (setq i 1)
  (while (< i VerN)
    (command "line" (polar LeftTopPt (* pi 1.5) (* i deltaY))
		    (polar (polar LeftTopPt (* pi 1.5) (* i deltaY)) pi 5) "")
    (command "line" (polar RightBottomPt (* pi 0.5) (* i deltaY))
		    (polar (polar RightBottomPt (* pi 0.5) (* i deltaY)) 0 5) "")
    (setq i (+ i 1))
  )
  (setq i 1)
  (while (<= i VerN)
    (command "text" "j" "mc" (polar (polar LeftTopPt (* pi 1.5) (* (- i 0.5) deltaY)) pi 3) 4 0 (char (+ 64 i)))
    (command "text" "j" "mc" (polar (polar RightBottomPt (* pi 0.5) (* (+ 0.5 (- VerN i)) deltaY)) 0 3) 4 0 (char (+ 64 i)))
    (setq i (+ i 1))
  )
  (DrawArrow (polar LeftTopPt     0          (* deltaX (/ HorN 2))) 8 5 4 (* pi 0.5))
  (DrawArrow (polar LeftTopPt     (* pi 1.5) (* deltaY (/ VerN 2))) 8 5 4 pi)
  (DrawArrow (polar RightBottomPt (* pi 0.5) (* deltaY (/ VerN 2))) 8 5 4 0)
  (DrawArrow (polar RightBottomPt pi         (* deltaX (/ HorN 2))) 8 5 4 (* pi 1.5))
  (setq LTPt (polar (polar LeftTopPt (* pi 0.5) 5) pi 5)
	RBPt (polar (polar RightBottomPt (* pi 1.5) 5) 0 5))
  (command "line" (polar LTPt pi 5) LTPt (polar LTPt (* pi 0.5) 5) ""
	   "line" (polar RBPt 0  5) RBPt (polar RBPt (* pi 1.5) 5) "") 
)