home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 8
/
CDASC08.ISO
/
VRAC
/
JUN93.ZIP
/
TIP878.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1993-05-19
|
2KB
|
69 lines
; TIP 878: SAVF.LSP (C)1993, Bill Larson
; THIS FUNCTION WILL SAVE CURRENT DRAWING TO FLOPPY DRIVE A OR B
; IF DRAWING HAS A PATH NAME, THE PATH IS IGNORED
;----------------- INTERNAL ERROR HANDLER -------------------
(defun lexerr (S) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= S"Function cancelled")
(princ (strcat "\nError: " S))
)
(setvar "expert" OEX) ; restore old expert value
(setvar "cmdecho" OCE) ; restore old cmdecho value
(setq *error* OLDERR) ; restore old *error* handler
(princ)
)
;----------------------- MAIN PROGRAM -------------------------
(setq OLDERR *error*
*error* LEXERR)
(setq OCE (getvar "cmdecho")) ; save value of cmdecho
(setq OEX (getvar "expert")) ; save value of highlight
(setvar "cmdecho" 1)
(setvar "expert" 2)
(setq ST1 (getvar "dwgname"))
(initget "b a")
(setq DR (getkword "\nSave to drive B,<A> "))
(if (= ST1 "UNNAMED") ;; check if dwg named
(progn
(princ "\nPlease name current drawing, then try again.")
(exit)
); end progn
); end if
(setq ST2 ST1)
(setq ST5 "")
(while (/= ST2 "")
(if (= (substr ST2 1 1) "\\") ;; strip out subdirectories
(setq ST5 (substr ST2 2))
) ;end test for "\\"
(setq ST2 (substr ST2 2))
) ;end while loop
(if (= ST5 "") ;; if no subdirectory
(progn
(setq ST5 ST1)
(if (= (substr ST5 2 1) ":")
(setq ST5 (substr ST5 3))
); end if
); end progn
); end if
(if (/= DR "b")
(setq ST3 "A:")
)
(if (= DR "b")
(setq ST3 "B:")
)
(setq ST4 (strcat ST3 ST5))
(command "Save" ST4)
(setq T1 "......Drawing")
(setq T2 "has been saved to Floppy Drive") (setq t3 "......")
(setq TXT (strcat T1 (chr 32) ST5 (chr 32) T2 (chr 32) ST3 (chr 32) T3))
(print TXT) (prin1)
(setvar "expert" OEX) ; restore old expert value
(setvar "cmdecho" OCE) ; restore old cmdecho value
(setq *error* OLDERR) ; restore old *error* handler
(gc) (princ)
;end function