Search for a 'word' in layers, select whole layer and merge to new layer

[gadgetjay]

Hi,

 

The below code does what I require manually (select items on multiple layers, then an item on target layer and moves whole layers items to target).

(defun c:lm ()
(if 
	(and 
		(not (prompt "\nSelect objects on layers to merge: "))
		(setq ss (ssget "_:L"))
		(setq sel (car (entsel "\nSelect object on target layer: ")))
     	)
		(progn
			(setq laya (strcase (cdr (assoc 8 (entget sel)))) curlay (strcase (getvar 'CLAYER)) laylst nil)
				(repeat 
					(setq i (sslength ss))
					(setq ent (entget (ssname ss (setq i (1- i)))) lay (strcase (cdr (assoc 8 ent)))
				)
					(if
						(and
							(not (wcmatch lay (strcat laya ",DEFPOINTS," curlay)))
							(not (member lay laylst))
						)
							(setq laylst (cons lay laylst))
					)
			)
     				(if laylst (progn (command "_.-laymrg") (foreach l laylst (command "_N" l)) (command "" "_N" laya "_Y")))
  	 	)
)
(princ)
);END

I'm trying (and failing) to automate this by searching for a *TEXT word in the layers moves those layers (all items on layer) to a new layer.

EG: searches for RED - finds RED on 4 different layers so merges the contents of these layers to a new layer 'colours'.

I can get it to search and find the *Text (probably a more elegant way to do this!) and move the found items but I cannot get it to select the other items on these layers and merge them together.

;search for a word in layers
(defun C:Test ()
(if (not (tblsearch "layer" "Colours")) 
	 (command "_.layer" "t" "Colours" "m" "Colours" "c" "7" "" ""))
(setq str  "RED" )

	(if 
		(setq ss (ssget "_X" (list (cons 0 "*TEXT")(cons 1 (strcat "*" str "*"))(cons 410 (getvar 'ctab)))))
		(repeat (setq i (sslength ss)) (setq d (entget (ssname ss (setq i (1- i)))))
		(entmod (setq d (subst (cons 8 "Colours") (assoc 8 d) d)))); DO THIS - MOVE TO COLOURS LAYER
		(setq str  "BLUE" );DO THAT - CANNOT FIND RED SEARCH BLUE
	)

	(if 
		(setq ss (ssget "_X" (list (cons 0 "*TEXT")(cons 1 (strcat "*" str "*"))(cons 410 (getvar 'ctab)))))
		(repeat (setq i (sslength ss)) (setq d (entget (ssname ss (setq i (1- i)))))
		(entmod (setq d (subst (cons 8 "Colours") (assoc 8 d) d)))); DO THIS - MOVE TO COLOURS LAYER
		(setq str  "GREEN");DO THAT - CANNOT FIND BLUE SEARCH GREEN
	)

	(if 
		(setq ss (ssget "_X" (list (cons 0 "*TEXT")(cons 1 (strcat "*" str "*"))(cons 410 (getvar 'ctab)))))
		(repeat (setq i (sslength ss)) (setq d (entget (ssname ss (setq i (1- i)))))
		(entmod (setq d (subst (cons 8 "Colours") (assoc 8 d) d)))); DO THIS - MOVE TO COLOURS LAYER
		(setq str  "YELLOW" );DO THAT - CANNOT FIND GREEN SEARCH YELLOW
	)

	(if 
		(setq ss (ssget "_X" (list (cons 0 "*TEXT")(cons 1 (strcat "*" str "*"))(cons 410 (getvar 'ctab)))))
		(repeat (setq i (sslength ss)) (setq d (entget (ssname ss (setq i (1- i)))))
		(entmod (setq d (subst (cons 8 "Colours") (assoc 8 d) d)))); DO THIS - MOVE TO COLOURS LAYER
		();DO THAT - CRY!
	)

); End

 

 

 

Edited February 20, 2019 by gadgetjay

[dlanorh]

I don't completely understand what you are trying to do!

 

You are searching text in the drawing that contains the part string  "*RED*" , or searching for text on a layer name that contains the part string "*RED*"?

[BIGAL]

So you have a layer "abc" which has texts "abcRED123" you want all items on that layer changed to "Colours".  I would use a foreach or defun so code is once only and pass a list item for red blue green etc '("red" "green" "blue")

 

This is untested

(setq ss (ssget "_X" (list (cons 0 "*TEXT")(cons 1 (strcat "*" str "*"))(cons 410 (getvar 'ctab)))))        
(repeat (setq i (sslength ss)) (setq d (entget (ssname ss (setq i (1- i)))))        
(setq ss2 (ssget "x" (list (cons 8 (assoc 8 d)))))        
(entmod (subst (cons 8 "Colours") (assoc 8 d) ss2))); DO THIS - MOVE TO COLOURS LAYER        
(setq str  "YELLOW" );DO THAT - CANNOT FIND GREEN SEARCH YELLOW
	

Edited February 21, 2019 by BIGAL

[gadgetjay]

Hi,

I was getting an error with the above code but I guess it was because of my explanation..

 

The layer names are all numbers 01,02,03,etc. There is no order to what these layers include so I'm trying to get a bit of order to the drawing by correctly naming the layers.

There would be numerous layers with *TEXT on but I know there are only a few layers will have unique word (e.g . 'RED' ) amongst the *TEXT.

'RED' maybe on 4 layers so I need to find this word and move the complete contents of those layers to a new 'colours' layer.

layer 01 - has text: yellow, RED, blue, green,...

layer 02 - has text: banana, apple, pear, grape,...

layer 03 - has text: gold, silver, orange, RED,...

layer 04 - has text: yellow, pink, RED, blue,...

layer 05 - has text: dog, cat, lion,...

 

As RED is on layers 01,03,04 - all the contents of these layers (red, blue orange etc. ) is place on new layer 'Colours'

If it didn't find RED it tries another unique word (eg BLUE).

 

Hope that makes more sense!

 

 

[dlanorh]

Try this quicky:

 

The colour name must be words. You should alter the highlighted list for any colour names you want to add or delete

 

(defun c:LM ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst)

	(defun *error* ( msg )
		(mapcar 'setvar sv_lst sv_vals)
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
		(princ)
	);end_*error*_defun
    
  (setq sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        ss (ssget "_X" '((0 . "TEXT") (410 . "Model")))
        colour_lst (list "* RED *" "* YELLOW *" "* GREEN *" "* CYAN *" "* BLUE *" "* MAGENTA *");<<== Alter list of colours here
  );end_setq
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (cond ( (not (tblobjname "LAYER" "COLOURS"))  (vla-add (vla-get-layers c_doc) "COLOURS")))
  
  (cond (ss
          (vlax-for obj (vla-get-activeselectionset c_doc)
            (setq t_str (vlax-get-property obj 'textstring)
                  lyr (strcase (vlax-get-property obj 'layer))
            )
            (foreach col colour_lst
              (cond ( (wcmatch (strcase t_str) col) (if (not (vl-position lyr l_lst)) (setq l_lst (cons lyr l_lst)))))                      
            );end_foreach
          );end_for
          (cond (l_lst (foreach lyr l_lst (command "_.-laymrg"  "_N" lyr "" "_N" "COLOURS" "_Y"))))
        )
  );end_cond
  (mapcar 'setvar sv_lst sv_vals)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun
;;

 

[gadgetjay]

Thanks Dlanorh,

 

it was the weekend here so away from pc... Brilliant it works thank you so much!