Help merging all layers that fit a name pattern

[Anonymous]

I Have a routine ive hodgepodged together that deletes date and initials from layers. where im struggling is if that layer already exists in the drawing (either via a previous layer being renamed or not) the program crashes as I cant create a new layer with an existing layers name.

What would be preferable would be if it checked for an existing layer and merged together outputs that would normally result in a duplicate layer name

(defun layerrenamer (/ doc lyrs nme flg len str);remove "GPSYYYMMDD LL " and variants from all layer names in a drawing file. will require Autodesk Visual Lisp installed on the machine
(vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        lyrs (vla-get-layers doc)
  );end_setq

  (vlax-for lyr lyrs
    (setq nme (vlax-get lyr 'name))
    (cond ( (wcmatch (strcase nme) "TXT RL @@@######## @@ *") (setq flg t len 22))
          ( (wcmatch (strcase nme) "TXT RL @@@########@@ *") (setq flg t len 21))
          ( (wcmatch (strcase nme) "TXT RL @@######## @@ *") (setq flg t len 21))
          ( (wcmatch (strcase nme) "TXT RL @@########@@ *") (setq flg t len 20))
          ( (wcmatch (strcase nme) "TXT RL @@###### @@ *") (setq flg t len 19))
          ( (wcmatch (strcase nme) "TXT RL @@######@@ *") (setq flg t len 18))
    );end_cond

    (cond (flg  (setq flg nil str (substr nme 1 len))
                (vlax-put lyr 'name (vl-string-subst "txt rl TOPO " str nme))
          )
    );end_cond
	(cond ( (wcmatch (strcase nme) "TXT CODE @@@######## @@ *") (setq flg t len 24))
        ( (wcmatch (strcase nme) "TXT CODE @@@########@@ *") (setq flg t len 23))
        ( (wcmatch (strcase nme) "TXT CODE @@######## @@ *") (setq flg t len 23))
        ( (wcmatch (strcase nme) "TXT CODE @@########@@ *") (setq flg t len 22))
        ( (wcmatch (strcase nme) "TXT CODE @@###### @@ *") (setq flg t len 21))
        ( (wcmatch (strcase nme) "TXT CODE @@######@@ *") (setq flg t len 20))
    );end_cond

    (cond (flg  (setq flg nil str (substr nme 1 len))
                (vlax-put lyr 'name (vl-string-subst "txt code TOPO " str nme))
          )
    );end_cond
	(cond ( (wcmatch (strcase nme) "@@@######## @@ *") (setq flg t len 15))
        ( (wcmatch (strcase nme) "@@@########@@ *") (setq flg t len 14))
        ( (wcmatch (strcase nme) "@@######## @@ *") (setq flg t len 14))
        ( (wcmatch (strcase nme) "@@########@@ *") (setq flg t len 13))
        ( (wcmatch (strcase nme) "@@###### @@ *") (setq flg t len 12))
        ( (wcmatch (strcase nme) "@@######@@ *") (setq flg t len 11))
    );end_cond

    (cond (flg  (setq flg nil str (substr nme 1 len))
                (vlax-put lyr 'name (vl-string-subst "TOPO " str nme))
          )
    );end_cond
  );end_for
  (princ)
);end_defun

thanks in advance for any assistance

[Moshe-A]

@Anonymous  hi,

here is a (layer_rename) function to be added to your code...replace each call (vlax-put layr 'name ...) with a call to (layer_rename) with 3 arguments:

1. is layer object in this case is layr

2. is the current layer name in this case is nme

2.  is new layer name which is (vl-string-subst.....)

cause you did not post a sample dwg the test is on you 😀

enjoy

Moshe

(defun layer_rename (AcDblayer currName newName)
 (if (null (tblsearch "layer" newName))
  (vlax-put AcDblayer 'name newName) 
  (command "._laymrg" "_name" currName "" "_name" newName "_yes")
 )  
)

[Anonymous]

Hi, Its took me a while to get back to this. Im struggling on how to integrate the new arguments into the existing code. and keep getting "error too few arguments"

Ive tried using the following but it seems to be tripping up still:

(defun layerrenamer (/ doc lyrs nme flg len str);remove "GPSYYYMMDD LL " and variants from all layer names in a drawing file. will require Autodesk Visual Lisp installed on the machine
(vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        lyrs (vla-get-layers doc)
  );end_setq

  (vlax-for lyr lyrs
    (setq nme (vlax-get lyr 'name))
    (cond ( (wcmatch (strcase nme) "TXT RL @@@######## @@ *") (setq flg t len 22))
          ( (wcmatch (strcase nme) "TXT RL @@@########@@ *") (setq flg t len 21))
          ( (wcmatch (strcase nme) "TXT RL @@######## @@ *") (setq flg t len 21))
          ( (wcmatch (strcase nme) "TXT RL @@########@@ *") (setq flg t len 20))
          ( (wcmatch (strcase nme) "TXT RL @@###### @@ *") (setq flg t len 19))
          ( (wcmatch (strcase nme) "TXT RL @@######@@ *") (setq flg t len 18))
    );end_cond

    (cond (flg  (setq flg nil str (substr nme 1 len))
                (setq currName nme)
                (setq newName (vl-string-subst "txt rl TOPO " str nme))
            (layer_rename)
          )
    );end_cond
	(cond ( (wcmatch (strcase nme) "TXT CODE @@@######## @@ *") (setq flg t len 24))
        ( (wcmatch (strcase nme) "TXT CODE @@@########@@ *") (setq flg t len 23))
        ( (wcmatch (strcase nme) "TXT CODE @@######## @@ *") (setq flg t len 23))
        ( (wcmatch (strcase nme) "TXT CODE @@########@@ *") (setq flg t len 22))
        ( (wcmatch (strcase nme) "TXT CODE @@###### @@ *") (setq flg t len 21))
        ( (wcmatch (strcase nme) "TXT CODE @@######@@ *") (setq flg t len 20))
        ( (wcmatch (strcase nme) "TEXT CODE @@@######## @@ *") (setq flg t len 25))
        ( (wcmatch (strcase nme) "TEXT CODE @@@########@@ *") (setq flg t len 24))
        ( (wcmatch (strcase nme) "TEXT CODE @@######## @@ *") (setq flg t len 24))
        ( (wcmatch (strcase nme) "TEXT CODE @@########@@ *") (setq flg t len 23))
        ( (wcmatch (strcase nme) "TEXT CODE @@###### @@ *") (setq flg t len 22))
        ( (wcmatch (strcase nme) "TEXT CODE @@######@@ *") (setq flg t len 21))
    );end_cond

    (cond (flg  (setq flg nil str (substr nme 1 len))
                (setq currName nme)
                (setq newName (vl-string-subst "txt code TOPO " str nme))
            (layer_rename)
          )
    );end_cond
	(cond ( (wcmatch (strcase nme) "@@@######## @@ *") (setq flg t len 15))
        ( (wcmatch (strcase nme) "@@@########@@ *") (setq flg t len 14))
        ( (wcmatch (strcase nme) "@@######## @@ *") (setq flg t len 14))
        ( (wcmatch (strcase nme) "@@########@@ *") (setq flg t len 13))
        ( (wcmatch (strcase nme) "@@###### @@ *") (setq flg t len 12))
        ( (wcmatch (strcase nme) "@@######@@ *") (setq flg t len 11))
    );end_cond

    (cond (flg  (setq flg nil str (substr nme 1 len))
                (setq currName nme)
                (setq newName (vl-string-subst "TOPO " str nme))
            (layer_rename)
          )
    );end_cond
  (COND ( (wcmatch (strcase nme) "CONTOUR @@@######## @@ *") (setq flg t len 23))
        ( (wcmatch (strcase nme) "CONTOUR @@@########@@ *") (setq flg t len 22))
        ( (wcmatch (strcase nme) "CONTOUR @@######## @@ *") (setq flg t len 22))
        ( (wcmatch (strcase nme) "CONTOUR @@########@@ *") (setq flg t len 21))
        ( (wcmatch (strcase nme) "CONTOUR @@###### @@ *") (setq flg t len 20))
        ( (wcmatch (strcase nme) "CONTOUR @@######@@ *") (setq flg t len 19))
  ); end cond
    
    (cond (flg  (setq flg nil str (substr nme 1 len))
                (setq currName nme)
                (setq newName (vl-string-subst "contour " str nme))
            (layer_rename)
    )
    );end cond
  );end_for
  (princ)
);end_defun

(defun layer_rename (lyr currName newName)
 (if (null (tblsearch "layer" newName))
  (vlax-put lyr 'name newName) 
  (command "._laymrg" "_name" currName "" "_name" newName "_yes")
 )  
)

attached is a mocked up version of the files the program would be working on.

[Kent1Cooper · Accepted solution]

---

@Anonymous wrote:

... keep getting "error too few arguments"

....

....
            (layer_rename)
....
(defun layer_rename (lyr currName newName)
...

....

---

You're calling for the function without supplying any arguments [upper quoted line above], which would certainly qualify as "too few."  The definition of the function calls for three arguments [lower line], which would need to be supplied after the function name, inside the parentheses calling the function.

If those argument names are the same as the variable names that get set before this function is called, they'll be usable within it from their existence outside it [as long as they're not localized within it], without being "arguments" to it -- leave them out of the parentheses after the function name in the definition, so usage calls won't need arguments supplied:

....

  (defun layer_rename ()

....

Or, it takes more code [both in the (defun) line for, and in the calling of, the function], but you could leave the function defined as it is, expecting the arguments, and supply them when you call the function:

....

  (layer_rename lyr currName newName)

....

[ronjonp]

Based on your sample drawing, run this and see if it's what you need.

(defun c:foo (/ a d l ln p r x)
  ;; RJP » 2021-04-13
  ;; Add one valid pattern to set the 'common' layernames.
  (setq p "TD20210521BD*")
  (vlax-for x (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object))))
    (cond ((= -1 (vlax-get x 'lock)) (vlax-put x 'lock 0) (setq a (cons x a))))
    (if	(wcmatch (vla-get-name x) p)
      (setq l (cons (substr (vla-get-name x) (1+ (strlen p))) l))
    )
  )
  (if l
    (progn (vlax-for b (vla-get-blocks d)
	     (if (= 0 (vlax-get b 'isxref))
	       (vlax-for o b
		 (cond ((vlax-write-enabled-p o)
			(setq ln (vla-get-layer o))
			(if (vl-some '(lambda (x) (and (wcmatch ln (strcat "*" x)) (setq r x))) l)
			  (entmod (append (entget (vlax-vla-object->ename o)) (list (cons 8 r))))
			)
		       )
		 )
	       )
	     )
	   )
	   (repeat 3 (vla-purgeall d))
    )
    (alert (strcat "No layers matching filter '" p "' found!!"))
  )
  (foreach l a (vlax-put l 'lock -1))
  (princ)
)

[pbejse]

---

@Anonymous wrote:

What would be preferable would be if it checked for an existing layer and merged together outputs that would normally result in a duplicate layer name

---

See if this works for you

(defun c:layerrenamer (/ doc layer_rename AnyOfThis lyrs nme flg len str)

(setq doc  (vla-get-activedocument (vlax-get-acad-object))
      lyrs (vla-get-layers doc)
)				
;;		Moshe-A Apr 2021		;;
(defun layer_rename (AcDblayer currName newName)
 (if (null (tblsearch "layer" newName))
  (vlax-put AcDblayer 'name newName) 
  (command "._laymrg" "_name" currName "" "_name" newName "_yes")
 )  
)
;;		pBe Apr 2021			;; 
(defun AnyOfThis (nm nme_)
  (vl-some '(lambda (p)
	      (if (wcmatch  nme_ (strcat nm "*"p "*")) 
		p
	      )
	    )
	   '("@@@######## @@"	     "@@@########@@"
	     "@@######## @@"	     "@@########@@"
	     "@@###### @@"	     "@@######@@"
	    )
  )
)
		  
(vlax-for lyr lyrs
    (setq nme (vlax-get lyr 'name))
	(if (setq hit  (Vl-some '(lambda (n)  
		     (if (setq ptn (AnyOfThis (Car n) (strcase nme)))
		       (list n (strlen ptn))))
 		'(("TXT RL " "txt rl TOPO")
		  ("TXT CODE "  "txt code TOPO")
		  ("" "TOPO")
	  	)
	  	)
	  )
	 	(layer_rename
		  lyr
		  nme
		  (strcat (Cadar hit)
			  (substr nme (+ (strlen (Caar hit))
					 (Cadr hit) 1))
			  )
		)
	  )
    )(princ)
  )

HTH

[ronjonp]

Here's another version that should preserve the *TXT* layers similar to @pbejse 

(defun c:foo (/ a d l ln p r x)
  ;; RJP » 2021-04-13
  ;; Add one valid pattern to set the 'common' layernames.
  (setq p "TD20210521BD*")
  (vlax-for x (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object))))
    (cond ((= -1 (vlax-get x 'lock)) (vlax-put x 'lock 0) (setq a (cons x a))))
    (if	(wcmatch (strcase (vla-get-name x)) p)
      (setq l (cons (substr (vla-get-name x) (1+ (strlen p))) l))
    )
  )
  (if l
    (progn
      (vlax-for	b (vla-get-blocks d)
	(if (= 0 (vlax-get b 'isxref))
	  (vlax-for o b
	    (cond
	      ((vlax-write-enabled-p o)
	       (setq ln (vla-get-layer o))
	       (if (vl-some '(lambda (x) (and (wcmatch ln (strcat "*" x)) (setq r x))) l)
		 (entmod
		   (append (entget (vlax-vla-object->ename o))
			   (list (cons 8
				       ;; Update to preserve *txt* layers
				       (strcat (cond ((wcmatch (strcase ln) "TXT CODE*") "txt code ")
						     ((wcmatch (strcase ln) "TXT LN*") "txt ln ")
						     ("")
					       )
					       r
				       )
				 )
			   )
		   )
		 )
	       )
	      )
	    )
	  )
	)
      )
      (repeat 3 (vla-purgeall d))
    )
    (alert (strcat "No layers matching filter '" p "' found!!"))
  )
  (foreach l a (vlax-put l 'lock -1))
  (princ)
)

[Anonymous · Accepted solution]

Thanks for the heads up on repairing my code. I'm still learning so this particular tool has been a hodgepodge/bodge of snippets etc as it stretched my current abilities.

Attached is the finished full file for anyone interested, the concept was to streamline our topo files coming in raw from the field quickly and consistiently to our standards.

Its not pretty, but it works!