;*****************************************************;
;* This is "apn_create.lsp" program 		     *;
;* Complete compiled in 02/01/99                     *;
;* Last change in 02/05/99   			     *;
;* ZX Mold Ltd  XY.Liao				     *;
;*****************************************************;

;************************************* Main function start **************************************;
(defun apn_create(/ 	mb		if_h_v		d_m_n		d_b_n		ang_n
			ang_lib		apn_id		apn_next	what_next	err_msg
			d 		hd		k		stk		ang
			stk_r 		rep_r)
;------------------------------------------------------------
;shut off command echo and set undo mark
  (setvar "cmdecho" 0)
  (command "undo" "m")
;------------------------------------------------------------
;save current system variable
  (progn
    (setq lt_old (getvar "celtype"))
    (setq co_old (getvar "cecolor"))
    (setq la_old (getvar "clayer"))
    (setq os_old (getvar "osmode"))
    (setq st_old (getvar "textstyle"))
    (setq pw_old (getvar "plinewid"))
    (setq orgpt  (getvar "ucsorg"))
    (setq or_old (getvar "orthomode"))
;------------------------------------------------------------
;set layer and pline width
    (if (not (tblsearch "layer" "apn"))
      (command "_.layer" "_new" "apn" "_color" "green" "apn" "_ltype" "continuous" "apn" "")
      (command "_.layer" "_thaw" "apn" "_on" "apn" "_unlock" "apn" "")
    )
  )
  (setvar "clayer" "apn")
  (setvar "plinewid" 0)
;------------------------------------------------------------
;Initializing
  (regapp "apn")
  (setq mb "B"
	if_h_v "0"
	d_m_n 0
	d_b_n 0
	ang_n 0
  )
  (setq ang_lib '("15" "18" "20" "23" ""))
  (load "apn_lib")
  (if (or (not apn_i) (< apn_i 1)) (setq apn_i 1))
  (ini_useri2)
;------------------------------------------------
;Start dialog
;------------------------------------------------
  (setq apn_id (load_dialog "AngPin"))
  (setq apn_next 1)
  (while (= 1 apn_next) 
    (if (not (new_dialog "APNDLG" apn_id))
      (exit)
    )
    (ini_apn_dia)
    (action_tile "IF_H"        "(ch_h)")
    (action_tile "APN_M"       "(mb_act)")
    (action_tile "APN_B"       "(mb_act)")
    (action_tile "APN_D_SEL"   "(d_act)")
    (action_tile "APN_ANG_SEL" "(ang_act)")
    (action_tile "APN_ITM"     "(setq rep_r $reason) (valid_rep)")
    (action_tile "APN_STK"     "(setq stk_r $reason) (valid_stk)")
    (action_tile "cancel"      "(done_dialog 0)")
    (action_tile "accept"      "(done_dialog 1)")
    (action_tile "APP_APN"     "(get_apn) (done_dialog 2)")
    (action_tile "APP_MOD"     "(done_dialog 3)")
    (setq what_next (start_dialog))
    (cond 
      ((= 0 what_next)
        (command "undo" "back")
        (setq apn_next 0)
      )
      ((= 1 what_next)
	(setq apn_next 0)
      )
      ((= 2 what_next)
        (setq apn_next 1)
	(if (not err_msg)
	;----------------------------
	;Call create_slide function
	;----------------------------
	  (create_slide)
        )
      )
      ((= 3 what_next)
        (apn_edit)
      )
    )
  )
;----------------------------------------
;Reset system variable and unload dialog
;----------------------------------------
  (ac_lxy_set)
  (unload_dialog apn_id)
  (prin1)
)
;*************************************** end of function ****************************************;

;************************************* Init dialog function *************************************;
(defun ini_apn_dia()
  (ini_list "APN_D_SEL" (lib_apn (if (= "B" mb) 4 1)))
  (ini_list "APN_ANG_SEL" ang_lib)
  (set_tile "APN_ANG_SEL" (itoa ang_n))
  (set_tile "APN_ANG" (nth ang_n ang_lib))
  (if stk
    (set_tile "APN_STK" stk)
    (set_tile "APN_STK" "")
  )
  (setq angd (get_tile "APN_ANG"))
  (setq stk (get_tile "APN_STK"))
  (if (= "B" mb)
    (progn
      (set_tile "APN_D" (nth d_b_n (lib_apn 4)))
      (set_tile "APN_B" "1")
      (setq d  (nth d_b_n (lib_apn 5)))
      (setq hd (nth d_b_n (lib_apn 6)))
      (setq k  (nth d_b_n (lib_apn 7)))
    )
    (progn
      (set_tile "APN_D" (nth d_m_n (lib_apn 1)))
      (set_tile "APN_M" "1")
      (setq d  (atof (nth d_m_n (lib_apn 1))))
      (setq hd (nth d_m_n (lib_apn 2)))
      (setq k (nth d_m_n (lib_apn 3)))
    )
  )
  (if err_msg
    (set_tile "MSG" err_msg)
    (set_tile "MSG" "")
  )
  (set_tile "IF_H" if_h_v)
  (if apn_i
    (progn
      (setq apn_rep (strcat "L" (itoa apn_i)))
      (set_tile "APN_ITM" apn_rep)
    )
  )
)
;*************************************** end of function ****************************************;

;**************************************** Change diameter ***************************************;
(defun d_act()
  (if (= "B" mb)
    (progn
      (setq d_b_n (atoi (get_tile "APN_D_SEL")))
      (set_tile "APN_D" (nth d_b_n (lib_apn 4)))
      (setq d  (nth d_b_n (lib_apn 5)))
      (setq hd (nth d_b_n (lib_apn 6)))
      (setq k  (nth d_b_n (lib_apn 7)))
    )
    (progn
      (setq d_m_n (atoi (get_tile "APN_D_SEL")))
      (set_tile "APN_D" (nth d_m_n (lib_apn 1)))
      (setq d  (atof (nth d_m_n (lib_apn 1))))
      (setq hd (nth d_m_n (lib_apn 2)))
      (setq k  (nth d_m_n (lib_apn 3)))
    )
  )
)
;*************************************** end of function ****************************************;

;************************************* Change Meter or inch *************************************;
(defun mb_act()
  (cond
    ((= "1" (get_tile "APN_B"))
      (setq mb "B")
      (ini_list "APN_D_SEL" (lib_apn 4))
      (set_tile "APN_D" (nth d_b_n (lib_apn 4)))
      (setq d  (nth d_b_n (lib_apn 5)))
      (setq hd (nth d_b_n (lib_apn 6)))
      (setq k  (nth d_b_n (lib_apn 7)))
    )
    ((= "1" (get_tile "APN_M"))
      (setq mb "M")
      (ini_list "APN_D_SEL" (lib_apn 1))
      (set_tile "APN_D" (nth d_m_n (lib_apn 1)))
      (setq d  (atof (nth d_m_n (lib_apn 1))))
      (setq hd (nth d_m_n (lib_apn 2)))
      (setq k  (nth d_m_n (lib_apn 3)))
    )
  )
)
;*************************************** end of function ****************************************;

;************************************* Select different ang *************************************;
(defun ang_act()
  (setq ang_n (atoi (get_tile "APN_ANG_SEL")))
  (set_tile "APN_ANG" (nth ang_n ang_lib))
  (setq angd (nth ang_n ang_lib))
)
;*************************************** end of function ****************************************;

;************************************* if draw it in hidden *************************************;
;Get the flag if draw it in hidden line or not
(defun ch_h()
  (setq if_h_v (get_tile "IF_H"))
)
;*************************************** end of function ****************************************;

;************************************** Verify ref number ***************************************;
(defun valid_rep()
  (if (= rep_r 2)
    (progn
      (setq apn_rep (get_tile "APN_ITM"))
      (if (/= "" apn_rep)
        (if (= 0 (atoi (substr apn_rep 2)))
	  (progn
	    (set_tile "APN_ITM" "")
            (mode_tile "APN_ITM" 2)
	    (setq apn_i nil)
	  )
          (progn
            (setq apn_rep (strcat "L" (itoa (atoi (substr apn_rep 2)))))
	    (setq apn_i (atoi (substr apn_rep 2))) 
	    (set_tile "APN_ITM" apn_rep)
	  )
        )
      )
    )
  )
)
;*************************************** end of function ****************************************;

;**************************************** Verify stroke *****************************************;
(defun valid_stk()
  (if (= stk_r 2)
    (progn
      (setq stk (get_tile "APN_STK"))
      (if (/= "" stk)
        (if (= 0.0 (atof stk))
	  (progn
	    (set_tile "APN_STK" "")
            (mode_tile "APN_STK" 2)
	  )
        )
      )
    )
  )
)
;*************************************** end of function ****************************************;

;************************************* Get user input data **************************************;
(defun get_apn()
  (setq angd (atof angd))
  (setq dd  (get_tile "APN_D"))
  (setq stk (get_tile "APN_STK"))
  (if (= 0.0 (atof stk))
    (setq err_msg "Invalid stroke value!")
    (setq err_msg nil)
  )
  (setq apn_rep (get_tile "APN_ITM"))
  (if (/= "" apn_rep)
    (setq apn_rep (strcase apn_rep))
  )
  (if (= "" apn_rep)
    (if (not err_msg)
      (setq err_msg "Invalid item number!")
      (setq err_msg (strcat err_msg " Invalid item number!"))
    )
  )
)
;*************************************** end of function ****************************************;


;************************************* Create slide function ************************************;
;main control function
(defun create_slide( / dirpt) 

 (defun dxc(n e) (cdr (assoc n (entget e))));defin local function

  (setq angd (* (/ angd 180) pi))
  (setq l    (/ (atof stk) (abs (sin angd)))) 
  (if (setq basept (getpoint "\nGet a base point:"))
    (if (setq pick1 (nentsel "\nSelect top side of slide"))
      (if (setq pick2 (nentsel "\nSelect bottom side of slide"))
        (progn
	  (setq pick_ent1 (dxc 0 (car pick1))
	        pick_ent2 (dxc 0 (car pick2))
          )
          (setq dirpt (getpoint "\nPlease assign direction:"))
          (if (and (or (= "LINE"       pick_ent1)
	               (= "CIRCLE"     pick_ent1)
	               (= "LWPOLYLINE" pick_ent1)
                       (= "ARC"        pick_ent1)
	           )
                   (or (= "LINE"       pick_ent2)
		       (= "CIRCLE"     pick_ent2)
	               (= "LWPOLYLINE" pick_ent2)
                       (= "ARC"        pick_ent2)
                   )
		   dirpt        
	      )
	    (bpoint_cst)
	    (setq err_msg "Invlid Entity!")
          )
        )
        (setq err_msg "Invlid Entity!")
      )
      (setq err_msg "Invalid entity!")
    )
  )
)
;*************************************** end of function ****************************************;


;**************************************** Get base point ****************************************;
;Calculate the base point function
(defun bpoint_cst()
  (setq dirpt1 (cadr pick2))
  (cond
    ((or (and (>= (angle basept dirpt1) (* pi 1.75)) (< (angle basept dirpt1) (* pi 2)))
         (and (>= (angle basept dirpt1) 0) (< (angle basept dirpt1) (* pi 0.25)))
     )
      (setq ang_ref 0)
      (if (> (cadr dirpt) (cadr basept))
        (setq ang angd)
        (setq ang (- 0 angd))
      )
    )
    ((and (>= (angle basept dirpt1) (* pi 0.25)) (< (angle basept dirpt1) (* pi 0.75)))
      (setq ang_ref (/ pi 2))
      (if (> (car dirpt) (car basept))
        (setq ang (- (* pi 0.5) angd))
        (setq ang (+ (* pi 0.5) angd))
      )
    )
    ((and (>= (angle basept dirpt1) (* pi 0.75)) (< (angle basept dirpt1) (* pi 1.25)))
      (setq ang_ref pi)
      (if (> (cadr dirpt) (cadr basept))
        (setq ang (- pi angd))
        (setq ang (+ pi angd))
      )
    )
    ((and (>= (angle basept dirpt1) (* pi 1.25)) (< (angle basept dirpt1) (* pi 1.75)))
      (setq ang_ref (* pi 1.5))
      (if (> (car dirpt) (car basept))
        (setq ang (+ (* pi 1.5) angd))
        (setq ang (- (* pi 1.5) angd))
      )
    )
  )
  (setq aa basept)
  (setq pt1 (polar basept ang k))
  (setq pt2 (pline_int basept pt1 (car pick1) (caddr pick1)))
  (setq aaa basept)
  (setq pt3 (pline_int basept pt1 (car pick2) (caddr pick2)))
  (if (and pt1 pt2 pt3)
    (progn
      (setq app_apn "NEW")
      (apn_cst)
    )
    (if pt2
      (if (not pt3)
        (setq err_msg "Not intersect with the second line you selected")
      )
      (setq err_msg "Not intersect with the first line you selected")
    )
  )
)
;*************************************** end of function ****************************************;


;************************************ Draw angle pin entity *************************************;
;Draw angle pin function
;it need the following parameter:
; l		translate from stroke
; ang		the orientation of angle pin based pt 
; basept	insert point
; pt2		intersection point of angle pin center and the first line
; pt3		intersection point of angle pin center and the second line
; apn_rep	item number
; dd		dimension diameter
; mb		meter and inch flag
; if_h_v	hidden flag
; stk		dimension stroke
; d		diameter of angle pin
; hd		head diameter of angle pin
; k		width of head
;***********************************************************************************************;
(defun apn_cst()
  (cond
    ((= "NEW" app_apn)
      (setq l02 (distance basept pt2))
      (setq l03 (distance basept pt3))
    )
    ((= "OLD" app_apn)
      (setq pt2 (polar basept ang l02))
      (setq pt3 (polar basept ang l03))
    )
  )
  (setq pt1 (polar basept ang k))
  (setq l (+ (distance basept pt2) l))
  (setq angv   (+ ang (* pi 0.5))
	angvv  (- ang (* pi 0.5))
	angh   (+ ang pi)
  )
  (if (< ang ang_ref)
    (setq spt1  (polar basept angv (/ hd 2))
	  spt2  (polar basept (- ang_ref (/ pi 2)) (/ (/ hd 2) (abs (cos angd))))
	  text_pt (polar (polar basept ang (/ k 2)) angv (/ hd 4))
    )
    (setq spt2  (polar basept angvv (/ hd 2))
	  spt1  (polar basept (+ ang_ref (/ pi 2)) (/ (/ hd 2) (abs (cos angd))))
	  text_pt (polar (polar basept ang (/ k 2)) angvv (/ hd 4))
    )
  )
  (setq spt3  (polar (polar basept ang k) angv (/ hd 2))
        spt4  (polar (polar basept ang k) angv (/ d 2))
        spt5  (polar (polar basept ang k) angvv (/ d 2))
	spt6  (polar (polar basept ang k) angvv (/ hd 2))
	spt7  (polar spt4 ang (- l k))
        spt8  (polar spt5 ang (- l k))
        spt9  (polar spt7 (- ang 0.3491) 4)
	spt10 (polar spt8 (+ ang 0.3491) 4)
  )
  (setq spt11 (polar basept (+ ang_ref (* pi 0.5)) (+ (/ hd 2) 0.5))
	spt12 (polar basept (- ang_ref (* pi 0.5)) (+ (/ hd 2) 0.5))
	spt13 (polar (polar basept ang k) angv (+ (/ hd 2) 0.5))
        spt14 (polar (polar basept ang k) angvv (+ (/ hd 2) 0.5))
  )
  (setq scpt1 (polar basept angh 2)
	scpt2 (polar basept ang (+ l 6))
  )
  (setvar "osmode" 0)
  (setq sel_ent (ssadd))
  (command "text" "j" "mc" text_pt 2.5 0 apn_rep)
  (setq sel_ent (ssadd (entlast) sel_ent))
  (if (= "1" if_h_v)
    (progn
      (command "linetype" "s" "hidden" "")
      (setvar "cecolor" "yellow")
    )
  )
  (command "pline" spt1 basept spt2 spt6 spt3 spt1 "")
  (setq sel_ent (ssadd (entlast) sel_ent))
  (command "pline" spt4 spt7 spt9 spt10 spt8 spt5 "")
  (setq sel_ent (ssadd (entlast) sel_ent))
  (setq trm_ent (entlast))
  (command "pline" spt7 spt8 "")
  (setq sel_ent (ssadd (entlast) sel_ent))
  (setq tmpt1 (polar basept angv (+ 0.5 (/ d 2)))
	tmpt2 (polar tmpt1 ang 1)
	tmpt3 (polar basept angvv (+ 0.5 (/ d 2)))
	tmpt4 (polar tmpt3 ang 1)
  )
  (setq spt15 (polar basept (+ ang_ref (/ pi 2)) (/ (+ 0.5 (/ hd 2)) (abs (cos angd))))
	spt16 (polar basept (- ang_ref (/ pi 2)) (/ (+ 0.5 (/ hd 2)) (abs (cos angd))))
	spt17 (polar (polar basept ang k) angv (+ 0.5 (/ hd 2)))
	spt18 (polar (polar basept ang k) angvv (+ 0.5 (/ hd 2)))
  )
  (if (and pick1 pick2)
    (progn
      (setq spt19 (pline_int tmpt1 tmpt2 (car pick1) (caddr pick1))
	    spt20 (pline_int tmpt3 tmpt4 (car pick1) (caddr pick1))
	    spt21 (pline_int tmpt1 tmpt2 (car pick2) (caddr pick2))
	    spt22 (pline_int tmpt3 tmpt4 (car pick2) (caddr pick2))
      )
      (command "trim" trm_ent "" pt2 pt3 "")
    )
    (setq spt19 (polar pt2 (+ ang_ref (* pi 0.5)) (+ (/ d 2) 0.5))
	  spt20 (polar pt2 (- ang_ref (* pi 0.5)) (+ (/ d 2) 0.5))
          spt21 (polar pt3 (+ ang_ref (* pi 0.5)) (+ (/ d 2) 0.5))
          spt22 (polar pt3 (- ang_ref (* pi 0.5)) (+ (/ d 2) 0.5))
    )
  )
  (command "pline" spt15 spt17 spt18 spt16 "")
  ;(setq sel_ent (ssadd (entlast) sel_ent))
  (if (and spt19 spt21)
    (progn
      (command "pline" spt19 spt21 "")
      ;(setq sel_ent (ssadd (entlast) sel_ent))
    )
  )
  (if (and spt20 spt22)
    (progn
      (command "pline" spt20 spt22 "")
      ;(setq sel_ent (ssadd (entlast) sel_ent))
    )
  )
  (progn 
    (command "linetype" "s" "center" "")
    (setvar "cecolor" "red")
    (command "pline" scpt1 scpt2 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
  )
  (setq l (+ l 4))
  (setq spec (strcat "%%C" dd "X" (len_round)))
  (if (and (> ang (* pi 0.50)) (< ang (* pi 1.50)))
    (progn
      (setq textang (* (+ ang pi) (/ 180 pi)))
      (setq textpt2 (polar (polar pt1 ang (* 1.25 (- (strlen spec) 1))) angvv 0.5))
    )
    (progn
      (setq textang (* ang (/ 180 pi)))
      (setq textpt2 (polar (polar pt1 ang 1.25) angv 0.5))
    )
  )
;-----------------------------------------------------
;Dim specification and item number
;-----------------------------------------------------
  (setvar "cecolor" "bylayer")
  (setvar "celtype" "bylayer")
  (progn
    (if (not (tblsearch "style" "lxy1"))
      (command "-style" "lxy1" "txt" "" 0.5 "" "" "" "")
      (setvar "textstyle" "lxy1")
    )
    (command "text" textpt2 2.5 textang spec)
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (setvar "textstyle" st_old)
  )
  (mblk (strcat "AC_LXY_BLK" (itoa (getvar "useri2"))) basept sel_ent)
  (setvar "useri2" (+ 1 (getvar "useri2")))
  (setq xd (strcat 	apn_rep " " 		;item number
			"C" " " 		;view flag
			dd " " 			;dim diameter
			(len_round) " " 	;dim length
			if_h_v " " 		;hidden flag
			"0" " " 		;type flag
			mb " " 			;meter or inch flag
			stk " " 		;stroke value
			(rtos ang 2 5) " "	;angle
			(rtos l 2 5) " " 	;length
			(rtos l02 2 5) " "	;distance between basept and pt2
			(rtos l03 2 5)))        ;distance between basept and pt3
  (setq xd (list (list -3 (list "apn" (cons 1000 xd)))))
  (mxdata  (entlast) xd)
  (setvar "osmode"  os_old)
  (zst_main)
)
;*************************************** end of function ****************************************;


;********************************** Round length of angle pin ***********************************;
;round the angle pin length 
(defun len_round( / n len_1 len_2 len)
  (cond
    ((= "M" mb)
      (cond 
	((>= 100 l)
	  (setq len "100")
	)
	((and (>= 125 l) (< 100 l))
	  (setq len "125")
	)
	((and (>= 160 l) (< 100 l))
	  (setq len "160")
	)
	((and (>= 200 l) (< 150 l))
	  (setq len "200")
	)
	((and (>= 250 l) (< 200 l))
	  (setq len "250")
	)
	((and (>= 300 l) (< 250 l))
	  (setq len "300")
	)
	((and (>= 350 l) (< 300 l))
	  (setq len "350")
	)  
	((and (>= 400 l) (< 350 l))
	  (setq len "400")
	)  
	((and (>= 450 l) (< 400 l))
	  (setq len "450")
	)  
	((and (>= 500 l) (< 450 l))
	  (setq len "500")
	)  
	((and (>= 550 l) (< 500 l))
	  (setq len "550")
	)  
	((and (>= 600 l) (< 550 l))
	  (setq len "600")
	)  
	((and (>= 650 l) (< 600 l))
	  (setq len "650")
	)  
	((and (>= 700 l) (< 650 l))
	  (setq len "700")
	)
      )
    )
    ((= "B" mb)
      (cond 
	((>= 101.6 l)
	  (setq len "4\"")
	)
	((and (>= 152.4 l) (< 101.6 l))
	  (setq len "6\"")
	)
	((and (>= 203.2 l) (< 152.4 l))
	  (setq len "8\"")
	)
	((and (>= 254 l) (< 203.2 l))
	  (setq len "10\"")
	)
	((and (>= 304.8 l) (< 254 l))
	  (setq len "12\"")
	)
	((and (>= 355.6 l) (< 304.8 l))
	  (setq len "14\"")
	)
	((and (>= 406.4 l) (< 355.6 l))
	  (setq len "16\"")
	)
	((and (>= 457.2 l) (< 406.4 l))
	  (setq len "18\"")
	)
	((and (>= 508 l) (< 457.4 l))
	  (setq len "20\"")
	)
	((and (>= 558.8 l) (< 508 l))
	  (setq len "22\"")
	)
	((and (>= 609.6 l) (< 558.8 l))
	  (setq len "24\"")
	)
	((and (>= 660.4 l) (< 609.6 l))
	  (setq len "26\"")
	)
	((and (>= 711.2 l) (< 660.4 l))
	  (setq len "28\"")
	)
      )
    )
  )
  len
)
;*************************************** end of function ****************************************;

;************************************* Init dialog function2 ************************************;
(defun ini_apn_dia2()
  (ini_list "APN_D_SEL" (lib_apn (if (= "B" mb) 4 1)))
  (if stk
    (set_tile "APN_STK" stk)
    (set_tile "APN_STK" "")
  )
  (setq stk (get_tile "APN_STK"))
  (if (= "B" mb)
    (progn
      (set_tile "APN_D" (nth d_b_n (lib_apn 4)))
      (set_tile "APN_B" "1")
      (setq d  (nth d_b_n (lib_apn 5)))
      (setq hd (nth d_b_n (lib_apn 6)))
      (setq k  (nth d_b_n (lib_apn 7)))
    )
    (progn
      (set_tile "APN_D" (nth d_m_n (lib_apn 1)))
      (set_tile "APN_M" "1")
      (setq d  (atof (nth d_m_n (lib_apn 1))))
      (setq hd (nth d_m_n (lib_apn 2)))
      (setq k (nth d_m_n (lib_apn 3)))
    )
  )
  (if apn_rep
    (set_tile "APN_ITM" apn_rep)
  )
  (if err_msg
    (set_tile "MSG" err_msg)
    (set_tile "MSG" "")
  )
  (set_tile "IF_H" if_h_v)
)
;*************************************** end of function ****************************************;

;*********************************** Edit angle pin function ************************************;
(defun apn_edit()
  (setq apn_ent nil)
  (while (not apn_ent)
    (setq apn_ent (car (entsel)))
  )
  (if (assoc -3 (entget apn_ent '("apn")))
    (progn
      (setq apn_data (cadr (assoc -3 (entget apn_ent '("apn")))))
      (if (= "APN" (car apn_data))
        (setq ed_next (yn "Reselect insert point?"))
        (setq apn_data nil)
      )
    )
    (setq apn_data nil)
  )
  (cond 
    ((and apn_data (= 1 ed_next))
      (get_edit_data)
      (entdel apn_ent)
    )
    ((and apn_data (= 0 ed_next))
      (get_edit_data)
      (setq apn_next 0)
      (apn_modify)
    )
    ((= nil apn_data)
      (setq err_msg "Invalid selected entity!")
    )
  )
)
;*************************************** end of function ****************************************;

;********************************** Get edit dialog parameter ***********************************;
(defun get_edit_data()
  (setq all_data (cdr (assoc 1000 (cdr apn_data))))
  (setq all_data (strtolst all_data))
  (setq apn_rep (nth 0 all_data)
	zc      (nth 1 all_data)
	dd      (nth 2 all_data)
	if_h_v  (nth 4 all_data)
	mb      (nth 6 all_data)
	stk     (nth 7 all_data)
	l       (nth 9 all_data)
	ang     (nth 8 all_data)
        l02     (atof (nth 10 all_data))
        l03     (atof (nth 11 all_data))
  )
  (cond 
    ((= "B" mb)
      (setq d_b_n (xh_get dd (lib_apn 4)))
      (setq d_m_n 0)
    )
    ((= "M" mb)
      (setq d_m_n (xh_get dd (lib_apn 1)))
      (setq d_b_n 0)
    )
  )
  (setq ang (atof ang))
  (if (= -1.0 (cdr (assoc 41 (entget apn_ent))))
    (progn
      (setq ang_mirr (cdr (assoc 50 (entget apn_ent))))
      (setq ang_mirr (/ ang_mirr 2))
      (setq ang_mirr (+ ang_mirr (/ pi 2)))
      (if (<= pi ang_mirr)
        (setq ang_mirr (- ang_mirr pi))
      )
      (if (= "C" zc)
        (progn
	  (setq ang_mirr (- (- ang (* (fix (/ ang pi)) pi)) ang_mirr))
	  (setq ang (- ang (* 2 ang_mirr)))
        )
      )
    )
    (setq ang (+ ang (cdr (assoc 50 (entget apn_ent)))))
  )
  (if (< (* pi 2) ang)
    (setq ang (- ang (* pi 2)))
  )
  (if (< ang 0)
    (setq ang (+ ang (* pi 2)))
  )
  (setq angdd (/ (* ang 180) pi))
  (if (> ang (* 1.75 pi))
    (setq ang (- ang (* 2 pi)))
  )
  (cond 
    ((and (> angdd 315) (< angdd 360))
      (setq angd (fix (- 360 angdd)))
      (setq ang_ref 0)
    )
    ((and (> angdd 0) (< angdd 45))
      (setq angd (fix angdd))
      (setq ang_ref 0)
    )
    ((and (> angdd 45) (< angdd 90))
      (setq angd (fix (- 90 angdd)))
      (setq ang_ref (/ pi 2))
    ) 
    ((and (> angdd 90) (< angdd 135))
      (setq angd (fix (- angdd 90)))
      (setq ang_ref (/ pi 2))
    )
    ((and (> angdd 135) (< angdd 180))
      (setq angd (fix (- 180 angdd)))
      (setq ang_ref pi)
    )
    ((and (> angdd 180) (< angdd 225))
      (setq angd (fix (- angdd 180)))
      (setq ang_ref pi)
    )
    ((and (> angdd 225) (< angdd 270))
      (setq angd (fix (- 270 angdd)))
      (setq ang_ref (* pi 1.5))
    )
    ((and (> angdd 270) (< angdd 315))
      (setq angd (fix (- angdd 180)))
      (setq ang_ref (* pi 1.5))
    )
  )
  (cond 
    ((or (= 14 angd) (= 16 angd))
      (setq angd 15)
    )
    ((or (= 17 angd) (= 19 angd))
      (setq angd 18)
    )
    ((or (= 19 angd) (= 21 angd))
      (setq angd 20)
    )
    ((or (= 22 angd) (= 24 angd))
      (setq angd 23)
    )
  ) 
  (setq ang_n (xh_get (itoa angd) ang_lib))
  (setq basept (cdr (assoc 10 (entget apn_ent))))
  (setq basept (wtou basept))
  (setq l1 (/ (atof stk) (sin (* (/ angd 180.0) pi))))
  (setq l  (atof l))
)
;*************************************** end of function ****************************************;

;********************************* Main modify control function *********************************;
(defun apn_modify()
  (command "undo" "m")
  (setq angd (itoa angd))
  (setq edit_next 1)
  (while (= 1 edit_next) 
    (if (not (new_dialog "APNEDIT" apn_id))
      (exit)
    )
    (ini_apn_dia2)
    (action_tile "IF_H"        "(ch_h)")
    (action_tile "APN_M"       "(mb_act)")
    (action_tile "APN_B"       "(mb_act)")
    (action_tile "APN_D_SEL"   "(d_act)")
    (action_tile "cancel"      "(done_dialog 0)")
    (action_tile "accept"      "(get_apn) (done_dialog 1)")
    (setq what_next (start_dialog))
    (setq apn_next 0)
    (cond 
      ((= 0 what_next)
        (command "undo" "back")
        (setq edit_next 0)
      )
      ((= 1 what_next)
        (setq pick1 nil)
        (setq pick2 nil)
        (if (not err_msg)
          (progn
            (setq l (/ (atof stk) (* (/ angd 180) pi)))
            (setq angd (* (/ angd 180) pi))
            (setq app_apn "OLD")
            (entdel apn_ent)
            (apn_cst)
            (setq edit_next 0)
          )
          (setq edit_next 1)
        )
      )
    )
  )
)
;*************************************** end of function ****************************************;

;*************************** Angle pin zst view main control function ***************************;
(defun zst_main()
  (command "undo" "M")
  (setq zst_nxt 1)
  (while (= 1 zst_nxt)
    (if (not (new_dialog "APNZST" apn_id))
      (exit)
    )
    (action_tile "TVIEW" "(done_dialog 1)")
    (action_tile "BVIEW" "(done_dialog 2)")
    (action_tile "accept" "(done_dialog 3)")
    (action_tile "cancel" "(done_dialog 4)")
    (action_tile "GOLOOK" "(done_dialog 5)")
    (setq zst_next (start_dialog))
    (cond
      ((= 1 zst_next)
        (setq what_sel "A")
        (apn_zst)
      )
      ((= 2 zst_next)
        (setq what_sel "B")
        (apn_zst)
      )
      ((= 3 zst_next)
        (setq zst_nxt 0)
      )
      ((= 4 zst_next)
        (setq zst_nxt 0)
        (command "undo" "B")
      )
      ((= 5 zst_next)
        (command "zoom" "")
      )
    )
  )
)
;*************************************** end of function ****************************************;

;*********************************** Create angle pin zst view **********************************;
(defun apn_zst( / zcpt)
;---------------------------------
;initializing
  (initget 32)
  (setvar "orthomode" 1) 
;---------------------------------
;get center point and calculate parameter
  (while (not zcpt)
    (if (= "A" what_sel)
      (setq zcpt (getpoint pt2 "\nPlease select center point:"))
      (setq zcpt (getpoint (polar basept ang l) "\nPlease select center point:"))
    )
  )
  (setq ang_refv  (+ ang_ref (* pi 0.5)))
  (setq ang_refvv (- ang_ref (* pi 0.5)))
  (setq ang_refh  (+ ang_ref pi))
  (setq hdd (+ (/ hd 2) 0.5))
  (setvar "osmode" 0)
;--------------------------------
;cond
  (cond
;;--------------------------------
;;if selected top view
    ((= "A" what_sel)
      (setq l1 (* (distance pt2 pt3) (sin angd)))
      (if (> ang ang_ref)
        (setq zcpt1 (polar zcpt ang_refv l1))
        (setq zcpt1 (polar zcpt ang_refvv l1))
      )
      (setq opt1 (polar zcpt ang_ref   (+ (/ d 2) 0.5))
	    opt2 (polar zcpt ang_refv  (/ (+ (/ d 2) 0.5) (cos angd)))
	    opt3 (polar zcpt ang_refh  (+ (/ d 2) 0.5))
	    opt4 (polar zcpt ang_refvv (/ (+ (/ d 2) 0.5) (cos angd)))
      )
      (setq ipt1 (polar zcpt1 ang_ref   (+ (/ d 2) 0.5))
	    ipt2 (polar zcpt1 ang_refv  (/ (+ (/ d 2) 0.5) (cos angd)))
	    ipt3 (polar zcpt1 ang_refh  (+ (/ d 2) 0.5))
	    ipt4 (polar zcpt1 ang_refvv (/ (+ (/ d 2) 0.5) (cos angd)))
      )
      (setq olpt1 (polar zcpt 0 (+ (/ d 2) 2))
            olpt2 (polar zcpt (/ pi 2) (+ (/ d 2) 2))
            olpt3 (polar zcpt pi (+ (/ d 2) 2))
            olpt4 (polar zcpt (* pi 1.5) (+ (/ d 2) 2))
      )
      (setq ilpt1 (polar zcpt1 0 (+ (/ d 2) 2))
            ilpt2 (polar zcpt1 (/ pi 2) (+ (/ d 2) 2))
            ilpt3 (polar zcpt1 pi (+ (/ d 2) 2))
            ilpt4 (polar zcpt1 (* pi 1.5) (+ (/ d 2) 2))
      )
      (setq text_zst (polar zcpt (/ pi 4) (/ hd 4)))
      (setq sel_ent (ssadd))
      (command "ellipse" "_c" zcpt opt1 opt2)
      (setq sel_ent (ssadd (entlast) sel_ent))
      (progn 
        (command "linetype" "s" "hidden" "")
        (setvar "cecolor" "yellow")
        (command "ellipse" "_c" zcpt1 ipt1 ipt2)
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" opt1 ipt1 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" opt3 ipt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
      )
      (progn 
        (command "linetype" "s" "center" "")
        (setvar "cecolor" "red")
        (command "pline" olpt1 olpt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" olpt2 olpt4 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" ilpt1 ilpt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" ilpt2 ilpt4 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (setvar "celtype" "bylayer")
        (setvar "cecolor" "bylayer")
      )
      (mblk (strcat "AC_LXY_BLK" (itoa (getvar "useri2"))) zcpt sel_ent)
      (setvar "useri2" (+ 1 (getvar "useri2")))
      (setq xd (strcat 	apn_rep " " 		;item number
			"ZA" " " 		;view flag
			dd " " 			;dim diameter
			(len_round) " " 	;dim length
			"0" " " 		;hidden flag
			if_h_v " " 		;type flag
			mb " " 			;meter or inch flag
			stk " " 		;stroke value
			(rtos l 2 5) " " 	;length
			(rtos ang 2 5)))	;angle
      (setq xd (list (list -3 (list "apn" (cons 1000 xd)))))
      (mxdata  (entlast) xd)
    )
;;-----------------------------------
;;if selected bottom view
    ((= "B" what_sel)
;;;;-----------------------------------
;;;;calculate parameterand point ordinate
      (setq l2 (* (- l (distance basept pt2)) (sin angd)))
      (setq l3 (* (- l (distance basept pt1)) (sin angd)))
      (setq l4 (* l (sin angd)))
      (setq l1 (- l (distance basept pt3)))
      (if (> ang ang_ref)
        (progn
          (setq zcpt1 (polar zcpt ang_refvv (* 4  (sin angd))))
          (setq zcpt2 (polar zcpt ang_refvv l2))
          (setq zcpt3 (polar zcpt ang_refvv l3))
          (setq zcpt4 (polar zcpt ang_refvv l4))
        )
        (progn
          (setq zcpt1 (polar zcpt ang_refv (* 4  (sin angd))))
          (setq zcpt2 (polar zcpt ang_refv l2))
          (setq zcpt3 (polar zcpt ang_refv l3))
          (setq zcpt4 (polar zcpt ang_refv l4))
        )
      )
      (setq hopt1 (polar zcpt4 ang_ref   hdd)
	    hopt2 (polar zcpt4 ang_refv  (/ hdd (cos angd)))
	    hopt3 (polar zcpt4 ang_refh  hdd)
	    hopt4 (polar zcpt4 ang_refvv (/ hdd (cos angd)))
      )
      (setq hipt1 (polar zcpt3 ang_ref   hdd)
	    hipt2 (polar zcpt3 ang_refv  (* hdd (cos angd)))
	    hipt3 (polar zcpt3 ang_refh  hdd)
	    hipt4 (polar zcpt3 ang_refvv (* hdd (cos angd)))
      )
      (setq hiipt1 (polar zcpt3 ang_ref   (/ d 2))
	    hiipt2 (polar zcpt3 ang_refv  (* (/ d 2) (cos angd)))
	    hiipt3 (polar zcpt3 ang_refh  (/ d 2))
	    hiipt4 (polar zcpt3 ang_refvv (* (/ d 2) (cos angd)))
      )
      (setq opt1 (polar zcpt2 ang_ref   (/ d 2))
	    opt2 (polar zcpt2 ang_refv  (/ (/ d 2) (cos angd)))
	    opt3 (polar zcpt2 ang_refh  (/ d 2))
	    opt4 (polar zcpt2 ang_refvv (/ (/ d 2) (cos angd)))
      )
      (setq ipt1 (polar zcpt1 ang_ref   (/ d 2))
	    ipt2 (polar zcpt1 ang_refv  (* (/ d 2) (cos angd)))
	    ipt3 (polar zcpt1 ang_refh  (/ d 2))
	    ipt4 (polar zcpt1 ang_refvv (* (/ d 2) (cos angd)))
      )
      (setq td (- d 2.736))
      (setq iipt1 (polar zcpt ang_ref   (/ td 2))
            iipt2 (polar zcpt ang_refv  (* (/ td 2) (cos angd)))
            iipt3 (polar zcpt ang_refh  (/ td 2))
            iipt4 (polar zcpt ang_refvv (* (/ td 2) (cos angd)))
      )
      (setq lpt1 (polar zcpt  ang_ref   (+ (/ d 2) 2))
            lpt3 (polar zcpt  ang_refh  (+ (/ d 2) 2))
      )
      (if (> ang ang_ref)
        (progn
          (setq ipt5 (polar ipt1 ang_refvv l2))
          (setq ipt6 (polar ipt3 ang_refvv l2))
          (setq ipt7 (polar ipt1 ang_refvv l3))
          (setq ipt8 (polar ipt3 ang_refvv l3))
          (setq lpt2 (polar zcpt ang_refvv (+ l4 (/ hd 2) 2.5)))
          (setq lpt4 (polar zcpt ang_refv  (+ (/ d 2) 2.5)))
        )
        (progn
          (setq ipt5 (polar ipt1 ang_refv l2))
          (setq ipt6 (polar ipt3 ang_refv l2))
          (setq ipt7 (polar ipt1 ang_refv l3))
          (setq ipt8 (polar ipt3 ang_refv l3))
          (setq lpt2 (polar zcpt ang_refv  (+ l4 (/ hd 2) 2.5)))
          (setq lpt4 (polar zcpt ang_refvv (+ (/ d 2) 2.5)))
        )
      )
;;;;--------------------------------------------
;;;;draw bottom view
      (progn
        (setq sel_ent (ssadd))
        (command "ellipse" "_c" zcpt1 ipt1 ipt2)
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "ellipse" "_c" zcpt iipt1 iipt2)
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" ipt1 ipt5 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" ipt3 ipt6 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (if (> ang ang_ref)
          (progn
            (command "arc" opt3 opt4 opt1) 
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
          (progn
            (command "arc" opt1 opt2 opt3)
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
        )
      )
      (progn 
        (command "linetype" "s" "hidden" "")
        (setvar "cecolor" "yellow")
        (command "ellipse" "_c" zcpt3 hipt1 hipt2)
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" ipt5 hiipt1 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" ipt6 hiipt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" hipt1 hopt1 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" hipt3 hopt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (if (> ang ang_ref)
          (progn
            (command "arc" opt1 opt2 opt3) 
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "arc" hiipt3 hiipt4 hiipt1) 
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "arc" hopt3 hopt4 hopt1)
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
          (progn
            (command "arc" opt3 opt4 opt1) 
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "arc" hiipt1 hiipt2 hiipt3) 
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "arc" hopt1 hopt2 hopt3)
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
        )
        (setvar "celtype" "bylayer")
        (setvar "cecolor" "bylayer")
      )
      (progn 
        (command "linetype" "s" "center" "")
        (setvar "cecolor" "red")
        (command "pline" lpt1 lpt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" lpt2 lpt4 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (setvar "celtype" "bylayer")
        (setvar "cecolor" "bylayer")
      )
;;;;------------------------------------------
;;;;translate drawing to block and make extend data
      (mblk (strcat "AC_LXY_BLK" (itoa (getvar "useri2"))) zcpt sel_ent)
      (setvar "useri2" (+ 1 (getvar "useri2")))
      (setq xd (strcat 	apn_rep " " 		;item number
			"ZB" " " 		;view flag
			dd " " 			;dim diameter
			(len_round) " " 	;dim length
			"0" " " 		;hidden flag
			if_h_v " " 		;type flag
			mb " " 			;meter or inch flag
			stk " " 		;stroke value
			(rtos l 2 5) " " 	;length
			(rtos ang 2 5)))	;angle
      (setq xd (list (list -3 (list "apn" (cons 1000 xd)))))
      (mxdata  (entlast) xd)
      (setq apn_i (+ apn_i 1))
    )
  )
;--------------------------------
;reset "osmode" var
  (setvar "osmode"  os_old)
)
;*************************************** end of function ****************************************;