社区 › 编程申请 › 求高手出马，对单行文字，删除后缀，并加前缀

xyxy 发表于 2012-6-28 10:25:31

求高手出马，对单行文字，删除后缀，并加前缀

本帖最后由 xyxy 于 2012-6-28 11:02 编辑

请高手出马！
程序要求，输入命令后，程序自动完成以下动作。先自动选择cad中含有以“yz”结尾的单行文字（如123yz，acd2yz，789513yz等），然后针对此选择集删除后缀“yz”，并加上前缀“xy”。如123yz变成xy123，acd2yz变成xyacd2，789513yz变成xy789513。谢谢！

Andyhon 发表于 2012-6-28 10:25:32

只通过附件之调试
(defun C:xy7yz ()
(setq ss (ssget "X" '((0 . "TEXT") (1 . "*yz")))
      i0
)

(while (setq ee (ssname ss i))
    (setq obj (vlax-ename->vla-object ee)
          txt (vla-get-textstring obj)
          txt (vl-string-subst "" "yz" txt)
          i   (1+ i)
    )
    (vla-put-textstring obj (strcat "xy" txt))
)
)

yanguangfei 发表于 2012-6-28 10:46:29

简单査看子符串函数，选择集组码1 .写成   ＊YZ

Andyhon 发表于 2012-6-28 10:46:33

请附上调试用的对映文件(Dwg)

xyxy 发表于 2012-6-28 11:04:11

Andyhon 发表于 2012-6-28 10:46 static/image/common/back.gif
请附上调试用的对映文件(Dwg)

Andyhon你好，附件已上传，请下载，非常感谢出手相助！

zyhandw 发表于 2012-6-28 11:48:39

我也简单写了一个，方法较笨(defun c:ss(/ n ss ssna sslst str strnew strnew2 sslst2)
(setq n 0)
(if (setq ss (ssget "x" '((0 . "text") (1 . "*yz"))))
      (repeat (sslength ss)
      (setq ssna (ssname ss n))
      (setq sslst (entget ssna))
      (setq str (cdr (assoc '1 sslst)))
      (setq strnew (vl-string-right-trim "yz" str))
      (setq strnew2 (strcat "xy" strnew))
      (setq sslst2 (subst (cons 1 strnew2) (assoc '1 sslst) sslst))
      (entmod sslst2)
      (entupd ssna)
      (setq n (1+ n))
      )
)
(princ)
)
(prompt "\n程序运行命令为ss")

Andyhon 发表于 2012-9-25 08:47:50

;;; 比如JL-1、WL-1，框选后输入2，则两个编号变成JL-2、WL-2
(defun C:str-NewN ()
(setq ss (ssget "X" '((0 . "TEXT") (1 . "*-#")))
       Num (getstring "\n新的编号: ")
      i0
)

(while (setq ee (ssname ss i))
    (setq obj (vlax-ename->vla-object ee)
          txt (vla-get-textstring obj)
          txt (reverse (vl-string->list txt))
          txt (vl-list->string (reverse (cdr txt)))
          i   (1+ i)
    )
    (vla-put-textstring obj (strcat txt Num))
)
)

半听可乐 发表于 2012-9-25 14:39:49

Andyhon 发表于 2012-9-25 08:47 static/image/common/back.gif
;;; 比如JL-1、WL-1，框选后输入2，则两个编号变成JL-2、WL-2

怎么不能选择呢？

vlisp2012 发表于 2012-10-17 19:52:01

不用选择了，全图纸中的全改完成了！
默认的全图纸中的文字

luyu9635 发表于 2012-10-24 11:18:43

来个加前缀和后缀一起的
                  ;文字加前缀或后缀
(defun C:adt (/ i ss qh ee obj txt)
(setq i 0)
(if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (INITGET "A B NIL")
      (setq qh(getkword "\n前缀<A>\后缀<B>:<A>"))
               (if (not qh)
                   (setq qh"A" str (getstring "\n输入前缀:") )
                   (setq qh"B" str (getstring "\n输入后缀:"))

                   )
                   (while(setq ee (ssname ss i))
                        (setq obj (vlax-ename->vla-object ee) txt (vla-get-textstring obj) i   (1+ i))
                                   (vla-put-textstring obj
                                     (cond ((= "A" qh) (strcat str txt))
                                           ((= "B" qh) (strcat txt str))
                                           )
                                     )
                                   )
               )
           )
    )

查看完整版本: 求高手出马，对单行文字，删除后缀，并加前缀