[原创]：一个递增复制文字和属性块的程序

gysjy

命令名：cptxt
程序特点：
1.本程序既适用于文字，也适用于带属性的块。
2.该程序拷贝字符串或带属性的块后，如果文字或块属性后带有数字，则该数字自动增加1；如果文字或块属性后没有数字，则程序会在后面添加一个数字。如：平面图==>平面图1==>平面图2
3.对于混杂文字及数字的字符串，增量后仅改变后面的数字，前面的文字则保留不变。如A-9增量后成为A-10，前面的“A-”不变。
4.对于形如A01的文字或块属性，增量后的结果依次是A02、A03……A10，不会丢掉“0”字。

（本程序已依据各位朋友的建议进行了一系列修改，其修改的内容是：1. 解决了0字开头的数的递增问题；2.纯字母的情况按字母排列顺序递增；3.有两个属性的块可以选择增加哪个属性；4.解决了拷贝起始点的偏移问题。2009.1.6）
[/COLOR]

gysjy

最初由 xmchy 发布
[B]能不能那样啊,如果尾数是数字,1,2,3之类得,就按数字来递增,如果是字母得,abcd,之类的就按字母来递增,能不能做的到? [/B]

字母的递增仅限于单个字母。如：D==> E==>F==>G……。
abcd==>abcd1==>abcd2==>abcd3……。

最初由 xotoo 发布
[B]如果一个块里面有两个属性文字，可不可以选择对哪个文字进行递增？
[/B]

将主程序和子程序tqwz分别修改如下：
子程序tqwz：

2. 
   
3.   [FONT=courier new]
   
4. (defun tqwz();;提取属性或文字内容
   
5.   (if (= "TEXT" (to 0))
   
6.     (setq st (to 1))
   
7.     (progn
   
8.       (setq s (entget (entnext (cdr (car (entget sn)))))
   
9.             st (cdr (assoc 1 s))
   
10.       )
    
11.           (setq sn1  (entnext sn)
    
12.                 s (entget (entnext (cdr (car (entget sn1)))))
    
13.                 str1 (cdr (assoc 1 s))
    
14.           )   
    
15.           (if str1
    
16.             (if loop
    
17.               (setq p (getpoint (strcat
    
18.                       "\n 请选择增长哪个属性/鼠标左键(" st ")/鼠标右键(" str1 "):"))
    
19.                     st (if p st str1)  loop nil
    
20.               )
    
21.               (setq st (if p st str1))
    
22.             )
    
23.           )
    
24.     )
    
25.   )
    
26. )
    
27.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun tqwz();;提取属性或文字内容 <br />   (if (= "TEXT" (to 0))<br />     (setq st (to 1))<br />     (progn<br />       (setq s (entget (entnext (cdr (car (entget sn)))))<br />             st (cdr (assoc 1 s))<br />       )<br />           (setq sn1  (entnext sn)<br />                 s (entget (entnext (cdr (car (entget sn1)))))<br />                 str1 (cdr (assoc 1 s)) <br />           )    <br />           (if str1 <br />             (if loop <br />               (setq p (getpoint (strcat<br />                       "\n 请选择增长哪个属性/鼠标左键(" st ")/鼠标右键(" str1 "):"))<br />                     st (if p st str1)  loop nil<br />               )<br />               (setq st (if p st str1))<br />             )<br />           )<br />     )<br />   )<br /> )<br />   [/FONT]<br />

主程序：

2. 
   
3.   [FONT=courier new]
   
