求一个简单的数字求和lisp,结果覆盖指定文本

lixwkkk001

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

newer

1. (defun c:XDTB_addnum (/                   #alignmentpoint
   
2.                       #HorizontalMode                #rotation
   
3.                       #textsize           #verticalmode
   
4.                       #WidthFactor e                eold
   
5.                       num           p0                ss
   
6.                       styl           tf                tol
   
7.                       txts old
   
8.                      )
   
9.   (xdrx_begin)
   
10.   (setq        tf  t
    
11.         num 0.0
    
12.   )
    
13.   (if (not #XDTB_addnum_tol)
    
14.     (setq #XDTB_addnum_tol 2)
    
15.   )
    
16.   (if (setq
    
17.         tol (getint
    
18.               (xdrx_prompt "\n保留小数位数<" #XDTB_addnum_tol ">:" t)
    
19.             )
    
20.       )
    
21.     (setq #XDTB_addnum_tol tol)
    
22.   )
    
23.   (while (and tf
    
24.               (xdrx_initssget "\n选取求和的文字<退出>:")
    
25.               (setq ss (xdrx_ssget '((0 . "*TEXT"))))
    
26.          )
    
27.     (if        ss
    
28.       (progn
    
29.         (xdrx_getpropertyvalue
    
30.           (setq eold (ssname ss 0))
    
31.           "textstring"
    
32.           "rotation"
    
33.           "HorizontalMode"
    
34.           "verticalmode"
    
35.           "WidthFactor"
    
36.           "textsize"
    
37.           "alignmentpoint"
    
38.         )
    
39.         (setq styl (xdrx_getpropertyvalue eold "textstyle"))
    
40.         (setq txts (xdrx_entity_getproperty ss "textstring")
    
41.               txts (xd::list:flat txts)
    
42.               txts (xdrx_string_regexps
    
43.                      "[0-9.]+"
    
44.                      (xdrx_string_join txts ",")
    
45.                    )
    
46.         )
    
47.         (setq num (apply '+ (mapcar 'atof txts)))
    
48.         (prompt (strcat "\n累加和:" (rtos num 2 #XDTB_addnum_tol)))
    
49.         (if (and (setq p0 (getpoint "\n插入点<修改存在文字>:"))
    
50.                  (setq p0 (trans p0 1 0))
    
51.                  num
    
52.             )
    
53.           (progn (setq e (xdrx_text_make
    
54.                            p0
    
55.                            (rtos num 2 #XDTB_addnum_tol)
    
56.                            (car styl)
    
57.                            #textsize
    
58.                            (+ 0 #rotation)
    
59.                          )
    
60.                  )
    
61.                  (xdrx_setpropertyvalue e "WidthFactor" #WidthFactor)
    
62.                  (xdrx_entity_setpropertiesfrom e eold)
    
63.                  (if (not (equal #alignmentpoint '(0 0 0) 1e-3))
    
64.                    (progn (XD::Text:AdjustAlignMent
    
65.                             e
    
66.                             #HorizontalMode
    
67.                             #verticalmode
    
68.                           )
    
69.                           (xdrx_entity_move
    
70.                             e
    
71.                             (xdrx_getpropertyvalue e "alignmentpoint")
    
72.                             p0
    
73.                           )
    
74.                    )
    
75.                  )
    
76.           )
    
77.           (progn
    
78.             (if        (and num
    
79.                      (setq old (xdrx_entsel
    
80.                                  "\n拾取覆盖文本<退出>:"
    
81.                                  '((0 . "text"))
    
82.                                )
    
83.                      )
    
84.                 )
    
85.               (progn
    
86.                 (xdrx_setpropertyvalue
    
87.                   (car old)
    
88.                   "textstring"
    
89.                   (rtos num 2 #XDTB_addnum_tol)
    
90.                 )
    
91.               )
    
92.             )
    
93.           )
    
94.         )
    
95.       )
    
96.       (setq tf nil)
    
97.     )
    
98.   )
    
99.   (xdrx_end)
    
100.   (princ)
     
101. )
     
102. 
     

(defun c:XDTB_addnum (/                   #alignmentpoint<br />                       #HorizontalMode                #rotation<br />                       #textsize           #verticalmode<br />                       #WidthFactor e                eold<br />                       num           p0                ss<br />                       styl           tf                tol<br />                       txts old<br />                      )<br />   (xdrx_begin)<br />   (setq        tf  t<br />         num 0.0<br />   )<br />   (if (not #XDTB_addnum_tol)<br />     (setq #XDTB_addnum_tol 2)<br />   )<br />   (if (setq<br />         tol (getint<br />               (xdrx_prompt "\n保留小数位数<" #XDTB_addnum_tol ">:" t)<br />             )<br />       )<br />     (setq #XDTB_addnum_tol tol)<br />   )<br />   (while (and tf<br />               (xdrx_initssget "\n选取求和的文字<退出>:")<br />               (setq ss (xdrx_ssget '((0 . "*TEXT"))))<br />          )<br />     (if        ss<br />       (progn<br />         (xdrx_getpropertyvalue<br />           (setq eold (ssname ss 0))<br />           "textstring"<br />           "rotation"<br />           "HorizontalMode"<br />           "verticalmode"<br />           "WidthFactor"<br />           "textsize"<br />           "alignmentpoint"<br />         )<br />         (setq styl (xdrx_getpropertyvalue eold "textstyle"))<br />         (setq txts (xdrx_entity_getproperty ss "textstring")<br />               txts (xd::list:flat txts)<br />               txts (xdrx_string_regexps<br />                      "[0-9.]+"<br />                      (xdrx_string_join txts ",")<br />                    )<br />         )<br />         (setq num (apply '+ (mapcar 'atof txts)))<br />         (prompt (strcat "\n累加和:" (rtos num 2 #XDTB_addnum_tol)))<br />         (if (and (setq p0 (getpoint "\n插入点<修改存在文字>:"))<br />                  (setq p0 (trans p0 1 0))<br />                  num<br />             )<br />           (progn (setq e (xdrx_text_make<br />                            p0<br />                            (rtos num 2 #XDTB_addnum_tol)<br />                            (car styl)<br />                            #textsize<br />                            (+ 0 #rotation)<br />                          )<br />                  )<br />                  (xdrx_setpropertyvalue e "WidthFactor" #WidthFactor)<br />                  (xdrx_entity_setpropertiesfrom e eold)<br />                  (if (not (equal #alignmentpoint '(0 0 0) 1e-3))<br />                    (progn (XD::Text:AdjustAlignMent<br />                             e<br />                             #HorizontalMode<br />                             #verticalmode<br />                           )<br />                           (xdrx_entity_move<br />                             e<br />                             (xdrx_getpropertyvalue e "alignmentpoint")<br />                             p0<br />                           )<br />                    )<br />                  )<br />           )<br />           (progn<br />             (if        (and num<br />                      (setq old (xdrx_entsel<br />                                  "\n拾取覆盖文本<退出>:"<br />                                  '((0 . "text"))<br />                                )<br />                      )<br />                 )<br />               (progn<br />                 (xdrx_setpropertyvalue<br />                   (car old)<br />                   "textstring"<br />                   (rtos num 2 #XDTB_addnum_tol)<br />                 )<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (setq tf nil)<br />     )<br />   )<br />   (xdrx_end)<br />   (princ)<br /> )<br /> <br />

lixwkkk001

newer 发表于 2018-7-5 20:50

这个直接复制到记事本，存为lsp不能用吗，我试了好几次不行，命令输的XDTB_addnum

lixwkkk001

newer 发表于 2018-7-5 20:50

我知道了，好像要安装XD工具箱，多谢版主！

lixwkkk001

newer 发表于 2018-7-5 20:50

我知道了，好像要安装论坛工具箱，多谢版主！

lixwkkk001

newer 发表于 2018-7-5 20:50

再打搅下，如果求和完不要插入文本，只要覆盖文本功能，该删除哪一段呢，多谢！

Lispboy

lixwkkk001 发表于 2018-7-5 21:41
再打搅下，如果求和完不要插入文本，只要覆盖文本功能，该删除哪一段呢，多谢！

1. (defun c:XDTB_addnum (/                  #alignmentpoint
   
2.                       #HorizontalMode              #rotation          #textsize
   
3.                       #verticalmode              #WidthFactor
   
4.                       e                  eold              num          p0
   
5.                       ss          styl              tf          tol
   
6.                       txts          old
   
7.                      )
   
8.   (xdrx_begin)
   
9.   (setq        tf  t
   
10.         num 0.0
    
11.   )
    
12.   (if (not #XDTB_addnum_tol)
    
13.     (setq #XDTB_addnum_tol 2)
    
14.   )
    
15.   (if (setq
    
16.         tol (getint
    
17.               (xdrx_prompt "\n保留小数位数<" #XDTB_addnum_tol ">:" t)
    
18.             )
    
19.       )
    
20.     (setq #XDTB_addnum_tol tol)
    
21.   )
    
22.   (while (and tf
    
23.               (xdrx_initssget "\n选取求和的文字<退出>:")
    
24.               (setq ss (xdrx_ssget '((0 . "*TEXT"))))
    
25.          )
    
26.     (setq txts (xdrx_entity_getproperty ss "textstring")
    
27.           txts (xd::list:flat txts)
    
28.           txts (xdrx_string_regexps
    
29.                  "[0-9.]+"
    
30.                  (xdrx_string_join txts ",")
    
31.                )
    
32.     )
    
33.     (setq num (apply '+ (mapcar 'atof txts)))
    
34.     (prompt (strcat "\n累加和:" (rtos num 2 #XDTB_addnum_tol)))
    
35.     (if        (and num
    
36.              (setq old (xdrx_entsel
    
37.                          "\n拾取覆盖文本<退出>:"
    
38.                          '((0 . "text"))
    
39.                        )
    
40.              )
    
41.         )
    
42.       (progn
    
43.         (xdrx_setpropertyvalue
    
44.           (car old)
    
45.           "textstring"
    
46.           (rtos num 2 #XDTB_addnum_tol)
    
47.         )
    
48.       )
    
49.       (setq tf nil)
    
50.     )
    
51.   )
    
52.   (xdrx_end)
    
53.   (princ)
    
54. )
    
55. 
    

(defun c:XDTB_addnum (/                  #alignmentpoint<br />                       #HorizontalMode              #rotation          #textsize<br />                       #verticalmode              #WidthFactor<br />                       e                  eold              num          p0<br />                       ss          styl              tf          tol<br />                       txts          old<br />                      )<br />   (xdrx_begin)<br />   (setq        tf  t<br />         num 0.0<br />   )<br />   (if (not #XDTB_addnum_tol)<br />     (setq #XDTB_addnum_tol 2)<br />   )<br />   (if (setq<br />         tol (getint<br />               (xdrx_prompt "\n保留小数位数<" #XDTB_addnum_tol ">:" t)<br />             )<br />       )<br />     (setq #XDTB_addnum_tol tol)<br />   )<br />   (while (and tf<br />               (xdrx_initssget "\n选取求和的文字<退出>:")<br />               (setq ss (xdrx_ssget '((0 . "*TEXT"))))<br />          )<br />     (setq txts (xdrx_entity_getproperty ss "textstring")<br />           txts (xd::list:flat txts)<br />           txts (xdrx_string_regexps<br />                  "[0-9.]+"<br />                  (xdrx_string_join txts ",")<br />                )<br />     )<br />     (setq num (apply '+ (mapcar 'atof txts)))<br />     (prompt (strcat "\n累加和:" (rtos num 2 #XDTB_addnum_tol)))<br />     (if        (and num<br />              (setq old (xdrx_entsel<br />                          "\n拾取覆盖文本<退出>:"<br />                          '((0 . "text"))<br />                        )<br />              )<br />         )<br />       (progn<br />         (xdrx_setpropertyvalue<br />           (car old)<br />           "textstring"<br />           (rtos num 2 #XDTB_addnum_tol)<br />         )<br />       )<br />       (setq tf nil)<br />     )<br />   )<br />   (xdrx_end)<br />   (princ)<br /> )<br /> <br />

kqqt6236

学习一下。

huangpc27

这个不错啊