表格式文字按行、按列相加（第二版）

XDSoft

1. (defun c:XDTB_TextSumByRC (/ val tf ss e1 h w entl el p1 sum m x txt plane mat box pj)
   
2.   (xdrx_begin)
   
3.   (if (not #xd_var_global_bits)
   
4.     (setq #xd_var_global_bits 1)
   
5.   )
   
6.   (if (setq val (getint
   
7.                   (xdrx_prompt "\n保留位数<" #xd_var_global_bits ">:" t)
   
8.                 )
   
9.       )
   
10.     (setq #xd_var_global_bits val)
    
11.   )
    
12.   (xdrx_initget "0 1")
    
13.   (if (not (setq tf (getint "\n计算方式[0-按行/1-按列]<1>:")))
    
14.     (setq tf 1)
    
15.   )
    
16.   (princ (strcat "\n选取"
    
17.                  (if (= tf 1)
    
18.                    "按列"
    
19.                    "按行"
    
20.                  )
    
21.                  "求和的数字文字<退出>:"
    
22.          )
    
23.   )
    
24.   (xdrx_initget)
    
25.   (while (and (xdrx_initssget
    
26.                 (strcat "\n选取"
    
27.                         (if (= tf 1)
    
28.                           "按列"
    
29.                           "按行"
    
30.                         )
    
31.                         "求和的数字文字<退出>:"
    
32.                 )
    
33.               )
    
34.               (setq ss (xdrx_ssget '((0 . "TEXT"))))
    
35.          )
    
36.     (progn (setq e1  (ssname ss 0)
    
37.                  box (XD::Entity:BoxAtEcs e1 e1)
    
38.                  h   (xdrx_text_height e1)
    
39.                  w   (distance (car box) (cadr box))
    
40.            )
    
41.            (xdrx_document_setPrec
    
42.              (if (= tf 1)
    
43.                w
    
44.                h
    
45.              )
    
46.              1.0
    
47.            )
    
48.            (setq xdir (cadr (xdrx_entity_getecs (ssname ss 0))))
    
49.            (setq entl (XD::Pickset:TableSortAtEcs ss xdir tf 0 '< '<))
    
50.            (setq el (mapcar '(lambda (x)
    
51.                                (setq sum 0)
    
52.                                (foreach m x
    
53.                                  (setq txt2 (xdrx_text_string m))
    
54.                                  (if (XD::String:IsNum txt2)
    
55.                                    (setq sum (+ sum (atof txt2)))
    
56.                                  )
    
57.                                )
    
58.                                (list (car x) (rtos sum 2 #xd_var_global_bits))
    
59.                              )
    
60.                             entl
    
61.                     )
    
62.            )
    
63.            (if (setq p1 (getpoint "\n插入点<退出>:"))
    
64.              (progn (setq mat0 (xdrx_matrix_identity 3))
    
65.                     (foreach n el
    
66.                       (setq e     (car n)
    
67.                             txt   (cadr n)
    
68.                             box   (xdrx_entity_box e t)
    
69.                             box   (xd::pnts:ucs2wcs box)
    
70.                             plane (apply 'XD::Geom:GetPerpPlaneWithLine
    
71.                                          (if (= tf 1)
    
72.                                            (list (car box) (last box) (xdrx_text_normal e))
    
73.                                            (list (car box) (cadr box) (xdrx_text_normal e))
    
74.                                          )
    
75.                                   )
    
76.                             pj    (xdrx_point_orthoproject (trans p1 1 0) plane)
    
77.                             mat   (xdrx_matrix_setTransLation
    
78.                                     mat0
    
79.                                     (mapcar '- pj (xdrx_getpropertyvalue e "position"))
    
80.                                   )
    
81.                       )
    
82.                       (xdrx_entity_transformedcopy e mat)
    
83.                       (xdrx_text_setstring (entlast) txt)
    
84.                       (xdrx_entity_setpropertiesfrom (entlast) e)
    
85.                     )
    
86.              )
    
87.            )
    
88.     )
    
89.   )
    
90.   (xdrx_end)
    
91.   (princ)
    
92. )
    

(defun c:XDTB_TextSumByRC (/ val tf ss e1 h w entl el p1 sum m x txt plane mat box pj)<br />   (xdrx_begin)<br />   (if (not #xd_var_global_bits)<br />     (setq #xd_var_global_bits 1)<br />   )<br />   (if (setq val (getint<br />                   (xdrx_prompt "\n保留位数<" #xd_var_global_bits ">:" t)<br />                 )<br />       )<br />     (setq #xd_var_global_bits val)<br />   )<br />   (xdrx_initget "0 1")<br />   (if (not (setq tf (getint "\n计算方式[0-按行/1-按列]<1>:")))<br />     (setq tf 1)<br />   )<br />   (princ (strcat "\n选取"<br />                  (if (= tf 1)<br />                    "按列"<br />                    "按行"<br />                  )<br />                  "求和的数字文字<退出>:"<br />          )<br />   )<br />   (xdrx_initget)<br />   (while (and (xdrx_initssget<br />                 (strcat "\n选取"<br />                         (if (= tf 1)<br />                           "按列"<br />                           "按行"<br />                         )<br />                         "求和的数字文字<退出>:"<br />                 )<br />               )<br />               (setq ss (xdrx_ssget '((0 . "TEXT"))))<br />          )<br />     (progn (setq e1  (ssname ss 0)<br />                  box (XD::Entity:BoxAtEcs e1 e1)<br />                  h   (xdrx_text_height e1)<br />                  w   (distance (car box) (cadr box))<br />            )<br />            (xdrx_document_setPrec<br />              (if (= tf 1)<br />                w<br />                h<br />              )<br />              1.0<br />            )<br />            (setq xdir (cadr (xdrx_entity_getecs (ssname ss 0))))<br />            (setq entl (XD::Pickset:TableSortAtEcs ss xdir tf 0 '< '<))<br />            (setq el (mapcar '(lambda (x)<br />                                (setq sum 0)<br />                                (foreach m x<br />                                  (setq txt2 (xdrx_text_string m))<br />                                  (if (XD::String:IsNum txt2)<br />                                    (setq sum (+ sum (atof txt2)))<br />                                  )<br />                                )<br />                                (list (car x) (rtos sum 2 #xd_var_global_bits))<br />                              )<br />                             entl<br />                     )<br />            )<br />            (if (setq p1 (getpoint "\n插入点<退出>:"))<br />              (progn (setq mat0 (xdrx_matrix_identity 3))<br />                     (foreach n el<br />                       (setq e     (car n)<br />                             txt   (cadr n)<br />                             box   (xdrx_entity_box e t)<br />                             box   (xd::pnts:ucs2wcs box)<br />                             plane (apply 'XD::Geom:GetPerpPlaneWithLine<br />                                          (if (= tf 1)<br />                                            (list (car box) (last box) (xdrx_text_normal e))<br />                                            (list (car box) (cadr box) (xdrx_text_normal e))<br />                                          )<br />                                   )<br />                             pj    (xdrx_point_orthoproject (trans p1 1 0) plane)<br />                             mat   (xdrx_matrix_setTransLation<br />                                     mat0<br />                                     (mapcar '- pj (xdrx_getpropertyvalue e "position"))<br />                                   )<br />                       )<br />                       (xdrx_entity_transformedcopy e mat)<br />                       (xdrx_text_setstring (entlast) txt)<br />                       (xdrx_entity_setpropertiesfrom (entlast) e)<br />                     )<br />              )<br />            )<br />     )<br />   )<br />   (xdrx_end)<br />   (princ)<br /> )<br />

liuyj

能扩展为四则运算吗？

XDSoft

liuyj 发表于 2018-7-25 15:12
能扩展为四则运算吗？

在CAD里面，逻辑不好加，对话框也不好设置，
导到EXCEL里面多方便，算完，在导进来，都有插件。

liuyj

其实我用的多的是相乘，就稍微改了一下。减和除麻烦点，就不弄了

戒色

这个好用，正好适合我

7079977a

这个好用，正好适合我