Change Objects Layer by List

[freedomonek]

Hello,
I'm working on a routine that will change objects on a particular layer to another layer.

I decided to do this with a list which I can expand in the future. My intentions are to capture all object on layer indicated by the 1st item in the list below and change their layer to the 2nd item in the list, then iterate thru every item in the list.

It somewhat works, but with a major problem:
It changes everything to "G-anno-Dims", instead of changing only the objects on layer within the list.


Here's the

;;; Changes all drawing objects (even blocks and nested blocks) on
;;; specified valid layers in first dotted-pair to layer in 2nd

(setq lnamelst '(("G-DIM" . "G-ANNO-DIMS")
                 ("G-NOTE" . "G-ANNO-NOTE")
                 ("G-NOTE2" . "G-ANNO-NOTE")
                 ("G-TITL" . "G-ANNO-TITLE")
                 ); Add to Layer list above
) ;_ end of setq
;for testing 
;(foreach each lnamelst (princ (car each)(terpri)))

(vl-load-com)
(setq listLength (length lnamelst))

(foreach each lnamelst				   ;Outer Loop
  (setq acdoc (vla-get-activeDocument (vlax-get-acad-object)))
  (if (snvalid (car each))
    (progn
      (or (tblsearch "LAYER" (car each))
	  (vla-add (vla-get-Layers acdoc) (car each))
      )
      (vlax-for	blk (vla-get-Blocks acdoc)
	(vlax-for obj blk
	  (vla-put-Layer obj (cdr each))

	);end Vlax-for
      );end Vlax-for
    );end Progn
    (princ "\nInvalid layer name. Try Again")
  );end if
);end foreach

(note: part of the code was barrowed from Lions60)
____________________________________________

I initially started this with just the layer propety, but I get a duplication error if the layer already exists on the 2nd dotted pair layer.
Works great otherwise.

Snippet:

	(foreach m lnamelst	
		(progn
		(setq LayerSearch (tblsearch "LAYER" (car m)))
			(if (/= LayerSearch nil) 
				(vla-put-Name (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 			 	(car m) ) (cdr m) ); Old-New Layer
			)

		)
	)

______________________________________

I would appreciate your help very much!

Thanks!

[T.Willey]

A better way would be to step through all the blocks like you are, but check the current layer of the object against the layer name list, if it is there then change it to the second item.

(vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vlax-for i blk
        (if (setq tempList (assoc (vla-get-Layer i) LayNameList))
            (vla-put-Layer i (cdr tempList))
        )
    )
)

If you need to make sure the new layer exists in the drawing, then I would do it before this portion of code. One way would to just make all of them, or you could just step through the layer name list, and if the first one exists then create the second one.

[freedomonek]

Thanks Tim,
It works-like-a-charm!
I have another routine that runs prior to this one, which it will setup the new layers with propeties.

Here's the full code in case others care to modify for their use.

;;; Changes all drawing objects (even blocks and nested blocks) on
;;; specified valid layers in first dotted-pair to layer in 2nd

(setq lnamelst '(("G-DIM" . "G-ANNO-DIMS")
                 ("G-NOTE" . "G-ANNO-NOTE")
                 ("G-NOTE2" . "G-ANNO-NOTE")
                 ("G-TITL" . "G-ANNO-TITLE")
                 ); Add to Layer list above
) ;_ end of setq
;for testing 
;(foreach each lnamelst (princ (car each)(terpri)))


(vl-load-com)
(setq listLength (length lnamelst))

(foreach each lnamelst				   ;Outer Loop
  (setq acdoc (vla-get-activeDocument (vlax-get-acad-object)))
  (if (snvalid (car each))
    (progn
      (or (tblsearch "LAYER" (car each))
	  (vla-add (vla-get-Layers acdoc) (car each))
      )
		(vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    		(vlax-for i blk
      		  (if (setq tempList (assoc (vla-get-Layer i) lnamelst))
       		    (vla-put-Layer i (cdr tempList))
        	   );END IF
    		);END VLAX-FOR
		);END VLAX-FOR
    );end Progn
    (princ "\nInvalid layer name. Try Again")
  );end if
);end foreach

Thanks-a-million!
Kelley

[T.Willey]

I would still code it differently, but if it works for you, then all is good.

