apn_new.lsp

plc设计编程软件

;*****************************************************;
;* 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()