;***************************************************************8
;*   C:BEXPLODE.LSP
;* 
;*  Function to explode all blocks in a drawing.
;*  It first sets the y and z scaling factors to agree with the
;*  x scaling factors for every block in the drawing.
;*  It then explodes each block in turn.
;* 
;*   AJR 5/7/88
;*      26/5/89  Amended to allow use off (ssx) prior to call.
;*        10/89  Amended to incorporate choice of what to do with
;*               layers.  
;*   Can be Original - ie as defined in block         
;*          Byblock  - all linework goes to layer onto
;*                     which block was inserted.
;******************************************************************

(vmon)

(defun err (msg)
  (prompt (strcat "\nError: " msg))
  (setq *error* olderr)               ; restore old *error* handler
  (setvar "HIGHLIGHT" 1)
  (setvar "CMDECHO" 1)
  (princ)
)

;-------------------------------------------------------------------
; lexp - local function to explode a block and put all its entities
;        onto the block layer.
;-------------------------------------------------------------------
(defun lexp (ename / e e0 e1 en s0 lay)

  (setq lay (cdr (assoc 8 (entget ename))))
  (setq e0 (entlast))
  (setq en (entnext e0))
  (while (not (null en))                ; find the last entity              
    (setq e0 en)
    (setq en (entnext e0))
  )
  (command ".explode" ename)           ; explode the entity
  (setq s0 (ssadd))
  (while (entnext e0)
    (ssadd (setq e0 (entnext e0)) s0)
  )
  (command "change" s0 "" "P"           ; change entities to the proper layer
           "c"   "bylayer"              ; regardless of their extrusion direction
           "lt"  "bylayer"
           "la"  lay "")

) ; end defun lexp

;-------------------------------------------------------------------
(defun C:BEX ()

  (SETQ olderr *error*
        *error* err)
  (SETVAR "cmdecho" 0)
  (setvar "HIGHLIGHT" 0)
  (setq ss (ssget))
  (if ss
    (progn
       (princ (strcat "\nSelected " (itoa (setq n (sslength ss))) " items."))
       (initget 1 "Original Byblock")
       (prompt "\nSpecify what to do with layers ..")
       (setq ans (getkword "\nOriginal/Byblock > "))
       (setq l 0 chm 0)
       (while (< l n)
         (setq ename (ssname ss l))
         (setq e (entget ename))
 
         (if  (equal (cdr (assoc 0 e)) "INSERT")
 
           (if  (AND (< (cdr (assoc 41 e)) 0.001)
                     (> (cdr (assoc 41 e)) -0.001)
              )
             (progn
               ; avoids floating point underflow.
               (entdel ename)
               (print "Block scaling too small - erased it!")
             )
             ; else
             (progn     
              ; force y and z scales to be equal to x scale.
              (setq e (subst (cons '42 (cdr(assoc 41 e))) (assoc 42 e) e) )
              (setq e (subst (cons '43 (cdr(assoc 41 e))) (assoc 43 e) e) )
              (entmod e) 
              (if (= ans "Original")
                (command ".EXPLODE" ename)
                ; else Byblock
                (lexp ename)
              )
              (setq chm (1+ chm))
             )
           ) ; end if
         ) ; end if
         (setq l (1+ l))
      ) ; end while
      (princ "\nExploded ")              ; Print total blocks exploded
      (princ chm)
      (princ " blocks.")
    ) ; end progn
   ) ; end if
  (setq *error* olderr)               ; restore old *error* handler
  (SETVAR "cmdecho" 1)
  (setvar "HIGHLIGHT" 1)
  (princ)
) ; end.