zdqwy19 发表于 2012-5-15 11:18:50

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

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

linshiyin2 发表于 2012-5-15 15:57:49

本帖最后由 linshiyin2 于 2012-5-15 15:59 编辑


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

s678z 发表于 2012-5-25 10:35:50

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

love12314 发表于 2012-8-11 11:34:54

试下效果。。。

kexiya123 发表于 2012-8-11 13:34:51

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

yjsksjscn 发表于 2012-8-11 14:02:35

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

yjsksjscn 发表于 2012-8-11 14:09:03

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

zhengbushun 发表于 2012-8-11 18:06:56

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

成仔 发表于 2012-8-11 19:26:54

感谢楼主分享,学习中

yihua_2626 发表于 2012-8-16 00:18:01

花钱,还买不到源码啊vb牛
页: 1 [2] 3 4
查看完整版本: 修改连续编号的程序