[编程交流] 移动层内的所有对象

(defun c:MOVOBJS ( / a b s )
 (defun *error* (msg) (setvar "cmdecho" 1)
                      (setq a nil b nil s nil)(princ) );end**
 (graphscr)
 (if (not usermel) (setq usermel "DOORS") );if
 (setq a (strcase (getstring (strcat
  "Move Entire Layer \nEnter destination layer <" usermel ">: "))))
 (if (= (strlen a) 0) (setq a usermel) );if
 (if (> (strlen a) 0)
     (progn
      (while (not (tblsearch "layer" a))
       (if (and (> (strlen a) 0) (/= a "Entry") );and
        (progn
         (initget "Yes No")
         (setq b (getkword (strcat "\n" a " not in drawing base, "
                            "create this layer? [Yes/No] <No>: "))) );progn
        (setq a "Entry") );if
       (if (= b "Yes")
           (progn
            (setvar "cmdecho" 0)
            (command ".layer" "n" a "")
            (if (/= (substr (getvar "clayer") 1 2) (substr a 1 2))
                (command ".layer" a "") );if
            (princ (strcat "\nLayer " a " created and frozen. "))
            (setvar "cmdecho" 1) );progn
           (setq a (strcase (getstring (strcat
                     "\n" a " invalid. Enter destination layer: ")))) );if
       (setq b nil) );while
      (setq usermel a) );progn
 );if
 (if (tblsearch "layer" usermel)
  (progn
   (Alert "Pick a object or pick nothing to exit)
   (while (setq a (entget (car (entsel "\nSelect an object: "))))
   (setq s (ssget "x" (list (cons 8 (cdr (assoc 8 a))))))
   (setvar "cmdecho" 0)
   (command ".chprop" s "" "la" usermel "")
   (setvar "cmdecho" 1)
   (princ (strcat "\n" (itoa (sslength s)) " object(s) on layer "
                  (cdr (assoc 8 a)) " moved to layer " usermel ".")) 
) ; while
);progn
                  
 );if
 (setq a nil s nil)(princ)
 (COMMAND "-LAYER" "C" "122" "DOORS" "")
   (vlax-for layout (vla-get-layouts
       (vla-get-ActiveDocument (vlax-get-acad-object))
    )
 
     (if        (/= (vla-get-name layout) "Model")
       (vla-delete layout)
     )
   )
   (command "-purge" "all" "*" "N") 
)

; NOT TESTED
(defun c:MOVOBJS (usermel / a b s )
 (defun *error* (msg) (setvar "cmdecho" 1)
                      (setq a nil b nil s nil)(princ) );end**
 (graphscr)
 (if (= usermel nil) (setq usermel "DOORS") );if
 (setq usermel (strcase usermel))
      (setq laysrch (tblsearch "layer" usermel))
       (if (= laysrch nil)
         (command ".layer" "n" usermel "C" "122" usermel "")
         (princ "layer exists")
        )
        
   (Alert "Pick a object or pick nothing to exit")
   (while (setq a (entget (car (entsel "\nSelect an object: "))))
   (setq s (ssget "x" (list (cons 8 (cdr (assoc 8 a))))))
   (setvar "cmdecho" 0)
   (command ".chprop" s "" "la" usermel "")
   (setvar "cmdecho" 1)
   (princ (strcat "\n" (itoa (sslength s)) " object(s) on layer "
            (cdr (assoc 8 a)) " moved to layer " usermel ".")) 
) ; while
  
   (vlax-for layout (vla-get-layouts
       (vla-get-ActiveDocument (vlax-get-acad-object))
   )
 
   (if        (/= (vla-get-name layout) "Model")
       (vla-delete layout)
   )
   
   (command "-purge" "all" "*" "N") 
   (command "-purge" "all" "*" "N") ; sometimes need 2
) ;defun