Move all objects within a layer to specific layer

[pavilon]

I have this lisp (I cannot remember the coder!) which is moving all objects within a layer to destination layer by selection on drawing, then change property and merge empty layers. It is working fine but according to my need, I don't want command line prompt for layer naming and I want to move in into pre-defined layer of "DOORS".

 

 

Also is that possible of multiple selection instead of one?

 

much appreciated.

MOVOBJS.lsp

[iconeo]

Why not use laymrg command in a macro?

[pavilon]

it is going to be part of a DCL form and there are other command line prompt with laymrg.

[BIGAL]

Here is a multi pick version check the extra while after the Alert

 

(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") 
)

[pavilon]

Thanks Bigal for modification. Multi selection is now working(I debug it a little error) but still I get user prompt to confirm the layer naming and...as below:

 

Command: MOVOBJS

Move Entire Layer

Enter destination layer : -

DOORS not in drawing base, create this layer? [Yes/No] : yes

Invalid option keyword. >

Enter an option ?>

[?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck

/Unlock/stAte/Description/rEconcile]: *Cancel* -

Command: MOVOBJS Move Entire Layer

Enter destination layer :

Select an object:

1 object(s) on layer Layer3 moved to layer DOORS.

Select an object:

1 object(s) on layer Layer1 moved to layer DOORS.

 

 

Purge surprisingly is not working.

 

Attached is the new version.

Many thanks

MOVOBJS.lsp

[pavilon]

I have this lisp which is working fine with single selection. How can I modify this to move entire layer by selecting one item to destination layer?

 

Many thanks

MOVOBJS2.lsp

[BIGAL]

One suggestion after loading is rather than type movobjs you type (movobjs "Doors") the code can then have the hard coding of the layer "DOORS" removed and rather the routine then becomes more generic with any layer name being destination name.

 

Suggestion 2 it is probably better to write a little defun that is the check for missing layer the nice thing is that you can put this in a library of lisps and call as required from any program. (chklay "doors" 3 "continuous")

 

; 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

[pavilon]

Sorry mate but got "error: too few arguments" and trying to resolve it. Thanks