!替换改字加换色

尘缘一生

闲来无事，修改了经典"文字替换修改"程序，加了换色代码，发来大家讨论。

1. ;;-------------替换改字并换色-------------------------------------------------------
   
2. (defun C:CHGTEXT (/ nam cd ang p l n e os as ns st s nsl osl sl si chf chm olderr pt1 pt2 pt11 pt22)
   
3.   (setq olderr  *error*
   
4.     *error* chgterr
   
5.     chm     0)
   
6.   (command)      
   
7.   (setq p (ssget))
   
8.   (setq oldlup (getvar "LUPREC"))
   
9.   (setvar "LUPREC" 0);;;;精度到各位,以便后续取得标准颜色号
   
10.   (if p (progn
    
11.           (while (= 0 (setq osl (strlen (setq os (getstring t "\nOld string:\n ")))))
    
12.             (princ "Null input invalid")
    
13.           )
    
14.           (setq nsl (strlen (setq ns (getstring t "\nNew string:\n "))))
    
15.           (setq l 0 n (sslength p))
    
16.           (while (< l n)
    
17.             (if (= "TEXT"(cdr (assoc 0 (setq e (entget (setq nam(ssname p l)))))))
    
18.               (progn
    
19.                 (setq chf nil si 1)
    
20.                 (setq s (cdr (setq as (assoc 1 e))))
    
21.                 (setq cd (strlen s))
    
22.                 (setq pt1 (cdr (setq pt11 (assoc 10 e))))
    
23.                 (setq pt2 (cdr (setq pt22 (assoc 11 e))))
    
24.                 (setq ang (angle pt1 pt2))
    
25.                 (while (= osl (setq sl (strlen(setq st (substr s si osl)))))
    
26.                   (if (= st os)
    
27.                     (progn
    
28.                       (if (= ns nil)
    
29.                         (setq s (strcat (substr s 1 (1- si)) (substr s (+ si osl))))
    
30.                       )
    
31.                       (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl))))
    
32.                       (setq chf t)
    
33.                       (setq si (+ si nsl))
    
34.                     )
    
35.                     (setq si (1+ si))
    
36.                   )
    
37.                 )
    
38.                 (if chf (progn
    
39.                           (if (/= cd (setq ll (strlen s)))
    
40.                             (progn
    
41.                               (if (> ll cd)
    
42.                                 (progn
    
43.                                   (setq pt1 (polar pt1 (+ ang pi) (- ll cd)))
    
44.                                   (setq pt2 (polar pt2 ang (- ll cd)))
    
45.                                 )
    
46.                                 (progn
    
47.                                   (setq pt1 (polar pt1 ang (- cd ll)))
    
48.                                   (setq pt2 (polar pt2 (+ ang pi) (- cd ll)))
    
49.                                 )
    
50.                               )
    
51.                               (setq e (subst (list 10 (nth 0 pt1) (nth 1 pt1) 0) pt11 e))
    
52.                               (setq e (subst (list 11 (nth 0 pt2) (nth 1 pt2) 0) pt22 e))
    
53.                               (setq e (subst (cons 1 s) as e))
    
54.                               (entmod e)
    
55.                               (setq chm (1+ chm))
    
56.                             )
    
57.                             (progn
    
58.                               (setq e (subst (cons 1 s) as e))
    
59.                               (entmod e)
    
60.                               (setq chm (1+ chm))
    
61.                             )
    
62.                           )
    
63.                         )
    
64.                 )
    
65.               )
    
66.             )
    
67.             (command "CHANGE" nam "" "P" "C" (rtos (1+ (rem (getvar "CPUTICKS") 8))) "")
    
68.             (setq l (1+ l))
    
69.           )
    
70.         )
    
71.   )
    
72.   (princ "Changed ")
    
73.   (princ chm)
    
74.   (princ " text lines.")
    
75.   (terpri)
    
76.   (setq *error* olderr)
    
77.   (setvar "LUPREC" oldlup)  ;;;;恢复数值小数位数
    
78.   (princ)
    
