cap_cst.lsp

plc设计编程软件

;****************************************;
;*this is cap_cst.lsp program		*;
;*completely complied in 12/13/98	*;
;*last changed in 02/03/99		*;
;*ZX Mold Ltd   XY.Liao			*;
;****************************************;
;********************************************************************************************************;
(defun cap_cst( / mpt1 	mpt2	mpt3	mpt4	mpt5	mpt6	mpt7	mpt8	mpt9	mpt10
		mpt11	mpt12 	mpt13	mpt14	mpt15	mpt16	mpt17	mpt18	mpt19	mpt20
		mpt21	mpt22	mpt23	mpt24	mpt25	mpt26	mpt27	mpt28	mpt29	angh	
		angv	angvv	mcpt1	mcpt2	sel_ent textpt1	textpt2 textang textangv)
;---------------------------------------------------------
;Calculate angle value
;---------------------------------------------------------
  (if (= "NEW" app_typ)
    (progn
      (setq l12 (distance pt1 pt2))
      (setq ang (angle pt1 pt2))
      (setq pt  (polar pt1 ang 1.0))
    )
    (progn
      (setq pt1 (polar pt  (+ pi ang) 1.0))
      (setq pt2 (polar pt1 ang l12))
    )
  )
  (setq angh  (+ pi ang))
  (setq angv  (+ ang (/ pi 2)))
  (setq angvv (- ang (/ pi 2)))
;-----------------------------------------------------
;calculate c'bore points ordinate
;-----------------------------------------------------
  (setq mpt1  (polar pt1 angv (/ (+ hd 1) 2))
	mpt2  (polar pt1 angvv (/ (+ hd 1) 2))
	mpt5  (polar mpt1 ang (+ d 1))
	mpt12 (polar mpt2 ang (+ d 1))
  )
  (setq mpt13 (polar pt2 angv (/ (+ d 1) 2))
	mpt16 (polar pt2 angvv (/ (+ d 1) 2))
	mpt7  (polar mpt13 angh (- (distance pt1 pt2) d 1))
	mpt10 (polar mpt16 angh (- (distance pt1 pt2) d 1))
	mpt14 (polar pt2 angv (/ d 2))
	mpt15 (polar pt2 angvv (/ d 2))
  )
;-----------------------------------------------------
;calculate screw points ordinate
;-----------------------------------------------------
  (setq mpt6  (polar mpt5 angvv 0.5)
	mpt11 (polar mpt12 angv 0.5)
	mpt3  (polar mpt6 angh d)
	mpt4  (polar mpt11 angh d)
	mpt8  (polar mpt6 angvv (/ (- hd d) 2))
	mpt9  (polar mpt11 angv (/ (- hd d) 2))
	mpt17 (polar mpt8 ang (- l (* d 0.1)))
	mpt18 (polar mpt9 ang (- l (* d 0.1)))
	mpt19 (polar (polar mpt8 ang l) angvv (* d 0.1))
	mpt20 (polar (polar mpt9 ang l) angv (* d 0.1))
  )
;-----------------------------------------------------
;calculate screw hole points ordinate
;-----------------------------------------------------
  (setq mpt21 (polar mpt8 ang (+ l 2))
	mpt22 (polar mpt9 ang (+ l 2))
	mpt23 (polar mpt19 ang 3.5)
	mpt24 (polar mpt20 ang 3.5)
	mpt25 (polar pt1 ang (+ l d 4.5 (* (* d 0.5) 0.5774)))
  )
;-----------------------------------------------------
;Justy if draw smooth cylinder part or not
;-----------------------------------------------------
  (if (<= l b)
     (progn
	(setq mpt27 (polar mpt8 angvv (* d 0.1)))
	(setq mpt28 (polar mpt9 angv (* d 0.1)))
     )
     (progn
	(setq mpt26 (polar mpt8 ang (- l b)))
	(setq mpt29 (polar mpt9 ang (- l b)))
  	(setq mpt27 (polar mpt26 angvv (* d 0.1)))
	(setq mpt28 (polar mpt29 angv (* d 0.1)))
     )
  )
;-----------------------------------------------------
;calculate center line points ordinate and
;text insert points ordinate
;-----------------------------------------------------
  (setq mcpt1 (polar pt1 angh 1)
	mcpt2 (polar mpt25 ang 1)
  )
  (setq textpt1 (polar pt1 angh (+ 1.5 (abs (* 1.77 (cos (- (/ pi 4) ang)))))))
  (if (and (> ang (* pi 0.51)) (< ang (* pi 1.50)))
    (progn
      (setq textang (* (+ ang pi) (/ 180 pi)))
      (setq textangv angvv)
      (if (and (> (- (distance mpt8 mpt17) 0.5) (* 1.25 (strlen (strcat screw_type "X" screw_len))))
	       (> d 4)
          )
        (progn
	  (setq textpt2 (polar (polar pt1 ang (+ d 1.0 (* 1.25 (strlen (strcat screw_type "X" screw_len))))) angv 1.25))
          (setq mcpt3   (polar pt1 ang (+ 1 d)))
          (setq mcpt4   (polar mcpt3  ang (* 1.25 (strlen (strcat screw_type "X" screw_len)))))
        )
        (progn
	  (setq textpt2 (polar (polar mpt2 ang (* 1.25 (strlen (strcat screw_type "X" screw_len)))) angvv 0.5))
          (setq mcpt3 nil)
          (setq mcpt4 nil)
        )
      )
    )
    (progn
      (setq textang (* ang (/ 180 pi)))
      (setq textangv angv)
      (if (and (> (- (distance mpt8 mpt17) 0.5) (* 1.25 (strlen (strcat screw_type "X" screw_len))))
	      (> d 4)
          )
        (progn
	  (setq textpt2 (polar (polar mpt8 angvv (+ (* d 0.5) 1.25)) ang 0.5))
          (setq mcpt3   (polar pt1 ang (+ 1 d)))
          (setq mcpt4   (polar mcpt3  ang (* 1.25 (strlen (strcat screw_type "X" screw_len)))))
        )
        (progn
          (setq textpt2 (polar (polar mpt1 angv 0.4) ang 0.5))
          (setq mcpt3 nil)
          (setq mcpt4 nil)
        )
      )
    )
  )
  (if mcpt4
    (if (= "B" mb)
      (setq mcpt4 (polar mcpt4 angh 2.5))
    )
  )
;-------------------------------------------------------
;if hidden then set current linetype as hidden
;-------------------------------------------------------
  (if (= if_h_v "1")
     (progn
    	(command "linetype" "s" "hidden" "")
    	(setvar "cecolor" "yellow")
     )
  )
;------------------------------------------------------
;draw screw
;------------------------------------------------------
  (setvar "osmode" 0)
  (progn
    (setq sel_ent (ssadd))
    (command "pline" mpt6 mpt3 mpt4 mpt11 mpt6 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" mpt27 mpt19 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" mpt8 mpt17 mpt19 mpt20 mpt18 mpt9 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (setq trm_ent (entlast))    
    (command "line" mpt28 mpt20 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" mpt17 mpt18 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (if (> l b)
      (progn
    	(command "line" mpt26 mpt29 "")
	(setq sel_ent (ssadd (entlast) sel_ent))
      )
    )
  )
;-----------------------------------------------------
;Draw c'bore and screw hole
;-----------------------------------------------------
  (progn
    (command "line" mpt7 mpt13 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" mpt10 mpt16 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
  )
  (if (= "0" if_h_v)
    (command "trim" trm_ent "" pt2 "")
  )
  (progn
    (command "pline" mpt1 mpt5 mpt12 mpt2 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" mpt19 mpt23 mpt25 mpt24 mpt20 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" mpt23 mpt24 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" mpt17 mpt21 mpt22 mpt18 mpt17 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
  )
;-----------------------------------------------------
;Draw center line
;-----------------------------------------------------
  (progn 
     (command "linetype" "s" "center" "")
     (setvar "cecolor" "red")
     (if (and mcpt2 mcpt4)
       (progn
         (command "line" mcpt1 mcpt3 "")
         ;(setq sel_ent (ssadd (entlast) sel_ent))
         (command "line" mcpt4 mcpt2 "")
         ;(setq sel_ent (ssadd (entlast) sel_ent))
       )
       (progn
         (command "line" mcpt1 mcpt2 "")
         ;(setq sel_ent (ssadd (entlast) sel_ent))
       )
     )
     (setvar "celtype" lt_old)
     (setvar "cecolor" co_old)
  )
;-----------------------------------------------------
;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 (strcat screw_type "X" screw_len))
     ;(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"))) pt sel_ent)
  (setq xd (strcat 	rep " " 			;item number
			"C" " " 			;view flag
			screw_type " " 			;dim diameter
			screw_len " " 			;dim length
			if_h_v " " 			;hidden flag
			"CAP" " " 			;type flag
			mb " " 				;meter or inch flag
			(rtos ang 2 5) " "		;angle
			(rtos l12 2 5)))		;thickness of 1st plate
  (setq xd (list (list -3 (list "screw" (cons 1000 xd)))))
  (mxdata  (entlast) xd)
  (setvar "useri2" (+ 1 (getvar "useri2")))
  (setvar "osmode" os_old)
)
;*************************************** End of function ****************************************;