【飞鸟集】数字文本的四则运算和统计（更新到2020.11.09)

highflybir · 发表于 2007-5-22 11:46:00

本帖最后由 highflybir 于 2020-11-9 20:20 编辑

本帖所附程序已经更新到2020.11.09.
==============================================

2020.11.09 更新特点：
1.还有一个非世界坐标系（WCS）下文本插入点跑远问题得到修正。
==============================================

2019.07.13 更新特点：
1.增加了天正类物体，并修正了崩溃问题。
2.修正了非世界坐标系（WCS）下文本插入点跑远问题。
3.修正了以前的64位的ScriptControl创建为nil的问题。
4.修正64位也可能无法创建用来计算表达式的时候采用自己的mycal程序

==============================================
2013.12.19 更新特点：
1.更改了操作方式，使得程序更易用。
2.修正了几个bug,包括64位CAD的错误问题。
3.可以计算文本中的算术表达式，譬如：1*2-sin(3)之类。
4.增加了对天正文字，斯维尔文本的支持。
5.统计命令改为stat,所有文本加减乘除某个数的命令改为++,--,**,//这个更方便记忆。

===============================================

应一个网友的要求写了这个一个小程序，但愿各位能用的着。
在绘图过程中，经常会对数字文本进行四则运算，或者统计数字，在现有的CAD命令中没有直接命令与之相关，用计算器又麻烦。所以编写了一个小程序。

用法：
1、先加载程序，首先会提示你如何用这个程序。

2、然后你输入计算结果的精度，即小数点位数：这个只要在开始的时候输入就可以了，以后的命令你不用输入精度，如果你要调整精度，随时输入命令JD.
3、下面为它的具体用法，你可以选择多个文字，如果是除法，劝你最好不要选择0数字，否则会出错。而且命令可以连用，直到你空输入（没有选择或者取点）为止。
+ - * / 命令不用多说。
++,--,**,// 命令为对所选文字同时加减乘除某个数。StatSet为设置。
4、统计的命令为stat。其速度是很快的，我曾对十万级的数字验证，求结果既快又准。

5、这个程序适用于各个版本，我甚至觉得可以用于DOS的CAD版本。
各位有什么建议或好的想法可以回帖，在此致谢。

highflybir · 发表于 2013-12-25 22:54:26

程序已经更新。

tigcat · 发表于 2021-12-21 17:33:56

；我计算楼梯过程中，核对踏步宽度高度是否正确，做的一个小程序，选中带符号的文字，将计算结果放置在右下角，图层为当前图层。
；感谢高飞大神

