; ** 22-Mar-07 NEHolt created    
(defun c:attr_lay_change ( / oldnam newnam ed en newed flg 
                dcl_id ll nl idx cancel accept x_ot_da_loop cl edd ix
                ben cnt enn slen x_it_da_loop ss)
  ; Change attribute layer assignments of select block instance(s).
  ; Enter the existing LAYER name and the "Move to" LAYER name. Then
  ; pick on the block instances you want to process. Attributes found
  ; on the existing layer name will be moved to the "Move to" layer
  ; name.
  (setq cancel nil)
  (setq accept nil)
  (setq x_it_da_loop 1)
  (setq cl nil)
  
  (if (OR (not GBL_wd_sup)
          (not (setq dcl_fnam (findfile (strcat GBL_wd_sup "wdedlay.dcl")))))
    (progn ; this utility probably not being run with AutoCAD Electrical present.
           ; Just prompt user for the "from" and "move to" layer names.
      (setq oldnam (getstring "\nOld layer name:"))
      (setq newnam (getstring "\nMove to layer name:"))           
    )
  ; ELSE
    (progn ; use the existing AutoCAD Electrical dialog to pick the "from"
           ; and "move to" layer names.
      (while x_it_da_loop
        (setq dcl_id (load_dialog dcl_fnam))
        (if (new_dialog "move_ent_2_new_layer" dcl_id)

          (progn
            ; Fuzz out until something selected
            (mode_tile "lay2_mv_TO" 1)
            (mode_tile "accept" 1)
            (mode_tile "Pk_ent_TO" 1)
            ; Move 'from'
            (start_list "lay2_mv_FRM")
            (setq ll '()
                  nl (tblnext "LAYER" t)
                  idx 0 )
            (while nl
              (if (=(getvar "CLAYER")(cdr(assoc 2 nl)))
                (setq idx (1+ idx)) 
              )
              (setq ll (append ll (list (cdr (assoc 2 nl))))
                    nl (tblnext "LAYER")
                    ll (acad_strlsort ll) )
            )
            (mapcar 'add_list ll)
            (end_list)
            ; Move 'to'
            (start_list "lay2_mv_TO")
            (setq ll '()
                  nl (tblnext "LAYER" t)
                  idx 0 )
            (while nl
              (if (=(getvar "CLAYER")(cdr(assoc 2 nl)))
                (setq idx (1+ idx)) 
              )
              (setq ll (append ll (list (cdr (assoc 2 nl))))
                    nl (tblnext "LAYER")
                    ll (acad_strlsort ll) )
            )
            (mapcar 'add_list ll)
            (end_list)
            (if cl 
              (progn 
                (set_tile "lay2_mv_FRM" (itoa cl))
                (setq oldnam (nth cl ll))
                (mode_tile "lay2_mv_TO" 0)
              ) 
            )
            (action_tile "lay2_mv_FRM" (strcat  
              "(setq oldnam (nth (atoi $value) ll))(setq cl (atoi $value))"
              "(if (= 1 $reason)(progn (mode_tile \"lay2_mv_TO\" 0)(mode_tile \"Pk_ent_TO\" 0)))"))
            (action_tile "lay2_mv_TO" "(setq newnam (nth (atoi $value) ll))(if (= 1 $reason)(mode_tile \"accept\" 0))")

            (action_tile "accept" "(done_dialog)")
            (action_tile "cancel" "(setq cancel 1)(setq oldnam nil)")
    
            (start_dialog)
            (unload_dialog dcl_id)
        ) )
        (cond
          ((and (= cancel 1)(= newnam oldnam))
           (setq x_it_da_loop nil))
          ((and (= cancel 1)(/= newnam oldnam))
           (setq x_it_da_loop nil))
          ((and (= cancel nil)(/= newnam oldnam))
           (setq x_it_da_loop nil))
          ((and (= cancel nil)(= newnam oldnam)); same layer ask again.
           (alert "Layer names must be different"))
        )
      )
  ) )    
  
  (if (AND (/= newnam "")(/= oldnam "")
           (/= newnam nil)(/= oldnam nil)(/= newnam oldnam) )
    (progn
      (setq cnt 0)
      (setq newnam (strcase newnam))
      (setq oldnam (strcase oldnam)) 
      (princ "Select blocks to process:")
      ; limit selection to block inserts
      (setq ss (ssget '((0 . "INSERT")))) 
      (if (/= ss nil)
        (progn ; some stuff selected
          (setq slen (sslength ss))
          (setq ix 0)
          (while (< ix slen)
            (setq ben (ssname ss ix))
            ; Open up this block instance and 
            ; check all attributes.
            (if (AND ben (setq edd (entget ben)) 
                     (= (cdr (assoc 0 edd)) "INSERT"))
              (progn
                (if (setq enn (entnext ben)) 
                  (setq edd (entget enn))
                )
                (while (AND enn 
                            (/= (cdr (assoc 0 edd)) "SEQEND")
                            (/= (cdr (assoc 0 edd)) "INSERT") )
                  (if (= (cdr (assoc 0 edd)) "ATTRIB")
                    (progn ; hit attribute, check layer it's on
                      (if (OR (= (cdr (assoc 8 edd)) oldnam)
                          (= (strcase (cdr (assoc 8 edd))) oldnam)) 
                        (progn ; found a match, change the lay name
                          (setq newed (subst (cons 8 newnam) 
                                             (assoc 8 edd) edd))
                          (entmod newed)                          
                          (setq cnt (1+ cnt))                      
                      ) )
                    )
                  )  
                  (if (setq enn (entnext enn)) 
                    (setq edd (entget enn)) ; keep going
                  )
            ) ) )  
            (setq ix (1+ ix)) ; increment pointer
                              ; for next block in selection set
          ) 
          (setq ss nil) ; release the selection set      
      ) )    
  ) )  
  (if (> cnt 0)
    (princ (strcat "\n" (itoa cnt) " attributes moved from layer " oldnam " --> " newnam))
  ; ELSE
    (princ "none found")
  )  
  (princ)
)