home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / may93.zip / ANCHOR.LSP < prev    next >
Lisp/Scheme  |  1993-05-12  |  6KB  |  172 lines
  1. ;; ANCHOR.LSP    Copyright (c) Barry R. Bowen 1993
  2.  
  3. (defun C:ANCHOR (/ ANS EL EL1 SZ MPT PLBL BL1 TL BT PT 1 PT2
  4.   PT3 PT3A HSZ PT3AA PT3B PT3BB PT4 PT5 PT6 PT5A PT6A PT7 SS1
  5.   ANG PT10 PT11 PT12 PT13 PT14)
  6.   (V3)
  7.   (setq CL (getvar "clayer") EL (entlast))
  8.   (if (= EL nil) (progn
  9.      (command "point" "0,0") (setq EL (entlast))))
  10.   (initget (+ 2 4))
  11.   (setq SZ (getdist "\nSize <3/4>: "))
  12.   (if (not SZ) (setq SZ 0.75))
  13.   (initget 1)
  14.   (setq MPT (getpoint "\nStart of Enbed Point: "))
  15.   (initget (+ 2 4))
  16.   (setq PL (getdist "\nProjection Length <3>: "))
  17.   (if (not PL) (setq PL 3.0))
  18.   (setq BL (+ PL 12.0) BL1 (rtos BL 4 2))
  19.   (initget (+ 2 4))
  20.   (setq BL1 (getdist (strcat "\nTotal Bolt Length <" BL1 ">: ")))
  21.   (if (/= BL1 nil) (setq BL BL1))
  22.   (initget (+ 2 4))
  23.   (setq TL (getdist
  24.                (strcat "\nThread Length <" (rtos PL 4 1) ">: ")))
  25.   (if (not TL) (setq TL PL))
  26.   (initget "S J")
  27.   (setq BT (getkword "\nBolt Type [Std/J]: <Std> "))
  28. ; -------------------- Std Anchor Bolt ---------------------------
  29.   (setq PT2 (polar MPT (D90) PL) PT1 (polar PT2 (D270) BL)
  30.         HSZ (/ SZ 2.0) PT3 (polar PT2 (D270) TL)
  31.        PT3A (polar PT3 0 HSZ) PT3AA (polar MPT 0 HSZ)
  32.        PT3B (polar PT3 pi HSZ) PT3BB (polar MPT pi HSZ)
  33.         PT4 (polar PT1 0 HSZ) PT5 (polar PT2 0 HSZ)
  34.        PT5A (polar PT3AA (D90) (+ 0.25 SZ))
  35.         PT6 (polar PT2 pi HSZ)
  36.        PT6A (polar PT3BB (D90) (+ 0.25 SZ))
  37.         PT7 (polar PT1 pi HSZ)
  38.   )
  39.   (LS "ANCHOR" "3" "")
  40.   (setq SS1 (ssadd))
  41.   (initget "Y N")
  42.   (setq ANS (getkword "\nAdd Nut & Washer <Y>: "))
  43.   (if (or (= ANS "Y") (= ANS nil))
  44.      (progn
  45.       (command "insert" "AWASH" MPT  SZ 1 0
  46.                "insert" "ANUT" (polar MPT (D90) 0.25) SZ SZ 0)
  47.   )  )
  48. ; ------------------ "J" Type Anchor Bolt -------------------------
  49.   (if (= BT "J") (progn
  50.     (grdraw PT4 PT5 5)
  51.     (grdraw PT5 PT6 5)
  52.     (grdraw PT6 PT7 5)
  53.     (setvar "orthomode" 1)
  54.     (initget 1)
  55.     (setq PT (getpoint PT1 "\nHook Length: "))
  56.     (setq ANG (angle PT1 PT))
  57.     (if (= ANG 0)
  58.       (setq PT10 (polar PT7 (D270) SZ))
  59.       (setq PT10 (polar PT4 (D270) SZ))
  60.     )
  61.     (setq PT11 (polar PT (D270) HSZ)
  62.           PT12 (polar PT (D90) HSZ)
  63.           PT13 (polar PT4 (D90) HSZ)
  64.           PT14 (polar PT7 (D90) HSZ))
  65.     (if (= ANG 0)
  66.      (command "pline" PT3A "w" 0 0 PT13 PT12 "")
  67.      (command "pline" PT3B "w" 0 0 PT14 PT12 "")
  68.     )
  69.     (command "fillet" "r" SZ
  70.              "fillet" "P" PT12
  71.              "fillet" "r" 0
  72.              "offset" SZ PT12 PT11 ""
  73.              "line" PT11 PT12 "")
  74.     )
  75.     (progn
  76.     (command "insert" "AHEAD" PT1 SZ SZ 0
  77.              "line" PT4 PT3A ""
  78.              "line" PT7 PT3B "")
  79.   ))
  80.   (command "snap" "r" PT3A 0)
  81.   (if (= ANS "N") (progn
  82.        (LS "layer" "ANCHOR" "3" "")
  83.        (command "pline" PT3A "w" 0 0 PT5 PT6 PT3B "c")
  84.        (LS "THREAD" "1" "")
  85.        (command "hatch" "TRANS" "2" 0 (entlast) "")
  86.     )
  87.     (progn
  88.       (LS "ANCHOR" "3" "")
  89.       (command "pline" PT3A "w" 0 0 PT3AA PT3BB PT3B "c")
  90.       (LS "THREAD" "1" "")
  91.       (command "hatch" "TRANS" "2" 0 (entlast) "")
  92.       (LS "ANCHOR" "3" "")
  93.       (command "pline" PT5A "w" 0 0 PT5 PT6 PT6A "c")
  94.       (LS "THREAD" "1" "")
  95.       (command "hatch" "TRANS" "2" 0 (entlast) "")
  96.     )
  97.   )
  98.   (command "snap" "r" "0,0" 0)
  99.   (S3 EL)
  100.   (if (= BT "J") (progn
  101.     (setq EL (entlast))
  102.     (initget "Y N")
  103.     (setq ANS (getkword "\nMirror Bolt <Y>: "))
  104.     (if (or (= ANS "Y") (= ANS nil))
  105.      (progn
  106.       (setq MPT1 (getpoint "\nFirst Mirror Point: ")
  107.             MPT2 (getpoint MPT1 "\nSecond Mirror Point: "))
  108.       (command "mirror" SS1 "" MPT1 MPT2 "n")))
  109.    )
  110.     (command "copy" SS1 "" MPT pause)
  111.   )
  112.   (command "redraw")
  113.   (RL)
  114.   (V4)
  115. )
  116.  
  117. ; ------------------------- S3 -----------------------------
  118. (defun S3 (EVAR1)
  119.   (setq SS1 (ssadd)
  120.         EN1 (entnext EVAR1))
  121.   (while EN1
  122.     (setq SS1 (ssadd EN1 SS1)
  123.           EN1 (entnext EN1))
  124.   )
  125. )
  126.  
  127. (defun D90 () (* pi 0.5))
  128. (defun D270 () (* pi 1.5))
  129.  
  130. ; ------------------------ V3.LSP --------------------------
  131.  (defun V3 ()
  132.    (setq BM (getvar "blipmode")) ;Current Blipmode setting
  133.    (setvar "blipmode" 0)         ;Turn Blips off
  134.    (setvar "cmdecho" 0)          ;Turn command echo off
  135.    (command "undo" "group")      ;Necessary for correct UNDO
  136.                                  ;of program being executed
  137.  )
  138.  
  139. ; ------------------------ V4.LSP --------------------------
  140.   (defun V4 (/ BA)
  141.     (setvar "blipmode" BM)   ;Reset to original setting
  142.     (command "undo" "end")   ;End of UNDO sequence
  143.     (prompt "\n")            ;New line
  144.     (setq BA "Program Completed. . . . .") ;Prints string
  145.   )
  146.  
  147. ; ------------------------- LS -----------------------------
  148. ; Layer search command for creating new layers.
  149. (defun LS (NLAY CLR LT)
  150.  
  151.  (setq LAY (tblsearch "layer" NLAY))
  152.  (if (not LAY)
  153.    (command "layer" "m" NLAY "c" CLR "" "lt" LT "" "");True
  154.     (progn
  155.       (setq FRZ (cdr (assoc 70 LAY)))
  156.       (if (= FRZ 65)
  157.         (progn
  158.          (command "layer" "t" NLAY "")
  159.          (command "layer" "s" NLAY "")
  160.         )
  161.          (command "layer" "s" NLAY "") ;False
  162. ))  ) )
  163.  
  164. ; -------------------------- RL ----------------------------
  165. ; Resets the previous layer to the current layer.
  166. ;
  167. (defun RL () (command "layer" "s" CL ""))
  168.  
  169. (prompt "\nAnchor Bolt Program Loaded........")
  170. (prompt "\nCopyright Barry R. Bowen 1993")
  171. (princ); end
  172.