[LISP程序]：日积月累：大家共同交流（Lisp程序源码）

stoneball

ARX中的日积月累，受益匪浅，期望大家共同交流，将自己认为可以交流的Lisp程序源码共享。
要求有程序的功能简单说明

2. 
   
3. 函数功能：替换指定文字，如“铸铁”-〉“铁”
   
4. (defun c:gbwb(/ ss n index ent oldtxt oldcz newtxt newcz ent2)
   
5.    (setq ss (ssget "x" (list (cons 0 "Text") (cons 8 "?mark"))))
   
6.    (setq n (sslength ss))
   
7.    (setq index 0)
   
8.    (repeat n
   
9.       (setq ent (entget (ssname ss index)))
   
10.       (setq index (+ 1 index))
    
11.        (progn
    
12.           (setq oldtxt (assoc 1 ent))
    
13.           (setq oldcz (cdr oldtxt))
    
14.           (cond
    
15.             ((wcmatch oldcz "铸铁*")
    
16.               (progn
    
17.                 (setq gj (substr oldcz 5) newtxt (strcat "铁 " gj))
    
18.                 (setq newtxt (cons (car oldtxt) newtxt))
    
19.                 (setq ent2 (subst newtxt oldtxt ent))
    
20.                 (entmod ent2)
    
21.               )
    
22.             )
    
23.             ((wcmatch oldcz "钢*")
    
24.               (progn
    
25.                 (setq gj (substr oldcz 3) newtxt (strcat "铁 " gj))
    
26.                 (setq newtxt (cons (car oldtxt) newtxt))
    
27.                 (setq ent2 (subst newtxt oldtxt ent))
    
28.                 (entmod ent2)
    
29.               )
    
30.             )
    
31.             
    
32.           )
    
33.         )
    
34.     )
    
35.     (setq ss "")
    
36.   (prin1)
    
37. )
    

<br /> 函数功能：替换指定文字，如“铸铁”-〉“铁”<br /> (defun c:gbwb(/ ss n index ent oldtxt oldcz newtxt newcz ent2)<br />    (setq ss (ssget "x" (list (cons 0 "Text") (cons 8 "?mark"))))<br />    (setq n (sslength ss))<br />    (setq index 0)<br />    (repeat n<br />       (setq ent (entget (ssname ss index)))<br />       (setq index (+ 1 index)) <br />        (progn<br />           (setq oldtxt (assoc 1 ent))<br />           (setq oldcz (cdr oldtxt))<br />           (cond<br />             ((wcmatch oldcz "铸铁*")<br />               (progn<br />                 (setq gj (substr oldcz 5) newtxt (strcat "铁 " gj))<br />                 (setq newtxt (cons (car oldtxt) newtxt))<br />                 (setq ent2 (subst newtxt oldtxt ent))<br />                 (entmod ent2)<br />               )<br />             )<br />             ((wcmatch oldcz "钢*")<br />               (progn<br />                 (setq gj (substr oldcz 3) newtxt (strcat "铁 " gj))<br />                 (setq newtxt (cons (car oldtxt) newtxt))<br />                 (setq ent2 (subst newtxt oldtxt ent))<br />                 (entmod ent2)<br />               )<br />             )<br />             <br />           )<br />         )<br />     )<br />     (setq ss "")<br />   (prin1)<br /> )<br />

乘风寻龙

每次都要进入文件改好，有点麻烦！

f4800

多谢分享源码。。