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

Question

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

Answer 1

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