 ; Wlay - wblock each layer in a drawing out to a separate drawing.
 ; Caution - overwrites existing layer drawings of the same name.
 ; Copyright 1995, 2001 by Rocket Software Ltd.
 ; The inflatable monitor - now in beta testing.

 ; Outlin - draw a polyline around the drawing extents.
 (DEFUN OUTLIN ( / aa cc bb dd)
  (setvar "cmdecho" 0)
  (setq aa (getvar "extmin"))
  (setq cc (getvar "extmax"))
  (setq bb (cons (car cc) (cdr aa)))
  (setq dd (cons (car aa) (cdr cc)))
  (command "pline" aa bb cc dd "c")
 (princ))

 ; Fay - error handler.
 (DEFUN FAY (shk /)
  (setq *error* esav)
  (close fn)
  (print shk)
 (princ))
 ; Fay end.

 ; Wlay - the beast.
 (DEFUN C:WLAY (/ esav tt fh reww layy laylst fn laynum lanam wname ss dwglst
                                                                       namstr)
  (setvar "cmdecho" 0)
  (command "undo" "m")
  (command "qsave")
  (setq esav *error*)                    ; save the previous error handler
  (setq tt (getvar "textstyle"))
  (setq fh (cdr (assoc 40 (tblsearch "style" tt))))
  (setq *error* fay)                     ; and install a new one
  (command "ucsicon" "off")
  (command "layer" "thaw" "0" "s" "0" "")
 ; Draw the extents outline.
  (outlin)
  (setq outnam (entlast))                ; save its ename
 ; Now get a list of the layer names and alphabetise it.  
  (setq reww T)
  (while (setq layy (cdr (assoc 2 (tblnext "layer" reww))))
         (setq reww ())
         (setq laylst (append laylst (list layy))))
  (setq laylst (acad_strlsort laylst))  ; alphabetize
 ; Open the log file.
  (setq fn (open "Layer.log" "w"))
 ; Initialize layers written counter.
  (setq laynum 0)
 ; The main loop: make names, write the layers to disk, add to the log file.
  (while (setq lanam (car laylst))
         (setq laylst (cdr laylst))
 ; Make the new drawing name.
         (setq wname (strcat (itoa laynum) lanam))
         (setq ss (ssget "X" (list (cons 8 lanam))))
         (if ss
             (progn
 ; Make the layer name and new drawing name string.
                  (if (member wname dwglst)
                      (setq warng " *** Duplicate file name overwritten ***")
                      (setq warng ""))
                  (setq dwglst (append dwglst (list wname)))
                  (setq namstr (strcat "DRAWING " wname))
                  (while (< (strlen namstr) 16)
                         (setq namstr (strcat namstr " ")))
                  (setq namstr (strcat namstr " = LAYER " lanam warng))
                  (setq pa (polar (getvar "extmin") (* pi 0.25) 5))
                  (if (= fh 0.0)
                      (command "text" pa
                                        (* (getvar "dimscale") 2.5) "0" namstr)
                      (command "text" pa "0" namstr))
 ; See if the file already exists.
                  (setq pnam (strcat (getvar "dwgprefix") wname ".DWG"))
 ; And write it whether or not it does.
                  (if (findfile pnam)
                      (command "wblock" wname "Y" "" "0,0"
                                                       ss outnam (entlast) "")
                      (command "wblock" wname "" "0,0" ss outnam (entlast) ""))
                  (command "oops")
                  (command "erase" "l" "")
 ; Add the layer name and new drawing name string to the log file.
                  (write-line namstr fn))
             (progn
                  (write-line (strcat "Nothing on " lanam "."))
                  (write-line (strcat "Nothing on " lanam ".") fn)))
         (setq laynum (1+ laynum)))                  ; incr. counter, loop end
  (close fn)                                         ; close the log file
  (entdel outnam)                                    ; delete the border
  (setq *error* esav)                                ; restore error handler
 (princ))