求一个简单的数字求和lisp

lixwkkk

如题，工作中需要大量统计单行文本的数字求和，希望一个lisp能实现输入命令--框选数字文本--程序求和--选择一个文本--该文本覆盖为求和数据，同时命令行提示求和值。
手上有的求和lisp和插件都是求和后新建个文本，我想直接覆盖某个文本，因为这个文本的位置已经留好了。当然如果lisp最后一步能提示新建或者覆盖文本最好了，非常感谢！

Andyhon

ref:
http://bbs.mjtd.com/thread-14951-2-1.html
http://bbs.mjtd.com/thread-93132-1-1.html
http://bbs.mjtd.com/thread-175849-1-1.html
http://bbs.mjtd.com/thread-23688-2-1.html
http://bbs.mjtd.com/thread-23688-1-1.html
http://bbs.mjtd.com/thread-53387-1-1.html
...

lixwkkk

Andyhon 发表于 2018-7-5 14:26
ref:
http://bbs.mjtd.com/thread-14951-2-1.html
http://bbs.mjtd.com/thread-93132-1-1.html

我都看了一遍，没有类似的，只有一个是求和然后新建个文本。。。
(DEFUN C:KK()
(setq jd (getint "input 精度<0>:"))
(if (= jd nil) (setq jd 0))
(princ "\nselect object:")
(setq s (ssget))
(setq n (sslength s))
(setq k 0 )(setq mm 0.0)
(while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq t1 (assoc '0 a))
      (setq t1 (cdr t1))
      (if (= t1 "TEXT") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (setq tx (atof tx))
          (setq mm (+ tx mm))
         ))
      (if (= t1 "DIMENSION") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (if (and (/= tx "")(/= tx "<>"))(setq tx (atof tx)))
          (if (or (= tx "")(= tx "<>"))(progn
              (setq tx (assoc '42 a))
              (setq tx (cdr tx))
              ))
          (if (= k 0) (setq MM TX) (setq mm (+ tx mm)))
         ))
      (setq k (+ k 1))
)
(setq mm (rtos mm 2 jd))
(setq po (getpoint "\n指定计算结果的写入点:"))
(command "text" po ""  "" mm)
)

evayleung

论坛上应该很多的吧，这样的文字求和

lixwkkk

evayleung 发表于 2018-7-5 17:04
论坛上应该很多的吧，这样的文字求和

我想要最后一步，指定某个文本，替换求和结果，我搜了半天，没搜到。。。

evayleung

再从论坛上找个文字刷的源码，从里面参考一段就可以的

zhangcan0515

谢谢楼主发的问题，让我学习到了！！

2496653555

  (initget "1 2")
  (setq fs(getkword "\n(1)新建文本 (2)覆盖文本<1>:"));暂停输入
  (cond
          ((or(= fs "1")(= fs nil))
     (setq po (getpoint "\n指定计算结果的写入点:"))
                 (entmake (list '(0 . "TEXT") (cons 1 mm)(cons 8 "txt")(cons 10 po)(cons 40 h2)(cons 62 7)))
          )
          ((= fs "2")
                  (while(/= (cdr(assoc 0 (setq en (entget(car (entsel "\n请选择要覆盖的文本: ")))))) "TEXT"))
                  (entmod (subst (cons 1 mm) (assoc 1 en) en))
          )
  );把这个接上去