表达式计算修改版本，增加计算函数选择按钮[2019年1月23日更新]

蓝盾设计

可以发一个你的计算器LSP版的吗，我用的微信登录，忘记密码换不到币无法买你的计算器，我的邮箱是335833868@qq.com

wowan1314

c:cal完全可以解决9999*9999的整数计算，
只是结果超过21亿的整数计算才会溢出。
修改下源代码比更换计算内核更好些。

wayne_myles

wowan1314 发表于 2019-1-21 12:58
c:cal完全可以解决9999*9999的整数计算，
只是结果超过21亿的整数计算才会溢出。
修改下源代码比更换计算 ...

终于现身啦!!!原创大大 修改一下吧!!!!21亿的整数绝对够用了

wayne_myles

arcers 发表于 2019-1-18 16:29
改了一下界面；1、关于内容补充；2、底部按钮改到列表右侧-更便于使用。

(defun c:wcal ( / oldch1)

多谢分享!!!

wayne_myles

这个计算器不错 我输入9999*9999直接提示表达式不正确 6666
http://bbs.mjtd.com/thread-111059-1-1.html
我们一起学习 一下

;阿甘CAD计算器 命令ad
;结果自动复制到剪贴板，支持天正文字、天正标高
(setq GL-precision 3)  ;3为计算结果保留位数 自己根据需要修改
(setq GL-text "D:/历史记录.txt" ) ;历史记录文件路径，注意路径为反斜杠“/”，可根据需要修改位置

;不出现对话框，直接计算 命令：y1=加法 y2=减法 y3=乘法 y4=除法
(defun c:y1() (GL:jiafa))
(defun c:y2() (GL:jianfa))
(defun c:y3() (GL:chengfa))
(defun c:y4() (GL:chufa))

;阿甘CAD计算器
(vl-load-com)
(command "cal")(command)     ;先调用cal，否则后面cal函数无法使用
(setq GL-result "")          ;计算结果，全局变量
(setq GL-lst (list ""))
(defun c:ad(/ file)
  (if (not (setq file (open GL-text "r")))
    (progn
      (setq file (open GL-text "w" ))
      (close file)
    )
    (close file)
  )
  (GL-xxjsq)
)
(defun GL-xxjsq (/ fname fn x dclid lin re file txt value reason)
       (if (not GL-result)
           (setq GL-result "")
       )
       (setq fname (vl-filename-mktemp nil nil ".dcl" ))
       (setq fn (open fname "w" ))
       (foreach x '(
                     "  xxjsq : dialog{"
                     "  label=\"阿甘CAD计算器V1.1\";"
                     "  :boxed_column{"
                     "  label=\"自动计算\";"
                     "  :row {"
                     "      :button{key=\"1\";label=\"+\";width=4;}"
                     "      :button{key=\"2\";label=\"-\";width=4;}"
                     "      :button{key=\"3\";label=\"*\";width=4;}"
                     "      :button{key=\"4\";label=\"/\";width=4;}"
                     "  }"
                     "  spacer_1;"
                     "  }"
                     "  :boxed_column{"
                     "  label=\"手动计算\";"
                     "  :row {"
                     "     :edit_box{width=35;key =\"5\";allow_accept = true;}"
                     "      :button{key=\"6\";label=\"计算\";width=4;}"
                     "  }"
                     "  spacer_1;"
                     "  :row {"
                     "      :button{key=\"11\";label=\"C↑\";width=4;}"
                     "      :button{key=\"12\";label=\"C↓\";width=4;}"
                     "      :button{key=\"8\";label=\"拾取\";width=4;}"
                     "      :button{key=\"10\";label=\"插算式\";width=4;}"
                     "      :button{key=\"7\";label=\"插结果\";width=4;}"
                     "  }"
                     "  spacer_1;"
                     "  }"
                     "  :list_box {key=\"9\";label=\"历史记录\";width=40;height=10;}"
                     "      cancel_button;"
                     "}"  
              )
              (princ x fn)
              (write-line "" fn)
       )
       (close fn)
       (setq fn (open fname "r" ))
       (setq dclid (load_dialog fname))
       (while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//" ) (eq (substr lin 1 (vl-string-search " " lin)) "" ) (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog" ))))
       (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)

           (start_list "9")
           (if (equal GL-lst (list ""))
              (progn
                (setq file (open GL-text "r")
                      txt (read-line file)
                )
                (while (/= txt nil)
                        (setq GL-lst (append GL-lst (list txt)))
                        (setq txt (read-line file))
                )
                (close file)
            (setq GL-lst (cdr GL-lst))
            (setq GL-lst (reverse GL-lst))
              )
           )
           (mapcar 'add_list GL-lst)
           (end_list)
      
           (set_tile "5" GL-result)
           (mode_tile "5" 2)
           (Vlax-Invoke-Method (Vlax-Get-Or-Create-Object "WScript.Shell" ) 'Sendkeys "{End}")
       (action_tile "5" "(setq GL-result $Value)")
       (action_tile "1" "(done_dialog 1)" )
       (action_tile "2" "(done_dialog 2)" )
       (action_tile "3" "(done_dialog 3)" )
       (action_tile "4" "(done_dialog 4)" )
       (action_tile "6" "(GL:key6)")
       (action_tile "7" "(done_dialog 7)" )
       (action_tile "8" "(done_dialog 8)" )
       (action_tile "9" "(GL:update-edit $value $reason)")
       (action_tile "10" "(done_dialog 10)" )
       (action_tile "11" "(GL:key11)" )
       (action_tile "12" "(GL:key12)" )
       (action_tile "cancel" "(done_dialog 0)" )
      
       (setq re (start_dialog))
       (cond
            ((= re 1) (GL:jiafa)(GL:update)(GL-xxjsq))
            ((= re 2) (GL:jianfa)(GL:update)(GL-xxjsq))
            ((= re 3) (GL:chengfa)(GL:update)(GL-xxjsq))
            ((= re 4) (GL:chufa)(GL:update)(GL-xxjsq))
            ((= re 7) (GL:crjswz GL-result))
            ((= re 8) (GL:key8))
            ((= re 10) (GL:crjswz (strcat GL-Num "=" GL-result)))
       )
       (unload_dialog dclid)
       (close fn)
       (vl-file-delete fname)
       (princ)
)

(defun GL:jiafa ()(GL:Galculate (GL:GetNumber "+")))
(defun GL:jianfa ()(GL:Galculate (GL:GetNumber "-")))
(defun GL:chengfa ()(GL:Galculate (GL:GetNumber "*")))
(defun GL:chufa ()(GL:Galculate (GL:GetNumber "/")))

;手动计算
(defun GL:key6 ()
  (setq GL-result (get_tile "5"))
  (if (/= GL-result "")
    (progn
     (if (GL:Galculate GL-result)
       (progn
         (set_tile "5" GL-result)
         (mode_tile "5" 2)
         (Vlax-Invoke-Method (Vlax-Get-Or-Create-Object "WScript.Shell" ) 'Sendkeys "{End}")
         (GL:update)
     ))
  ))
)

;拾取
(defun GL:key8 (/ num)
  (if (setq num (GL:GetNumber "+"))
   (progn
    (if (/= GL-result "")
        (setq  GL-result (strcat GL-result "+" num))
        (setq  GL-result (strcat GL-result num))
    )
  ))
  (GL-xxjsq)
)

;清空计算框
(defun GL:key11 ()
  (set_tile "5" "")
  (mode_tile "5" 2)
  (Vlax-Invoke-Method (Vlax-Get-Or-Create-Object "WScript.Shell" ) 'Sendkeys "{End}")
)

;清空历史记录
(defun GL:key12 ()
  (if (GL-qrdhk)
    (progn
      (setq GL-lst (list ""))
          (start_list "9")
          (mapcar 'add_list GL-lst)
          (end_list)
      (setq file (open GL-text "w"))
      (write-line "" file)
      (close file)
    )
  )
  (mode_tile "5" 2)
  (Vlax-Invoke-Method (Vlax-Get-Or-Create-Object "WScript.Shell" ) 'Sendkeys "{End}")
)

;提取数字和运算符
(defun GL:GetNumber (ope / en num i regex ss text tn)
  (setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
  (vlax-put-property regex "IgnoreCase" 0)            ;不忽略大小写
  (vlax-put-property regex "Global" 1)                ;全文匹配，而不是只匹配第一处
  (setq ss (ssget '((0 . "*TEXT,TCH_ELEVATION"))))    ;只拾取文字、天正标高
  (if ss
  (progn
  (setq i 0 Num "")
  (repeat (sslength ss)
    (setq en (ssname ss i))
    (setq GL-ed (entget en))
    (setq text (cdr (assoc 1 GL-ed)))
    (vlax-put-property regex "Pattern" "[^0-9\\+\\-\\*\\/\\.\\(\\)]") ;匹配数字和运算符
    (setq text (vlax-invoke-method regex "Replace" text ""))
    (if (/= text "")
     (progn
      (if (= Num "") ;表达式加括号
        (if (wcmatch text "*`+*,*`-*,*`**,*`/*")
         (setq Num (strcat"(" text ")") TN nil)
         (setq Num text TN nil)
        )
        (setq TN T)
      )
      (if TN ;表达式加括号
        (if (wcmatch text "*`+*,*`-*,*`**,*`/*")
          (setq Num (strcat Num ope "(" text ")"))
          (setq Num (strcat Num ope text))
        )
      )
      ;(if (= Num "")(setq Num text TN nil)(setq TN T));表达式不加括号
      ;(if TN (setq Num (strcat Num ope text)));表达式不加括号
     )
    )
    (setq i (1+ i))
  )
  ))
  Num
)

;计算
(defun GL:Galculate (Num)
  (if Num
   (progn
    (if (setq GL-result (cal (strcat Num "*" "1.0"))) ;*1.0将整数转换为小数，整数只能介于-32768和32767之间
      (progn
            (setq GL-result (rtos GL-result 2 GL-precision))
        (set-clip-string GL-result) ;向系统剪贴板写入文字
        (setq GL-Num Num)
        (princ (strcat "\n表达式：" Num "=" GL-result "  >>>>计算结果：" GL-result))
        (princ)
      )
      (alert (strcat Num "   表达式语法错误!"))
  )))
)

;向系统剪贴板写入文字
(defun set-clip-string (STR / HTML RESULT)
    (and (= (type STR) 'STR)
         (setq HTML (vlax-create-object "htmlfile"))
         (setq RESULT (vlax-invoke
                          (vlax-get (vlax-get HTML 'PARENTWINDOW)
                                    'CLIPBOARDDATA
                          )
                          'SETDATA
                          "Text"
                          STR
                      )
         )
         (vlax-release-object HTML)
    )
)

;插入计算文字
(defun GL:crjswz (GL-result / h la pt sc st ty tzbl)
  (if (/= GL-result "")
   (if (setq pt (getpoint "\n请点取插入点:"))
    (if GL-ed
     (progn
       (setq ty (cdr (assoc 0 GL-ed));字体类型
             st (cdr (assoc 7 GL-ed));字体样式
             la (cdr (assoc 8 GL-ed));图层
             h (cdr (assoc 40 GL-ed));文字高度
             sc (cdr (assoc 47 GL-ed));天正比例
             ;ar (cdr (assoc 41 GL-ed));文字宽高比
             ;co (cdr (assoc 62 GL-ed));颜色
       )
       (if (wcmatch ty "TCH_*")
          (entmake (list
            '(0 . "TEXT")
             (cons 1 GL-result)
             (cons 7 st)
             (cons 8 la)
             (cons 10 pt)
             (cons 40 (* h sc))
             (cons 41 0.8)
           )
          )
          (entmake (list
            '(0 . "TEXT")
             (cons 1 GL-result)
             (cons 7 st)
             (cons 8 la)
             (cons 10 pt)
             (cons 40 h)
             (cons 41 0.8)
           )
          )
       )
     )
         (progn
          ;(setq h (getvar 'textsize)) ;当前样式文字高度
          (setq tzbl (getvar "HPSCALE") ;天正比例
                h (* tzbl 3)
      )
      (entmake (list
          '(0 . "TEXT")
           (cons 1 GL-result)
           (cons 10 pt)
           (cons 40 h)
           )
      )
   ))))
)

;更新历史记录数据，并保存
(defun GL:update (/ file ex)
  (if GL-result
    (progn
      (setq ex (strcat GL-Num "=" GL-result))
      (setq GL-lst (append (list ex) GL-lst))
          (start_list "9")
          (mapcar 'add_list GL-lst)
          (end_list)
      (setq file (open GL-text "a"))
      (write-line ex file)
      (close file)
    )
  )
)

;将历史记录上到计算框
(defun GL:update-edit (value reason / a b ex i len)
  (if (= reason 4)
    (progn
      (setq ex (nth (atoi value) GL-lst)
            len (strlen ex)
            i 1 b ""
      )
      (while (<= i len)
        (setq a (substr ex i 1))
        (if (= a "=")
            (setq i (1+ len))
            (setq b (strcat b a))
        )
        (setq i (1+ i))
      )
      (set_tile "5" b)
      (mode_tile "5" 2)
      (Vlax-Invoke-Method (Vlax-Get-Or-Create-Object "WScript.Shell" ) 'Sendkeys "{End}")
  ))
)

(defun GL-qrdhk (/ fname fn x dclid lin re YorN)
       (setq fname (vl-filename-mktemp nil nil ".dcl" ))
       (setq fn (open fname "w" ))
       (foreach x '(
                     "  qrdhk : dialog{"
                     "  spacer_1;"
                     "      :text{key=\"2\";label=\"是否清除历史记录\";}"
                     "  spacer_1;"
                     "  :row {"
                     "      :button{key=\"1\";label=\"是\";width=8;}"
                     "  spacer_1;"
                     "      cancel_button;"
                     "  }"
                     "  spacer_1;"
                     "}"  
              )
              (princ x fn)
              (write-line "" fn)
       )
       (close fn)
       (setq fn (open fname "r" ))
       (setq dclid (load_dialog fname))
       (while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//" ) (eq (substr lin 1 (vl-string-search " " lin)) "" ) (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog" ))))
       (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
       (action_tile "1" "(done_dialog 1)" )
       (action_tile "cancel" "(done_dialog 0)" )
       (setq re (start_dialog))
       (cond
            ((= re 1) (setq YorN T))
       )
       (unload_dialog dclid)
       (close fn)
       (vl-file-delete fname)
       YorN
)

highflybir

除了用c:cal和我的那个表达式求值方法外，还可以用如下办法：

1.   (or
   
2.     *SCR
   
3.     (setq
   
4.       *SCR (vlax-create-object "Aec32BitAppServer.AecScriptControl.1")
   
5.     )
   
6.     (setq *SCR (vlax-create-object "ScriptControl"))
   
7.   )
   
8.   (vlax-put *SCR 'language "VBScript")
   
9. 
   
10.   (vlax-invoke *SCR 'eval expr)
    

  (or<br />     *SCR<br />     (setq<br />       *SCR (vlax-create-object "Aec32BitAppServer.AecScriptControl.1")<br />     )<br />     (setq *SCR (vlax-create-object "ScriptControl"))<br />   )<br />   (vlax-put *SCR 'language "VBScript")<br /> <br />   (vlax-invoke *SCR 'eval expr)<br />

譬如:
(vlax-invoke *scr 'eval "1+2*3-sin(1/3)")

zixuan203344

highflybir 发表于 2019-1-22 15:31
除了用c:cal和我的那个表达式求值方法外，还可以用如下办法：

譬如:

飞鸟大师666啊，我之前想过调用COM，但是不知道调用哪个……

highflybir

zixuan203344 发表于 2019-1-17 14:30
问题1：已修复
问题2：已修复
问题3：多次测试，2019正常使用，本人电脑装有08、12、14、18、19均正常 ...

关于我的那个mycal函数小数的问题解决：
1、计算表达式本身就改成小数表达，特别是除法： 譬如"1/3"改成"1.0/3"
2、在下面函数中添加
    (if (= (type a) 'INT)
      (setq a (float a))
    )
如下：

1. (defun CAL:Operators (lst funs Recursive / fun L n)
   
2.   (foreach a lst
   
3.     (if        (listp a)
   
4.       (setq a (CAL:Operators a funs T))                                ;如果元素为表，则递归进去
   
5.     )
   
6.     (if (= (type a) 'INT)
   
7.       (setq a (float a))
   
8.     )...

(defun CAL:Operators (lst funs Recursive / fun L n)<br />   (foreach a lst<br />     (if        (listp a)<br />       (setq a (CAL:Operators a funs T))                                ;如果元素为表，则递归进去<br />     )<br />     (if (= (type a) 'INT)<br />       (setq a (float a))<br />     )...

zixuan203344

highflybir 发表于 2019-1-22 16:56
关于我的那个mycal函数小数的问题解决：
1、计算表达式本身就改成小数表达，特别是除法： 譬如"1/3"改成 ...

小数不正确的原因是，值转字符串时候原程序用vl-princ-to-string。见啥输出啥，换成了rtos就好了。
但是c:cal的999*999溢出整数范围确实是识别问题

zixuan203344

wayne_myles 发表于 2019-1-22 11:09
这个计算器不错 我输入9999*9999直接提示表达式不正确 6666
http://bbs.mjtd.com/thread-111059-1-1.html
...

折腾一个就好了，这个我就不想折腾了，其实主题那个我自己用不上，只是看有这么多人需要我就花点时间折腾了