求助改进

MRHDF

我有一个这样的程序：把选择的物体修改到当前图层。恳请大家帮忙改进下，希望可以把选择的那些物体所在的层内的所有对象都修改到当前层。就是把整层的都西都修改到当前层，如果能把那些非0层的图块也一起修改到当前层就更好了。
(defun c:ca  (/ gp) (setq gp (ssget)) (setq layer (getvar "clayer")) (command "change" gp "" "p" "la" layer ""))

MRHDF

或者给一个删除图层的命令，如果图层又对象就移动到当前层后在删除图层。

MRHDF

The awesome Express Tool LAYDEL will come to your rescue.  Of course you've installed the Express Tools - you'll find Delete Layer under the Layer sub-menu of the Express Tools.  This command does not care what is on the layer - it is happy to vanish it into oblivion.  Even if that layer is referenced in a block definition, LAYDEL is smart enough to open that block definition, remove the layer from the block, and then delete the layer - now that is power!  But remember...where there is power - there is Danger!  So be careful what you ask for...Since the layer doesn't have to be empty to be removed with LAYDEL - your drawing could definitely incur some damage if you aren't paying attention.

So there's your Quick Tip - Don't forget you can all sign up for Autodesk University on Tuesday - get your credit cards ready!  The Early Bird gets the best classes...for sure!  (a little California speak for you there)

搜索到一个这样的文章 可是我去找这个人说的  laydel 却找不到  郁闷阿

xiaoquansb

你把你要动的图元选择到一个集合里，在把它门代表层的群码改掉就成拉

要删除图层，在你把所有图元放到其他层后，直接PU掉就是了

MRHDF

找到了这个图层合并的et工具 ，要装2006才行。能提取得简单一些么   ？
;;
;;;
;;;    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 CAYDEL ()
  (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 CAYMRG ()
  (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)

willsnow1982

我自己写的一个小工具。

似乎能完成你说的那个功能。

尚在改进中。你先用着吧。

 

 

(defun C:gcc()
  (setvar "cmdecho" 0)
  (initget "1 2 3")
  (princ "\n请选择要改变图层的地物:")
  (setq key (getkword "\n1:手动选择\\2:通过块名自动选择\\3:通过图层自动选择<回车为..1..>:"))
  (cond
    ((not key) (sxc))
    ((= key "1") (sxc))
    ((= key "2") (mxc))
    ((= key "3") (cxc))
    );cond
  );defun
(defun sxc()
  (setq mm (ssget))
  (zhc)
  );defun
(defun mxc()
  (setq kml (entsel "\n请指定要转换图层的块<回车手动输入名称>:"))
  (if (/= nil kml)
    (progn
      (setq kmc (entget (nth 0 kml)))
      (setq ssk (cdr (assoc 2 kmc)))
      (setq mm (ssget "x" (list (cons 2 ssk))))
      (zhc)  
    ))
  (if (= nil kml)
    (progn
      (setq zkm (getstring "\n输入要转换块的名称:"))
      (setq mm (ssget "x" (list (cons 2 zkm))))
      (zhc)
    ))
  )
(defun cxc()
  (setq cml (entsel "\n请指定在需要转换图层的地物<回车手动输入名称>:"))
  (if (/= nil cml)
    (progn
      (setq cmc (entget (nth 0 cml)))
      (setq ssk (cdr (assoc 8 cmc)))
      (setq mm (ssget "x" (list (cons 8 ssk))))
      (zhc)  
    ))
  (if (= nil cml)
    (progn
      (setq tcm (getstring "\n输入要转换图层的层名:"))
      (setq mm (ssget "x" (list (cons 8 tcm))))
      (zhc)
    ))
  )
(defun zhc()
  (setq cm (getstring "\n请输入转换后的层名:"))
  (if (not (tblsearch "layer" cm))
    (command "layer" "m" cm "")
    )
  (command "change" mm "" "p" "la" cm "")
  (princ "\n处理完成!")
  (princ)
  )