flat_cst.lsp

plc设计编程软件

;****************************************;
;*this is flat_cst.lsp program		*;
;*completely complied in 12/13/98	*;
;*last changed in 02/03/99		*;
;*ZX Mold Ltd   XY.Liao			*;
;****************************************;
;********************************************************************************************************;
(defun flat_cst(/ fpt1 	fpt2	fpt3	fpt4	fpt5	fpt6	fpt7	fpt8	fpt9	fpt10
		fpt11	fpt12 	fpt13	fpt14	fpt15	fpt16	fpt17	fpt18	fpt19	fpt20
		fpt21	fpt22	fpt23	fpt24	fpt25	fpt26	fpt27   angh	angv	angvv	
		fcpt1	fcpt2	sel_ent textpt1	textpt2	textang	textangv)
;---------------------------------------------------------
;Calculate angle value
;---------------------------------------------------------
  (if (= "NEW" app_typ)
    (progn
      (setq l12 (distance pt1 pt2))
      (setq ang (angle pt1 pt2))
    )
    (progn
      (setq pt1 (polar pt (+ pi ang) 0.5))
      (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 fpt1 (polar pt1 angv (+ k 0.5 (/ d 2)))
	fpt2 (polar pt1 angvv (+ k 0.5 (/ d 2)))
	fpt7  (polar fpt1 (- ang (/ pi 4)) (* k 1.41421))
	fpt10 (polar fpt2 (+ ang (/ pi 4)) (* k 1.41421))
  )
  (setq fpt16 (polar pt2 angv (/ d 2))
	fpt17 (polar pt2 angvv (/ d 2))
	fpt15 (polar fpt16 angv 0.5)
	fpt18 (polar fpt17 angvv 0.5)
  )
;-----------------------------------------------------
;calculate screw points ordinate
;-----------------------------------------------------
  (setq fpt3 (polar (polar pt1 ang 0.5) angv (/ hd 2))
	fpt4 (polar (polar pt1 ang 0.5) angvv (/ hd 2))
	fpt5 (polar fpt3 ang (- k (/ (- hd d) 2)))
	fpt6 (polar fpt4 ang (- k (/ (- hd d) 2)))
	fpt8 (polar fpt1 (- ang (/ pi 4)) (* (+ 0.5 k) 1.41421))
	fpt9 (polar fpt2 (+ ang (/ pi 4)) (* (+ 0.5 k) 1.41421))
	fpt11 (polar fpt8 ang 1)
	fpt14 (polar fpt9 ang 1)
	fpt12 (polar fpt11 angvv (* d 0.1))
	fpt13 (polar fpt14 angv (* d 0.1))
	fpt19 (polar fpt8 ang (- l k (* d 0.1)))
	fpt22 (polar fpt9 ang (- l k (* d 0.1)))
	fpt20 (polar fpt12 ang (- l k 1))
	fpt21 (polar fpt13 ang (- l k 1))
  )
;-----------------------------------------------------
;calculate screw hole points ordinate
;-----------------------------------------------------
  (setq fpt23 (polar fpt19 ang (+ 1.5 (* d 0.1)))
	fpt24 (polar fpt22 ang (+ 1.5 (* d 0.1)))
	fpt25 (polar fpt20 ang 2.5)
	fpt26 (polar fpt21 ang 2.5)
	fpt27 (polar pt1 ang (+ l 3 (* d 0.231)))
  )
;-----------------------------------------------------
;calculate center line points ordinate and
;text insert points ordinate
;-----------------------------------------------------
  (setq fcpt1 (polar pt1 angh 1)
	fcpt2 (polar fpt27 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 fpt11 fpt19) 0.5) (* 1.25 (strlen (strcat screw_type "X" screw_len))))
	       (>= d 4)
          )
        (progn
        (setq textpt2 (polar (polar pt1 ang (+ k 1.0 (* 1.25 (strlen (strcat screw_type "X" screw_len))))) angv 1.25))
          (setq fcpt3   (polar pt1 ang (+ 1 k)))
          (setq fcpt4   (polar fcpt3  ang (* 1.25 (strlen (strcat screw_type "X" screw_len)))))
        )
        (progn
	(setq textpt2 (polar (polar fpt2 ang (* 1.25 (strlen (strcat screw_type "X" screw_len)))) angvv 0.5))
          (setq fcpt3 nil)
          (setq fcpt4 nil)
        )
      )
    )
    (progn
      (setq textang (* ang (/ 180 pi)))
      (setq textangv angv)
      (if (and (> (- (distance fpt11 fpt19) 0.5) (* 1.25 (strlen (strcat screw_type "X" screw_len))))
	       (>= d 4)
          )
        (progn
        (setq textpt2 (polar (polar fpt11 angvv (+ (* d 0.5) 1.25)) ang 0.5))
          (setq fcpt3   (polar pt1 ang (+ 1 k)))
          (setq fcpt4   (polar fcpt3  ang (* 1.25 (strlen (strcat screw_type "X" screw_len)))))
        )
        (progn
	(setq textpt2 (polar (polar fpt5 angv 0.4) ang 0.5))
          (setq fcpt3 nil)
          (setq fcpt4 nil)
        )
      )
    )
  )
