Monster Media 1993 #2/Image.iso/cad/jul93.zip/MPLOT.LSP

Lisp/Scheme | 1993-06-21 | 5KB | 172 lines

;==========================================================
; MPLOT.LSP Copyright 1993 by Looking Glass Microproducts
;==========================================================
; Produce Multiple Single-Layer plots from a drawing
;=============================================================
(defun C:MPLOT (/ ERROR PUSHVARS POPVARS SYSVARS OLD-ERROR NOTRANS
                ITEM GET_PLOT_LAYERS MPLOT PLOT_FIRST_LAYER PLOT_OTHER_LAYERS
)
   ;==========================================================
   ; Error Handler
   (defun ERROR (S)
      (if (not
             (member
                S
                '("Function cancelled" "console break")
             )
          )
         (alert S)
      )
      (command ".undo" "end")
      (command ".undo" "1")
      (POPVARS)
      (princ)
   )
   ;==========================================================
   ; Set and Save System Variables
   (defun PUSHVARS (VLIST)
      (foreach PAIR VLIST
         (setq
            SYSVARS (cons
                       (cons
                          (strcase (car PAIR))
                          (getvar
                             (car PAIR)
                          )
                       )
                       SYSVARS
                    )
         )
         (if (cdr PAIR) (setvar (car PAIR) (cdr PAIR)))
      )
   )
   ;==========================================================
   ; Restore System Variables
   (defun POPVARS ()
      (foreach PAIR SYSVARS (setvar (car PAIR) (cdr PAIR)))
      (setq *error* OLD-ERROR)
      (setq SYSVARS nil)
   )
   ;==========================================================
   ; Disallow transparent invocation of routine.
   (defun NOTRANS ()
      (cond
         ((zerop (logand (getvar "cmdactive") (+ 1 2 4 8))))
         ((alert
             "This command may not be invoked transparently."
          )
         )
      )
   )
   ;==========================================================
   ; Item from association list
   (defun ITEM (A B) (cdr (assoc A B)))
   ;==========================================================
   ; Get the layers to be plotted
   (defun GET_PLOT_LAYERS (/ FIRST LNAMES ENTRY NAME FLAGS COLOR
   )
      (setq FIRST t)
      (while (setq ENTRY (tblnext "layer" FIRST))
         (setq
            FIRST nil
            NAME  (ITEM 2 ENTRY)
            COLOR (ITEM 62 ENTRY)
            FLAGS (ITEM 70 ENTRY)
         )
         (if (and
                (/= NAME CLAYER)         ; not the current layer
                (> COLOR 0)              ; on
                (zerop (logand FLAGS 1)) ; not frozen
             )
            (setq LNAMES (cons NAME LNAMES))
         )
      )
      (if LNAMES (ACAD_STRLSORT LNAMES))
   )
   ;==========================================================
   ; Main Routine
   (defun MPLOT (/ CLAYER LAYERS)
      (cond
         ((progn
             (alert
                (strcat
                   "Make the format layer the current layer."
                   "\nTurn on all the layers to be plotted."
                )
             )
             (command ".ddlmodes")
             (zerop (getvar "diastat"))
          )
            ; Layer dialog box was cancelled
         )
         ((null
             (setq
                CLAYER (getvar "clayer")
                LAYERS (GET_PLOT_LAYERS)
             )
          )
            (alert "No layers to plot.")
         )
         (t (PLOT_FIRST_LAYER) (PLOT_OTHER_LAYERS))
      )
   )
   ;==========================================================
   (defun PLOT_FIRST_LAYER ()
      (command
         ".layer" "off" "*" "on" CLAYER "on" (car LAYERS) ""
      )
      (setvar "cmdecho" 1)
      (command ".plot")
      (textpage)
      (while (/= 0 (getvar "cmdactive"))
         (command pause)
      )
   )
   ;==========================================================
   (defun PLOT_OTHER_LAYERS ()
      (setvar "cmdecho" 0)
      (while (cdr LAYERS)
         (command
            ".layer" "off" (car LAYERS) "on" (cadr LAYERS) ""
         )
         (textpage)
         (prompt
            (strcat
               "\nPlotting layer "
               (cadr LAYERS)
               "\n\n"
            )
         )
         (command ".plot")
         (while (/= 0 (getvar "cmdactive"))
            (command "")
         )
         (setq LAYERS (cdr LAYERS))
      )
   )
   ;==========================================================
   ; Body of c:mplot
   (if (NOTRANS)
      (progn
         (setq OLD-ERROR *error* *error* ERROR)
         (setvar "cmdecho" 0)
         (command "_undo" "group")
         (PUSHVARS
            '(("cmddia" . 0) ("expert" . 1))
         )
         (MPLOT)
         (command ".undo" "end")
         (command ".undo" "1")
         (POPVARS)
      )
   )
   (princ)
)
(princ
   (strcat
      "  MPLOT.LSP (Copyright 1993 by"
      " Looking Glass Microproducts) loaded."
   )
)
(princ)