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

XDSoft · 发表于 2018-7-25 13:27:23

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

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

liuyj · 发表于 2018-7-25 15:12:25

能扩展为四则运算吗？

XDSoft · 发表于 2018-7-25 16:08:07

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

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

liuyj · 发表于 2018-7-25 16:55:27

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

戒色 · 发表于 2018-7-27 16:39:06

这个好用，正好适合我

7079977a · 发表于 2019-1-30 17:03:20

这个好用，正好适合我

账号		自动登录	找回密码
密码			立即注册

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

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评