Lisp adjustment

[Anonymous]

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)
)

[ВeekeeCZ]

It's never good to have two different filters for the same thing.

I've also little improved your prompts by adding clickable END!

Spoiler

(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)
)

[Kent1Cooper]

---

@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].

[Anonymous]

I am not have any luck changing the code. Thanks Kent

[SeeMSixty7]

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.uhden]

I am somewhat curious why you are changing objects (by renaming layers) from New to Existing. I can see if projects are being built in separate phases that New features will become Existing once they are constructed, but you really can't be sure they were constructed exactly according to plan without an as-built survey. IMHO you should be requiring that your client pay for an as-built survey after completion of each phase. IOW don't assume that items were constructed exactly per earlier plans. Any differences will become your responsibility and potential for damage claims against you.

[Kent1Cooper]

---

@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.

[SeeMSixty7]

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))))

[ВeekeeCZ]

---

@SeeMSixty7 wrote:
...

(if (= (strcase pattern) (strcase (substring layname 1 (strlen pattern))))

---

IMHO it should be only substr

BTW my solution is under the SPOILER tag... in case it was overlooked 🙂

[Kent1Cooper]

---

@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.

[SeeMSixty7]

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.

[SeeMSixty7]

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))))

[Anonymous]

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.

[Anonymous]

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)
)

[SeeMSixty7 · Accepted solution]

 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.

[john.uhden]

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)
)

[Anonymous]

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. Thank you

[Interplan LLC] [cid:image002.png@01D21B13.5156D760][cid:image003.png@01D21B13.5156D760]
Over 40 Years and 40,000 Projects
Glenn Bailey | Mechanical Designer
604 Courtland St, Suite 100 | Orlando, FL 32804
o 407.645.5008 | c 407.963.0634 | f 407.629.9124
GBailey@interplanllc.com | www.interplanllc.com

ORLANDO * CHICAGO
Architecture - Engineering - Interior Design - Permitting
________________________________
PHILADELPHIA
Permitting - Entitlements - Due Diligence

AA 003420 | CA 8660
Any drawings and data supplied via this electronic mail are copyrighted property of Interplan LLC.,
and are provided only for the recipient's purposes on the specified project. Any use, other than for
purposes within the recipient's organization is not authorized and shall be the sole responsibility of
the recipient in accepting these drawings and data. The recipient thereby agrees to indemnify and hold
harmless Interplan LLC, for consequential or incidental damages resulting from recipient's disclosure of
same, without written consent of Interplan LLC.

[Kent1Cooper]

---

@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].

[Anonymous]

It works perfect now. Thank you so much for all the effort and everyone else too. Good day guys

[john.uhden]

Thank you, Kent, for explaining my variance. It should have at least reported how many layers were renamed. Come to think of it, it doesn't check (or catch) if the "new" name already exists. Shame on me.