;;
;;;
;;;    LYDELMRG.LSP
;;;
;;;    By Dominic Panholzer
;;;
;;;    Copyright © 1999 by Autodesk, Inc.
;;;
;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    "[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------
;;;
;;;  External Functions:
;;;
;;;     ACET-ERROR-INIT       --> ACETUTIL.FAS   Intializes bonus error routine
;;;     ACET-ERROR-RESTORE    --> ACETUTIL.FAS   restores old error routine
;;;     ACET-LAYER-LOCKED     --> ACETUTIL.FAS   Checks to see if layer is locked
;;;     ACET-TABLE-NAME-LIST  --> ACETUTIL.FAS   Returns a list of table enties
;;;     ACET-SPINNER          --> ACETUTIL.FAS   Shows spinner while work is being done
 
; -------------------- LAYER DELETE FUNCTION ---------------------
; Deletes layer from drawing.
; ----------------------------------------------------------------
 
(defun C:LAYDEL ()
  (if (= (getvar "fullopen") 1)
    (acet-lydelmrg-main "delete")
    (princ "\nLAYDEL cannot be used on partially opened drawings.")
  )
  (princ)
)
 
; --------------------- LAYER MERGE FUNCTION ---------------------
; Merges layer with second layer.
; ----------------------------------------------------------------
 
(defun C:LAYMRG ()
  (if (= (getvar "fullopen") 1)
    (acet-lydelmrg-main "merge")
    (princ "\nLAYMRG cannot be used on partially opened drawings.")
  )
  (princ)
)
 
; ------------- LAYER PROCESSOR FOR LAYDEL & LAYMRG --------------
;  Main program body for LAYDEL and LAYMRG.
;  This function will remove all the entities on a selected layer and
;  remove the layer from the drawing. If the merge option is
;  selected, all the entities on the layer to be removed will be
;  changed to the merging layer. Block definitions referencing the
;  layer to be removed will be redefined with the dependencies
;  removed (or changed when merging.)
; ----------------------------------------------------------------
 
