修改连续编号的程序

zdqwy19

linshiyin2 发表于 2012-5-15 08:56
最好能加上匹配高度，颜色，这样即使在同一个层里也可以操作了。

现在的附件是只修改同层同前缀同后缀且大于选择的编号的编号。

linshiyin2

2. 
   
3. (defun C:xgxh ( / be h h1 hh j k lx n names sa shzi ss str str1 tc xh ys yusf zg)
   
4.   (initget 1)
   
5.   (setq be (entsel "\n选取要修改的序号:")
   
6. be (car be)
   
7. be (entget be);获取数据
   
8. lx (assoc '0 be);对象类型
   
9. tc (assoc '8 be);所在图层
   
10. xh (atof (cdr (assoc '1 be)));序号
    
11. ys (assoc '62 be);颜色
    
12. zg (assoc '40 be);字高
    
13. )
    
14.   (if ys
    
15.     (setq ss (ssget "x" (list lx tc zg ys)))
    
16.     (setq ss (ssget "x" (list lx tc zg )))
    
17.     )
    
18.   (setq str (getstring "\n 输入四则运算及数值<默认+1>:"))
    
19.   (if (= str "")
    
20.     (setq str "+1")
    
21.     )
    
22. (setq yusf (substr str 1 1)
    
23.        shzi (atof (substr str 2))
    
24.        n (sslength ss)
    
25.        k 0
    
26.        j 0)
    
27. (while (< k n)
    
28.    (setq names (ssname ss k)
    
29.      sa (entget names)
    
30.       h (assoc '1 sa)
    
31.      hh (atof(cdr h));对象序号
    
32.      )
    
33.    (if (>= hh xh)
    
34.      (progn
    
35.        (if (= yusf "+")(setq  str1 (rtos (+ hh shzi) 2)))
    
36.        (if (= yusf "-")(setq  str1 (rtos (- hh shzi) 2)))
    
37.        (if (= yusf "*")(setq  str1 (rtos (* hh shzi) 2)))
    
38.        (if (= yusf "/")(setq  str1 (rtos (/ hh shzi) 2)))
    
39.        (if (= yusf "^")(setq  str1 (rtos (expt hh shzi) 2)))
    
40.        (setq h1 (cons 1 str1))
    
41.        (setq sa (subst h1 h sa))
    
42.        (setq j (+ 1 j))
    
43.        (entmod sa)
    
44.        )
    
45.      )
    
46.    (setq k (+ k 1))
    
47.    )
    
48.   (print (strcat "修改文字数：" (itoa j)))
    
49.   (princ)
    
50.   )

<br /> (defun C:xgxh ( / be h h1 hh j k lx n names sa shzi ss str str1 tc xh ys yusf zg)<br />   (initget 1)<br />   (setq be (entsel "\n选取要修改的序号:")<br /> be (car be)<br /> be (entget be);获取数据<br /> lx (assoc '0 be);对象类型<br /> tc (assoc '8 be);所在图层<br /> xh (atof (cdr (assoc '1 be)));序号<br /> ys (assoc '62 be);颜色<br /> zg (assoc '40 be);字高<br /> )<br />   (if ys<br />     (setq ss (ssget "x" (list lx tc zg ys)))<br />     (setq ss (ssget "x" (list lx tc zg )))<br />     )<br />   (setq str (getstring "\n 输入四则运算及数值<默认+1>:"))<br />   (if (= str "")<br />     (setq str "+1")<br />     )<br /> (setq yusf (substr str 1 1)<br />        shzi (atof (substr str 2))<br />        n (sslength ss)<br />        k 0<br />        j 0)<br /> (while (< k n)<br />    (setq names (ssname ss k)<br />      sa (entget names)<br />       h (assoc '1 sa)<br />      hh (atof(cdr h));对象序号<br />      )<br />    (if (>= hh xh)<br />      (progn<br />        (if (= yusf "+")(setq  str1 (rtos (+ hh shzi) 2)))<br />        (if (= yusf "-")(setq  str1 (rtos (- hh shzi) 2)))<br />        (if (= yusf "*")(setq  str1 (rtos (* hh shzi) 2)))<br />        (if (= yusf "/")(setq  str1 (rtos (/ hh shzi) 2)))<br />        (if (= yusf "^")(setq  str1 (rtos (expt hh shzi) 2)))<br />        (setq h1 (cons 1 str1))<br />        (setq sa (subst h1 h sa))<br />        (setq j (+ 1 j))<br />        (entmod sa)<br />        )<br />      )<br />    (setq k (+ k 1))<br />    )<br />   (print (strcat "修改文字数：" (itoa j)))<br />   (princ)<br />   )

s678z

钢构CAD 3.1.rar软件有这个功能，不需要输入数字

love12314

试下效果。。。

kexiya123

有重大错误，会误删很多不是编号的数字，不能用

yjsksjscn

这样也能赚钱？
厉害，小弟曾经找到过这样的程序，免费的呀。
好像是zzxxqq老大的作品。

yjsksjscn

呵呵，小弟还根据自己的需要进行了修改。
向zzxxqq老大致敬

zhengbushun

没有钱啊，怎么买，只能看看，好喜欢这个程序。

成仔

感谢楼主分享，学习中

yihua_2626

花钱，还买不到源码啊vb牛