4. (defun c:nn( / asc e1 e2 en en1 k l loop p p1 p2 sn sn1 st st1 st2)
   
5.   (setq *error* nil)
   
6.   (command "undo" "g")
   
7.   (princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY  2008.12.16")
   
8.   (if (setq sn (entsel "\n点取物体:"))
   
9.     (progn
   
10.       (setq p1 (cadr sn) p2 t sn (car sn) loop t)
    
11.       (if (or (= "TEXT" (to 0))(and p2 (to 66)(= "INSERT" (to 0))))
    
12.         (progn                                                
    
13.           (tqwz)
    
14.           (tqtxt)
    
15.           (setq l (1+ l ))
    
16.           (while p2
    
17.             (setq p2 (getpoint "\n下一点:" p1))
    
18.             (command "copy" sn "" p1 p2)   
    
19.             (setq sn (entlast) p1 p2 en (entget sn))
    
20.             (tqwz);(princ st)(getstring)
    
21.             (setq asc (ascii st))
    
22.             (if p2
    
23.               (if (and (= (strlen st) 1)
    
24.                     (or (and (> asc 64) (< asc 90))
    
25.                         (and (> asc 96) (< asc 122))
    
26.                     )
    
27.                   );判断字符串是否是单个字母
    
28.                 (setq k (if (or (= asc 78)(= asc 72))(+ asc 2)(1+ asc));排除字母I,O
    
29.                       st (chr k)
    
30.                 ) ;如果字符串是单个字母，则按字母顺序增长              
    
31.                 (setq st2 (substr st l) st2 (tost2)
    
32.                       st (strcat st1 st2)  
    
33.                 ) ;按数字增长
    
34.               )
    
35.             )
    
36.             (if (= "TEXT" (to 0))
    
37.               (progn
    
38.                 (setq e1 (subst (cons 1 st) (assoc 1 en) en))
    
39.                 (entmod e1)
    
40.               );修改文字
    
41.               (if (or loop p)
    
42.                 (progn
    
43.                   (setq e1 (entget (entnext (cdr (car en)))))
    
44.                   (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))
    
45.                   (entmod e1)(entmod en)
    
46.                 )
    
47.                 (progn
    
48.                   (setq  sn1(entnext sn) en1 (entget sn1)
    
49.                      e1 (entget (entnext (cdr (car en1))))
    
50.                      e2 (subst (cons 1 st) (assoc 1 e1) e1)
    
51.                   )
    
52.                   (entmod e2)(entmod en1)(entmod en)
    
53.                 )
    
54.               );修改属性
    
55.             )
    
56.             (princ st)
    
57.           )
    
58.         )
    
59.         (princ "\n   ***你所点取的图元不是属性块或文字!本程序只拷贝带属性的块或文字。***")
    
60.       )
    
61.         )
    
62.   )
    
63.   (command "undo" "e")
    
64.   (princ)
    
65. )
    
66. 
    
67.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:nn( / asc e1 e2 en en1 k l loop p p1 p2 sn sn1 st st1 st2)<br />   (setq *error* nil)<br />   (command "undo" "g") <br />   (princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY  2008.12.16")<br />   (if (setq sn (entsel "\n点取物体:"))<br />     (progn <br />       (setq p1 (cadr sn) p2 t sn (car sn) loop t) <br />       (if (or (= "TEXT" (to 0))(and p2 (to 66)(= "INSERT" (to 0))))<br />         (progn                                                <br />           (tqwz)<br />           (tqtxt)<br />           (setq l (1+ l ))<br />           (while p2<br />             (setq p2 (getpoint "\n下一点:" p1))<br />             (command "copy" sn "" p1 p2)    <br />             (setq sn (entlast) p1 p2 en (entget sn))<br />             (tqwz);(princ st)(getstring)<br />             (setq asc (ascii st))<br />             (if p2 <br />               (if (and (= (strlen st) 1) <br />                     (or (and (> asc 64) (< asc 90))<br />                         (and (> asc 96) (< asc 122))<br />                     )<br />                   );判断字符串是否是单个字母<br />                 (setq k (if (or (= asc 78)(= asc 72))(+ asc 2)(1+ asc));排除字母I,O<br />                       st (chr k)<br />                 ) ;如果字符串是单个字母，则按字母顺序增长              <br />                 (setq st2 (substr st l) st2 (tost2)<br />                       st (strcat st1 st2)  <br />                 ) ;按数字增长<br />               ) <br />             )<br />             (if (= "TEXT" (to 0))<br />               (progn<br />                 (setq e1 (subst (cons 1 st) (assoc 1 en) en))<br />                 (entmod e1)<br />               );修改文字<br />               (if (or loop p)<br />                 (progn<br />                   (setq e1 (entget (entnext (cdr (car en)))))<br />                   (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))<br />                   (entmod e1)(entmod en)<br />                 )<br />                 (progn<br />                   (setq  sn1(entnext sn) en1 (entget sn1)<br />                      e1 (entget (entnext (cdr (car en1))))<br />                      e2 (subst (cons 1 st) (assoc 1 e1) e1)<br />                   )<br />                   (entmod e2)(entmod en1)(entmod en)<br />                 )<br />               );修改属性<br />             )<br />             (princ st)<br />           )<br />         ) <br />         (princ "\n   ***你所点取的图元不是属性块或文字!本程序只拷贝带属性的块或文字。***") <br />       )<br />         )<br />   )<br />   (command "undo" "e")<br />   (princ)<br /> )<br /> <br />   [/FONT]<br />

gysjy

如图所示

gysjy

如图

userzhluserzhl

欢迎使用文字或属性块连续增量拷贝程序! GYSJY  2008.12.9
点取物体:; 错误: 参数值错误: 正 0

0字开头的会出错！！！

gysjy

最初由 userzhluserzhl 发布
[B]
0字开头的会出错！！！ [/B]

将子程序tqtxt修改如下：

2. 
   
3.   [FONT=courier new]
   
4. (defun tqtxt( / n n0 st0 l0);;提取尾部数字前的字符串
   
5.   (setq st1 st l(strlen st1) st0 (substr st1 l) s1 (substr st 1 1)
   
6.         n (atoi st0) n0 (atoi st1) l0 (strlen (itoa n0))
   
7.   )
   
8.   (if (or (= s1 "0")(and (> n0 0) (= l l0)));纯数字不循环
   
9.     (setq  l 0 st1 "")
   
10.     (while (or (> n 0) (= st0 "0"))
    
11.       ;= st0 "0"，如果遇到形如A01中的0，继续循环
    
12.       (setq st1 (substr st1 1 (1- l))
    
13.             l (strlen st1) st0 (substr st1 l) n (atoi st0)            
    
14.       )
    
15.     )
    
16.   )
    
17. )
    
18.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun tqtxt( / n n0 st0 l0);;提取尾部数字前的字符串<br />   (setq st1 st l(strlen st1) st0 (substr st1 l) s1 (substr st 1 1)<br />         n (atoi st0) n0 (atoi st1) l0 (strlen (itoa n0))<br />   )<br />   (if (or (= s1 "0")(and (> n0 0) (= l l0)));纯数字不循环<br />     (setq  l 0 st1 "")<br />     (while (or (> n 0) (= st0 "0"))<br />       ;= st0 "0"，如果遇到形如A01中的0，继续循环<br />       (setq st1 (substr st1 1 (1- l)) <br />             l (strlen st1) st0 (substr st1 l) n (atoi st0)            <br />       )<br />     ) <br />   )<br /> )<br />   [/FONT]<br />

