文字替换函数.

鱼与熊掌

2. (defun cx-str-th (etext old new)
   
3.   (setq  thln   (strlen old)
   
4.     runstr ""
   
5.   )
   
6.   (while (> (strlen etext) 0)
   
7.     (if  (= old (substr etext 1 thln))
   
8.       (progn
   
9.         (setq runstr (strcat runstr new))
   
10.         (setq etext (substr etext (1+ thln)))
    
11.       )
    
12.       (progn
    
13.         (setq runstr (strcat runstr (substr etext 1 1)))
    
14.         (setq etext (substr etext 2))
    
15.       )
    
16.     )
    
17.   )
    
18.   runstr
    
19. )

(defun cx-str-th (etext old new)<br />   (setq  thln   (strlen old)<br />     runstr ""<br />   )<br />   (while (> (strlen etext) 0)<br />     (if  (= old (substr etext 1 thln))<br />       (progn<br />         (setq runstr (strcat runstr new))<br />         (setq etext (substr etext (1+ thln)))<br />       )<br />       (progn<br />         (setq runstr (strcat runstr (substr etext 1 1)))<br />         (setq etext (substr etext 2))<br />       )<br />     )<br />   )<br />   runstr<br /> )

鱼与熊掌

正在准备功能.
'("1" "2" "3" "4") '("A" "B" "C" "D"))  批量替换.~
抛砖引玉.

鱼与熊掌

目测成功了.
(cx-str-rep
    "af1fewr2gdfg6ggd3fgd2gfd4"
    '("1" "2" "3" "4")
    '("A" "B" "C" "D")
  )

=>"afAfewrBgdfg6ggdCfgdBgfdD"

;疯狂敛财,没用请不要下载.~

bai2000

支持楼主做成能用的lisp，还有最好支持属性块

鱼与熊掌

bai2000 发表于 2015-1-18 21:12
支持楼主做成能用的lisp，还有最好支持属性块

已经做好了-.-    马上上传..   

鱼与熊掌

画里面索引这种属性块时,有时候需要重新编号,那么就会非常麻烦.
或者排号的时候,比较麻烦,现在推出这个功能, 我觉得还行.
属于代码的引用实例.包括函数.
cx-reptext
;功能,替换文字或者属性块的文字.
;参数 ss 选择集或者图元表.
;oldstr 旧文字 支持单文本替换和集体替换如 "1" 或者'("1" "2" "3" "4")
;newstr新文字,同上                                       "A"  或者'("A" "B" "C" "D")
;工作中可能需要1>A 2>B 3>C 4>D.
那么使用传统的替换方式可能最后的结果需要多重转换,也就是变量转换的问题.
比如A=>1
后来1又被替换成C,最后造成结果不正确代码太长不好维护.

;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

鱼与熊掌

;跟帖伪源码.
;上方演示图的伪源码.
;另外为替换文字函数的函数,支持属性块.
;函数Etype,Dxf,entmod,借用一部分E派函数.

2. ;功能,索引加
   