;-------------------------------------------------------
;if hidden then set current linetype as hidden
;-------------------------------------------------------
  (if (= if_h_v "1")
     (progn
    	(command "linetype" "s" "hidden" "")
    	(setvar "cecolor" "yellow")
     )
  )
;------------------------------------------------------
;cancel all osnap mode
;------------------------------------------------------
  (setvar "osmode" 0)
;------------------------------------------------------
;draw screw
;------------------------------------------------------
  (progn
    (setq sel_ent (ssadd))
    (command "pline" fpt3 fpt4 fpt6 fpt5 "c")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" fpt12 fpt20 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" fpt6 fpt9 fpt8 fpt5 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" fpt8 fpt19 fpt20 fpt21 fpt22 fpt9 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (setq trm_ent (entlast))
    (command "line" fpt11 fpt14 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" fpt13 fpt21 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" fpt19 fpt22 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
  )
;-----------------------------------------------------
;Draw c'bore and screw hole
;-----------------------------------------------------
  (progn
    (command "pline" fpt19 fpt23 fpt24 fpt22 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" fpt20 fpt25 fpt27 fpt26 fpt21 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" fpt1 fpt7 fpt15 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" fpt2 fpt10 fpt18 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
    (if (= "0" if_h_v)
      (command "trim" trm_ent "" pt2 "")
    )
    (command "line" fpt25 fpt26 "")
    ;(setq sel_ent (ssadd (entlast) sel_ent))
  )
;-----------------------------------------------------
;Draw center line
;-----------------------------------------------------
  (progn 
     (command "linetype" "s" "center" "")
     (setvar "cecolor" "red")
     (if (and fcpt2 fcpt4)
       (progn
         (command "line" fcpt1 fcpt3 "")
         ;(setq sel_ent (ssadd (entlast) sel_ent))
         (command "line" fcpt4 fcpt2 "")
         ;(setq sel_ent (ssadd (entlast) sel_ent))
       )
       (progn
         (command "line" fcpt1 fcpt2 "")
         ;(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
			"FLAT" " " 		;type flag
			mb " " 			;meter or inch flag
			(rtos ang 2 5) " "	;angle
			(rtos l12 2 5)))	;thickness of first plate
  (setq xd (list (list -3 (list "screw" (cons 1000 xd)))))
  (mxdata  (entlast) xd)
  (setvar "useri2" (+ 1 (getvar "useri2")))
;------------------------------------------------------
;reset osnap mode
;------------------------------------------------------
  (setvar "osmode" os_old)
)
;*************************************** End of function ****************************************;