qiuxiang129

好东东

userzhluserzhl

建议增加：先确定拷贝的起始点，这样才好定位。

xotoo

楼主可不可以进行如下的修改：
1、如果遇到需要递增的文字为单个字母的时候（比如“D”）递增的时候不是递增为D1、D2，而是递增为“E、F、G……”
2、如果遇到需要递增的文字为字母+数字的时候（比如“D1”），递增的时候再递增成“D2、D3、D4……”
3、接第一个问题——遇到需要递增内容为“带属性的块”时，如果块内有两个不同的内容，可不可以有选择性的进行某个内容的递增或者二者同时递增——下面用一个图来说明这个问题

gysjy

最初由 xotoo 发布
[B]楼主可不可以进行如下的修改：
1、如果遇到需要递增的文字为单个字母的时候（比如“D”）递增的时候不是递增为D1、D2，而是递增为“E、F、G……”
2、如果遇到需要递增的文字为字母+数字的时候（比如“D1”），递?.. [/B]

对于第一和第二个问题，将主程序修改如下：

2. 
   
3.   [FONT=courier new]
   
4. (defun c:nn( / asc e1 en k l p1 p2 sn st st1 st2)
   
5.   (setq *error* nil)
   
6.   (command "undo" "g")
   
7.   (princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY  2008.12.15")
   
8.   (if (setq sn (entsel "\n点取物体:"))
   
9.     (progn
   
10.       (setq p1 (cadr sn) p2 t sn (car sn))
    
11.       (if (or (= "TEXT" (to 0))(and p2 (to 66)(= "INSERT" (to 0))))
    
12.         (progn
    
13.           (tqwz)
    
14.           (tqtxt)
    
15.           (setq l (1+ l ))
    
16.           (while p2
    
17.             (setq p2 (getpoint "\n下一点:" p1))
    
18.             (command "copy" sn "" p1 p2)   
    
19.             (setq sn (entlast) p1 (to 10) en (entget sn))
    
20.             (tqwz)
    
21.             (setq asc (ascii st))
    
22.             (if p2
    
23.               (if (and (= (strlen st) 1)
    
24.                     (or (and (> asc 64) (< asc 90))
    
25.                         (and (> asc 96) (< asc 122))
    
26.                     )
    
27.                   );判断字符串是否是单个字母
    
28.               (setq k (if (or (= asc 78)(= asc 72))(+ asc 2)(1+ asc));排除字母I,O
    
29.                     st (chr k)
    
30.               ) ;如果字符串是单个字母，则按字母顺序增长              
    
31.               (setq st2 (substr st l) st2 (tost2)
    
32.                     st (strcat st1 st2)  
    
33.               ) ;按数字增长
    
34.             )
    
35.           )
    
36.             (if (= "TEXT" (to 0))
    
37.               (progn
    
38.                 (setq e1 (subst (cons 1 st) (assoc 1 en) en))
    
39.                 (entmod e1)
    
40.               );修改文字
    
41.               (progn
    
42.                 (setq e1 (entget (entnext (cdr (car en)))))
    
43.                 (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))
    
44.                 (entmod e1)(entmod en)
    
45.               );修改属性
    
46.             )
    
47.             (princ st)
    
48.           )
    
49.         )
    
50.         (princ "\n   ***你所点取的图元不是属性块或文字!本程序只拷贝带属性的块或文字。***")
    
51.       )
    
52.     )
    
53.   )
    
54.   (command "undo" "e")
    
55.   (princ)
    
56. )
    
