home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
cad
/
may93.zip
/
ANCHOR.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1993-05-12
|
6KB
|
172 lines
;; ANCHOR.LSP Copyright (c) Barry R. Bowen 1993
(defun C:ANCHOR (/ ANS EL EL1 SZ MPT PLBL BL1 TL BT PT 1 PT2
PT3 PT3A HSZ PT3AA PT3B PT3BB PT4 PT5 PT6 PT5A PT6A PT7 SS1
ANG PT10 PT11 PT12 PT13 PT14)
(V3)
(setq CL (getvar "clayer") EL (entlast))
(if (= EL nil) (progn
(command "point" "0,0") (setq EL (entlast))))
(initget (+ 2 4))
(setq SZ (getdist "\nSize <3/4>: "))
(if (not SZ) (setq SZ 0.75))
(initget 1)
(setq MPT (getpoint "\nStart of Enbed Point: "))
(initget (+ 2 4))
(setq PL (getdist "\nProjection Length <3>: "))
(if (not PL) (setq PL 3.0))
(setq BL (+ PL 12.0) BL1 (rtos BL 4 2))
(initget (+ 2 4))
(setq BL1 (getdist (strcat "\nTotal Bolt Length <" BL1 ">: ")))
(if (/= BL1 nil) (setq BL BL1))
(initget (+ 2 4))
(setq TL (getdist
(strcat "\nThread Length <" (rtos PL 4 1) ">: ")))
(if (not TL) (setq TL PL))
(initget "S J")
(setq BT (getkword "\nBolt Type [Std/J]: <Std> "))
; -------------------- Std Anchor Bolt ---------------------------
(setq PT2 (polar MPT (D90) PL) PT1 (polar PT2 (D270) BL)
HSZ (/ SZ 2.0) PT3 (polar PT2 (D270) TL)
PT3A (polar PT3 0 HSZ) PT3AA (polar MPT 0 HSZ)
PT3B (polar PT3 pi HSZ) PT3BB (polar MPT pi HSZ)
PT4 (polar PT1 0 HSZ) PT5 (polar PT2 0 HSZ)
PT5A (polar PT3AA (D90) (+ 0.25 SZ))
PT6 (polar PT2 pi HSZ)
PT6A (polar PT3BB (D90) (+ 0.25 SZ))
PT7 (polar PT1 pi HSZ)
)
(LS "ANCHOR" "3" "")
(setq SS1 (ssadd))
(initget "Y N")
(setq ANS (getkword "\nAdd Nut & Washer <Y>: "))
(if (or (= ANS "Y") (= ANS nil))
(progn
(command "insert" "AWASH" MPT SZ 1 0
"insert" "ANUT" (polar MPT (D90) 0.25) SZ SZ 0)
) )
; ------------------ "J" Type Anchor Bolt -------------------------
(if (= BT "J") (progn
(grdraw PT4 PT5 5)
(grdraw PT5 PT6 5)
(grdraw PT6 PT7 5)
(setvar "orthomode" 1)
(initget 1)
(setq PT (getpoint PT1 "\nHook Length: "))
(setq ANG (angle PT1 PT))
(if (= ANG 0)
(setq PT10 (polar PT7 (D270) SZ))
(setq PT10 (polar PT4 (D270) SZ))
)
(setq PT11 (polar PT (D270) HSZ)
PT12 (polar PT (D90) HSZ)
PT13 (polar PT4 (D90) HSZ)
PT14 (polar PT7 (D90) HSZ))
(if (= ANG 0)
(command "pline" PT3A "w" 0 0 PT13 PT12 "")
(command "pline" PT3B "w" 0 0 PT14 PT12 "")
)
(command "fillet" "r" SZ
"fillet" "P" PT12
"fillet" "r" 0
"offset" SZ PT12 PT11 ""
"line" PT11 PT12 "")
)
(progn
(command "insert" "AHEAD" PT1 SZ SZ 0
"line" PT4 PT3A ""
"line" PT7 PT3B "")
))
(command "snap" "r" PT3A 0)
(if (= ANS "N") (progn
(LS "layer" "ANCHOR" "3" "")
(command "pline" PT3A "w" 0 0 PT5 PT6 PT3B "c")
(LS "THREAD" "1" "")
(command "hatch" "TRANS" "2" 0 (entlast) "")
)
(progn
(LS "ANCHOR" "3" "")
(command "pline" PT3A "w" 0 0 PT3AA PT3BB PT3B "c")
(LS "THREAD" "1" "")
(command "hatch" "TRANS" "2" 0 (entlast) "")
(LS "ANCHOR" "3" "")
(command "pline" PT5A "w" 0 0 PT5 PT6 PT6A "c")
(LS "THREAD" "1" "")
(command "hatch" "TRANS" "2" 0 (entlast) "")
)
)
(command "snap" "r" "0,0" 0)
(S3 EL)
(if (= BT "J") (progn
(setq EL (entlast))
(initget "Y N")
(setq ANS (getkword "\nMirror Bolt <Y>: "))
(if (or (= ANS "Y") (= ANS nil))
(progn
(setq MPT1 (getpoint "\nFirst Mirror Point: ")
MPT2 (getpoint MPT1 "\nSecond Mirror Point: "))
(command "mirror" SS1 "" MPT1 MPT2 "n")))
)
(command "copy" SS1 "" MPT pause)
)
(command "redraw")
(RL)
(V4)
)
; ------------------------- S3 -----------------------------
(defun S3 (EVAR1)
(setq SS1 (ssadd)
EN1 (entnext EVAR1))
(while EN1
(setq SS1 (ssadd EN1 SS1)
EN1 (entnext EN1))
)
)
(defun D90 () (* pi 0.5))
(defun D270 () (* pi 1.5))
; ------------------------ V3.LSP --------------------------
(defun V3 ()
(setq BM (getvar "blipmode")) ;Current Blipmode setting
(setvar "blipmode" 0) ;Turn Blips off
(setvar "cmdecho" 0) ;Turn command echo off
(command "undo" "group") ;Necessary for correct UNDO
;of program being executed
)
; ------------------------ V4.LSP --------------------------
(defun V4 (/ BA)
(setvar "blipmode" BM) ;Reset to original setting
(command "undo" "end") ;End of UNDO sequence
(prompt "\n") ;New line
(setq BA "Program Completed. . . . .") ;Prints string
)
; ------------------------- LS -----------------------------
; Layer search command for creating new layers.
(defun LS (NLAY CLR LT)
(setq LAY (tblsearch "layer" NLAY))
(if (not LAY)
(command "layer" "m" NLAY "c" CLR "" "lt" LT "" "");True
(progn
(setq FRZ (cdr (assoc 70 LAY)))
(if (= FRZ 65)
(progn
(command "layer" "t" NLAY "")
(command "layer" "s" NLAY "")
)
(command "layer" "s" NLAY "") ;False
)) ) )
; -------------------------- RL ----------------------------
; Resets the previous layer to the current layer.
;
(defun RL () (command "layer" "s" CL ""))
(prompt "\nAnchor Bolt Program Loaded........")
(prompt "\nCopyright Barry R. Bowen 1993")
(princ); end