home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / jun93.zip / TIP878.LSP < prev    next >
Lisp/Scheme  |  1993-05-19  |  2KB  |  69 lines
  1. ; TIP 878: SAVF.LSP (C)1993, Bill Larson
  2.  
  3. ; THIS FUNCTION WILL SAVE CURRENT DRAWING TO FLOPPY DRIVE A OR B
  4. ;     IF DRAWING HAS A PATH NAME, THE PATH IS IGNORED              
  5.  
  6. ;----------------- INTERNAL ERROR HANDLER -------------------
  7.  
  8. (defun lexerr (S)                     ; If an error (such as CTRL-C) occurs
  9.      ; while this command is active...
  10.      (if (/= S"Function cancelled")
  11.           (princ (strcat "\nError: " S))
  12.      )
  13.      (setvar "expert" OEX)               ; restore old expert value
  14.      (setvar "cmdecho" OCE)              ; restore old cmdecho value
  15.      (setq *error* OLDERR)               ; restore old *error* handler
  16.      (princ)
  17. )
  18. ;----------------------- MAIN PROGRAM -------------------------
  19.  
  20. (setq OLDERR *error*
  21. *error* LEXERR)
  22. (setq OCE (getvar "cmdecho"))         ; save value of cmdecho
  23. (setq OEX (getvar "expert"))          ; save value of highlight
  24. (setvar "cmdecho" 1)
  25. (setvar "expert" 2)
  26. (setq ST1 (getvar "dwgname"))
  27. (initget  "b a")  
  28. (setq DR (getkword "\nSave to drive B,<A> ")) 
  29.  
  30. (if (= ST1 "UNNAMED")              ;; check if dwg named
  31.      (progn
  32.           (princ "\nPlease name current drawing, then try again.")
  33.           (exit)
  34.      ); end progn
  35. ); end if
  36. (setq ST2 ST1)
  37. (setq ST5 "")
  38. (while (/= ST2 "")  
  39.      (if (= (substr ST2 1 1) "\\") ;; strip out subdirectories
  40.           (setq ST5 (substr ST2 2))   
  41.      ) ;end test for "\\"
  42.      (setq ST2 (substr ST2 2))
  43. ) ;end while loop
  44. (if (= ST5 "")                     ;; if no subdirectory
  45.     (progn
  46.     (setq ST5 ST1)
  47.     (if (= (substr ST5 2 1) ":")
  48.        (setq ST5 (substr ST5 3))
  49.        ); end if
  50.     ); end progn
  51. ); end if
  52. (if (/= DR "b")
  53.      (setq ST3 "A:")
  54. )
  55. (if (= DR "b")  
  56.      (setq ST3 "B:") 
  57. )
  58. (setq ST4 (strcat ST3 ST5))
  59. (command "Save"  ST4)
  60. (setq T1 "......Drawing")
  61. (setq T2 "has been saved to Floppy Drive") (setq t3 "......")
  62. (setq TXT (strcat T1 (chr 32) ST5 (chr 32) T2 (chr 32) ST3 (chr 32) T3))
  63. (print TXT) (prin1)
  64. (setvar "expert" OEX)                ; restore old expert value
  65. (setvar "cmdecho" OCE)                ; restore old cmdecho value
  66. (setq *error* OLDERR)                 ; restore old *error* handler
  67. (gc) (princ)
  68. ;end function
  69.