home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / apr94cad.zip / TIP975.LSP < prev    next >
Text File  |  1994-03-11  |  7KB  |  239 lines
  1. ; TIP975.LSP: TAP-SEC.LSP   Draw Holes to Scale   (c)1994, John K. Sherman
  2.  
  3. (defun rtd (b)
  4.   (* 180.0 (/ b pi))
  5. )
  6. (defun taperr (msg)
  7.   (setq *error* temperr)
  8.   (princ msg)
  9.   (setvar "CLAYER" CLY)
  10.   (setvar "OSMODE" OSM)
  11.   (setvar "CMDECHO" CMD)
  12.   (setvar "SNAPANG" OSN)
  13.   (setvar "SNAPMODE" SNM)
  14.   (princ)
  15. )
  16. (defun CBS ()
  17.   (setq PT0 PT1)
  18.   (setq PT1 (list
  19.     (+ (car PT1) (* (cos ANG) DIAM))
  20.     (+ (cadr PT1)(* (sin ANG) DIAM))))
  21.   (command "layer" "s" "H" "")
  22.   (command "INSERT" "C-BORE" PT0 DIAM CBD (rtd ANG))
  23. )
  24. (defun CLEAR ()
  25.   (setvar "SNAPANG" ANG)
  26.   (command "ARRAY" HS "" "R" 2 "" (/ CH 2))
  27.   (command "ARRAY" HS "" "R" 2 "" (/ (- CH) 2))
  28.   (command "ERASE" HS "")
  29.   (command "LINE" PT3 PT4 "")
  30.   (setq CLN (ENTLAST))
  31.   (command "MOVE" CLN "" PT1 PT2)
  32.   (setvar "SNAPANG" OSN)
  33. )
  34. (defun THRU ()
  35.   (command "OSNAP" "INT")
  36.   (prompt "\nOSNAP set to INT ")
  37.   (setq PT1 (getpoint "\nStart point: ")) (terpri)
  38.   (command "OSNAP" "INT,PER")
  39.   (prompt "\nOSNAP set to INT, PER ")
  40.   (setq PT2 (getpoint PT1
  41.       "\nPick INTersection of or opposite side of material: "))
  42.   (terpri)
  43.   (setq ANG (angle PT1 PT2))
  44. )
  45. (defun POINTS ()
  46.   (command "layer" "s" "H" "")
  47.   (command "LINE" PT1 PT2 "")
  48.   (setq HS (ENTLAST))
  49.   (setq BR (/ DIAM 2))
  50.   (setq TD (/ (- DIAM RD) 2))
  51.   (setq PT3 (list
  52.    (- (car PT1) (* (sin ANG) BR))
  53.    (+ (cadr PT1)(* (cos ANG) BR))))
  54.   (setq PT4 (list
  55.    (+ (car PT1) (* (sin ANG) BR))
  56.    (- (cadr PT1)(* (cos ANG) BR))))
  57.   (setq PT5 (list
  58.    (+ (car PT3) (* (COS ANG) P))
  59.    (+ (cadr PT3)(* (SIN ANG) P))))
  60.   (setq PT5 (list
  61.    (+ (car PT5) (* (sin ANG) TD))
  62.    (- (cadr PT5)(* (cos ANG) TD))))
  63.   (setq PT6 (list
  64.    (+ (car PT4) (* (COS ANG) P))
  65.    (+ (cadr PT4)(* (SIN ANG) P))))
  66.   (setq PT6 (list
  67.    (- (car PT6) (* (sin ANG) TD))
  68.    (+ (cadr PT6)(* (cos ANG) TD))))
  69. )
  70. (defun SIDES ()
  71.   (command "OSNAP" "NONE")
  72.   (command "COPY" HS "" PT1 PT3)
  73.   (command "COPY" HS "" PT1 PT4)
  74.   (command "ERASE" HS "")
  75. )
  76. (defun THDS ()
  77.   (command "OSNAP" "NONE")
  78.   (setq D (distance PT1 PT2))
  79.   (setq TQY (/ D P))
  80.   (setq TQF (fix TQY))
  81.   (setq RM (rem TQF 2))
  82.   (if (= RM 1)
  83.     (setq TQE (1+ TQF))
  84.     (setq TQE TQF)
  85.   )
  86.   (setq TQH (/ TQE 2))
  87.   (command "LINE" PT3 PT4 "")
  88.   (setq LTL (ENTLAST))
  89.   (setvar "SNAPANG" ANG)
  90.   (setq PT7 (list
  91.     (+ (car PT1) (* (cos ANG) (* P 2)))
  92.     (+ (cadr PT1)(* (sin ANG) (* P 2)))))
  93.   (command "COPY" LTL "" PT1 PT7)
  94.   (setq TQD (- (- TQF TQH) 1))
  95.   (setq TQ 0)
  96.   (while (< TQ TQD)
  97.     (setq PT7 (list
  98.       (+ (car PT7) (* (cos ANG) (* P 2)))
  99.       (+ (cadr PT7)(* (sin ANG) (* P 2)))))
  100.     (command "COPY" LTL "" PT1 PT7)
  101.     (setq TQ (1+ TQ))
  102.   )
  103.   (command "LINE" PT5 PT6 "")
  104.   (setq STL (ENTLAST))
  105.   (setq PT7 (list
  106.     (+ (car PT1) (* (cos ANG) P))
  107.     (+ (cadr PT1)(* (sin ANG) P))))
  108.   (setq D2 (* P 2))
  109.   (setq PT8 (list
  110.     (+ (car PT7) (* (cos ANG) (* P 2)))
  111.     (+ (cadr PT7)(* (sin ANG) (* P 2)))))
  112.   (command "COPY" STL "" PT7 PT8)
  113.   (while (< D2 (- D (* P 3)))
  114.     (setq PT8 (list
  115.       (+ (car PT8) (* (cos ANG) (* P 2)))
  116.       (+ (cadr PT8)(* (sin ANG) (* P 2)))))
  117.     (command "COPY" STL "" PT7 PT8)
  118.     (setq D2 (+ D2 (* P 2)))
  119.   )
  120.   (setvar "SNAPANG" OSN)
  121.   (if (= OPN 4)
  122.     (command "COPY" LTL "" PT1 PT2)
  123.   )
  124.   (command "ERASE" LTL "")
  125. )
  126. (defun BLIND ()
  127.   (command "OSNAP" "INT")
  128.   (prompt "\nOSNAP set to INT ")
  129.   (setq PT1 (getpoint "\nStart point for BLIND SECTION view: "))
  130.   (command "OSNAP" "INT")
  131.   (princ "\nOSNAP set to INT ")
  132.   (setq D (getdist PT1 
  133.              "\nEnter thread depth or pick bottom of thread: "))
  134.   (terpri)
  135.   (command "OSNAP" "NEA")
  136.   (princ "\nOSNAP set to NEA ") (terpri)
  137.   (setq ANG (getangle PT1 "Enter or pick angle: "))
  138.   (setq PT2 (list
  139.     (+ (car PT1) (* (cos ANG) D))
  140.     (+ (cadr PT1)(* (sin ANG) D))))
  141.   (setq ANG (angle PT1 PT2))
  142.   (command "INSERT" "DRILL-PT" PT2 RD "" (rtd ANG))
  143. )
  144. (defun DC ()
  145.   (command "OSNAP" "CEN,INT")
  146.   (prompt "\nOSNAP set to CEN, INT ")
  147.   (setq CPT (getpoint "\nCenter for circles: "))
  148.   (cond
  149.     ((= OPN 1)(CLH) (CLT))
  150.     ((= OPN 2)(CLC))
  151.     ((= OPN 3)(CLC) (CLCB))
  152.     ((= OPN 4)(CLH) (CLT))
  153.   )
  154. )
  155. (defun CLCB ()
  156.   (command "layer" "s" "0" "")
  157.   (command "circle" CPT "d" CBD)
  158. )
  159. (defun CLC ()
  160.   (command "layer" "s" "0" "")
  161.   (command "circle" CPT "d" CH)
  162. )
  163. (defun CLH ()
  164.   (command "layer" "s" "H" "")
  165.   (command "circle" CPT "d" DIAM)
  166. )
  167. (defun CLT ()
  168.   (command "layer" "s" "0" "")
  169.   (command "circle" CPT "d" RD)
  170. )
  171. (defun PLAN ()
  172.   (initget 0 "Y N")
  173.   (setq ANS (getkword
  174.            "\nDo you want circles in PLAN view? Y/<N>: "))
  175.   (if (or (= ANS "N") (= ANS nil))
  176.     (princ)
  177.     (DC)
  178.   )
  179. )
  180. (defun C:TAPSEC  (/ ANG ANS BR CBD CH CLN CLY CMD CPT D DIAM D2 HS
  181.              LTL OMD OPN OSM OSN P PT0 PT1 PT2 PT3 PT4 PT5 PT6 PT7
  182.                   PT8 RD RM SNM STL TD TPI TQ TQD TQE TQF TQH TQY)
  183.   (setq temperr *error* *error* taperr)
  184.   (setq CLY (getvar "CLAYER"))
  185.   (setq OSM (getvar "OSMODE"))
  186.   (setq CMD (getvar "CMDECHO"))
  187.   (setq OMD (getvar "ORTHOMODE"))
  188.   (setq OSN (getvar "SNAPANG"))
  189.   (setq SNM (getvar "SNAPMODE"))
  190.   (setvar "OSMODE" 0)
  191.   (setvar "CMDECHO" 0)
  192.   (setvar "ORTHOMODE" 0)
  193.   (setvar "SNAPMODE" 0)
  194.   (if (not (tblsearch "LTYPE" "HIDDEN"))
  195.     (command "LINETYPE" "LOAD" "HIDDEN" "" "")
  196.     (command "LAYER" "M" "H" "C" "MAGENTA" "H" "LT"
  197.                                      "HIDDEN" "H" "")
  198.   )
  199.   (if (tblsearch "LAYER" "H") (command "layer" "s" "H" "")
  200.                               (command "layer" "m" "H" "c"
  201.                                "6" "" "")
  202.   )
  203.   (if (not *DIAM) (setq *DIAM 0.375))
  204.   (princ "\nBolt diameter:< ")
  205.   (princ *DIAM)
  206.   (setq DIAM (getreal "> "))
  207.   (if (not DIAM) (setq DIAM *DIAM)
  208.                  (setq *DIAM DIAM)
  209.   )
  210.   (cond
  211.     ((< DIAM 0.2500)(EXIT))
  212.     ((= DIAM 0.2500)(setq TPI 20 RD 0.188 CBD 0.4375 CH 0.281))
  213.     ((= DIAM 0.3125)(setq TPI 18 RD 0.244 CBD 0.5312 CH 0.344))
  214.     ((= DIAM 0.3750)(setq TPI 16 RD 0.298 CBD 0.6250 CH 0.406))
  215.     ((= DIAM 0.4375)(setq TPI 14 RD 0.350 CBD 0.7188 CH 0.469))
  216.     ((= DIAM 0.5000)(setq TPI 13 RD 0.406 CBD 0.8125 CH 0.531))
  217.     ((> DIAM 0.5000)(EXIT))
  218.   )
  219.   (setq P (/ 1.0 TPI))
  220.   (graphscr)
  221.   (prompt "1=Thru: 2=Clearance: 3=C'Bore w/Clearance: 4=Blind: ")
  222.   (setq OPN (getreal "\nEnter option number: "))
  223.   (cond
  224.     ((= OPN 1) (THRU) (POINTS) (SIDES) (THDS) (PLAN))
  225.     ((= OPN 2) (THRU) (POINTS) (CLEAR) (PLAN))
  226.     ((= OPN 3) (THRU) (CBS) (POINTS) (CLEAR) (PLAN))
  227.     ((= OPN 4) (BLIND) (POINTS) (SIDES) (THDS) (PLAN))
  228.   )
  229.   (setvar "CLAYER" CLY)
  230.   (setvar "OSMODE" OSM)
  231.   (setvar "CMDECHO" CMD)
  232.   (setvar "ORTHOMODE" OMD)
  233.   (setvar "SNAPANG" OSN)
  234.   (setvar "SNAPMODE" SNM)
  235.   (setq temperr *error*)
  236.   (princ)
  237. )
  238. 
  239.