sp_cst.lsp

plc设计编程软件

;*****************************************************;
;* This is "pin_cst.lsp" program 		     *;
;* Complete compiled in 02/25/99                     *;
;* Last change in 02/25/99    			     *;
;* ZX Mold Ltd  XY.Liao				     *;
;*****************************************************;
;****************************************Main function start********************************************;
(defun sp_cst(/ npt1  		npt2  		npt3  		npt4  		npt5  
		npt6  		npt7  		npt8		npt9  		npt10 
		angv  		angvv 		angh  		int_pt1		
		textpt1 	int_pt2     	npct1 		npct2 		tr_ent1		
		tr_ent2		instpt  	sel_ent   	textpt2		textang		
		textangv)

;------------------------------------------------
;calculate parameter
;------------------------------------------------
  (if (= "NEW" sp_app)
    (progn
      (setq l (distance pt1 pt2))
      (setq ang  (angle pt1 pt2))
    )
    (setq pt2 (polar pt1 ang l))
  )
  (setq angv  (+ ang (/ pi 2)))
  (setq angvv (- ang (/ pi 2)))
  (setq angh  (+ ang pi))
;------------------------------------------------
;calculate parameter
;------------------------------------------------
  (setq npt1  (polar pt1 angv (+ (+ (/ id 2) (/ (- od id) 4)) (/ b 2)))
	npt2  (polar npt1 angvv b)
	npt4  (polar pt1 angvv (+ (+ (/ id 2) (/ (- od id) 4)) (/ b 2)))
	npt3  (polar npt4 angv b)
	npt5  (polar npt1 ang a)
	npt6  (polar npt2 ang a)
	npt7  (polar npt3 ang a)
	npt8  (polar npt4 ang a)
  )
  (setq npt13 (polar npt1 ang l)
	npt14 (polar npt2 ang l)
	npt15 (polar npt3 ang l)
	npt16 (polar npt4 ang l)
	npt9  (polar npt13 angh a)
	npt10 (polar npt14 angh a)
	npt11 (polar npt15 angh a)
	npt12 (polar npt16 angh a)
  )
  (setq cpt1  (polar (polar npt1 ang (/ a 2)) angvv (/ b 2))
	cpt2  (polar (polar npt4 ang (/ a 2)) angv (/ b 2))
	cpt3  (polar (polar npt13 angh (/ a 2)) angvv (/ b 2))
	cpt4  (polar (polar npt16 angh (/ a 2)) angv (/ b 2))
  )
  (setq cpt11 (polar cpt1 angv (/ (- od id) 4))
	cpt12 (polar cpt1 angvv (/ (- od id) 4))
	cpt21 (polar cpt2 angv (/ (- od id) 4))
	cpt22 (polar cpt2 angvv (/ (- od id) 4))
	cpt31 (polar cpt3 angv (/ (- od id) 4))
	cpt32 (polar cpt3 angvv (/ (- od id) 4))
	cpt41 (polar cpt4 angv (/ (- od id) 4))
	cpt42 (polar cpt4 angvv (/ (- od id) 4))
  )
  (setq ccpt1 (polar cpt1 angh (+ (/ a 2) 1))
	ccpt2 (polar cpt2 angh (+ (/ a 2) 1))
	ccpt3 (polar cpt3 ang (+ (/ a 2) 1))
	ccpt4 (polar cpt4 ang (+ (/ a 2) 1))
  )
  (setq ncpt1 (polar pt1 angh 1.5)
	ncpt2 (polar pt2 ang 1.5)
  )
  (setq npt17 (polar pt1 angv (/ id 2))
        npt18 (polar pt1 angvv (/ id 2))
        npt19 (polar pt2 angv (/ id 2))
        npt20 (polar pt2 angvv (/ id 2))
  )
;---------------------------------------------------
;Draw pin entitis and c'bore
;---------------------------------------------------
      (if (= "1" if_h_v)
        (progn
     	  (command "linetype" "s" "hidden" "")
	  (setvar "cecolor" "yellow")
        )
      )
      (setvar "osmode" 0)
      (progn
        (setq sel_ent (ssadd))
        (command "pline" npt17 npt1 npt5 npt6 npt2 "") 
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" npt18 npt4 npt8 npt7 npt3 "") 
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" npt19 npt13 npt9 npt10 npt14 "") 
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" npt20 npt16 npt12 npt11 npt15 "") 
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" npt5 npt9 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" npt6 npt10 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" npt7 npt11 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" npt8 npt12 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" cpt1 cpt4 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" cpt2 cpt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
      )
;--------------------------------------------------
;get correct epin specification
;--------------------------------------------------
      (setq spec (strcat "OD" spring_type "X" spring_len))
;--------------------------------------------------
;get center line points and text locate points
;--------------------------------------------------
      (setq textpt1 (polar pt1 angh (+ 2 (abs (* 1.77 (cos (- (/ pi 4) ang)))))))
;-----------------------------------------------------
;Draw center line
;-----------------------------------------------------
      (progn 
        (command "linetype" "s" "center" "")
        (setvar "cecolor" "red")
        (command "line" ncpt1 ncpt2 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" ccpt1 ccpt3 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" ccpt2 ccpt4 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" cpt11 cpt12 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" cpt21 cpt22 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" cpt31 cpt32 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" cpt41 cpt42 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (setvar "celtype" "bylayer")
        (setvar "cecolor" "bylayer")
      )
;-----------------------------------------------------
;Dim specification and item number
;-----------------------------------------------------
;      (progn
;        (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 spring 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
			spring_type " " 		;dim diameter
			spring_len " " 			;dim length
			if_h_v " " 			;hidden flag
			"0" " " 			;type flag
			mb " " 				;meter or inch flag
			(rtos ang 2 5) " "		;angle
			(rtos l 2 5)))			;length
      (setq xd (list (list -3 (list "spring" (cons 1000 xd)))))
      (mxdata  (entlast) xd)
      (setvar "useri2" (+ 1 (getvar "useri2")))
      (setvar "osmode" os_old)
      (setq err_msg2 nil)
)
;*************************************** End of function ****************************************;