(defun c:CAt (/ box Els ent i lst nls num p1 p2 p3 p4 sel strlst wcs wz_jd wz_obj wz_zg)
(if
(or
(setq wcs (vlax-create-object "Aec32BitAppServer.AecScriptControl.1"))
(setq wcs (vlax-create-object "ScriptControl"))
)
(vlax-put-property wcs "language" "VBScript")
)
(setq i 0)
(setq sel (ssget '((0 . "text"))))
(repeat (sslength sel)
(setq ent (ssname sel i))
(command "ucs" "e" ent)
(setq wz_obj (vlax-ename->vla-object ent))
(setq wz_jd (vlax-get-property wz_obj 'Rotation)) ;取得角度
(setq wz_zg (vlax-get-property wz_obj 'Height)) ;取得字高
(setq lst (entget ent))
(setq box (textbox lst)) ;取得文字的外框坐标
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)));p2为文字插入坐标
(setq p2 (trans p2 1 0))
(setq p4 (list (car p1) (cadr p3)))
(setq num (cdr (assoc 1 lst)))
(if (wcmatch (cdr (assoc 0 lst)) "*_TEXT")
(setq num (atof num))
(progn
(foreach s '("㎡" "平方米" "米")
(while (/= num (setq num (vl-string-subst "" s num))))
)
(while (/= num (setq num (vl-string-subst "*" "×" num))))
(setq num (vl-string-translate "xX" "**" num))
;;优先使用CAD的cal函数计算.
(if CAL
(setq num (float (cal (strcat num "+0.0")))) ;这个地方需要转化为浮点，不然cal函数会出错
;;然后采用vbs计算
(if wcs
(setq num (vlax-invoke wcs 'eval num))
(setq num (CAL:Expr2Value Num))
)
)
)
)
;;; (setq Els (cons ent Els))
;;; (setq Nls (cons num Nls))
(entmake (list '(0 . "TEXT") (cons 1 (rtos num)) (cons 10 p2) (cons 40 (* 0.3 wz_zg))))
(setq i (1+ i))
)
(command "ucs" "")
;;; (list
;;; (reverse Els)
;;; (reverse Nls)
;;; )
(prin1)
)
(prompt "\n根据高飞大神四则运算进行修改<c:cat>")
(prin1)

(defun c:CAt (/ box Els ent i lst nls num p1 p2 p3 p4 sel strlst wcs wz_jd wz_obj wz_zg) 
   
  (if 
    (or 
      (setq wcs (vlax-create-object "Aec32BitAppServer.AecScriptControl.1")) 
      (setq wcs (vlax-create-object "ScriptControl")) 
    ) 
    (vlax-put-property wcs "language" "VBScript") 
  ) 
  (setq i 0) 
  (setq sel (ssget '((0 . "text")))) 
  (repeat (sslength sel) 
    (setq ent (ssname sel i)) 
    (command "ucs" "e" ent) 
    (setq wz_obj (vlax-ename->vla-object ent)) 
    (setq wz_jd (vlax-get-property wz_obj 'Rotation)) ;取得角度 
    (setq wz_zg (vlax-get-property wz_obj 'Height)) ;取得字高 
    (setq lst (entget ent)) 
    (setq box (textbox lst))  ;取得文字的外框坐标 
    (setq p1 (car box)) 
    (setq p3 (cadr box)) 
    (setq p2 (list (car p3) (cadr p1)));p2为文字插入坐标 
                (setq p2 (trans p2 1 0)) 
    (setq p4 (list (car p1) (cadr p3))) 
    
    (setq num (cdr (assoc 1 lst))) 
    (if (wcmatch (cdr (assoc 0 lst)) "*_TEXT") 
      (setq num (atof num)) 
      (progn 
        (foreach s '("㎡" "平方米" "米") 
          (while (/= num (setq num (vl-string-subst "" s num)))) 
        ) 
        (while (/= num (setq num (vl-string-subst "*" "×" num)))) 
        (setq num (vl-string-translate "xX" "**" num)) 
        ;;优先使用CAD的cal函数计算. 
        (if CAL                
          (setq num (float (cal (strcat num "+0.0"))))    ;这个地方需要转化为浮点，不然cal函数会出错 
          ;;然后采用vbs计算 
          (if wcs 
            (setq num (vlax-invoke wcs 'eval num)) 
            (setq num (CAL:Expr2Value Num)) 
          ) 
        ) 
      ) 
    ) 
    ;;;    (setq Els (cons ent Els)) 
    ;;;    (setq Nls (cons num Nls)) 
    (entmake (list '(0 . "TEXT") (cons 1 (rtos num)) (cons 10 p2) (cons 40 (* 0.3 wz_zg)))) 
    (setq i (1+ i)) 
  ) 
  (command "ucs" "") 
  ;;;  (list 
  ;;;    (reverse Els) 
  ;;;    (reverse Nls) 
  ;;;  ) 
  (prin1) 
) 
 
(prompt "\n根据高飞大神四则运算进行修改<c:cat>") 
(prin1)

tigcat · 发表于 2021-12-21 14:23:27

有点尴尬的是我用“stat"命令，进行了统计计算，其实我只想在旁边写出一个结果就好：例："3*5"，我想的是输入命令单击它后在旁边出现一个文字15就行。不知道直接操作怎么实现，看来要利用高飞大神的函数自己稍微改造下？或是原来就带的有呢？

andyding · 发表于 2007-5-22 23:38:00

能否改一下？对尺寸标注的文本也能计算，插入计算结果。

实际运用中很多时候会用到。

TKS！

egos · 发表于 2007-6-4 12:03:00

不错，楼主花了不少功夫

MTEXT对象不受支持

zqb05 · 发表于 2007-6-17 15:40:00

R14底下怎么不能用

carrot1983 · 发表于 2007-6-21 09:18:00

我也来一个。有什么问题，请指教！
输入tt选择多个文本，在文本末尾进行整数四则运算

(defun right-string-number (str / stringlength mantissa)
(setq stringlength (1- (strlen str)))
(setq mantissa (vl-string-elt str stringlength))
(if (and (>= mantissa 48) (<= mantissa 57))
(progn
(setq string (vl-string-right-trim "0123456789" str))
(setq n (vl-string-mismatch string str))
(setq number (substr str (1+ n) (1+ stringlength)))
(list string number)
)
(if (princ (strcat "\n" str "末尾不是数字!"))
nil
)
)
)
(defun jw:szys (sign numlst /)
(if (= sign "+")
(setq result (apply '+ numlst))
)
(if (= sign "-")
(setq result (apply '- numlst))
)
(if (= sign "*")
(setq result (apply '* numlst))
)
(if (= sign "/")
(setq result (apply '/ numlst))
)
result
)
;;;格式化输入整数
(defun jw:int ()
(if (= nil orig_int)
(setq orig_int 1)
(setq orig_int int)
)
(setq int
(getint
(strcat "\n请输入增值<" (itoa orig_int) ">:")
)
)
(if (= nil int)
(setq int orig_int)
)
int
)
(defun jw:sign ()
(if (= nil orig_sign)
(setq orig_sign "+")
(setq orig_sign sign)
)
(initget "+ - * /")
(setq sign
(getkword
(strcat "\n四则运算[/]or[*]or[-]or[+] <"
orig_sign
">:"
)
)
)
(if (= nil sign)
(setq sign orig_sign)
)
sign
)
(princ "\n输入tt选择多个文本，在文本末尾整数进行四则运算")
(princ)
(defun c:tt ()
(if (jw:sign)
(if (jw:int)
(if (setq ss (ssget '((0 . "*text"))))
(progn
(setq slen (- (sslength ss) 1)
i 0
)
(while (<= i slen)
(setq na (ssname ss i)
data (entget na)
str (cdr (assoc 1 data))
)
(if (right-string-number str)
(progn
(setq string (car (right-string-number str))
number (cadr (right-string-number str))
num (jw:szys sign (list (atoi number) int))
str (strcat string (itoa num))
data (subst (cons 1 str) (assoc 1 data) data)
)
(entmod data)
)
)
(setq i (+ i 1))
)
)
)
)
)
(princ)
)

(defun right-string-number (str / stringlength mantissa)
  (setq stringlength (1- (strlen str)))
  (setq mantissa (vl-string-elt str stringlength))
  (if (and (>= mantissa 48) (<= mantissa 57))
    (progn
      (setq string (vl-string-right-trim "0123456789" str))
      (setq n (vl-string-mismatch string str))
      (setq number (substr str (1+ n) (1+ stringlength)))
      (list string number)
    )
    (if (princ (strcat "\n" str "末尾不是数字!"))
      nil
    )
  )
)
(defun jw:szys (sign numlst /)
  (if (= sign "+")
    (setq result (apply '+ numlst))
  )
  (if (= sign "-")
    (setq result (apply '- numlst))
  )
  (if (= sign "*")
    (setq result (apply '* numlst))
  )
  (if (= sign "/")
    (setq result (apply '/ numlst))
  )
  result
)
;;;格式化输入整数
(defun jw:int ()
  (if (= nil orig_int)
    (setq orig_int 1)
    (setq orig_int int)
  )
  (setq int
  (getint
    (strcat "\n请输入增值<" (itoa orig_int) ">:")
  )
  )
  (if (= nil int)
    (setq int orig_int)
  )
  int
)
(defun jw:sign ()
  (if (= nil orig_sign)
    (setq orig_sign "+")
    (setq orig_sign sign)
  )
  (initget "+ - * /")
  (setq sign
  (getkword
    (strcat "\n四则运算[/]or[*]or[-]or[+] <"
     orig_sign
     ">:"
    )
  )
  )
  (if (= nil sign)
    (setq sign orig_sign)
  )
  sign
)

(princ "\n输入tt选择多个文本，在文本末尾整数进行四则运算")
(princ)
(defun c:tt ()
  (if (jw:sign)
    (if (jw:int)
      (if (setq ss (ssget '((0 . "*text"))))
 (progn
   (setq slen (- (sslength ss) 1)
  i    0
   )
   (while (<= i slen)
     (setq na   (ssname ss i)
    data (entget na)
    str  (cdr (assoc 1 data))
     )
     (if (right-string-number str)
       (progn
  (setq string (car (right-string-number str))
        number (cadr (right-string-number str))
        num    (jw:szys sign (list (atoi number) int))
        str    (strcat string (itoa num))
        data   (subst (cons 1 str) (assoc 1 data) data)
  )
  (entmod data)
       )
     )
     (setq i (+ i 1))
   )
 )
      )
    )
  )
  (princ)
)

dkj0322 · 发表于 2010-10-12 08:37:00

谢谢楼上的分享，参考下，很感激

coco25825 · 发表于 2011-7-1 21:18:13

carrot1983 发表于 2007-6-21 09:18
我也来一个。有什么问题，请指教！
输入tt选择多个文本，在文本末尾进行整数四则运算

能否设置一下小数位数啊，不要全整数

humble · 发表于 2011-9-9 15:15:33

不错，功能挺多的

梦里水香 · 发表于 2012-5-10 23:14:29

谢谢楼主，功能很实用。
也谢谢5楼，支持多文本，文本+数字，非常好

freeok · 发表于 2012-7-28 23:45:45

能否实现2*3/2+1-3 求值呢？

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

[【高飞鸟】] 【飞鸟集】数字文本的四则运算和统计（更新到2020.11.09)

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐: