[编程申请]：批量文字加前缀工具。

merlin-hu

遇到很多相似情况。需要在一些已经有一定顺序的文字前面统一加一个字母或者字段。
比如：轴线都是1－1，1－2，1－3，1－4，。。。。需要改成，11－1，11－2，11－3，11－4，。。。。。
在比如：一组坐标，X1,X2,X3,X4,....a全部要在后面加上字母B.
类似的，同样的轴线问题，1－1，1－2，1－3，1－4，。。。需要改成2－1，2－2，2－3，。。。。

qrs

(defun c:try (/ ss i s1 ent)
; (CMDLA0)
  (setq ukw (UKWORD 1 "1 2" "\n: 1-前缀/2-后缀" ukw)
        tx (USTR 1 "\n请输入前缀或后缀文字" tx nil)
        ss (ssget '((0 . "TEXT")))
        i  -1
  )
  (repeat (sslength ss)
    (setq s1 (ssname ss (setq i (1+ i))))   
(setq sss (entget s1))
    (if        (= ukw "1")
      (setq txnew (strcat tx (cdr(assoc 1 sss))))
      (setq txnew (strcat (cdr(assoc 1 sss)) tx))
    )
   (setq txt (cons 1 txnew))
    (setq sss (subst txt (assoc 1 sss) sss))
    (entmod sss)
   )
)

TLHMQH

好象不是楼主所要的。

qrs

1－1，1－2，1－3，1－4，。。。。需要改成，11－1，11－2，11－3，11－
1－1，1－2，1－3，1－4，。。。需要改成2－1，2－2，2－3，。。。。  两个要求不是一回事。
(defun c:try (/ ss i s1 ent)
(setq ukw (UKWORD 1 "1 2" "\n: 1-加/2-减" ukw)
tx (USTR 1 "\n请输入加减数" tx nil)
ss (ssget '((0 . "TEXT")))
i -1
)
(repeat (sslength ss)
(setq s1 (ssname ss (setq i (1+ i))))
(setq sss (entget s1))
(setq oldtxt (cdr(assoc 1 sss)))
(setq txt1 (substr oldtxt 1 1))
(setq txt2 (substr oldtxt 2))
(if (= ukw "1")
(progn
   (setq txto (rtos (+ (atoi tx) (atoi txt1))))
   (setq txnew (strcat txto txt2))
)
(progn
  (setq txto (rtos (- (atoi txt1) (atoi tx))))
   (setq txnew (strcat txto txt2))
  )
)
(setq txt (cons 1 txnew))
(setq sss (subst txt (assoc 1 sss) sss))
(entmod sss)
)
)

xyp1964

2. [FONT=courier new](defun c:test ()
   
3.   (CMDLA0)
   
4.   (setq        ss  (ssget '((0 . "TEXT")))
   
5.         ukw (UKWORD 1 "1 2 3" "1-前置加1/2-后置加B/3-前置1改2" ukw)
   
6.         i   -1
   
7.   )
   
8.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
9.     (setq tx (xyp-get-dxf 1 s1)
   
10.           x1 (substr tx 1 1)
    
11.     )
    
12.     (cond ((and (= ukw "1") (= x1 "1"))
    
13.            (xyp-SUBUPD s1 1 (strcat "1" tx))
    
14.           )
    
15.           ((and (= ukw "2") (= x1 "X"))
    
16.            (xyp-SUBUPD s1 1 (strcat tx "B"))
    
17.           )
    
18.           ((and (= ukw "3") (= x1 "1"))
    
19.            (xyp-SUBUPD s1 1 (strcat "2" (substr tx 2)))
    
20.           )
    
21.     )
    
22.   )
    
23.   (CMDLA1)
    
24. )[/FONT]

[FONT=courier new](defun c:test ()<br />   (CMDLA0)<br />   (setq        ss  (ssget '((0 . "TEXT")))<br />         ukw (UKWORD 1 "1 2 3" "1-前置加1/2-后置加B/3-前置1改2" ukw)<br />         i   -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq tx (xyp-get-dxf 1 s1)<br />           x1 (substr tx 1 1)<br />     )<br />     (cond ((and (= ukw "1") (= x1 "1"))<br />            (xyp-SUBUPD s1 1 (strcat "1" tx))<br />           )<br />           ((and (= ukw "2") (= x1 "X"))<br />            (xyp-SUBUPD s1 1 (strcat tx "B"))<br />           )<br />           ((and (= ukw "3") (= x1 "1"))<br />            (xyp-SUBUPD s1 1 (strcat "2" (substr tx 2)))<br />           )<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

TLHMQH

都显示“错误”

qrs

下载斑竹的通用函数xyplib.vlx

10074815

能不能弄个写好的传上来,偶不会啊,或发到我的有邮箱,hc_10074815@126.com,先谢了!!

siyangyang

(DEFUN C:ch3 ()
(prompt "\n加前后缀: ")
(setq qh (getint "\n1--加前缀,2--加后缀,<1>"))
(if (= qh nil)(setq qh 1))
(princ "\nselect object:")
(setq s (ssget))
(setq str (getstring "\n输入要加的字:"))
(setq n (sslength s))
(setq k 0 )
(while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq t1 (assoc '0 a))
      (setq t1 (cdr t1))
      (if (= t1 "TEXT") (PROGN
        (setq h (assoc '1 a))
        (setq hh (cdr h))
        (if (= qh 1)(setq  str1 (strcat str hh)))
        (if (/= qh 1)(setq str1 (strcat hh str)))
        (setq h1 (cons 1 str1))
        ;(if (= str "") (setq h1 h))
        (setq a (subst h1 h a))
        (entmod a)
        ))
      (setq k (+ k 1))
)
)