3. (defun c:jsy (/ *cx_jsyint attlst minx slst ss)
   
4.   ;;;  (setq ss (ssget ))
   
5.   (if (null *cx_jsyint)
   
6.     (setq *cx_jsyint 1)
   
7.   )
   
8.   (while (progn
   
9.       (setq ss
   
10.         (cx-ssget (strcat "选择递增块,起始值:" (itoa *cx_jsyint) "\n")
    
11.           (CX-LST+STR (CX-RANGE-STRNUM 1 100) " ")
    
12.           '((0 . "INSERT"))
    
13.         )
    
14.       )
    
15.       (cond
    
16.         ((=
    
17.             'str
    
18.             (type ss)
    
19.           )
    
20.           (setq *cx_jsyint (atoi ss))
    
21.           t
    
22.         )
    
23.         (ss
    
24.           nil
    
25.         )
    
26.         (t t)
    
27.       )
    
28.     )
    
29.   )
    
30.   (if ss
    
31.     (progn
    
32.       (setq slst (cx-ss2en ss))
    
33.       (setq attlst (mapcar '(lambda (x) (cx-Get-Attstr x)) slst))
    
34.       (setq attlst (apply 'append attlst))
    
35.       (setq attlst (VL-REMOVE-IF-NOT 'CX-STRISINT attlst))
    
36.       (setq attlst (mapcar 'atoi attlst))
    
37.       (setq minx (apply 'min attlst))
    
38.       (cx-reptext
    
39.         slst
    
40.         (CX-RANGE-STRNUM minx (+ minx 3))
    
41.         (CX-RANGE-STRNUM *cx_jsyint (+ *cx_jsyint 3))
    
42.       )
    
43.       (setq *cx_jsyint (+ 4 *cx_jsyint))
    
44.     )
    
45.   )
    
46. )
    
47. 
    
48. 
    
49. ;批量替换文本.
    
50. (defun CX-reptext (SS     oldch   newch   /     ct0     ct1
    
51.     ct2     edata   etext   newtext obj     readch
    
52.     schct   ssl     subln   txtln
    
53.   )
    
54.   (if (/= 'list (type ss))
    
55.     (setq ss (cx-ss2en ss))
    
56.   )
    
57.   (foreach x ss
    
58.     (cond
    
59.       ((cx-Etype x "*TEXT")
    
60.         (cx-entmod x 1 (cx-str-th newch oldch (cx-dxf 1 x)))
    
61.       )
    
62.       ((cx-Etype x "INSERT")
    
63.         (setq obj (zvla x))
    
64.         (mapcar '(lambda  (att)
    
65.             ;(cons (vla-get-TagString att) (vla-get-TextString att))
    
66.             (vla-put-TextString
    
67.               att
    
68.               (cx-str-th newch
    
69.                 oldch
    
70.                 (vla-get-TextString
    
71.                   att
    
72.                 )
    
73.               )
    
74.             )
    
75.             
    
76.             
    
77.           )
    
78.           (vlax-invoke obj "GetAttributes")
    
79.         )
    
80.       )
    
81.     )
    
82.   )
    
83. )
    

;功能,索引加<br /> (defun c:jsy (/ *cx_jsyint attlst minx slst ss)<br />   ;;;  (setq ss (ssget ))<br />   (if (null *cx_jsyint)<br />     (setq *cx_jsyint 1)<br />   )<br />   (while (progn<br />       (setq ss<br />         (cx-ssget (strcat "选择递增块,起始值:" (itoa *cx_jsyint) "\n")<br />           (CX-LST+STR (CX-RANGE-STRNUM 1 100) " ")<br />           '((0 . "INSERT"))<br />         )<br />       )<br />       (cond<br />         ((=<br />             'str<br />             (type ss)<br />           )<br />           (setq *cx_jsyint (atoi ss))<br />           t<br />         )<br />         (ss<br />           nil<br />         )<br />         (t t)<br />       )<br />     )<br />   )<br />   (if ss<br />     (progn<br />       (setq slst (cx-ss2en ss))<br />       (setq attlst (mapcar '(lambda (x) (cx-Get-Attstr x)) slst))<br />       (setq attlst (apply 'append attlst))<br />       (setq attlst (VL-REMOVE-IF-NOT 'CX-STRISINT attlst))<br />       (setq attlst (mapcar 'atoi attlst))<br />       (setq minx (apply 'min attlst))<br />       (cx-reptext<br />         slst<br />         (CX-RANGE-STRNUM minx (+ minx 3))<br />         (CX-RANGE-STRNUM *cx_jsyint (+ *cx_jsyint 3))<br />       )<br />       (setq *cx_jsyint (+ 4 *cx_jsyint))<br />     )<br />   )<br /> )<br /> <br /> <br /> ;批量替换文本.<br /> (defun CX-reptext (SS     oldch   newch   /     ct0     ct1<br />     ct2     edata   etext   newtext obj     readch<br />     schct   ssl     subln   txtln<br />   )<br />   (if (/= 'list (type ss))<br />     (setq ss (cx-ss2en ss))<br />   )<br />   (foreach x ss<br />     (cond<br />       ((cx-Etype x "*TEXT")<br />         (cx-entmod x 1 (cx-str-th newch oldch (cx-dxf 1 x)))<br />       )<br />       ((cx-Etype x "INSERT")<br />         (setq obj (zvla x))<br />         (mapcar '(lambda  (att)<br />             ;(cons (vla-get-TagString att) (vla-get-TextString att))<br />             (vla-put-TextString<br />               att<br />               (cx-str-th newch<br />                 oldch<br />                 (vla-get-TextString<br />                   att<br />                 )<br />               )<br />             )<br />             <br />             <br />           )<br />           (vlax-invoke obj "GetAttributes")<br />         )<br />       )<br />     )<br />   )<br /> )<br />

davide888

我的为什么做不了这效果

LIULISHENG

真强大