You're welcome Kelley.

[freedomonek]

I realize my method is sloppy, a bit.
I suppose there may be a way to handle it through a layer standard.

I plan to eventually have the routine pull the info from an excel file, perhaps from 2 columns, but I do not know how to link data to/from excel. yet.

Do you have an example of how you would address changing objects' layer from a list?

Curious to see other examples.
Thanks!

[T.Willey]

I didn't mean anything about the sloppyness of it, just that you are stepping through the blocks collection per item in your layer name list, when you only need to do it once. On that thinking, this should run faster as you are only stepping through the collection once. This also assumes that the new layers exist in the drawing already.

(setq lnamelst
    '(
        ("G-DIM" . "G-ANNO-DIMS")
        ("G-NOTE" . "G-ANNO-NOTE")
        ("G-NOTE2" . "G-ANNO-NOTE")
        ("G-TITL" . "G-ANNO-TITLE")
    ); Add to Layer list above
)
(vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vlax-for i blk
        (if (setq tempList (assoc (vla-get-Layer i) lnamels))
            (vla-put-Layer i (cdr tempList))
        )
    )
)

This will not change any attributes, so if they are on the offending layers they will not be changed. Just an FYI.

You could also just change the name of the existing layer to the new layer, then you wouldn't need to step through anything. But if the new name already exists, then you would have to do it they you are, or use the command LayMerge. It used to be an express tool routine, but I think it is a built in command in the later versions.

[freedomonek]

I was a little too critical of myself, with my limited knowledge of Visual Lisp.
I didn't know about the LayMrg command.
This really simplifies things for me.

Cool!

Thanks again for the info!

Kelley

[nojunk217]

Hello

I want to refresh this thread because of some reasons:

a) Typo in Code?
I think that the code above lost a "t" in lnamelst - see below.

(setq lnamelst
    '(
        ("G-DIM" . "G-ANNO-DIMS")
        ("G-NOTE" . "G-ANNO-NOTE")
        ("G-NOTE2" . "G-ANNO-NOTE")
        ("G-TITL" . "G-ANNO-TITLE")
    ); Add to Layer list above
)
(vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vlax-for i blk
        (if (setq tempList (assoc (vla-get-Layer i) lnamelst)) ; ATTENTION: THE LAST LETTER T IS MISSING IN THE CODE ABAOVE.
            (vla-put-Layer i (cdr tempList))
        )
    )
)

b) Code for all entities.
Here are so many codes that I lost the track of the differences ..
I use Acad2006, and it is not possible to use the express-tools command "laymrg" in scripts. Now I'm searching a routine which merges ALL entities (Block definitions, attdef, text, Mtext, INSERTS. Attribs, lines, ...) from Layer A to Layer B.

Which of the fragments (or which other solution) is the best one?

Regards

Peter

[freedomonek]

Thanks Peter,
I picked up on the variable earlier. Below is the full code as it works for my situation, which only deals with the layer table.
I'm sure there is a solution to your issue. Just place it in a new Thread and one of the experts will help you or give example code. T.Willey is a great source!

Thanks!
Kelley

  (vl-load-com)
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

(setq lnamelst
    '(
        ("G-DIM" . "G-ANNO-DIMS")
        ("G-NOTE" . "G-ANNO-NOTE")
        ("G-NOTE2" . "G-ANNO-NOTE")
        ("G-TITL" . "G-ANNO-TITLE")
    ); Add to Layer list above
)

(vl-load-com)

(foreach each lnamelst
	(setq LayrTblSearch (tblsearch "LAYER" (cdr each)))				;Search if 2nd Layr Exists
	(if (= LayrTblSearch nil)
		(progn
		(COMMAND "-LAYER" "m" (cdr each) "")
		(princ (strcat "Layer: " (cdr each) " created."))(terpri)
		)
	)

)

(vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vlax-for i blk
        (if (setq tempList (assoc (vla-get-Layer i) lnamelst))
            (vla-put-Layer i (cdr tempList))
        )
    )
)


  (setvar "CMDECHO" usercmd)
  (princ)

[T.Willey]

These codes will not get nested entities, such as attributes of an inserted block or vertexes of an old style polyline, and I'm not sure about entities that make up a table, as I don't use them.