epwscst.lsp

plc设计编程软件

;*****************************************************;
;* This is "epin_ws_cst.lsp" program 		     *;
;* Complete compiled in 12/20/98                     *;
;* Last change in 1/26/99    			     *;
;* ZX Mold Ltd  XY.Liao				     *;
;*****************************************************;
;****************************************Main function start********************************************;
(defun ws_cst(/ wpt1  		wpt2  		wpt3  		wpt4  		wpt5  		wpt6  		
		wpt7  		wpt8 		wpt9  		wpt10 		wpt11 		wpt12 		
		wpt13 		wpt14 		wpt15 		wpt16		wpt17 		wpt18 		
		wpt19 		wpt20 		wpt21 		wpt22 		wpt23 		wpt24		
		wpt25 		wpt26 		textpt2		angv		angvv 		angh  		
		wpt27 		wpt28		wpt29 		wpt30 		wpt31 		wpt32 		
		wpt33		wpt34		wpt35 		wpt36 		wpt37 		wpt38		
		int_pt1   	int_pt2		wpct1 		wpct2 		sel_ent	    	tr_ent3     	
		textpt1		textang		textangv)

;------------------------------------------------
;calculate parameter
;------------------------------------------------
  (if (= "NEW" epin_app)
    (progn
      (setq ang  (angle pt1 pt2))
      (if (> (abs (- ang (angle pt1 pt3))) 0.001)
        (setq err_msg2 "三点不在一条线上")
        (setq l12 (distance pt1 pt2)
	      l23 (distance pt2 pt3)
        )
      )
    )
    (progn
      (setq pt2 (polar pt1 ang l12))
      (setq pt3 (polar pt2 ang l23))
    )
  )
  (setq angv  (+ ang (/ pi 2)))
  (setq angvv (- ang (/ pi 2)))
  (setq angh  (+ ang pi))
;------------------------------------------------
;calculate parameter
;------------------------------------------------
  (setq wpt2 (polar pt1 angv (/ hd 2.0))
	wpt1 (polar wpt2 angv 0.5)
	wpt3 (polar pt1 angvv (/ hd 2.0))
	wpt4 (polar wpt3 angvv 0.5)
  )
  (setq wpt14 (polar pt2 angv (/ dd 2.0))
	wpt13 (polar wpt14 angv 0.5)
	wpt15 (polar pt2 angvv (/ dd 2.0))
	wpt16 (polar wpt15 angvv 0.5)
  )
  (setq wpt5 (polar wpt1 ang b)
	wpt6 (polar wpt2 ang b)
	wpt11 (polar wpt3 ang b)
	wpt12 (polar wpt4 ang b)
	wpt7 (polar wpt13 angh (- l12 b))
	wpt8 (polar wpt14 angh (- l12 b))
	wpt9 (polar wpt15 angh (- l12 b))
	wpt10 (polar wpt16 angh (- l12 b))
	wpt37 (polar wpt6 angvv (/ (- hd d) 2))
	wpt38 (polar wpt11 angv (/ (- hd d) 2))
  )
  (setq wpt21 (polar wpt13 ang l23)
	wpt22 (polar wpt37 ang (- (distance pt1 pt3) b))
	wpt23 (polar wpt38 ang (- (distance pt1 pt3) b))
	wpt24 (polar wpt16 ang l23)
  )
  (if (= "NEW" epin_app)
    (setq int_pt1 (pline_int wpt37 wpt22 (car ob_ent) (caddr ob_ent))
  	  int_pt2 (pline_int wpt38 wpt23 (car ob_ent) (caddr ob_ent))
    ) 
    (setq int_pt1 (polar wpt37 ang (- li1 b))
	  int_pt2 (polar wpt38 ang (- li2 b))
    )
  )
  (if (not (and int_pt1 int_pt2))
    (setq err_msg2 "Ejector pin don't intersect entity you selected!")
    (progn
      (if (listp (car int_pt1))
        (if (> (distance (cadr ob_ent) (car int_pt1))
	       (distance (cadr ob_ent) (cadr int_pt1))
            )
          (setq int_pt1 (cadr int_pt1))
          (setq int_pt1 (car int_pt1))
        )
      )
      (if (listp (car int_pt2))
        (if (> (distance (cadr ob_ent) (car int_pt2))
	       (distance (cadr ob_ent) (cadr int_pt2))
            )
          (setq int_pt2 (cadr int_pt2))
          (setq int_pt2 (car int_pt2))
        )
      )
      (setq li1 (+ b (distance wpt37 int_pt1))
	    li2 (+ b (distance wpt38 int_pt2))
      )
      (setq l (if (> li1 li2) li1 li2))
      (if (> l 254.0)
	(setq err_msg2 "Invalid step ejector pin length!")
      )
    )
  )
  (if (not err_msg2)
    (progn 
;-------------------------------------------------
;Round l as a standard ejector pin length
;-------------------------------------------------
      (cond
	((= "M" mb)
	  (cond 
	    ((>= 100 l)
	      (setq len "100")
	      (setq nl_ws 25)
	    )
	    ((and (>= 125 l) (< 100 l))
	      (setq len "125")
	      (setq nl_ws 50)
	    )
	    ((and (>= 160 l) (< 100 l))
	      (setq len "160")
	      (setq nl_ws 50)
	    )
	    ((and (>= 200 l) (< 160 l))
	      (setq len "200")
	      (setq nl_ws 50)
	    )
	    ((and (>= 250 l) (< 200 l))
	      (setq len "250")
	      (setq nl_ws 75)
	    )
	  )
	)
	((= "B" mb)
	  (cond 
	    ((>= 101.6 l)
	      (setq len "4\"")
	      (setq nl_ws 25.4)
	    )
	    ((and (>= 152.4 l) (< 101.6 l))
	      (setq len "6\"")
	      (setq nl_ws 50.8)
	    )
	    ((and (>= 203.2 l) (< 152.4 l))
	      (setq len "8\"")
	      (setq nl_ws 50.8)	
	    )
	    ((and (>= 254 l) (< 203.2 l))
	      (setq len "10\"")
	      (setq nl_ws 76.2)
	    )
	  )
	)
      )
;------------------------------------------------
;calculate the remain points' ordinate
;------------------------------------------------
      (if (<= li1 li2)
        (setq wpt32 (polar int_pt1 angh 20)
	      wpt31 (polar wpt32 angv 0.5)
	      wpt33 (polar wpt32 angvv d)
	      wpt34 (polar wpt33 angvv 0.5)
        )
        (setq wpt33 (polar int_pt2 angh 20)
	      wpt34 (polar wpt33 angvv 0.5)
	      wpt32 (polar wpt33 angv d)
	      wpt31 (polar wpt32 angv 0.5)
        )
      )
      (setq wpt17 (polar wpt8 ang (- nl_ws b))
	    wpt18 (polar wpt37 ang (- nl_ws b))
	    wpt19 (polar wpt38 ang (- nl_ws b))
	    wpt20 (polar wpt9 ang (- nl_ws b))
      )
      (setq wpt25 (polar wpt21 ang (+ 2 (- nl_ws l12)))
	    wpt27 (polar wpt22 ang (+ 2 (- nl_ws l12)))
	    wpt26 (polar wpt27 angv 0.5)
	    wpt28 (polar wpt23 ang (+ 2 (- nl_ws l12)))
	    wpt29 (polar wpt28 angvv 0.5)
	    wpt30 (polar wpt24 ang (+ 2 (- nl_ws l12)))
      )
      (setq wpt41 (polar wpt14 ang l23)
	    wpt42 (polar wpt15 ang l23)
	    
      )
      (setq wcpt1 (polar pt1 angh 0.5)
	    wcpt2 (polar pt1 ang (+ l 2))
      )
      (setvar "osmode" 0)
;---------------------------------------------------
;Draw pin entitis and c'bore
;---------------------------------------------------
      (if (< (distance wpt14 wpt17) l23)
      	(progn
          (setq sel_ent (ssadd))
          (command "line" wpt18 wpt22 "")
          (setq sel_ent (ssadd (entlast) sel_ent))
          (setq tr_ent1 (entlast))
          (command "line" wpt19 wpt23 "")
          (setq sel_ent (ssadd (entlast) sel_ent))
          (setq tr_ent2 (entlast))
          (command "pline" wpt14 wpt17 wpt20 wpt15 "")
          (setq sel_ent (ssadd (entlast) sel_ent))
          (setq tr_ent3 (entlast))
          (if (= "1" if_h_v)
            (progn
     	      (command "linetype" "s" "hidden" "")
	      (setvar "cecolor" "yellow")
            )
            (command "trim" tr_ent1 tr_ent2 tr_ent3 "" pt2 pt3 "")
          )
        )
	(progn
	  (command "line" wpt14 wpt41 "")
          (setq sel_ent (ssget "l"))
          (setq tr_ent1 (entlast))
	  (command "line" wpt15 wpt42 "")  
          (setq sel_ent (ssadd (entlast) sel_ent))
          (setq tr_ent2 (entlast))
          (if (= "1" if_h_v)
            (progn
     	      (command "linetype" "s" "hidden" "")
	      (setvar "cecolor" "yellow")
            )
            (command "trim" tr_ent1 tr_ent2 "" pt2 pt3 "")
          )
          (command "pline" wpt41 wpt17 wpt20 wpt42 "")
          (setq sel_ent (ssadd (entlast) sel_ent))
        )
      )
      (progn
        (command "pline" wpt2 wpt6 wpt11 wpt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" wpt8 wpt14 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" wpt15 wpt9 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (if (< (distance wpt14 wpt17) l23)
	  (progn
            (command "line" wpt22 int_pt1 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "line" wpt23 int_pt2 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
	  (progn
            (command "line" wpt18 int_pt1 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "line" wpt19 int_pt2 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
        )
      )
      (progn
        (command "pline" wpt1 wpt5 wpt12 wpt4 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" wpt7 wpt13 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" wpt10 wpt16 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" wpt21 wpt25 wpt27 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" wpt24 wpt30 wpt28 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
	(if (> 0.01 (abs (- (angle wpt26 wpt31) ang)))
	  (progn
            (command "pline" wpt26 wpt31 wpt32 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "pline" wpt29 wpt34 wpt33 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
        )
      )
;--------------------------------------------------
;get correct epin specification
;--------------------------------------------------
      (setq spec (strcat "%%C" epin_type "X" len))
;--------------------------------------------------
;get center line pints and text locate points
;--------------------------------------------------
      (setq textpt1 (polar pt1 angh (+ 2 (abs (* 1.77 (cos (- (/ pi 4) ang)))))))
      (if (and (> ang (* pi 0.51)) (< ang (* pi 1.51)))
        (progn
	  (setq textang (* (+ ang pi) (/ 180 pi)))
          (setq textangv angvv)
          (setq textpt2 (polar (polar wpt8 ang (* 1.25 (- (strlen spec) 2))) angvv (- (/ dd 2) 1.25)))
	  (setq wcpt3 (polar pt1 ang b))
	  (setq wcpt4 (polar wcpt3 ang (* 1.25 (- (strlen spec) 2))))
        )
        (progn
	  (setq textang (* ang (/ 180 pi)))
          (setq textangv angv)
          (setq textpt2 (polar (polar wpt8 ang 0.4) angvv (+ (/ dd 2) 1.25)))
	  (setq wcpt3 (polar pt1 ang b))
	  (setq wcpt4 (polar wcpt3 ang (* 1.25 (- (strlen spec) 2))))
        )
      )
;-----------------------------------------------------
;Draw center line
;-----------------------------------------------------
      (progn 
        (command "linetype" "s" "center" "")
        (setvar "cecolor" "red")
        (if (and wcpt3 wcpt4)
          (progn
            (command "line" wcpt1 wcpt3 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
            (command "line" wcpt4 wcpt2 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
          (progn
            (command "line" wcpt1 wcpt2 "")
            (setq sel_ent (ssadd (entlast) sel_ent))
          )
        )
        (setvar "celtype" "bylayer")
        (setvar "cecolor" "bylayer")
      )
;-----------------------------------------------------
;Dim specification and item number
;-----------------------------------------------------
      (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))
        (if (not (tblsearch "style" "lxy2"))
	  (command "-style" "lxy2" "txt" "" 0.6 "" "" "" "")
	  (setvar "textstyle" "lxy2")
        )
        (command "text" "j" "mc" textpt1 2.5 0 rep)
        (setq sel_ent (ssadd (entlast) sel_ent))
        (setvar "textstyle" st_old)
      )
;-----------------------------------------------------
;Make screw block and add extend data in it
;-----------------------------------------------------
      (mblk (strcat "AC_LXY_BLK" (itoa (getvar "useri2"))) pt1 sel_ent)
      (setq xd (strcat 	rep " " 			;item number
			"C" " " 			;view flag
			epin_type " " 			;dim diameter
			len " " 			;dim length
			if_h_v " " 			;hidden flag
			"W" " " 			;type flag
			mb " " 				;meter or inch flag
			(rtos ang 2 5) " "		;angle
			(rtos l12 2 5) " "		;thickness of 1st plate
			(rtos l23 2 5) " "		;gap between 1st plate and 2st plate
			(rtos li1 2 5) " "		;int_pt1
			(rtos li2 2 5)))		;int_pt2
      (setq xd (list (list -3 (list "epin" (cons 1000 xd)))))
      (mxdata  (entlast) xd)
      (setvar "useri2" (+ 1 (getvar "useri2")))
      (setvar "osmode" os_old)
      (setq err_msg2 nil)
    )
  )
)
;*************************************** End of function ****************************************;