79. )
    
80. 
    
81. ;;------------------------------------------

;;-------------替换改字并换色-------------------------------------------------------<br /> (defun C:CHGTEXT (/ nam cd ang p l n e os as ns st s nsl osl sl si chf chm olderr pt1 pt2 pt11 pt22)<br />   (setq olderr  *error*<br />     *error* chgterr<br />     chm     0)<br />   (command)      <br />   (setq p (ssget))<br />   (setq oldlup (getvar "LUPREC"))<br />   (setvar "LUPREC" 0);;;;精度到各位,以便后续取得标准颜色号<br />   (if p (progn<br />           (while (= 0 (setq osl (strlen (setq os (getstring t "\nOld string:\n ")))))<br />             (princ "Null input invalid")<br />           )<br />           (setq nsl (strlen (setq ns (getstring t "\nNew string:\n "))))<br />           (setq l 0 n (sslength p))<br />           (while (< l n)<br />             (if (= "TEXT"(cdr (assoc 0 (setq e (entget (setq nam(ssname p l)))))))<br />               (progn<br />                 (setq chf nil si 1)<br />                 (setq s (cdr (setq as (assoc 1 e))))<br />                 (setq cd (strlen s))<br />                 (setq pt1 (cdr (setq pt11 (assoc 10 e))))<br />                 (setq pt2 (cdr (setq pt22 (assoc 11 e))))<br />                 (setq ang (angle pt1 pt2))<br />                 (while (= osl (setq sl (strlen(setq st (substr s si osl)))))<br />                   (if (= st os)<br />                     (progn<br />                       (if (= ns nil)<br />                         (setq s (strcat (substr s 1 (1- si)) (substr s (+ si osl))))<br />                       )<br />                       (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl))))<br />                       (setq chf t)<br />                       (setq si (+ si nsl))<br />                     )<br />                     (setq si (1+ si))<br />                   )<br />                 )<br />                 (if chf (progn<br />                           (if (/= cd (setq ll (strlen s)))<br />                             (progn<br />                               (if (> ll cd)<br />                                 (progn<br />                                   (setq pt1 (polar pt1 (+ ang pi) (- ll cd)))<br />                                   (setq pt2 (polar pt2 ang (- ll cd)))<br />                                 )<br />                                 (progn<br />                                   (setq pt1 (polar pt1 ang (- cd ll)))<br />                                   (setq pt2 (polar pt2 (+ ang pi) (- cd ll)))<br />                                 )<br />                               )<br />                               (setq e (subst (list 10 (nth 0 pt1) (nth 1 pt1) 0) pt11 e))<br />                               (setq e (subst (list 11 (nth 0 pt2) (nth 1 pt2) 0) pt22 e))<br />                               (setq e (subst (cons 1 s) as e))<br />                               (entmod e)<br />                               (setq chm (1+ chm))<br />                             )<br />                             (progn<br />                               (setq e (subst (cons 1 s) as e))<br />                               (entmod e)<br />                               (setq chm (1+ chm))<br />                             )<br />                           )<br />                         )<br />                 )<br />               )<br />             )<br />             (command "CHANGE" nam "" "P" "C" (rtos (1+ (rem (getvar "CPUTICKS") 8))) "")<br />             (setq l (1+ l))<br />           )<br />         )<br />   )<br />   (princ "Changed ")<br />   (princ chm)<br />   (princ " text lines.")<br />   (terpri)<br />   (setq *error* olderr)<br />   (setvar "LUPREC" oldlup)  ;;;;恢复数值小数位数<br />   (princ)<br /> )<br /> <br /> ;;------------------------------------------

yangchao2005090

貌似不好用，能否简单介绍一下

尘缘一生

yangchao2005090 发表于 2017-12-12 10:13
貌似不好用，能否简单介绍一下

先选择字符实体，例如：123XYZ  ，接着输入旧字符，比如X，接着输入，替换X的新字符，比如，输入ab

那么第一次选择的实体就变成：123abyz ,并随机改变1-8号颜色！