57. 
    
58.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:nn( / asc e1 en k l p1 p2 sn st st1 st2)<br />   (setq *error* nil)<br />   (command "undo" "g") <br />   (princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY  2008.12.15")<br />   (if (setq sn (entsel "\n点取物体:"))<br />     (progn <br />       (setq p1 (cadr sn) p2 t sn (car sn)) <br />       (if (or (= "TEXT" (to 0))(and p2 (to 66)(= "INSERT" (to 0))))<br />         (progn<br />           (tqwz)<br />           (tqtxt)<br />           (setq l (1+ l ))<br />           (while p2<br />             (setq p2 (getpoint "\n下一点:" p1))<br />             (command "copy" sn "" p1 p2)    <br />             (setq sn (entlast) p1 (to 10) en (entget sn))<br />             (tqwz)<br />             (setq asc (ascii st))<br />             (if p2 <br />               (if (and (= (strlen st) 1) <br />                     (or (and (> asc 64) (< asc 90))<br />                         (and (> asc 96) (< asc 122))<br />                     )<br />                   );判断字符串是否是单个字母<br />               (setq k (if (or (= asc 78)(= asc 72))(+ asc 2)(1+ asc));排除字母I,O<br />                     st (chr k)<br />               ) ;如果字符串是单个字母，则按字母顺序增长              <br />               (setq st2 (substr st l) st2 (tost2)<br />                     st (strcat st1 st2)  <br />               ) ;按数字增长<br />             ) <br />           )<br />             (if (= "TEXT" (to 0))<br />               (progn<br />                 (setq e1 (subst (cons 1 st) (assoc 1 en) en))<br />                 (entmod e1)<br />               );修改文字<br />               (progn<br />                 (setq e1 (entget (entnext (cdr (car en)))))<br />                 (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))<br />                 (entmod e1)(entmod en)<br />               );修改属性<br />             )<br />             (princ st)<br />           )<br />         ) <br />         (princ "\n   ***你所点取的图元不是属性块或文字!本程序只拷贝带属性的块或文字。***") <br />       )<br />     )<br />   )<br />   (command "undo" "e")<br />   (princ)<br /> )<br /> <br />   [/FONT]<br />

第三个问题比较复杂，主要是第二个属性难以提取。如果谁知道的话，欢迎贴出代码来。

xotoo

谢谢楼主，试用了一下，我前两个问题解决了；
如果排除不提取第二个属性的话，可不可以修改成这样的哪——如果一个块里面有两个属性文字，可不可以选择对哪个文字进行递增？

另外麻烦楼主去下面的链接看看15楼的程序，那个程序可以把一个文字中的所有数字（不相连）进行递增，可惜还是没有做到可以有选择的进行……
http://www.xdcad.net/forum/showthread.php?s=&threadid=655545

gysjy

最初由 xotoo 发布
[B]谢谢楼主，试用了一下，我前两个问题解决了；
如果排除不提取第二个属性的话，可不可以修改成这样的哪——如果一个块里面有两个属性文字，可不可以选择对哪个文字进行递增？
[/B]

提取第二个属性的代码已经找到，选择属性的想法可以实现。

xmchy

能不能那样啊,如果尾数是数字,1,2,3之类得,就按数字来递增,如果是字母得,abcd,之类的就按字母来递增,能不能做的到?

xotoo

好好好……超级感谢！
另外你签名档里面的那个“双线交叉”的网页怎么打不开了啊？

userzhluserzhl

如果有多个属性（比如四个）呢？