I have this lisp that changes the prefix of a layer, example N-MHCONTROL to E-MHCONTORL. The problem with the lisp is that It changes all the letter "N" to "E". So changing Layer N-MHCONTROL come out like N-MHCOETROL. We have layers here that are N for new, E for existing, D for demo. Sometime I need to change multiple objects to a different layer. Thank you for taking a look at this lisp.
(vl-load-com)
(defun c:LAYSUBST () (c:LayerSubstitute))
(defun c:LayerSubstitute
(/ *error* pattern ss newString acDoc oLayers layerName)
(defun *error* (msg)
(if acDoc
(vla-endundomark acDoc)
)
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)
(if
(and
(setq pattern
(getstring "\nEnter pattern to substitute (case sensitive): ")
)
(setq ss (ssget "_:L"
(list '(-4 . "<AND")
(cons 8 (strcat pattern "*"))
'(-4 . "<NOT")
'(8 . "0,DEFPOINTS,*|*")
'(-4 . "NOT>")
'(-4 . "AND>")
)
)
)
(setq newString
(getstring "\nEnter new string (case sensitive): ")
)
(/= pattern newString)
)
(progn
(vla-startundomark
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq oLayers (vla-get-layers acDoc))
(vlax-for x (vla-get-activeselectionset acDoc)
(setq layerName (vla-get-layer x))
(while (vl-string-search pattern layerName)
(setq layerName
(vl-string-subst newString pattern layerName)
)
)
(vla-add oLayers layerName)
(vla-put-layer x layerName)
)
)
)
(*error* nil)
)
Solved! Go to Solution.
Solved by SeeMSixty7. Go to Solution.
It's never good to have two different filters for the same thing.
I've also little improved your prompts by adding clickable END!
(vl-load-com) (defun c:LAYSUBST () (c:LayerSubstitute)) (defun c:LayerSubstitute (/ *error* pattern ss newString acDoc oLayers layerName) (defun *error* (msg) (if acDoc (vla-endundomark acDoc) ) (cond ((not msg)) ; Normal exit ((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit) ((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it ) (princ) ) (if (and (not (initget "E N D")) (setq pattern (getstring "\nEnter pattern to substitute (case sensitive) [E/N/D]: ") ) (setq ss (ssget "_:L" (list '(-4 . "<AND") (cons 8 (strcat pattern "*")) '(-4 . "<NOT") '(8 . "0,DEFPOINTS,*|*") '(-4 . "NOT>") '(-4 . "AND>") ) ) ) (not (initget "E N D")) (setq newString (getstring "\nEnter new string (case sensitive) [E/N/D]: ") ) (/= pattern newString) ) (progn (vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object))) ) (setq oLayers (vla-get-layers acDoc)) (vlax-for x (vla-get-activeselectionset acDoc) (setq layerName (vla-get-layer x)) (if (wcmatch layerName (strcat pattern "*")) (setq layerName (strcat newString (substr layerName (1+ (strlen pattern)))))) (vla-add oLayers layerName) (vla-put-layer x layerName) ) ) ) (*error* nil) )
@Anonymous wrote:
I have this lisp that changes the prefix of a layer, example N-MHCONTROL to E-MHCONTORL. The problem with the lisp is that It changes all the letter "N" to "E".
....
(cons 8 (strcat pattern "*"))....
(while (vl-string-search pattern layerName)
(setq layerName
(vl-string-subst newString pattern layerName)
)
)
....
I think the (while) function is the problem. It will keep going back and looking for the 'pattern' again, as long as it keeps finding it.
Since you're talking about the first letter of the Layer name, and you have the selection filtering for only things on Layers whose names start with the 'pattern' string, I don't think you need to use (vl-string-search) at all -- everything selected will pass that test. You should be able to remove the (while) "wrapper" around that 'layerName' setting entirely, and (vl-string-subst) will replace only the first instance [at the beginning of the name].
If you only want the pattern to match the beginning part of the layer try the following.
Hope this gets you where you want to be.
(vl-load-com)
(defun c:LAYSUBST () (c:LayerSubstitute))
(defun c:LayerSubstitute
(/ *error* pattern ss newString acDoc oLayers layerName)
(defun *error* (msg)
(if acDoc
(vla-endundomark acDoc)
)
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)
(if
(and
(setq pattern
(getstring "\nEnter pattern to substitute (case sensitive): ")
)
(setq ss (ssget "_:L"
(list '(-4 . "<AND")
(cons 8 (strcat pattern "*"))
'(-4 . "<NOT")
'(8 . "0,DEFPOINTS,*|*")
'(-4 . "NOT>")
'(-4 . "AND>")
)
)
)
(setq newString
(getstring "\nEnter new string (case sensitive): ")
)
(/= pattern newString)
)
(progn
(vla-startundomark
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq oLayers (vla-get-layers acDoc))
(vlax-for x (vla-get-activeselectionset acDoc)
(setq layerName (vla-get-layer x))
(if (= (strcase pattern) (strcase (substring layname 1 (strlen pattern))))
(setq layerName (vl-string-subst newString pattern layerName))
)
(vla-add oLayers layerName)
(vla-put-layer x layerName)
)
)
)
(*error* nil)
)
John F. Uhden
@Anonymous wrote:
I am not have any luck changing the code. Thanks Kent
To start with, try just removing that (while) function wrapper by commenting out its code lines by putting semicolons at the beginning of each:
....
; (while (vl-string-search pattern layerName)
(setq layerName
(vl-string-subst newString pattern layerName)
)
; )
....
If it works that way, you can remove those lines entirely.
Kent,
I agree that the problem is the while, but the problem with just taking out the while part is that if the system finds a match anywhere in the string it will change it.
If he was looking for a layer that prefixed with N to replace with it would change as follows:
E-MHCONTROL would become E-MHCOETROL
I suggested he replace the while with an if and just look at the prefix that matches the pattern
(if (= (strcase pattern) (strcase (substring layname 1 (strlen pattern))))
@SeeMSixty7 wrote:
...
(if (= (strcase pattern) (strcase (substr
inglayname 1 (strlen pattern))))
IMHO it should be only substr
BTW my solution is under the SPOILER tag... in case it was overlooked 🙂
@SeeMSixty7 wrote:
.... the problem with just taking out the while part is that if the system finds a match anywhere in the string it will change it.
If he was looking for a layer that prefixed with N to replace with it would change as follows:
E-MHCONTROL would become E-MHCOETROL
....
It won't find a situation like that, because the (ssget) filter [see part of it in the first line of quoted code in Post 3] will find only things on Layers that start with their 'pattern' [in that case the N], and it later extracts the Layer names from only them [each 'x' in (vlax-for)] to assign the new names to. So that E-... Layer name will not come up in the processing of the selection -- all the things to be changed will have Layer names starting with N, so that first letter will be the one replaced with E.
DOH! Yes it should be:
(if (= (strcase pattern) (strcase (subst layname 1 (strlen pattern))))
LOL To many languages in my head.
And yes I completely overlooked the Spoiler. I will have to start watching for that better. Thanks.
Thank you again BeekeeCZ for pointing out the missing "r"
It has been a long day.
This one should be correct. DOH!
(if (= (strcase pattern) (strcase (substr layname 1 (strlen pattern))))
Yes the client pays. My menu is set up to draw all new (this keep it smaller not so many commands for people to use) so when I need to draw a field survey up I draw it all new and then use this lisp the change all the layers the existing at once. Once I start demo I can change just the layers I am demolishing. And If I need to change any layer back no problem. Works good except where there are more than one letter N, E or D in that layer name. There are only 23 layer that we use and it is faster to change them this way instead of just going an setting that layer as current and then drawing. My menu use to use aia standards but the management here would not change to that. It was to hard for the older folks t get used to it. Anyway I attached a layer pdf so you could see what they like.
I tried the lisp this morning and I am getting an error, I reposted the lisp as I have it now. I do appreciate all your help on this. This is the error I get;
C:LAYERSUBSTITUTE
Command:
Enter pattern to substitute (case sensitive): N
Select objects: 1 found
Select objects:
Enter new string (case sensitive): E
** Error: bad argument type: stringp nil **
Command:
(vl-load-com)
(defun c:LAYSUBST () (c:LayerSubstitute))
(defun c:LayerSubstitute
(/ *error* pattern ss newString acDoc oLayers layerName)
(defun *error* (msg)
(if acDoc
(vla-endundomark acDoc)
)
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)
(if
(and
(setq pattern
(getstring "\nEnter pattern to substitute (case sensitive): ")
)
(setq ss (ssget "_:L"
(list '(-4 . "<AND")
(cons 8 (strcat pattern "*"))
'(-4 . "<NOT")
'(8 . "0,DEFPOINTS,*|*")
'(-4 . "NOT>")
'(-4 . "AND>")
)
)
)
(setq newString
(getstring "\nEnter new string (case sensitive): ")
)
(/= pattern newString)
)
(progn
(vla-startundomark
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq oLayers (vla-get-layers acDoc))
(vlax-for x (vla-get-activeselectionset acDoc)
(setq layerName (vla-get-layer x))
(if (= (strcase pattern) (strcase (substr layname 1 (strlen pattern))))
(setq layerName (vl-string-subst newString pattern layerName))
)
(vla-add oLayers layerName)
(vla-put-layer x layerName)
)
)
)
(*error* nil)
)
would think after the 37 times this was updated yesterday I would have gotten all the issues worked out. Sorry It was a long day yesterday.
This is what you have
(if (= (strcase pattern) (strcase (substr layname 1 (strlen pattern))))
this is what it needs to be
(if (= (strcase pattern) (strcase (substr LayerName 1 (strlen pattern))))
Sorry about that. It should work now.
I don't know if this is any better than the wizards have offered, but here's one from the ancient past. You'll have to add your own error and undo control, or I can add that if you need.
Bear in mind that (vl-string-subst) will work on only the first occurrence of any characters in a string, so this one won't change "P-PIPE" into "E-EIEE" or P-PIPIO" into "E-EIEIO" even though Old MacDonald might approve.
Note the use of the long (and ...). It's a style I picked up from Stephan Koster back in the day. It stops evaluating upon the first evaluation that returns nil. Though others disdain it, don't worry one bit about having multiple calls of (vl-load-com). It is absolutely harmless to repeat and may lose you only about 5 milliseconds during the course of a month (24/7 that is).
(defun C:RenLays (/ old new) (vl-load-com) (and (setq old (getstring T "\nEnter string to change: ")) (or (snvalid old 1) (prompt " Invalid string.") ) (setq new (getstring T "\nEnter new string: ")) (or (snvalid new 1) (prompt " Invalid string.") ) (or (/= new old) (prompt " Same string.") ) (vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (vla-put-name layer (vl-string-subst new old (vla-get-name layer) ) ) ) ) (princ) )
John F. Uhden
@Anonymous wrote:
This routine did not work. When I invoke the command it ask Enter String to change, then and for new string, that's as far as in goes, does not even give the option to select the object. ....
Are you sure it didn't work? The earlier routines on this thread change the names of the Layers of selected objects, but this one is different -- it's designed to just go through all Layer names and change any that fit. That's why it doesn't ask you to select anything, but you may find that it did, in fact,change some Layer name(s) [if any fit the pattern].
John F. Uhden
Can't find what you're looking for? Ask the community or share your knowledge.