Auto Lisp to replace (underscore+Number) in a Layer name but ignore any single underscores between letters

Pezza 0
Viewed 28

I am trying to rename a large amount of layers that contain _1 and _2 in the Layer name for example:

AAA_XXX_1_CP or AAA_XXX_2_DD

I want to remove the _1 and _2 but leave all the other underscores in the new layer name so the new names would be:

AAA_XXX_CP or AAA_XXX_DD

I have a Lisp routine I am trying to adapt but it is taking all of the underscores out leaving this

AAAXXXCP or AAAXXXDD

Here is the Lisp I am trying to adapt.

(vl-load-com)
(defun C:SLPC (/ layname fixed); = Strip Layer names of numbers _1 & _2
  (vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) 
    (setq
      layname (vla-get-name layer)
      fixed (vl-string-translate "_1_2" "   " layname)
        ; replace all such characters with spaces
    ); setq
    (while (wcmatch fixed "* *") (setq fixed (vl-string-subst "" " " fixed)))
      ; remove all spaces [original as well as just-substituted]
    (if
      (and
        (not (tblsearch "layer" fixed)); doesn't duplicate an existing Layer name
        (/= fixed ""); wasn't made of only such characters [reduced to nothing]
      ); and
      (vla-put-name layer fixed); rename it
    ); if
  ); vlax-for
  (princ)
); defun
autolisp autocad rename lisp layer
2 Answers

Have a look at the help entry for "vl-string-translate". It is interpreting each character of your sourceset as a replacement character. It is not seeing "_1" and "_2" but "_", "1", and "2" as items to be replaced in your string. That is why it is taking out all of your underscores. You can probably skip the translate and just use "vl-string-subst" to get the job done.

Replace

    (setq layname (vla-get-name layer) fixed (vl-string-translate "_1_2" " " layname);
    setq (while (wcmatch fixed "**") 
    (setq fixed (vl-string-subst "" " " fixed)))

With

    (setq layname (vla-get-name layer) fixed (vl-string-subst "_1" "" layname);
    (setq layname (vla-get-name layer) fixed (vl-string-subst "_2" "" layname);
    setq (while (wcmatch fixed "**")
R Porter0

I found this worked for my needs - it could maybe be made more efficient though.

(vl-load-com) (defun C:SLPC (/ layname layname2 fixed fixed2); = Strip Layer names of numbers _1 & _2 (vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq layname (vla-get-name layer) fixed (vl-string-subst " " "_1" layname) ; replace all such characters with spaces ); setq (while (wcmatch fixed "* ") (setq fixed (vl-string-subst "" " " fixed))) ; remove all spaces [original as well as just-substituted] (if (and (not (tblsearch "layer" fixed)); doesn't duplicate an existing Layer name (/= fixed ""); wasn't made of only such characters [reduced to nothing] ); and (vla-put-name layer fixed); rename it ); if ); vlax-for (princ) ; ; now the no2 ; (vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq layname2 (vla-get-name layer) fixed2 (vl-string-subst " " "_2" layname2) ; replace all such characters with spaces ); setq (while (wcmatch fixed2 " *") (setq fixed2 (vl-string-subst "" " " fixed2))) ; remove all spaces [original as well as just-substituted] (if (and (not (tblsearch "layer" fixed2)); doesn't duplicate an existing Layer name (/= fixed2 ""); wasn't made of only such characters [reduced to nothing] ); and (vla-put-name layer fixed2); rename it ); if ); vlax-for (princ) ); defun

Pezza0
Related