;Title - Erin Stephens Lisp Page
;Lisp Page from Internet - Internet Worldwide Communications
 ;FIXBLOCK.LSP  [4/16/96]
 ;
 ; Copyright 1996 Manu-Soft Computer Services
 ;
 ; freeware by:
 ;   Owen Wengerd
 ;   Manu-Soft Computer Services
 ;   CompuServe:  71324,3252
 ;   owenw@nvi.nvi.net
 ;
 ; Load function, then enter FIXBLOCK to redefine selected blocks
 ;  so that all entities are on layer '0'.
 ;


(defun c:fixblock (/ ss cnt b donelist bredef)
  (defun bredef (b / e el)
    (setq e (tblobjname "BLOCK" b))
    (while e
      (setq el (entget e))
      (setq el (subst '(8 . "0") (assoc 8 el) el))
      (setq el (if (assoc 62 el) (subst '(62 . 0) (assoc 62 el) el) (append el '((62 . 0)))))
      (entmake el)
      (setq e (entnext e))
    )
    (if (/= "ENDBLK" (cdr (assoc 0 el))) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
  )
  (if (> (logand (cdr (assoc 70 (tblsearch "layer" "0"))) 1) 0)
    (princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
    (if (setq ss (ssget '((0 . "INSERT"))))
      (progn
        (setq cnt (sslength ss))
        (while (>= (setq cnt (1- cnt)) 0)
          (if (not (member (setq b  (cdr (assoc 2 (entget (ssname ss cnt))))) donelist))
            (progn
              (bredef b)
              (setq donelist (cons b donelist))
            )
          )
        )
        (princ (strcat "\n" (itoa (sslength ss)) " blocks redefined\n"))
      )
      (princ "\nNo blocks selected!\n")
    )
  )
  (princ)
)
;End-of-file