Auto Lisp 替換層名稱中的（下划線+數字），但忽略字母之間的任何單個下划線

Question

我正在嘗試重命名圖層名稱中包含_1和_2的大量圖層，例如：

AAA_XXX_1_CP或AAA_XXX_2_DD

我想刪除_1和_2但將所有其他下划線保留在新圖層名稱中，因此新名稱將是：

AAA_XXX_CP或AAA_XXX_DD

我有一個我正在嘗試適應的 Lisp 例程，但它把所有的下划線都去掉了

AAAXXXCP或AAAXXXDD

這是我正在嘗試適應的 Lisp。

(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

查看“vl-string-translate”的幫助條目。 它將源集中的每個字符解釋為替換字符。 它看不到“_1”和“_2”，而是將“_”、“1”和“2”視為要在字符串中替換的項目。 這就是為什么它會去掉你所有的下划線。 您可能可以跳過翻譯，只使用“vl-string-subst”來完成工作。

代替

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

和

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

Answer 2

我發現這可以滿足我的需要——盡管它可能會變得更有效率。

(vl-load-com) (defun C:SLPC (/layname layname2 fixed fixed2); = 去除數字 _1 和 _2 的層名稱 (vlax-for layer (vla-get-layers (vla-get-activedocument (vlax-get -acad-object))) (setq layoutname (vla-get-name layer) fixed (vl-string-subst " " "_1" layoutname); 用空格替換所有這些字符); setq (while (wcmatch fixed "* " ) (setq fixed (vl-string-subst "" " " fixed))); 刪除所有空格 [原始的以及剛剛替換的] (if (and (not (tblsearch "layer" fixed)); 不重復現有的層名稱（/= 固定的“”）；不是僅由這樣的字符組成[減少到無]）；和（vla-put-name 層固定）；重命名它）；如果）；vlax-for（princ ); ; 現在是 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); 用空格替換所有這些字符); setq (while (wcmatch fixed2 " *") (setq fixed2 (vl-string-subst "" " " fixed2))); 刪除所有空格 [原始的以及剛剛替換的] (if (and (not (tblsearch "layer" fixed2)); 不復制現有圖層名稱 (/= fixed2 ""); 不只是由這樣的字符組成[減少到無]）； 和（vla-put-name layer fixed2）； 重命名）； 如果 ）; vlax-for (princ) ); 德芬