Lisp for moving all objects inc. blocks to another layer in entire dwg spaces.

[Anonymous]

I look for a lisp moving all objects (which are all in the same layer) including those inside blocks in dwg (both model space and all other paper spaces) to another layer (destination layer). Potentially several layers at the same time. For instance, all objects in "Layer01" want to be in "Layer01_New" and all objects in "Layer02" want to be in "Layer02_New" and so on. All layers (original names such as “Layer01”, “Layer02” “…” and destination names such as “Layer01_New”, “Layer02_New”, “…” are all existing. Preferably if the destination names do not exist, it creates those layers. (If this is possible, please let me know how to specify the color and linetype as well when it creates destination layers.) Then, delete the original layers. (Deleting the original layers hopefully will be done with the command below.)

(command "-purge" "la" " Layer01" "n")

(command "-purge" "la" " Layer02" "n")  

Highly appreciated for this solution and help. I would like to describe the process I made and issues I came across below so I can make what I need much more sense and easier to understand.

First I found this topic below.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/move-all-objects-from-one-defined-la...

The lisp mentioned in the middle of topic, which might work fine is below. This one worked fine if objects are in the all different spaces (model space and paper spaces). But did not work for objects inside block and especially when objects with the old layer name did not exist in the drawing (it returned “error” and stopped loading other programs.

(command

"_.chprop"

(setq ss (ssget "_X" '((8 . "GREEN"))))

(repeat (sslength ss)

(setq

   objdata (entget (ssname ss 0))

   objdata (subst '(8 . "PURPLE") '(8 . "GREEN") objdata)

); end setq

(entmod objdata)

(ssdel (ssname ss 0) ss)

); end repeat

)

So, then I tried to look up more and also found the topic below.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/changing-of-block-entity-layers/m-p/...

This lisp below worked perfect with the objects inside blocks. But it did not change the regular objects outside of blocks, which means this works great only for blocks. And not sure if it worked all objects in the all different spaces (model space and paper spaces)

(vl-load-com)

(defun c:demo (/ put-layer)

(defun put-layer (obj old-lay new-lay / layers olay)

(or *adoc (setq *adoc (vla-get-activedocument (vlax-get-acad-object))))

(setq layers (vla-get-layers *adoc))

(if (vl-catch-all-error-p

(vl-catch-all-apply 'vla-item (list layers new-lay))

)

(progn

(vla-add layers new-lay)

(setq layers (vla-get-layers *adoc))

)

)

(if (= (vla-get-Lock (setq olay (vla-item layers old-lay))) :vlax-true)

(progn

(vla-put-Lock olay :vlax-false)

(vla-put-Layer obj new-lay)

(vla-put-Lock olay :vlax-true)

)

(vla-put-Layer obj new-lay)

)

)

(or *adoc (setq *adoc (vla-get-activedocument (vlax-get-acad-object))))

(vlax-for blk (vla-get-blocks *adoc)

(if (and (= (vla-get-IsXref blk) :vlax-false)

(= (vla-get-IsLayout blk) :vlax-false)

)

(vlax-for x blk

(cond ((= (vla-get-Layer x) "1")

(put-layer x "1" "a")

)

((= (vla-get-Layer x) "2")

(put-layer x "2" "b")

)

((= (vla-get-Layer x) "3")

(put-layer x "3" "c")

)

)

)

)

)

(vla-regen *adoc acAllViewports)

(princ)

)

[3wood]

Have you tried command LAYTRANS?

[Kent1Cooper]

LAYMRG?  That will handle things inside Blocks as well as top-level things.  Since it eliminates the source Layer, if you still need Layer01 after everything in it has been put on Layer01_New with LAYMRG, just Make Layer01 again, or for a lot of Layers, Insert a drawing that contains them but has no drawn content..

[Anonymous]

Thank you very much for your comments.

I need lisp routine so it automatically update the layer names when dwgs are opening. But, I do not know how to write this.

Please help solve this.

[Anonymous]

Also, I tried to write lisp using LAYMRG as below.

(command "-laymrg" "N" "PEN0 " "" "N" "PEN1" "y")

Looking at the site below.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/laymrg-fails-in-a-script/td-p/533352...

However, this script asks to select the object with the orignal layer when the orignal (source) layer does not exist in the drawing. If this happens, all other lisp program stopps.

So if there is no original (source) layer exist anymore after many dwgs are updated, this method will not work very well.

I appreciate if you kindly reply. 

[Kent1Cooper]

---

@Anonymous wrote:

Also, I tried to write lisp using LAYMRG as below.

(command "-laymrg" "N" "PEN0 " "" "N" "PEN1" "y")

.... this script asks to select the object with the orignal layer when the orignal (source) layer does not exist in the drawing. .... 

---

You can have it check whether the source Layer exists first:

(if (tblsearch "layer" "PEN0") (command "-laymrg" "N" "PEN0 " "" "N" "PEN1" "y"))

[Anonymous]

hi There, I have an old autoLISP routine, Last edit in 1997: BLK-MGR.lsp

I do NOT have any Autocad installed at the moment, so I can not load it

and Try it out To make sure it is still compatible, with the present Autocad version

If You want I can upload This for You To Look at. see snippet below:

****

;(prompt "\nLoading, BLK-MGR.LSP... ")

;==========================================================================
;Block Manager created by Randy Sanders and Greg Petersen
;==========================================================================

(DEFUN C:BLK (/ CECHO OLDERR)
(setq OLDERR *error*
*error* BLK_ERR
CECHO (getvar "CMDECHO")
)
(setvar "CMDECHO" 1)
(BLKSTART)
(setvar "CMDECHO" CECHO)
(princ)
)

(DEFUN BLKSTART ()
(setq BKM "0=FIX")
(prompt "\nBlock Manager options are: 0=Fix 1=Attribute 2=Count 3=Delete 4=Scale 5=Insert <0=FIX>")
(setq BKM (usekword 0 "0 1 2 3 4 5 Attribute Count Delete Fix Scale Insert" "Enter Block Manager option" BKM))
(cond
((eq BKM "0") (progn (setq BKM "0=FIX") (C:BFX)))
((eq BKM "1") (progn (setq BKM "1=Attribute") (C:BA)))
((eq BKM "2") (progn (setq BKM "2=Count") (C:BC)))
((eq BKM "3") (progn (setq BKM "3=Delete") (C:BD)))
((eq BKM "4") (progn (setq BKM "4=Scale") (C:BS)))
((eq BKM "5") (progn (setq BKM "5=Insert") (C:BI)))
(T
(progn
(setq BKM
(cond
((eq BKM "0") (progn (setq BKM "0=FIX") (C:BFX)))
((eq BKM "1") (progn (setq BKM "1=Attribute") (C:BA)))
((eq BKM "2") (progn (setq BKM "2=Count") (C:BC)))
((eq BKM "3") (progn (setq BKM "3=Delete") (C:BD)))
((eq BKM "4") (progn (setq BKM "4=Scale") (C:BS)))
((eq BKM "5") (progn (setq BKM "5=Insert") (C:BI)))
(T (progn (setq BKM "0=FIX") (C:BFX)))
)
)
)
)
(setvar "CMDECHO" CECHO)
(princ)
)

***

This is just The 1st part. I am NOT sure I can Take This apart without making a complete mess of it.

There were Two of us, and/or even Three of us working on This at various points. This was written for

immediate production problems, when one of our bosses would Insert various Blocks on various Layers

using his black & white Toshiba LapTop, back in the day. (circa 1990 or so or soon Thereafter) I Think it was.

sorry I can not be more useful. if This does not work and There are still remaining dependencies Let me know

I will see if I can find what ever else belongs to This file. we did a LOT of "xref"fing AutoLISP within The same directory

**

Thanks

Randy Sanders

[Anonymous]

Dear Kent1Cooper,

Thank you very much for your tender assistance. I created the lisp below. Could you please make this script creating destination (new) layers if they do not exist in the dwg and specify layer names, colors and linetypes? The issue is when the destination (new) layers do not exist, the script shows the error "Invalid Layer Name" and stopped whole other scripts as well. Your help is higly appreciated.

(defun c:lm ()
(setvar "cmdecho" 0)
(if (tblsearch "layer" "Layer01")
(command "-laymrg" "n" "Layer01" "" "n" "Layer01_New" "y")
)
(if (tblsearch "layer" "Layer02")
(command "-laymrg" "n" "Layer02" "" "n" "Layer02_New" "y")
)
(graphscr)
)

[Kent1Cooper · Accepted solution]

---

@Anonymous wrote:

.... Could you please make this script creating destination (new) layers if they do not exist in the dwg and specify layer names, colors and linetypes? The issue is when the destination (new) layers do not exist, the script shows the error "Invalid Layer Name" and stopped whole other scripts as well. ....

---

You don't need to check whether they exist.  You can just make them, and all at once, and if they already exist, it won't matter [a message will go by that there's a Layer by that name, but it won't interfere with anything].

(defun c:lm ()
(setvar "cmdecho" 0)
(command

  "_.layer"

    "_new" "Layer01,Layer02,Layer03,Layer04" ;;; etc.

    "_color" XYZ "Layer01" "_color" ABC "Layer02,Layer07" ;;; etc.

    "_ltype" "whatever" "Layer01,Layer99" "_ltype" "something" "Layer02" ;;; etc.

    "" ;;; end Layer command

  "-laymrg" "n" "Layer01" "" "n" "Layer01_New" "y"
  "-laymrg" "n" "Layer02" "" "n" "Layer02_New" "y"

); command
(graphscr)
)

Alternatively, use the Make option in Layer, and the Layer will become current, and will be the default for color and linetype [and other] assignments:

....

(command

  "_.layer"

    "_make" "Layer01" "_color" XYZ "" "ltype" "whatever" ""

    "_make" "Layer02" "_color" ABC "" "ltype" "something" ""

...

    "" ;;; end Layer command

....

[Anonymous · Accepted solution]

Dear Kent1Cooper,

Thank you for your answer. And I am so sorry that I could not reply for a long time to your last post because I was away from the office for a while...

Anyway, below is the final solution that I created based on your instruction.

Please let me know if you have any comments.

Best,

(defun c:LM ()

(setvar "cmdecho" 0)

(command

"_.layer"

   "_new" "Layer01_New,Layer02_New" ;;; etc.

   "_color" Color#01 "Layer01_New" "_color" Color#02 "Layer02_New" ;;; etc.

   "_ltype" "LineTypeName01" "Layer01_New" "_ltype" "LineTypeName02" "Layer02_New" ;;; etc.

   "" ;;; end Layer command

); command

(if (tblsearch "layer" "Layer01_Old")

(command "-laymrg" "n" "Layer01_Old" "" "n" "Layer01_New" "y")

)

(if (tblsearch "layer" "Layer02_Old")

(command "-laymrg" "n" " Layer02_Old " "" "n" "Layer02_New" "y")

)

(graphscr)

)