home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / GBBZ.LSP < prev    next >
Encoding:
Text File  |  1989-01-14  |  12.2 KB  |  339 lines
  1. ;*************************************************
  2. ;**                                             **
  3. ;**               A u t o G B B Z               **
  4. ;**                                             **
  5. ;**     Version  1.1       for AutoCAD 2.18     **
  6. ;**                                             **
  7. ;*************************************************
  8. (textscr)
  9. (terpri)
  10. (princ "            A u t o G B B Z")
  11. (terpri)
  12. (terpri)
  13. (princ "Copyright (C) 1987  GANSU GONGYE DAXUE")
  14. (terpri)
  15. (princ "Version 1.1 (16/6/87)  for AutoCAD 2.18")
  16. (terpri)
  17. (princ "Serial Number: 01-014")
  18. (repeat 19 (terpri))
  19. (princ "Loading GBBZ command file...")
  20. (setvar "cmdecho" 0)
  21. (setvar "aperture" 5)
  22.  
  23.  
  24. ; ===================================
  25. ;|  The function for error dealing.  |
  26. ; ===================================
  27. (defun *error* (st)
  28.    (terpri)
  29.    (if (eq st "quit / exit abort") (setq st1 "" st "") (setq st1 "error: "))
  30.    (if (or (eq st "bad point value")
  31.            (eq st "bad argument type")
  32.            (eq st "console break")
  33.            (eq st "invalid")
  34.            (eq st "bad point argument")
  35.        )
  36.        (progn
  37.           (princ "GBBZ error: entry mistake!")
  38.           (terpri)
  39.           (princ "*Invalid*")
  40.        )
  41.        (progn (princ st1)
  42.           (princ st)
  43.        )
  44.    )
  45.    (princ )
  46. )
  47.  
  48.  
  49. ; ==================================================
  50. ;|  The functoin for redisplay a "Command" prompt.  |
  51. ; ==================================================
  52. (defun cmdprompt ()
  53.    (quit)
  54. )
  55.  
  56.  
  57. ; =============================================
  58. ;|  The function for call a *error* function.  |
  59. ; =============================================
  60. (defun err ()
  61.    (*error* "invalid")
  62.    (quit)
  63. )
  64.  
  65.  
  66. ; ===================
  67. ;|  Scale function.  |
  68. ; ===================
  69. (defun scale1 ()
  70.    (setq sca (getreal "\n▒╚└²: <1>: "))
  71.    (if (null sca) (setq sca 1))
  72. )
  73.  
  74.  
  75. ; ================================================
  76. ;|  The function for entry a dimensioning point.  |
  77. ; ================================================
  78. (defun point1 ()
  79.    (setq pt1 (getpoint "\n▒Ω╫ó╡π: "))
  80. )
  81.  
  82.  
  83. ;++++++++++++++++++++++++++++++++++++++++++++++
  84. ;+  This function for clean AutoLISP memory.  +
  85. ;++++++++++++++++++++++++++++++++++++++++++++++
  86. (defun C:CLEAN ()
  87.    (setq atomlist (member 'C:CLEAN atomlist))
  88.    'done
  89. )
  90.  
  91.  
  92. ;*********************************************************
  93. ;*  The function for dimensioning geometric tolerances.  *
  94. ;*********************************************************
  95. (defun C:XWGC ()
  96.   (prompt "\n╤í╘±: 1:╓▒╧▀╢╚ 2:╞╜├µ╢╚ 3:╘▓╢╚ 4:╘▓╓∙╢╚ 5:╧▀┬╓└¬╢╚ 6:├µ┬╓└¬╢╚ 7:╞╜╨╨╢╚: ")
  97.   (prompt "8:┤╣╓▒╢╚ 9:╟π╨▒╢╚ 10:═¼╓ß╢╚ 11:╢╘│╞╢╚ 12:╬╗╓├╢╚ 13:╘▓╠°╢»  14:╚½╠°╢»: ")
  98.  (setq n (getint))
  99.   (if (null n) (setq n 8))
  100.   (setq st "wzk" q 36)
  101.   (if (and (>= n 1) (<= n 6)) (setq st "xzk" q 28))
  102.   (setq d (getint "\n▒Ω╫ó╖╜╧≥: 1/2 <1>: "))
  103.   (point1)
  104.   (setq pt2 (getpoint "\n┐≥╕±╗∙╡π: "))
  105.   (scale1)
  106.   (setq sy (nth n '(nil "zxd" "pmd" "yd" "yzd" "xlkd" "mlkd" "pxd" "czd" "qxd" "tzd" "dcd" "wzd" "ytd" "qtd")))
  107.   (setq v (getstring "\n╣½▓ε╓╡: "))
  108.   (if (= st "wzk")(progn
  109.          (setq sb (getstring "\n╗∙╫╝┤·║┼: "))
  110.          (setq nn (strlen sb))
  111.          (if (= nn 1)(setq st "wzk"))
  112.          (if (= nn 3)(setq st "wzk1" q 47))
  113.   ))
  114.   (if (or (null pt1) (null pt2) (null sy) (null st)) (err))
  115.   (if (= d 2) (setq a (/ pi 2)) (setq a 0))
  116.   (if (= d 2)
  117.       (if (> (cadr pt2) (cadr pt1)) (setq ip pt2) (setq ip (list (car pt2) (- (cadr pt2) (* q sca)))))
  118.       (if (> (car pt2) (car pt1)) (setq ip pt2) (setq ip (list (- (car pt2) (* q sca)) (cadr pt2))))
  119.   )
  120.   (if (= d 2)
  121.       (setq pt5 (list (+ (car ip) (* sca 1.5)) (+ (cadr ip) (* 18 sca))) pt6 (list (+ (car ip) (* sca 2)) (+ (cadr ip) (* sca 32))))
  122.       (setq pt5 (list (+ (car ip) (* 18 sca)) (- (cadr ip) (* sca 1.5))) pt6 (list (+ (car ip) (* sca 32)) (- (cadr ip) (* sca 2))))
  123.   )
  124.   (if (= d 2) (if (= (car pt1) (car pt2)) (setq pt3 pt2) (setq pt3 (list (car pt2) (cadr pt1))))
  125.               (if (= (cadr pt1) (cadr pt2)) (setq pt3 pt2) (setq pt3 (list (car pt1) (cadr pt2))))
  126.   )
  127.   (if (= a 0) (setq a "0") (setq a (angtos a 0 0)))
  128.   (command "layer" "s" 6 "" "insert" st ip sca "" a "insert" sy ip sca "" a)
  129.  (if (= n 10)(setq v (strcat "%%c" v)))
  130.   (command "text" "c" pt5 (* 3.5 sca) a v)
  131.   (if (= st "wzk")(command "text" "c" pt6 (* 4.5 sca) a sb))
  132.   (if (= st "wzk1")(command "text" pt6 (* 4.5 sca) a sb))
  133.   (command "line" pt1 pt3 pt2 "")
  134.   (setq pt4 (polar pt1 (angle pt1 pt3) (* 5 sca)))
  135.   (command "pline" pt1 "w" 0 (* 1.2 sca) pt4 "")
  136.   (redraw)
  137.   (cmdprompt)
  138. )
  139.  
  140.  
  141. ;******************************************************
  142. ;*  This function to dimension the code of reference  *
  143. ;*              about position tolerance!             *
  144. ;******************************************************
  145. (defun C:JZDH ()
  146.   (point1)
  147.   (setq pt2 (osnap pt1 "nea"))
  148.   (setq pt3 (osnap pt2 "end"))
  149.   (setq d (getint "\n╖╜╧≥: 0-4, <1>: "))
  150.   (setq a 0)
  151.   (if (= d 2) (setq a (/ pi 2)))
  152.   (if (= d 3) (setq a pi))
  153.   (if (= d 4) (setq a (* pi 1.5)))
  154.   (if (= d 0) (setq a (angle pt2 pt3)))
  155.   (scale1)
  156.   (setq ds (getdist pt2 "\n╥²│÷╧▀│ñ╢╚: "))
  157.   (setq sy (getstring "\n╗∙╫╝┤·║┼: "))
  158.   (setq pt4 (polar pt2 (+ a (* pi 0.5)) (* 2 sca)))
  159.   (setq pt5 (polar pt4 a (* 4 sca)))
  160.   (setq pt6 (polar pt4 (+ a pi) (* 4 sca)))
  161.   (setq pt7 (polar pt4 (+ a (* pi 0.5)) ds))
  162.   (setq pt8 (polar pt7 (+ a (* pi 0.5)) (* 5 sca)))
  163.   (setq pt9 (polar pt8 (* pi 1.5) (* 3 sca)))
  164.   (command "layer" "s" 6 "" "pline" pt5 "w" 0.4 "" pt6 "" "line" pt4 pt7 "")
  165.   (command "circle" pt8 (* 5 sca) "text" "c" pt9 (* 5.2 sca) 0 sy)
  166.   (redraw)
  167.   (cmdprompt)
  168. )
  169.  
  170.  
  171. ;**********************************************************
  172. ;*  The function for dimensioning the surface roughness.  *
  173. ;**********************************************************
  174. (defun C:CCD()
  175.   (setq f (getstring "\n┤╓▓┌╢╚└α╨═:╚Ñ│²▓─┴╧Q/▓╗╚Ñ│²▓─┴╧B/╚╬╥ΓR: <Q>: "))
  176.   (setq c "ccd")
  177.   (if (or (= f "B") (= f "b")) (setq c "ccd1"))
  178.   (if (or (= f "R") (= f "r")) (setq c "ccd2"))
  179.   (setq d (getint "\n╖╜╧≥: (0-4) <1>:"))
  180.   (setq a 0)
  181.   (if (= d 2) (setq a (/ pi 2)))
  182.   (if (= d 3) (setq a pi))
  183.   (if (= d 4) (setq a (* pi 1.5)))
  184.   (point1)
  185.   (setq pt2 (osnap pt1 "end"))
  186.   (scale1)
  187.   (setq st (getstring "\n╓╡:<RETURN▒φ╩╛├╗╙╨╓╡>: "))
  188.   (if (null pt1) (err))
  189.   (if (= d 0) (setq a (angle pt1 pt2)))
  190.   (if (= a 0) (setq a1 0) (setq a1 (angtos a 0 0)))
  191.   (command "layer" "s" 6 "" "insert" c pt1 sca "" a1)
  192.   (if (and (> a -1) (< a 2))
  193.       (setq cc (polar pt1 (+ a (/ pi 2)) (* 5.4 sca)))
  194.       (progn (setq cc (polar pt1 (+ a (/ pi 2)) (* 7.8 sca)))
  195.              (setq a1 (angtos (+ a pi) 0 0))
  196.       )
  197.   )
  198.   (command "text" "c" cc (* 2.4 sca) a1 st)
  199.   (redraw)
  200.   (cmdprompt)
  201. )
  202.  
  203.  
  204. ;******************************************************
  205. ;*  The function to dimension the technical request.  *
  206. ;******************************************************
  207. (defun C:JSYQ ()
  208.    (point1)
  209.    (if (null pt1) (err))
  210.    (scale1)
  211.    (setq n (getint "\n▒Ω╫ó╧ε╡─╩²─┐: "))
  212.    (command "layer" "s" 6 "" "insert" "*jsyq" pt1 sca "")
  213.    (setq m 1)
  214.    (setq pt2 (list (- (car pt1) (* sca 24)) (- (cadr pt1) (* sca 17))))
  215.    (while (<= m n)
  216.       (prompt "\n╤í╘±: 1:╬┤╫ó╘▓╜╟ 2:╬┤╫ó╡╣╜╟ 3:╡≈╓╩┤ª└φ 4:▒φ├µ┤π╗≡ 5:╔°╠╝┤π╗≡ 6:╒²╗≡┤ª└φ: ")
  217.   (prompt "7:┤╓▓┌╢╚╡╚╙┌ 8:╓²╝■╥¬╟≤ 9:╩▒╨º┤ª└φ 10:╚±▒▀╡╣╢█: ")
  218.  (setq q (getint))
  219.       (if (and (>= q 1) (<= q 7)) (setq str (getstring "\n╓╡:<RETURN ▒φ╩╛╬▐╓╡>: ")
  220.           pt3 (list (+ (car pt2) (* sca 22)) (cadr pt2))))
  221.       (if (null str) (setq str ""))
  222.       (if (= m n) (setq str3 ".") (setq str3 ";"))
  223.       (setq str1 (nth q '(nil "*wzyj" "*wzdj" "*tzcl" "*bmch" "*stch" "*zhcl" "*ccdd" "*zjyq" "*sxcl" "*rjdd"))
  224.             str2 (nth q (list nil (strcat "R=" str str3)
  225.                               (strcat str "x45%%d" str3)
  226.                               (strcat "HB=" str str3)
  227.                               (strcat "HRC=" str str3)
  228.                               (strcat "HRC=" str str3)
  229.                               (strcat "HB=" str str3)
  230.                          )
  231.                   )
  232.       )
  233.       (if (null str1) (err))
  234.       (command "text" pt2 (* sca 4.5) 0 (strcat (itoa m) "."))
  235.       (command "insert" str1 pt2 sca "")
  236.       (if (and (>= q 1) (<= q 6))
  237.         (command "text" pt3 (* sca 4.5) "" str2))
  238.       (if (= q 7) (progn
  239.         (setq pt3 (list (+ (car pt2) (* sca 19.5)) (+ (cadr pt2) (* sca 3.6))))
  240.         (command "text" "c" pt3 (* sca 2.2) 0 str)))
  241.       (setq pt2 (list (car pt2) (- (cadr pt2) (* sca 8.5))) m (1+ m))
  242.    )
  243.    (redraw)
  244.    (cmdprompt)
  245. )
  246.  
  247.  
  248. ;*******************************************************************
  249. ;*  The function to dimension any character, taper, chamfer, etc.  *
  250. ;*******************************************************************
  251. (defun C:PZ ()
  252.    (setq f (getint "\n╤í╘±▒Ω╫ó└α╨═: 0:╫╓╖√; 1:╡╣╜╟; 2:╫╢╢╚; 3:╨▒╢╚; 4:╛∙▓╝. <0>: "))
  253.    (if (null f) (setq f 0))
  254.    (point1)
  255.    (if (= f 1)
  256.        (setq pt2 (osnap pt1 "end") a1 (angle pt1 pt2) pt1 pt2
  257.              d (getdist "\n╥²│÷╧▀│ñ╢╚: ") pt2 (polar pt1 a1 d)
  258.        )
  259.        (setq pt2 (getpoint "\n╬─╫╓╡π: "))
  260.    )
  261.    (scale1)
  262.    (setq str (getstring T "\n╬─╫╓: "))
  263.    (if (= f 1) (setq str (strcat str "x45%%d") n (- (strlen str) 2)) (setq n (strlen str)))
  264.    (if (or (= f 2) (= f 3))
  265.        (setq d1 (+ (* n 2.9 sca) (* 7 sca)))
  266.        (setq d1 (* n 2.9 sca))
  267.    )
  268.    (if (> (car pt1) (car pt2))
  269.        (setq a2 pi)
  270.        (setq a2 0)
  271.    )
  272.    (setq pt3 (polar pt2 a2 d1))
  273.    (if (> (car pt1) (car pt2)) (setq pt4 pt3) (setq pt4 pt2))
  274.    (if (or (= f 2) (= f 3))
  275.        (setq pt5 (list (+ (car pt4) (* 6.5 sca)) (+ (cadr pt4) (* 1.2 sca)))
  276.              pt6 (list (+ (car pt5) (* (strlen str) 1.4 sca)) (cadr pt5)))
  277.        (setq pt6 (list (+ (car pt4) (/ d1 2)) (+ (cadr pt4) (* 1.2 sca))))
  278.    )
  279.    (if (= f 2) (setq st1 "zd"))
  280.    (if (= f 3) (setq st1 "xd"))
  281.    (if (= f 4) (setq pt5 pt6 st1 "jb"))
  282.    (command "layer" "s" 6 "" "line" pt1 pt2 pt3 "")
  283.    (command "text" "c" pt6 (* 3 sca) 0 str)
  284.    (if (or (= f 2) (= f 3) (= f 4)) (progn
  285.        (if (or (null st1) (null pt5)) (err))
  286.        (command "insert" st1 pt5 sca sca 0)
  287.        )
  288.    )
  289.    (redraw)
  290.    (cmdprompt)
  291. )
  292.  
  293.  
  294. ;*********************************************************
  295. ;*  The function for dimensioning geometric tolerances.  *
  296. ;*********************************************************
  297. (defun C:XW ()
  298.   (prompt "\n╤í╘±: 1:╓▒╧▀╢╚ 2:╞╜├µ╢╚ 3:╘▓╢╚ 4:╘▓╓∙╢╚ 5:╧▀┬╓└¬╢╚ 6:├µ┬╓└¬╢╚ 7:╞╜╨╨╢╚: ")
  299.   (prompt "8:┤╣╓▒╢╚ 9:╟π╨▒╢╚ 10:═¼╓ß╢╚ 11:╢╘│╞╢╚ 12:╬╗╓├╢╚ 13:╘▓╠°╢»  14:╚½╠°╢»: ")
  300.  (setq n (getint))
  301.   (if (null n) (setq n 8))
  302.   (setq st "wzk" q 36)
  303.   (if (and (>= n 1) (<= n 6)) (setq st "xzk" q 28))
  304.   (point1)
  305.   (setq d (getint "\n▒Ω╫ó╖╜╧≥: 1/2 <1>: "))
  306.   (setq pt02 (getpoint "\n┐≥╕±╗∙╡π:"))
  307.   (scale1)
  308.   (if (= d 2) (setq pt2 (polar pt02 pi (* 4 sca))) (setq pt2 (polar pt02 (/ pi 2) (* 4 sca))))
  309.   (setq sy (nth n '(nil "zxd" "pmd" "yd" "yzd" "xlkd" "mlkd" "pxd" "czd" "qxd" "tzd" "dcd" "wzd" "ytd" "qtd")))
  310.   (setq v (getstring "\n╣½▓ε╓╡: "))
  311.   (if (= st "wzk")(progn
  312.             (setq sb (getstring "\n╗∙╫╝┤·║┼: "))
  313.             (setq nn (strlen sb))
  314.             (if (= nn 1)(setq st "wzk"))
  315.             (if (= nn 3)(setq st "wzk1" q 47))
  316.   ))
  317.   (if (= d 2) (setq a (/ pi 2)) (setq a 0))
  318.   (if (= d 2)
  319.       (if (> (cadr pt2) (cadr pt1)) (setq ip pt2) (setq ip (list (car pt2) (- (cadr pt2) (* q sca)))))
  320.       (if (> (car pt2) (car pt1)) (setq ip pt2) (setq ip (list (- (car pt2) (* q sca)) (cadr pt2))))
  321.   )
  322.   (if (= d 2)
  323.       (setq pt5 (list (+ (car ip) (* sca 1.5)) (+ (cadr ip) (* 18 sca))) pt6 (list (+ (car ip) (* sca 2)) (+ (cadr ip) (* sca 32))))
  324.       (setq pt5 (list (+ (car ip) (* 18 sca)) (- (cadr ip) (* sca 1.5))) pt6 (list (+ (car ip) (* sca 32)) (- (cadr ip) (* sca 2))))
  325.   )
  326.   (if (= d 2) (if (= (car pt1) (car pt2)) (setq pt3 pt2) (setq pt3 (list (car pt2) (cadr pt1))))
  327.               (if (= (cadr pt1) (cadr pt2)) (setq pt3 pt2) (setq pt3 (list (car pt1) (cadr pt2))))
  328.   )
  329.   (if (= a 0) (setq a "0") (setq a (angtos a 0 0)))
  330.   (command "layer" "s" 6 "" "insert" st ip sca "" a "insert" sy ip sca "" a)
  331.   (command "text" "c" pt5 (* 3.5 sca) a v)
  332.   (if (= st "wzk")(command "text" "c" pt6 (* 4.5 sca) a sb))
  333.   (if (= st "wzk1")(command "text" pt6 (* 4.5 sca) a sb))
  334.   (redraw)
  335.   (cmdprompt)
  336. )
  337.   (GRAPHSCR)
  338.   (cmdprompt)
  339.