(defun acet-lydelmrg-main (MODE / acet-lydelmrg-blkredef acet-lydelmrg-attredef acet-lydelmrg-layinblklst
                                  acet-lydelmrg-layoutlist acet-lydelmrg-vpcheck
                                  ANS LOOP LAYLST CLAY LAYSTR LAY VAL LST BLKLST STR FLTR
                                  SS CNT EN PASS NEWLAY CVPORT NOPURGE_LST ALERT_STRING 
                                  LAYOUTLST CLAYOUT)
 
; --------------------- BLKREDEF FUNCTION ------------------------
;   This function redefines block BNAM removing dependencies on
;   layers in the list LAYLST. MODE can be either
;   "delete" or "merge". If merge is used NEWLAY specifies
;   the target layer.
; ----------------------------------------------------------------
 
  (defun acet-lydelmrg-blkredef (BNAM LAYLST MODE NEWLAY / BLK EN ED ILAY ABLK FLTR)
 
    (entmake)
 
    (setq BLK (entget (tblobjname "BLOCK" BNAM)'("*"))    ; Get first block definition
          BLK (subst (cons 8 "0") (assoc 8 BLK) BLK)      ; Make sure the def is on lay 0
          EN  (cdr (assoc -2 BLK))                        ; and the first subentity
    )
 
    (entmake BLK)                                         ; Start redefining the block
    (while EN                                             ; While there are subentities
 
      (setq ED (entget EN '("*")))
      (if (or
            (= "POLYLINE" (cdr (assoc 0 ED)))             ; If the subent is a polyline
            (and
              (= "INSERT" (cdr (assoc 0 ED)))             ; or if the subent is a block
              (= 1 (cdr (assoc 66 ED)))                   ; with attributes
            )
          )
        (setq ABLK T                                      ; then set the complex entity flag
              ILAY (cdr (assoc 8 ED))                     ; and save the layer.
        )
      )
 
      (if (member (cdr (assoc 8 ED)) LAYLST)              ; If its layer is in the list
        (progn
          (if (= (xstrcase MODE) "MERGE")                  ; if the layer is to be merged
            (progn
              (setq ED (subst (cons 8 NEWLAY) (assoc 8 ED) ED))  ; substitute the old layer with new
              (entmake ED)                                ; and add the entity to the definition
            )
            (progn                                        ; else if layer is to be deleted
              (if (= "SEQEND" (cdr (assoc 0 ED)))         ; If the ent is a seqend
                (progn                                    ; change its layer to that of the insert
                  (setq ED (subst (cons 8 ILAY) (assoc 8 ED) ED))
                  (entmake ED)                            ; and add it to the definition.
                )
              )
              (if ABLK                                    ; If the complex entity flag is set,
                (while (/= "SEQEND" (cdr (assoc 0 ED)))   ; while the entity is not a seqend,
                  (setq EN (entnext EN)                   ; step through the sub entities
                        ED (entget EN '("*"))             ; removing them from the definition.
                  )
                )
              )
            )
          )
        )
        (entmake ED)                                      ; If layer does not match, add
      )                                                   ; the entity to the definition
      (setq EN   (entnext EN)                             ; get the next subentity
            ABLK nil                                      ; and reset the attribute block flag.
      )
    )
 
    (setq BNAM (entmake (list (cons 0 "ENDBLK"))))        ; complete the redefinition
 
    (if (and (= (xstrcase MODE) "DELETE")                  ; If in delete mode and
             (not (entnext (tblobjname "BLOCK" BNAM)))    ; the block definition has no entities
        )
      (progn
        (Setq FLTR (list '(-4 . "<AND")
                           '(0 . "INSERT")
                           (cons 2 BNAM)
                         '(-4 . "AND>")
                   )
        )
        (if (setq SS  (ssget "_x" FLTR))
          (command "_.erase" SS "")                       ; erase all the insertions
        )
        (if (setq SS  (ssget "_x" FLTR))
          (progn
            (setq CNT 0)
            (while (and ss
                        (> (sslength ss) 0)
                        (setq EN (ssname SS CNT))
                   );and
              (entdel EN)
              (setq CNT (1+ CNT))
            )
          )
        )
        (if (tblobjname "BLOCK" BNAM)
            (acet-table-purge "block" bnam nil)
        )
      )
    )
  )
 
; ----------------- ATTRIBUTE REDEF FUNCTION ---------------------
;   This function recreates block insertions which have
;   attributes which reference layer LAY. MODE can be either
;   "delete" or "merge". If merge is used NEWLAY specifies
;   the target layer.
; ----------------------------------------------------------------
 
  (defun acet-lydelmrg-attredef (LAY MODE NEWLAY / FLTR SS CNT EN ILAY ELST DOIT LAYLCK)
    (setq FLTR (list '(0 . "INSERT") '(66 . 1))
          SS   (ssget "_x" FLTR)
          CNT  0
    )
    (while (and ss
                (> (sslength ss) 0)
                (setq EN (ssname SS CNT))
           );and
      (setq ED   (entget EN '("*"))
            ILAY (cdr (assoc 8 ED))
            ELST (list ED)
            DOIT nil
      )
      (while (/= "SEQEND" (cdr (assoc 0 (entget (setq EN (entnext EN))))))
        (setq ED (entget EN '("*")))
        (if (/= LAY (cdr (assoc 8 ED)))
          (setq ELST (cons ED ELST))
          (progn
            (if (= (xstrcase MODE) "MERGE")
              (setq ED   (subst (cons 8 NEWLAY) (assoc 8 ED) ED)
                    ELST (cons ED ELST)
              )
            )
            (setq DOIT T)
          )
        )
      )
 
      (setq ELST (reverse ELST)
            ED   (entget EN '("*"))
      )
 
      (if (< 1 (length ELST))
        (if (or DOIT (= LAY (cdr (assoc 8 ED))))
          (progn
            ;;(entmake nil)
            (entmake)
            (foreach MBR ELST (entmake MBR))
            (entmake (subst (cons 8 ILAY) (assoc 8 ED) ED))
            (entdel (cdr (assoc -1 (car ELST))))
          )
        )
        (progn
          ;;(entmake nil)
          (entmake)
          (entmake (subst (cons 66 0) (assoc 66 (car ELST)) (car ELST)))
          (if (setq LAYLCK (acet-layer-locked (cdr (assoc 8 (car ELST)))))
            (command "_.-layer" "_u" (cdr (assoc 8 (car ELST))) "")
          )
          (entdel (cdr (assoc -1 (car ELST))))
          (if LAYLCK (command "_.-layer" "_lo" (cdr (assoc 8 (car ELST))) ""))
        )
      )
      (setq CNT (1+ CNT))
    )
  )
 
; --------------- GET REFERENCED LAYERS FUNCTION -----------------
;  Returns list of blocks which reference Layer LAY
; ----------------------------------------------------------------
 
  (defun acet-lydelmrg-layinblklst (LAY / BLK NAM EN NAMLST)
 
    (princ "\nQuerying block table  ")
 
    (setq BLK    (tblnext "BLOCK" T))                     ; Get first block definition
    (while BLK                                            ; If there is a block
      (if (= (logand (cdr (assoc 70 BLK)) 32) 0)          ; and it is not xref dependent,
        (progn
          (setq NAM    (cdr (assoc 2 BLK))                ; get the name
                EN     (tblobjname "BLOCK" NAM)           ; and the first entity
          )
          (while EN                                       ; while there is a subentity
            (if (= LAY (cdr (assoc 8 (entget EN))))       ; if the ent is on the layer
              (setq NAMLST (if NAMLST                     ; add the name to the list
                             (append NAMLST (list NAM))
                             (list NAM)
                           )
                    EN     nil                            ; and skip other subentities
              )
              (setq EN (entnext EN))                      ; else get the next subentity
            )
            (acet-spinner)
          )
        )
      )
      (setq BLK (tblnext "BLOCK"))                        ; get the next block
    )
    (prompt "\r                      ")
    (if (/= NAMLST "")
      NAMLST                                              ; return the list of blocks
    )
  )
 
 
; -------------------- LAYOUT LIST FUNCTION ----------------------
;   Returns list of layouts that have viewports that reference
;   the layers in LAYLST via vplayer freeze or by being on the layer.
;   If MODE == "Merge" the layout list will include those layouts
;   with any entities on the layer to be merged.
; ----------------------------------------------------------------
 
  (defun acet-lydelmrg-layoutlist (LAYLST MODE / SS LAYOUTS CNT VP XLST LAYOUTNAME CLAYOUT
                                             LAYOUTLST ADD VPFRZ DEPLAYLST LAYFLTR LAYOUTFLTR
                                   )
  
    (setq LAYOUTS (cons "Model" (layoutlist))            ; Get a list of all the layouts
          LAYOUTS (vl-remove (getvar "ctab") LAYOUTS)    ; except the current one
          LAYOUTFLTR (mapcar '(lambda (X) (cons 410 X)) LAYOUTS)      ; Make a layout filter list
          LAYOUTFLTR (append '((-4 . "<OR")) LAYOUTFLTR '((-4 . "OR>")))
          CNT   0
    )
 
    (setq SS (ssget "_x" (append '((-4 . "<AND"))        ; Get all the viewports in all layouts
                                   '((0 . "VIEWPORT"))   ; except the current one.
                                   LAYOUTFLTR
                                 '((-4 . "AND>"))
                         )
             )
    )
 
    (if (and SS (> (sslength SS) 0))                     ; if there are any
      (progn 
        (while (and
                 LAYOUTS                                 ; while not all layouts have been used
                 (setq VP (ssname SS CNT))               ; step through each viewport
               )
 
          (setq VP         (entget VP '("ACAD"))         ; get the viewport's edata
                LAYOUTNAME (cdr (assoc 410 VP))          ; get the viewport's layout
                XLST       (cdadr (assoc -3 VP))         ; get the xdata list
          )
 
          (if (member (cdr (assoc 8 VP)) LAYLST)         ; if the vp is on the layer
            (setq ADD   T                                ; earmark the layout to be added
                  VPFRZ T                                ; and increment the vpfrz counter
            )
          )
 
          (if (not ADD)                                  ; If the layout has not been earmarked
            (progn
              (setq DEPLAYLST (acet-list-m-assoc 1003 XLST) ; Find all the dependant layers
                    DEPLAYLST (mapcar 'cdr DEPLAYLST)       ; and get their names
              )
              (while DEPLAYLST                       ; while the dependant name list exists,
                (if (member (car DEPLAYLST) LAYLST)  ; if the first member is in LAYLST
                  (setq ADD       T
                        DEPLAYLST nil                ; Stop processing this viewport
                  )
                  (setq DEPLAYLST (cdr DEPLAYLST))   ; remove the first item of the dependant list
                )
              )
            )
          )
          (if (and ADD (not (member LAYOUTNAME LAYOUTLST))) ; If the layout has not already been added
            (setq LAYOUTLST (cons LAYOUTNAME LAYOUTLST)     ; Add it to the list,
                  LAYOUTS   (vl-remove LAYOUTNAME LAYOUTS)  ; remove it from the master list,
                  ADD       nil                             ; and reset the ADD flag
            )
            (setq ADD nil)                                  ; otherwise just reset the ADD flag
          )
          (setq CNT (1+ CNT))
        )
      )
    )
 
    (if (= (xstrcase MODE) "DELETE")
      (setq CLAYOUT (vla-get-activedocument (vlax-get-acad-object))
            CLAYOUT (vla-get-name (vla-get-layout (vla-get-paperspace CLAYOUT)))
            LAYOUTS (vl-remove CLAYOUT LAYOUTS)
      )
    )
 
    (if LAYOUTS
      (progn
        (setq LAYFLTR (mapcar '(lambda (X) (cons 8 X)) LAYLST)         ; Make a layer filter list
              LAYFLTR (append '((-4 . "<OR")) LAYFLTR '((-4 . "OR>")))
        )
        (foreach LAYOUT LAYOUTS
          (if (ssget "_x" (append
                            '((-4 . "<AND"))
                              (list (cons 410 LAYOUT))
                              LAYFLTR
                            '((-4 . "AND>"))
                          )
              )
            (setq LAYOUTLST (cons LAYOUT LAYOUTLST))                   ; Add the layout to the list
          )
        )
      )
    )
    (if LAYOUTLST (setq LAYOUTLST (cons VPFRZ LAYOUTLST)))
  )
 
 
; ----------------- VIEWPORT CHECKING FUNCTION -------------------
;   This function will check for viewports being referenced by
;   any layer in LAYLST. If it finds any it will clear the
;   references via VPLAYER. If tilemode is 1 and referenced
;   viewports exist, The user is asked permission to switch tilemode.
;   Returns T if no viewports exist.
;   Returns nil if vp exist but user does not want to switch tilemode.
;   Else returns active viewport number.
; ----------------------------------------------------------------
 
  (defun acet-lydelmrg-vpcheck (LAYLST MODE / LAYOUTLST VPON PASS CLAYOUT CVPORT)
 
    (setq LAYOUTLST (acet-lydelmrg-layoutlist LAYLST MODE))
 
    (if LAYOUTLST                                        ; If layers are being referenced
      (if (= (logand (getvar "cmdactive") 4) 4)          ; if a script is active
        (setq PASS "Yes")                                ; skip the questions
        (progn
          (setq VPON      (car LAYOUTLST)                ; retrieve the VP on layer flag
                LAYOUTLST (cdr LAYOUTLST)
          )
          (cond
            ((< 1 (length LAYOUTLST))                    ; More than one layout with vpfreeze referenced layer(s)
              (terpri)
              (prompt (acet-str-format "\nThere are %1 other layouts that reference one or more of the selected layers."  (length LAYOUTLST)))
              (prompt "\nIn order for this command to continue these layouts will need to be set current.")
            )
            ((and
               (/= (getvar "ctab") (car LAYOUTLST))      ; One layout that is not the current layout
               (= 1 (length LAYOUTLST))                  ; with vpfreeze referenced layer(s)
             )
              (terpri)
              (prompt "\nThere is one other layout that references one or more of the selected layers.")
              (prompt "\nIn order for this command to continue this layout will need to be set current." )
            )
          )
 
          (if (and VPON (= (xstrcase MODE) "DELETE"))
            (progn
              (terpri)
              (prompt "\nThere are one or more paperspace viewports that are on one of the")
              (prompt "\nselected layers. THESE VIEWPORTS WILL BE DELETED.")
            )
          )
 
          (textscr)
          (terpri)
          (initget "Yes No _Yes No")
 
          (setq PASS (getkword "\nDo you wish to continue? [Yes/No] <No>:")
                PASS (if PASS PASS "No")
          )
 
        )
      )
    )
    
    (cond
      ((= PASS "Yes")                                                    ; If layout switching is needed
        (setq LAYOUTLST (cons (getvar "ctab") LAYOUTLST))                ; add the current layout to the list
      )
      ((= PASS "No")                                                     ; If cancel is desired
        (setq LAYOUTLST nil)                                             ; return nil
      )
      (T
        (setq LAYOUTLST (list (getvar "ctab")))                          ; otherwise just return the current layout
      )
    )
    LAYOUTLST
  )
 
; ----------------------------------------------------------------
;                          MAIN PROGRAM
; ----------------------------------------------------------------
 
  (acet-error-init
    (list
      (list "cmdecho" 0
            "cecolor" "bylayer"
            "pickstyle" 0
 
      )
      T     ;flag. True means use undo for error clean up.
      '(if (and (= (xstrcase MODE) "MERGE") LAYLST)
         (foreach LAY LAYLST
           (setq SS  (ssget "_x" (list (cons 8 LAY)))
                 CNT 0
           )
           (while (and ss
                       (> (sslength ss) 0)
                       (setq EN (ssname SS CNT))
                  );and
             (redraw EN 4)
             (setq CNT (1+ CNT))
           )
         )
       )
    );list
  );acet-error-init
 
 
  (setq ANS  "START"
        LOOP T
        CLAY (getvar "clayer")
  )
 
  (command "_.undo" "_m")
  (while LOOP
    (cond
      ((not ANS)
        (setq LOOP nil)
      )
      ((listp ANS)
        (setq LAY (cdr (assoc 8 (entget (car ANS)))))
      )
      ((= ANS "Type-it")
        (setq LAY (getstring "\nEnter layer name or [?]: " T))
        (cond
          ((= LAY "")
            (setq ANS nil
                  LAY nil
            )
          )
          ((= LAY "?")
            (setq STR (getstring "\nEnter layer name(s) to list <*>:"))
            (textscr)
            (setvar "qaflags" 2)
            (command "_.layer" "?" STR)
            (while (< 0 (getvar "cmdactive")) (command ""))
            (setvar "qaflags" 0)
            (setq LAY nil)
          )
          ((setq LAY (tblobjname "LAYER" LAY))
            (setq LAY (cdr (assoc 2 (entget LAY)))     ; get its real name
                  ANS T
            )
          )
          (T
            (prompt "\nInvalid Layer name.")
            (setq LAY nil)
          )
        )
      )
      ((= ANS "Undo")
        (if LAYLST
          (progn
            (if (= (xstrcase MODE) "DELETE")
              (command "_.undo" "1")
            )
            (if (= (xstrcase MODE) "MERGE")
              (progn
                (setq SS  (ssget "_x" (list (cons 8 (car LAYLST))))
                      CNT 0
                )
                (while (and ss
                            (> (sslength ss) 0)
                            (setq EN (ssname SS CNT))
                       );and
                  (redraw EN 4)
                  (setq CNT (1+ CNT))
                )
              )
            )
            (setq LAYLST (cdr LAYLST))
          )
          (prompt "\nEverything has been undone.")
        )
      )
    )
 
    (if LAY
      (cond
        ((= LAY "0")
          (if (= (xstrcase MODE) "DELETE")
            (prompt "\nCannot delete layer 0.")
            (prompt "\nCannot merge layer 0.")
          )
        )
        ((= LAY "DEFPOINTS")
          (if (= (xstrcase MODE) "DELETE")
            (prompt "\nCannot delete layer DEFPOINTS.")
            (prompt "\nCannot merge layer DEFPOINTS.")
          )
        )
        ((wcmatch LAY "*|*")
          (if (= (xstrcase MODE) "DELETE")
            (prompt (acet-str-format "\nLayer %1 is externally dependent and cannot be deleted." LAY))
            (prompt (acet-str-format "\nLayer %1 is externally dependent and cannot be merged." LAY))
          ) ;if
        )
        ((and
           (= LAY CLAY)
           (= (xstrcase MODE) "DELETE")
         )
          (prompt "\nCannot delete current layer.")
        )
        ((acet-layer-locked LAY)
          (if (= (xstrcase MODE) "DELETE")
            (prompt (acet-str-format "\nLayer %1 is locked and cannot be deleted." LAY))
            (prompt (acet-str-format "\nLayer %1 is locked and cannot be merged." LAY))
          ) ;if
        )
        ((not (member LAY LAYLST))
          (setq LAYLST (if LAYLST
                         (append (list LAY) LAYLST)
                         (list LAY)
                       )
          )
          (if (= (xstrcase MODE) "DELETE")
            (command "_.-layer" "_f" LAY "")
          )
          (if (= (xstrcase MODE) "MERGE")
            (progn
              (setq SS  (ssget "_x" (list (cons 8 LAY)))
                    CNT 0
              )
              (while (and ss
                          (> (sslength ss) 0)
                          (setq EN (ssname SS CNT))
                     );and
                (redraw EN 3)
                (setq CNT (1+ CNT))
              )
            )
          )
        )
      )
    )
 
    (if (and LOOP (/= ANS "Type-it"))
      (progn
        (setvar "errno" 7)
        (setq LAY nil)
        (while (= (getvar "errno") 7)
          (setvar "errno" 0)
          (initget "Type-it Undo _Type-it Undo")
          (if LAYLST
            (progn
              (setq LAYSTR "")
              (foreach VAL LAYLST (setq LAYSTR (strcat LAYSTR VAL ",")))
              (setq LAYSTR (substr LAYSTR 1 (1- (strlen LAYSTR))))
              (prompt (acet-str-format "\nSelected layers: %1" LAYSTR))
              (if (= (xstrcase MODE) "DELETE")
                (setq ANS  (entsel "\nSelect object on layer to delete or [Type-it/Undo] <done>: "))
                (setq ANS  (entsel "\nSelect object on layer to merge or [Type-it/Undo] <done>: "))
              )
            )
            (if (= (xstrcase MODE) "DELETE")
              (setq ANS  (entsel "\nSelect object on layer to delete or [Type-it/Undo]: "))
              (setq ANS  (entsel "\nSelect object on layer to merge or [Type-it/Undo]: "))
            )
          )
          (if (= (getvar "errno") 7)
            (prompt "\nNothing selected.")
          )
        )
      )
    )
  ); while LOOP
 
 
  (if LAYLST
    (progn
 
; ----------------------- build BLKLST ---------------------------
; BLKLST has the form: (("blk1" "lay1") ("blk2" "lay1" "lay2")...)
; ----------------------------------------------------------------
 
      (foreach LAY LAYLST                                ; Check each layer selected
        (setq LST (acet-lydelmrg-layinblklst LAY))       ; if it is referenced in a block
        (if (and LST (not BLKLST))                       ; if so and no BLKLST
          (setq BLKLST                                   ; build BLK LST
            (mapcar '(lambda (x)
                      (list x LAY)
                    )
                    LST
            )
          )
          (foreach BLK LST                               ; else go through each referenced block
            (if (setq VAL (assoc BLK BLKLST))                           ; if the block already is in BLKLST
              (setq BLKLST (subst (append VAL (list LAY)) VAL BLKLST))  ; update the entry to include layer
              (setq BLKLST (append BLKLST (list (list BLK LAY))))       ; else make a new entry
            )
          )
        )
      )
 
      (cond
 
; ------------------------ Layer Delete --------------------------
 
        ((= (xstrcase MODE) "DELETE")
          (prompt "\n******** WARNING ********")
          (if BLKLST
            (progn
              (textscr)
              (terpri)
              (terpri)
              (prompt (acet-str-format "\nThere are %1 block definition(s) which reference the layer(s) you are deleting."
                        (rtos (length BLKLST) 2 0)
                      ))
              (prompt (strcat "\nThe block(s) will be redefined and the entities referencing the layer(s)\nwill be removed from the block definition(s)."))
            )
          )
          (terpri)
          (if (= (length LAYLST) 1)
            (prompt (acet-str-format "\nYou are about to permanently delete layer %1 from this drawing."  (car LAYLST)))
            (progn
              (textscr)
              (prompt "\nYou are about to permanently delete the following layers from this drawing:\n")
              (foreach LAY LAYLST
                (prompt (strcat "\n" LAY))
              )
              (terpri)
            )
          )
          (initget "Yes No _Yes No")
          (setq PASS (getkword "\nDo you wish to continue? [Yes/No] <No>:"))
          (setq PASS (if (null PASS) "No" PASS)) ;setq
 
          (if (and
                (= PASS "Yes")
                (setq LAYOUTLST (acet-lydelmrg-vpcheck LAYLST MODE))
              )
 
            (progn
              (setq FLTR (mapcar '(lambda (X) (cons 8 X)) LAYLST)         ; Make a layer filter list
                    FLTR (append '((-4 . "<OR")) FLTR '((-4 . "OR>")))
              )
 
              (if BLKLST                               ; Clean up block table
                (foreach BLK BLKLST                    ; by going through each block in BLKLST
                  (acet-lydelmrg-blkredef (car BLK) (cdr BLK) MODE NEWLAY) ; and removing the referencing entities
                )
              )
 
 
              (progn
                (setq CLAYOUT (getvar "ctab")
                      CVPORT (getvar "cvport")
                )
                (foreach LAYOUT LAYOUTLST
                  (setvar "ctab" LAYOUT)
                  (if (/= LAYOUT "Model")
                    (progn
                      (command "_.pspace")
                      (command "_.vplayer" "_t" LAYSTR "_a" "" )
                    )
                  )
                  (if (setq SS  (ssget "_x" FLTR))
                    (command "_.erase" SS "")
                  )
                )
                (setvar "ctab" CLAYOUT)
 
                (if (and (/= CLAYOUT "Model")
                         (< 1 CVPORT)
                         (ssget "_x" '((0 . "VIEWPORT")))
                    )
                  (command "_.mspace")
                )
              )
 
              (if (setq SS  (ssget "_x" FLTR))
                (progn
                  (setq CNT 0)
                  (while (and ss
                              (> (sslength ss) 0)
                              (setq EN (ssname SS CNT))
                         );and
                    (entdel EN)
                    (setq CNT (1+ CNT))
                  )
                )
              )
 
              (foreach LAY LAYLST
                (acet-lydelmrg-attredef LAY MODE NEWLAY)             ; Recreate inserts which reference LAY
                (terpri)
              )
              
              (if (bns_tbl_match "block" '((2 . "`*D*")))
                  (acet-safe-command T T
                    (list "_.purge" "_block" "`*D*" "_n")            ; Purge all anonymous dim blocks
                  )
              );if
 
              (acet-safe-command T T (list "_.purge" "_layer" LAYSTR "_n"))  ; Purge all the layers
 
              (foreach LAY LAYLST
                (if (tblobjname "LAYER" LAY)
                    (setq NOPURGE_LST (append NOPURGE_LST (list LAY)))
                )
              )
 
              (if NOPURGE_LST
                (progn
                  (if (< 1 (length NOPURGE_LST))
                    (progn
                      (setq LAYSTR "\n")
                      (foreach VAL NOPURGE_LST (setq LAYSTR (strcat LAYSTR VAL "\n")))
                      (setq ALERT_STRING
                        (acet-str-format "The following Layers could not be purged because they\nare being referenced by some object(s) in the drawing:\n%1"
                          LAYSTR
                        )
                      )
                    )
                    (setq ALERT_STRING
                      (acet-str-format "Layer %1 could not be purged because\nit is being referenced by some object(s) in the drawing."
                        (car NOPURGE_LST)
                      )
                    )
                  )
                  (acet-alert ALERT_STRING)
                )
              )
            )
            (progn
              (prompt "\nOperation aborted.")
              (command "_.undo" "_b")
            )
          )
        )
 
; ------------------------- Layer Merge --------------------------
 
        ((= (xstrcase MODE) "MERGE")
 
          (setq ANS  T
                LOOP T
          )
 
          (while LOOP
            (cond
              ((not ANS)
                (setq LOOP nil)
              )
              ((listp ANS)
                (setq NEWLAY  (cdr (assoc 8 (entget (car ANS))))
                      LOOP nil
                )
              )
              ((= ANS "Type-it")
                (setq NEWLAY (getstring "\nEnter layer name or [?]: " T))
                (cond
                  ((= NEWLAY "")
                    (setq ANS    nil
                          NEWLAY nil
                    )
                  )
                  ((= NEWLAY "?")
                    (setq STR (getstring "\nEnter layer name(s) to list <*>:"))
                    (textscr)
                    (setvar "qaflags" 2)
                    (command "_.layer" "?" STR)
                    (while (< 0 (getvar "cmdactive")) (command ""))
                    (setvar "qaflags" 0)
                  )
                  ((setq NEWLAY (tblobjname "LAYER" NEWLAY))
                    (setq NEWLAY (cdr (assoc 2 (entget NEWLAY)))     ; get its real name
                          LOOP   nil
                    )
                  )
                  (T
                    (prompt "\nInvalid Layer name.")
                    (setq NEWLAY nil)
                  )
                )
              )
            )
 
            (if (and NEWLAY (not LOOP))
              (cond
                ((member NEWLAY LAYLST)
                  (prompt "\nCannot merge a layer with itself.")
                  (setq LOOP T)
                )
                ((wcmatch NEWLAY "*|*")
                  (prompt (acet-str-format "\nLayer %1 is externally dependent and cannot be used."  NEWLAY ))
                  (setq LOOP T)
                )
              )
            )
 
            (if (and LOOP (/= ANS "Type-it"))
              (progn
                (setvar "errno" 7)
                (terpri)
                (while (= (getvar "errno") 7)
                  (setvar "errno" 0)
                  (initget "Type-it _Type-it")
                  (setq ANS  (entsel "\rSelect object on target layer or [Type-it]: "))
                  (if (= (getvar "errno") 7)
                    (prompt "\nNothing selected.")
                  )
                )
              )
            )
          ); while LOOP
 
          (if NEWLAY
            (progn
              (terpri)
              (prompt "\n******** WARNING ********")
              (if BLKLST
                (progn
                  (textscr)
                  (terpri)
                  (prompt (acet-str-format "\nThere are %1 block definition(s) which reference the layer(s) you are deleting."
                            (rtos (length BLKLST) 2 0)
                           )
                  )
                  (prompt (acet-str-format "\nThe block(s) will be redefined and the entities referencing\nthe layer(s) will be changed to reference layer %1." NEWLAY))
                )
              )
              (terpri)
 
              (if (= (length LAYLST) 1)
                (prompt (acet-str-format "\nYou are about to permanently merge layer %1 into layer %2." (car LAYLST) NEWLAY))
                (progn
                  (textscr)
                  (prompt (acet-str-format "\nYou are about to permanently merge the following layers into layer %1:\n"  NEWLAY ))
                  (foreach LAY LAYLST
                    (prompt (strcat "\n" LAY))
                  )
                  (terpri)
                )
              )
              (initget "Yes No _Yes No")
              (setq PASS (getkword "\nDo you wish to continue? [Yes/No] <No>:"))
              (setq PASS (if (null PASS) "No" PASS))
              (graphscr)
 
              (if (and
                (= PASS "Yes")
                (setq LAYOUTLST (acet-lydelmrg-vpcheck LAYLST MODE))
              )
                (progn
 
                  (if BLKLST
                    (foreach BLK BLKLST
                      (acet-lydelmrg-blkredef (car BLK) (cdr BLK) MODE NEWLAY)
                    )
                  )
 
                  (if (member CLAY LAYLST)
                      (setvar "clayer" NEWLAY)
                  )
 
                  (setq CLAYOUT (getvar "ctab")
                        CVPORT (getvar "cvport")
                  )
 
                  (foreach LAYOUT LAYOUTLST
                    (setvar "ctab" LAYOUT)
                    
                    (if (/= LAYOUT "Model")
                      (progn
                        (command "_.pspace")
                        (command "_.vplayer" "_t" LAYSTR "_a" "" )
                      )
                    )
 
                    (foreach LAY LAYLST
                      (terpri)
                      (princ (acet-str-format "\nMerging layer %1 into layer %2." LAY NEWLAY))
 
                      (setq FLTR (list '(-4 . "<AND") (cons 8 LAY) (cons 410 LAYOUT) '(-4 . "AND>")))
 
                      (if (setq SS (ssget "_x" FLTR))
                        (command "_.chprop" SS "" "_layer" NEWLAY "")
                      )
 
                      (if (setq SS (ssget "_x" FLTR))
                        (progn
                          (setq CNT 0)
                          (while (and ss
                                      (> (sslength ss) 0)
                                      (setq EN (ssname SS CNT))
                                 );and
                            (setq EN (entget EN '("*"))
                                  EN (subst (cons 8 NEWLAY) (assoc 8 EN) EN)
                            )
                            (entmod EN)
                            (setq CNT (1+ CNT))
                          )
                        )
                      )
                    )
                    (setvar "ctab" CLAYOUT)
 
                    (if (and (/= CLAYOUT "Model")
                             (< 1 CVPORT)
                             (ssget "_x" '((0 . "VIEWPORT")))
                        )
                      (command "_.mspace")
                    )
                  )
 
                  (foreach LAY LAYLST
                    (acet-lydelmrg-attredef LAY MODE NEWLAY)             ; Recreate inserts which reference LAY
                    (prompt (acet-str-format "\nAll entities which were on layer %1 have been moved to layer %2." LAY NEWLAY))
                  )
                  (terpri)
                  (terpri)
                  (acet-safe-command T T (list "_.purge" "_layer" LAYSTR "_n"))
                  (foreach LAY LAYLST
                    (if (tblobjname "LAYER" LAY)
                      (setq NOPURGE_LST (append NOPURGE_LST (list LAY)))
                    )
                  )
                  (if NOPURGE_LST
                    (progn
                      (if (< 1 (length NOPURGE_LST))
                        (progn
                          (setq LAYSTR "\n")
                          (foreach VAL NOPURGE_LST (setq LAYSTR (strcat LAYSTR VAL "\n")))
                          (setq ALERT_STRING
                            (acet-str-format "The following Layers could not be purged because they\nare being referenced by some object(s) in the drawing:\n%1"
                                  LAYSTR
                            )
                          )
                        )
                        (setq ALERT_STRING
                          (acet-str-format "Layer %1 could not be purged because\nit is being referenced by some object(s) in the drawing."
                            (car NOPURGE_LST) )
                        )
                      )
                      (acet-alert ALERT_STRING)
                    )
                  )
 
                )
 
                (progn
                  (prompt "\nOperation aborted.")
                  (foreach LAY LAYLST
                    (setq SS  (ssget "_x" (list (cons 8 LAY)))
                          CNT 0
                    )
                    (while (and ss
                                (> (sslength ss) 0)
                                (setq EN (ssname SS CNT))
                           );and
                      (redraw EN 4)
                      (setq CNT (1+ CNT))
                    )
                  )
                )
              )
            )
            (progn
              (prompt "\nOperation aborted.")
              (foreach LAY LAYLST
                (setq SS  (ssget "_x" (list (cons 8 LAY)))
                      CNT 0
                )
                (while (and ss
                            (> (sslength ss) 0)
                            (setq EN (ssname SS CNT))
                       );and
                  (redraw EN 4)
                  (setq CNT (1+ CNT))
                )
              )
            )
          )
        )
      )
    )
    (setvar "clayer" CLAY)
  )
 
 
  (acet-error-restore)                                  ; Retsore values
  (princ)
)


(princ)