求更改源码适合2014版cad使用

wayne_myles

这里不是最新版的  最新请到http://bbs.mjtd.com/thread-178871-1-1.html
谢谢zixuan203344大大对它的改进 完善 已经让它焕发出新胡生命力!!!!!!!


最终修改的源码在14#     !!!     再次感谢谢谢zixuan203344大大和yshf大大指点!!!!!!!十分感谢!!!!!!!

但是这个文本计算自身有局限 比如999*999它就计算不了!!!!!!!!!!!!!!!!!
求原因!!! 求改进!!-----已解决谢谢zixuan203344大大
感谢yshf大大指点-----已解决2014使用问题
最终修改的源码在14#  


葛老wowan1314的源码原贴地址http://bbs.mjtd.com/thread-110081-1-1.html

求助葛老本人 没反应
所以求助诸位大大 帮忙修改一下让cad2014可以完美运行!!!
谢谢关注谢谢指点!!






下面需要更新源码
=======================================================
;;;表达式计算器
(prompt "\n >>>欢迎使用表达式计算器，命令: wwcalc <<<")
(defun c:wwcal ( / oldch1)
    (vl-load-com)
    (if (member "geomcal.arx" (arx)) nil
        (arxload "geomcal.arx" nil)
    )
    ;;; 灰显控件
    (defun gps->dcl-disablectrls (keylist / key)
        (foreach key keylist (mode_tile key 1))
    )
    ;;;激活控件
    (defun gps->dcl-enablectrls (keylist / key)
        (foreach key keylist (mode_tile key 0))
    )
    ;;;设置剪切板
    (defun gxl-copytoclipboard(text / clip_board)
        (setq clip_board (vlax-get-property (vlax-get (vlax-create-object "htmlfile") 'parentwindow) 'clipboarddata))
        (vlax-invoke clip_board 'setdata "text" text)
        (vlax-release-object clip_board)
        text
    )
    ;;;关于
    (defun note_about ()
        (alert
            (strcat
                "────────────────────────────\n"
                "表达式计算器 V1.0 for AutoCAD2004\n"
                "wowan1314 ,2014年5月13日\n"
                "────────────────────────────\n"
                "程序简介<表达式写法参考cal命令>:\n"
                "1.表达式计算器,并将计算过程存在图形文件中.方便查看.\n"
                "2.作者尽力将本程序做得完善,但不会因本软件的错失\n"
                "  而造成的损失承担任何责任。\n"
                "3.程序还无法增加自定义函数，等待您的参与"
            )
        )
    )
    ;;;计算
    (defun note_add( / note time mmm)
        (if (/= (setq note (get_tile "edit")) "")
            (progn
                (setq mmm (vl-catch-all-apply 'c:cal (list note)))
                (if
                    (null mmm)
                    (progn (mode_tile "edit" 2)(alert "表达式错误!请检查!"))
                    (progn
                        (setq time (menucmd "M=$(edtime,$(getvar,date),YYYY_MODD_HHMMSS)"))
                        (setq mmm (vl-princ-to-string mmm))
                        (vlax-ldata-put "#wwcalc#" time (strcat note "=" mmm))
                        (gxl-copytoclipboard mmm)
                        (setq oldch1 mmm)
                        (note_fill_lst)
                    )
                )
            )
            (progn
                (mode_tile "edit" 2)
                (alert "输入计算表达式!")
            )
        )
    )
    ;;;dcl赋值
    (defun note_fill_lst( / n)
        (setq #notedataall(vlax-ldata-list "#wwcalc#") #notedata (mapcar 'cdr #notedataall))
        (if oldch1 (set_tile "edit" oldch1))
        (start_list "list")
        (if #notedataall
            (progn
                (foreach n #notedataall
                    (add_list (cdr n))
                )
                (gps->dcl-enablectrls '("sdel" "alldel"))
            )
            (gps->dcl-disablectrls '("sdel" "alldel"))
        )
        (end_list)
        (set_tile "list" "0")
        (mode_tile "edit" 2)
    )
    ;;;单删
    (defun note_lst_sdel( / get n)
        (if (and #notedataall (/= "" (setq get (get_tile "list"))))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (vlax-ldata-delete "#wwcalc#" (car n))
                (note_fill_lst)
            )
        )
    )
    ;;;全删
    (defun note_lst_alldel( / n)
        (foreach n #notedataall (vlax-ldata-delete "#wwcalc#" (car n)))
        (note_fill_lst)
    )
    ;;;双击list.
    (defun note_ok( / get n)
        (if (/= "" (setq get (get_tile "list")))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (gxl-copytoclipboard (cdr n))
                (set_tile "edit" (cdr n))(mode_tile "edit" 2)
            )
        )
    )
    ;;拾取内容
    (defun shiqua (/ ent1 ent2 entdata tmlist entlist textzs)
        (while (null (setq ent1 (nentsel ))))
        (if ent1
            (progn(setq oldch1 (cdr(assoc 1(entget(car ent1)))))
                (caldhk))
        )
    )
    ;end shiqu1
    ;;;
    (defun caldhk ( / #notedata #notedataall dclid dclname filen fn get n note stream tempname time re)
        (setq dclname
            (cond
                ((setq tempname (vl-filename-mktemp "gps-dcl-tmp.dcl") filen (open tempname "w"))
                    (foreach stream
                        '(
                            "ibutton:button{width=12;fixed_width=true;}\n"
                            "wwcalc:dialog{label=\"表达式计算器 v1.0----by wowan1314 \";\n"
                            "  :boxed_row{label=\"输入计算表达式\";\n"
                            "     :edit_box{key=\"edit\"; allow_accept=true;}\n"
                            "  :ibutton{label=\"计算\";key=\"add\";is_default = true;}\n"
                            "  }\n"
                            "  :boxed_column{label=\"历史记录\";\n"
                            "     :list_box{key=\"list\";}\n"
                            "  }\n"
                            ":image {color = 194 ;height = 0.1 ;}\n"
                            "  :row{\n"
                            "  :ibutton{label=\"拾取\";key=\"txtin\";}\n"
                            "  :ibutton{label=\"单删\";key=\"sdel\";}\n"
                            "  :ibutton{label=\"全删\";key=\"alldel\";}\n"
                            "  :ibutton{is_cancel=true;label=\"取消\";}\n"
                            "  :ibutton{label=\"预留扩展\";key=\"about\";}\n"
                            "  }\n"
                            "}\n"
                        )
                        (princ stream filen)
                    )
                    (close filen)
                    tempname
                )
            )
        )
        (setq dclid (load_dialog dclname))
        (if (not(new_dialog "wwcalc" dclid))
            (progn (alert "dcl对话框加载失败.")(exit))
        )
        (note_fill_lst)
        (action_tile "add" "(note_add)")
        (action_tile "list" "(if(= $reason 4)(note_ok))")
        (action_tile "cancel" "(done_dialog 0)")
        (action_tile "sdel" "(note_lst_sdel)")
        (action_tile "alldel" "(note_lst_alldel)")
        (action_tile "about" "(note_about)")
        (action_tile "txtin" "(done_dialog 1)")
        (action_tile "txtout" "(note_out)")
        (setq re (start_dialog))
        (if (= re 1) (shiqua))
        (unload_dialog dclid)
        (vl-file-delete dclname)
        (prin1)
    )
    (caldhk)
)


      
#########################################################
#########################################################
#########################################################
#########################################################
#########################################################
#########################################################
#########################################################

                !!!!!!!!!!!!!!!!!!!!!!!以下版本可以高版cad运行!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

========================================================
                        感谢yshf大大指点 ----改进版  for 高版本CAD
========================================================
;;;表达式计算器
(prompt "\n >>>欢迎使用表达式计算器，命令: wwcalc <<<")
(defun c:wwcal  ( / oldch1)
    (vl-load-com)
     (if (< (atof (substr (getvar "acadver") 1 4)) 19)
        (setq calwjm "geomcal.arx")
        (setq calwjm "geomcal.crx")
    )
    (if (member calwjm (arx))
        nil
        (arxload calwjm nil)
    )
    ;;; 灰显控件
    (defun gps->dcl-disablectrls (keylist / key)
        (foreach key keylist (mode_tile key 1))
    )
    ;;;激活控件
    (defun gps->dcl-enablectrls (keylist / key)
        (foreach key keylist (mode_tile key 0))
    )
    ;;;设置剪切板
    (defun gxl-copytoclipboard(text / clip_board)
        (setq clip_board (vlax-get-property (vlax-get (vlax-create-object "htmlfile") 'parentwindow) 'clipboarddata))
        (vlax-invoke clip_board 'setdata "text" text)
        (vlax-release-object clip_board)
        text
    )
    ;;;关于
    (defun note_about ()
        (alert
            (strcat
                "────────────────────────────\n"
                "表达式计算器 V1.0 for AutoCAD2014\n"
                "wowan1314 ,yshf改进 2014年5月13日\n"
                "────────────────────────────\n"
                "程序简介<表达式写法参考cal命令>:\n"
                "1.表达式计算器,并将计算过程存在图形文件中.方便查看.\n"
                "2.作者尽力将本程序做得完善,但不会因本软件的错失\n"
                "  而造成的损失承担任何责任。\n"
                "3.程序还无法增加自定义函数，等待您的参与"
            )
        )
    )
    ;;;计算
    (defun note_add( / note time mmm)
        (if (/= (setq note (get_tile "edit")) "")
            (progn
                (setq mmm (vl-catch-all-apply 'c:cal (list note)))
                (if
                    (null mmm)
                    (progn (mode_tile "edit" 2)(alert "请检查表达式!"))
                    (progn
                        (setq time (menucmd "M=$(edtime,$(getvar,date),YYYY_MODD_HHMMSS)"))
                        (setq mmm (vl-princ-to-string mmm))
                        (vlax-ldata-put "#wwcalc#" time (strcat note "=" mmm))
                        (gxl-copytoclipboard mmm)
                        (setq oldch1 mmm)
                        (note_fill_lst)
                    )
                )
            )
            (progn
                (mode_tile "edit" 2)
                (alert "输入计算表达式!")
            )
        )
    )
    ;;;dcl赋值
    (defun note_fill_lst( / n)
        (setq #notedataall(vlax-ldata-list "#wwcalc#") #notedata (mapcar 'cdr #notedataall))
        (if oldch1 (set_tile "edit" oldch1))
        (start_list "list")
        (if #notedataall
            (progn
                (foreach n #notedataall
                    (add_list (cdr n))
                )
                (gps->dcl-enablectrls '("sdel" "alldel"))
            )
            (gps->dcl-disablectrls '("sdel" "alldel"))
        )
        (end_list)
        (set_tile "list" "0")
        (mode_tile "edit" 2)
    )
    ;;;单删
    (defun note_lst_sdel( / get n)
        (if (and #notedataall (/= "" (setq get (get_tile "list"))))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (vlax-ldata-delete "#wwcalc#" (car n))
                (note_fill_lst)
            )
        )
    )
    ;;;全删
    (defun note_lst_alldel( / n)
        (foreach n #notedataall (vlax-ldata-delete "#wwcalc#" (car n)))
        (note_fill_lst)
    )
    ;;;双击list.
    (defun note_ok( / get n)
        (if (/= "" (setq get (get_tile "list")))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (gxl-copytoclipboard (cdr n))
                (set_tile "edit" (cdr n))(mode_tile "edit" 2)
            )
        )
    )
    ;;拾取内容
    (defun shiqua (/ ent1 ent2 entdata tmlist entlist textzs)
        (while (null (setq ent1 (nentsel ))))
        (if ent1
            (progn(setq oldch1 (cdr(assoc 1(entget(car ent1)))))
                (caldhk))
        )
    )
    ;end shiqu1
    ;;;
    (defun caldhk ( / #notedata #notedataall dclid dclname filen fn get n note stream tempname time re)
        (setq dclname
            (cond
                ((setq tempname (vl-filename-mktemp "gps-dcl-tmp.dcl") filen (open tempname "w"))
                    (foreach stream
                        '(
                            "ibutton:button{width=12;fixed_width=true;}\n"
                            "wwcalc:dialog{label=\"  \";\n"
                            "  :boxed_row{label=\"输入计算表达式\";\n"
                            "     :edit_box{key=\"edit\"; allow_accept=true;}\n"
                            "  :ibutton{label=\"运算\";key=\"add\";is_default = true;}\n"
                            "  }\n"
                            "  :boxed_column{label=\"历史记录\";\n"
                            "  :list_box{key=\"list\";height=17;}\n"
                            "  }\n"
                            "  :image {color = 194 ;height = 0.1 ;}\n"
                            "  :row{\n"
                            "  :ibutton{label=\"拾取\";key=\"txtin\";}\n"
                            "  :ibutton{label=\"单删\";key=\"sdel\";}\n"
                            "  :ibutton{label=\"全删\";key=\"alldel\";}\n"
                            "  :ibutton{is_cancel=true;label=\"取消\";}\n"

                            "  }\n"
                            "}\n"
                        )
                        (princ stream filen)
                    )
                    (close filen)
                    tempname
                )
            )
        )
        (setq dclid (load_dialog dclname))
        (if (not(new_dialog "wwcalc" dclid))
            (progn (alert "dcl对话框未加载.")(exit))
        )
        (note_fill_lst)
        (action_tile "add" "(note_add)")
        (action_tile "list" "(if(= $reason 4)(note_ok))")
        (action_tile "cancel" "(done_dialog 0)")
        (action_tile "sdel" "(note_lst_sdel)")
        (action_tile "alldel" "(note_lst_alldel)")
        (action_tile "about" "(note_about)")
        (action_tile "txtin" "(done_dialog 1)")
        (action_tile "txtout" "(note_out)")
        (setq re (start_dialog))
        (if (= re 1) (shiqua))
        (unload_dialog dclid)
        (vl-file-delete dclname)
        (prin1)
    )
    (caldhk)
)


#########################################################
#########################################################
#########################################################
#########################################################
#########################################################
#########################################################
#########################################################
=========================================================
                     谢谢zixuan203344大大对999*999它就计算不了的改进 最终完美的代码                                                              温馨提示   较大数值不在此文本计算器能力范围之内 注意检查 !!  
=========================================================
;;;表达式计算器
;修改by 晗子轩 515357067 2019-1-16
;引用飞鸟大师的计算函数库，修正999*999结果溢出的bug
(prompt "\n >>>欢迎使用表达式计算器，命令: wwcalc <<<")
(defun c:wwcal  ( / oldch1)
        (vl-load-com)
        (if (< (atof (substr (getvar "acadver") 1 4)) 19)
                (setq calwjm "geomcal.arx")
                (setq calwjm "geomcal.crx")
        )
        (if (member calwjm (arx))
                nil
                (arxload calwjm nil)
        )
        ;;; 灰显控件
        (defun gps->dcl-disablectrls (keylist / key)
                (foreach key keylist (mode_tile key 1))
        )
        ;;;激活控件
        (defun gps->dcl-enablectrls (keylist / key)
                (foreach key keylist (mode_tile key 0))
        )
        ;;;设置剪切板
        (defun gxl-copytoclipboard(text / clip_board)
                (setq clip_board (vlax-get-property (vlax-get (vlax-create-object "htmlfile") 'parentwindow) 'clipboarddata))
                (vlax-invoke clip_board 'setdata "text" text)
                (vlax-release-object clip_board)
                text
        )
        ;;;关于
        (defun note_about ()
                (alert
                        (strcat
                                "────────────────────────────\n"
                                "表达式计算器 V1.0 for AutoCAD2014\n"
                                "wowan1314 ,yshf改进 2014年5月13日\n"
                                "────────────────────────────\n"
                                "程序简介<表达式写法参考cal命令>:\n"
                                "1.表达式计算器,并将计算过程存在图形文件中.方便查看.\n"
                                "2.作者尽力将本程序做得完善,但不会因本软件的错失\n"
                                "  而造成的损失承担任何责任。\n"
                                "3.程序还无法增加自定义函数，等待您的参与"
                        )
                )
        )
        ;;;计算
        (defun note_add( / note time mmm)
                (if (/= (setq note (get_tile "edit")) "")
                        (progn
                                ;(setq mmm (vl-catch-all-apply 'c:cal (list note)))
                                (setq mmm (vl-catch-all-apply 'CAL:Expr2Value (list note)))
                                (if
                                        (null mmm)
                                        (progn (mode_tile "edit" 2)(alert "请检查表达式!"))
                                        (progn
                                                (setq time (menucmd "M=$(edtime,$(getvar,date),YYYY_MODD_HHMMSS)"))
                                                (setq mmm (vl-princ-to-string mmm))
                                                (vlax-ldata-put "#wwcalc#" time (strcat note "=" mmm))
                                                (gxl-copytoclipboard mmm)
                                                (setq oldch1 mmm)
                                                (note_fill_lst)
                                        )
                                )
                        )
                        (progn
                                (mode_tile "edit" 2)
                                (alert "输入计算表达式!")
                        )
                )
        )
        ;;;dcl赋值
        (defun note_fill_lst( / n)
                (setq #notedataall(vlax-ldata-list "#wwcalc#") #notedata (mapcar 'cdr #notedataall))
                (if oldch1 (set_tile "edit" oldch1))
                (start_list "list")
                (if #notedataall
                        (progn
                                (foreach n #notedataall
                                        (add_list (cdr n))
                                )
                                (gps->dcl-enablectrls '("sdel" "alldel"))
                        )
                        (gps->dcl-disablectrls '("sdel" "alldel"))
                )
                (end_list)
                (set_tile "list" "0")
                (mode_tile "edit" 2)
        )
        ;;;单删
        (defun note_lst_sdel( / get n)
                (if (and #notedataall (/= "" (setq get (get_tile "list"))))
                        (progn
                                (setq n (nth (atoi get) #notedataall))
                                (vlax-ldata-delete "#wwcalc#" (car n))
                                (note_fill_lst)
                        )
                )
        )
        ;;;全删
        (defun note_lst_alldel( / n)
                (foreach n #notedataall (vlax-ldata-delete "#wwcalc#" (car n)))
                (note_fill_lst)
        )
        ;;;双击list.
        (defun note_ok( / get n)
                (if (/= "" (setq get (get_tile "list")))
                        (progn
                                (setq n (nth (atoi get) #notedataall))
                                (gxl-copytoclipboard (cdr n))
                                (set_tile "edit" (cdr n))(mode_tile "edit" 2)
                        )
                )
        )
        ;;拾取内容
        (defun shiqua (/ ent1 ent2 entdata tmlist entlist textzs)
                (while (null (setq ent1 (nentsel))))
                (if ent1
                        (progn(setq oldch1 (cdr(assoc 1(entget(car ent1)))))
                                (caldhk))
                )
        )
        ;end shiqu1
        ;;;
        (defun caldhk ( / #notedata #notedataall dclid dclname filen fn get n note stream tempname time re)
                (setq dclname
                        (cond
                                ((setq tempname (vl-filename-mktemp "gps-dcl-tmp.dcl") filen (open tempname "w"))
                                        (foreach stream
                                                '(
                                                         "ibutton:button{width=12;fixed_width=true;}\n"
                                                         "wwcalc:dialog{label=\"          较大数值不在此文本计算器能力范围之内 注意检查 !!      \";\n"
                                                         "  :boxed_row{label=\"输入计算表达式\";\n"
                                                         "     :edit_box{key=\"edit\"; allow_accept=true;}\n"
                                                         "  :ibutton{label=\"运算\";key=\"add\";is_default = true;}\n"
                                                         "  }\n"
                                                         "  :boxed_column{label=\"历史记录\";\n"
                                                         "  :list_box{key=\"list\";height=25;}\n"
                                                         "  }\n"
                                                         "  :image {color = 194 ;height = 0.1 ;}\n"
                                                         "  :row{\n"
                                                         "  :ibutton{label=\"拾取\";key=\"txtin\";}\n"
                                                         "  :ibutton{label=\"单删\";key=\"sdel\";}\n"
                                                         "  :ibutton{label=\"全删\";key=\"alldel\";}\n"
                                                         "  :ibutton{is_cancel=true;label=\"取消\";}\n"
                                                         
                                                         "  }\n"
                                                         "}\n"
                                                 )
                                                (princ stream filen)
                                        )
                                        (close filen)
                                        tempname
                                )
                        )
                )
                (setq dclid (load_dialog dclname))
                (if (not(new_dialog "wwcalc" dclid))
                        (progn (alert "dcl对话框未加载.")(exit))
                )
                (note_fill_lst)
                (action_tile "add" "(note_add)")
                (action_tile "list" "(if(= $reason 4)(note_ok))")
                (action_tile "cancel" "(done_dialog 0)")
                (action_tile "sdel" "(note_lst_sdel)")
                (action_tile "alldel" "(note_lst_alldel)")
                (action_tile "about" "(note_about)")
                (action_tile "txtin" "(done_dialog 1)")
                (action_tile "txtout" "(note_out)")
                (setq re (start_dialog))
                (if (= re 1) (shiqua))
                (unload_dialog dclid)
                (vl-file-delete dclname)
                (prin1)
        )
        (caldhk)
)
(defun CAL:Expr2Value (expr / lst)
  (setq lst (CAL:Separate expr))                                ;先按照括号空格和运算符分离字符
  (setq lst (CAL:Operators lst '((^ . expt)) ()))                ;乘方（幂）最优先
  (setq lst (CAL:Operators lst '((* . *) (/ . /) (% . rem)) ()));其次乘除和求模运算
  (setq lst (CAL:Operators lst '((+ . +) (- . -)) ()))                ;最后处理加减法运算
  (eval (car lst))                                                ;求值
)
(defun CAL:Separate (expr / CHAR FUNS LASTCHAR LST Temp LBRACKET RBRACKET next)
  (setq expr (vl-string-translate "{[]}\t\n," "(())   " expr))  ;替换{[]}\t\n,字符
  (setq expr (strcase expr t))                                        ;全部转为小写
  (setq funs '("+" "-" "*" "/" "^" "%" ))                        ;按照基本运算符分割字符
  (setq Temp "")
  (setq lst "(")
  (setq Lbracket 0)                                                ;左括号计数器
  (setq Rbracket 0)                                                ;右括号计数器
  (while (/= expr "")
    (setq char (substr expr 1 1))                               ;字符串的第一个字符
    (setq next (substr expr 2 1))                                ;字符串的第二个字符
    (if(or (= char "(")
                                 (= char ")")                                        ;括号一定是分隔符
                                 (and (= char " ") (/= next "(") (/= next " "))      ;如果不是连续的空格符
                                 (and (member char funs)                                ;根据运算符进行分割
                                         (not (CAL:isScientific temp lastchar char))    ;忽略科学计数法
                                 )                                                                                 
                         )
      (progn
        (if (CAL:IsFunction (Read temp))                        ;如果为普通函数
          (setq        lst         (strcat lst "(" Temp " " )                ;则把括号移至函数符号前
                                                Lbracket (1+ Lbracket)                                ;左括号计数器加1
          )
          (progn
            (and (= char "(") (setq Lbracket (1+ Lbracket)))    ;左括号计数器加1
            (and (= char ")") (setq Rbracket (1+ Rbracket)))        ;右括号计数器加1
            (setq lst (strcat lst Temp " " char " "))
          )
        )
        (setq Temp "")                                          ;如果是函数或者括号空格之类，则在此处重新开始  
      )
      (setq Temp (strcat Temp char))                            ;否则连取这个字符
    )
    (setq expr (substr expr 2))                                        ;字符串剩下的字符
    (setq lastchar char)
  )
  (if (/= Lbracket Rbracket)                                        ;如果括号不平衡
    (alert "括号不匹配(Mismatched Brackets)!")                        ;警告信息
    (read (strcat lst Temp ")"))                                ;否则转为表
  )
)
(defun CAL:Operators (lst funs Recursive / fun L n)
  (foreach a lst
    (if(listp a)
      (setq a (CAL:Operators a funs T))                                ;如果元素为表，则递归进去
    )
    (if(setq fun (cdr (assoc (car L) funs)))                   ;前一个符号为+-*/%^运算符
      (if (or (null (setq n (cadr L)))                          ;前前一个符号为空
                                                (and (VL-SYMBOLP n) (CAL:IsFunction n))           ;或者是函数符号
          )
        (setq L (cons (list fun a) (cdr L)))                    ;无须交换位置
        (setq L (cons (list fun n a) (cddr L)))                        ;交换运算符和操作数位置
      )
      (setq L (cons a L))                                       ;其他的不做改变
    )                                            
  )
  (setq n (car L))
  (if (and Recursive (not (cadr L)) (or (listp n) (numberp n))) ;如果是递归的,而且只有一个元素，且这个元素为表或者数字
    n                                                                ;那么就只取这个元素，以防止多余括号出现
    (reverse L)                                                        ;cons运算后的反转表列
  )
)
(defun CAL:isScientific (temp lastchar char)
  (and (= lastchar "e") (numberp (read (strcat temp char "0"))))
)
(defun CAL:IsFunction (n)
  (setq n (type (eval n)))
  (or (= n 'SUBR) (= n 'USUBR))
)

yshf

只需要将：
    (if (member "geomcal.arx" (arx)) nil
        (arxload "geomcal.arx" nil)
    )
改为：
    (if (< (atof (substr (getvar "acadver") 1 4)) 19)
        (setq calwjm "geomcal.arx")
        (setq calwjm "geomcal.crx")
    )
    (if (member calwjm (arx))
        nil
        (arxload calwjm nil)
    )
即可。

wayne_myles

yshf 发表于 2019-1-10 07:19
只需要将：
    (if (member "geomcal.arx" (arx)) nil
        (arxload "geomcal.arx" nil)

大大 高手 一下子成功!十分感谢!
方便我等小白

最终代码
;;;表达式计算器
(prompt "\n >>>欢迎使用表达式计算器，命令: wwcalc <<<")
(defun c:wwcal ( / oldch1)
    (vl-load-com)
     (if (< (atof (substr (getvar "acadver") 1 4)) 19)
        (setq calwjm "geomcal.arx")
        (setq calwjm "geomcal.crx")
    )
    (if (member calwjm (arx))
        nil
        (arxload calwjm nil)
    )
    ;;; 灰显控件
    (defun gps->dcl-disablectrls (keylist / key)
        (foreach key keylist (mode_tile key 1))
    )
    ;;;激活控件
    (defun gps->dcl-enablectrls (keylist / key)
        (foreach key keylist (mode_tile key 0))
    )
    ;;;设置剪切板
    (defun gxl-copytoclipboard(text / clip_board)
        (setq clip_board (vlax-get-property (vlax-get (vlax-create-object "htmlfile") 'parentwindow) 'clipboarddata))
        (vlax-invoke clip_board 'setdata "text" text)
        (vlax-release-object clip_board)
        text
    )
    ;;;关于
    (defun note_about ()
        (alert
            (strcat
                "────────────────────────────\n"
                "表达式计算器 V1.0 for AutoCAD2004\n"
                "wowan1314 ,2014年5月13日\n"
                "────────────────────────────\n"
                "程序简介<表达式写法参考cal命令>:\n"
                "1.表达式计算器,并将计算过程存在图形文件中.方便查看.\n"
                "2.作者尽力将本程序做得完善,但不会因本软件的错失\n"
                "  而造成的损失承担任何责任。\n"
                "3.程序还无法增加自定义函数，等待您的参与"
            )
        )
    )
    ;;;计算
    (defun note_add( / note time mmm)
        (if (/= (setq note (get_tile "edit")) "")
            (progn
                (setq mmm (vl-catch-all-apply 'c:cal (list note)))
                (if
                    (null mmm)
                    (progn (mode_tile "edit" 2)(alert "表达式错误!请检查!"))
                    (progn
                        (setq time (menucmd "M=$(edtime,$(getvar,date),YYYY_MODD_HHMMSS)"))
                        (setq mmm (vl-princ-to-string mmm))
                        (vlax-ldata-put "#wwcalc#" time (strcat note "=" mmm))
                        (gxl-copytoclipboard mmm)
                        (setq oldch1 mmm)
                        (note_fill_lst)
                    )
                )
            )
            (progn
                (mode_tile "edit" 2)
                (alert "输入计算表达式!")
            )
        )
    )
    ;;;dcl赋值
    (defun note_fill_lst( / n)
        (setq #notedataall(vlax-ldata-list "#wwcalc#") #notedata (mapcar 'cdr #notedataall))
        (if oldch1 (set_tile "edit" oldch1))
        (start_list "list")
        (if #notedataall
            (progn
                (foreach n #notedataall
                    (add_list (cdr n))
                )
                (gps->dcl-enablectrls '("sdel" "alldel"))
            )
            (gps->dcl-disablectrls '("sdel" "alldel"))
        )
        (end_list)
        (set_tile "list" "0")
        (mode_tile "edit" 2)
    )
    ;;;单删
    (defun note_lst_sdel( / get n)
        (if (and #notedataall (/= "" (setq get (get_tile "list"))))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (vlax-ldata-delete "#wwcalc#" (car n))
                (note_fill_lst)
            )
        )
    )
    ;;;全删
    (defun note_lst_alldel( / n)
        (foreach n #notedataall (vlax-ldata-delete "#wwcalc#" (car n)))
        (note_fill_lst)
    )
    ;;;双击list.
    (defun note_ok( / get n)
        (if (/= "" (setq get (get_tile "list")))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (gxl-copytoclipboard (cdr n))
                (set_tile "edit" (cdr n))(mode_tile "edit" 2)
            )
        )
    )
    ;;拾取内容
    (defun shiqua (/ ent1 ent2 entdata tmlist entlist textzs)
        (while (null (setq ent1 (nentsel ))))
        (if ent1
            (progn(setq oldch1 (cdr(assoc 1(entget(car ent1)))))
                (caldhk))
        )
    )
    ;end shiqu1
    ;;;
    (defun caldhk ( / #notedata #notedataall dclid dclname filen fn get n note stream tempname time re)
        (setq dclname
            (cond
                ((setq tempname (vl-filename-mktemp "gps-dcl-tmp.dcl") filen (open tempname "w"))
                    (foreach stream
                        '(
                            "ibutton:button{width=12;fixed_width=true;}\n"
                            "wwcalc:dialog{label=\"表达式计算器 v1.0----by wowan1314 \";\n"
                            "  :boxed_row{label=\"输入计算表达式\";\n"
                            "     :edit_box{key=\"edit\"; allow_accept=true;}\n"
                            "  :ibutton{label=\"计算\";key=\"add\";is_default = true;}\n"
                            "  }\n"
                            "  :boxed_column{label=\"历史记录\";\n"
                            "     :list_box{key=\"list\";}\n"
                            "  }\n"
                            ":image {color = 194 ;height = 0.1 ;}\n"
                            "  :row{\n"
                            "  :ibutton{label=\"拾取\";key=\"txtin\";}\n"
                            "  :ibutton{label=\"单删\";key=\"sdel\";}\n"
                            "  :ibutton{label=\"全删\";key=\"alldel\";}\n"
                            "  :ibutton{is_cancel=true;label=\"取消\";}\n"
                            "  :ibutton{label=\"预留扩展\";key=\"about\";}\n"
                            "  }\n"
                            "}\n"
                        )
                        (princ stream filen)
                    )
                    (close filen)
                    tempname
                )
            )
        )
        (setq dclid (load_dialog dclname))
        (if (not(new_dialog "wwcalc" dclid))
            (progn (alert "dcl对话框加载失败.")(exit))
        )
        (note_fill_lst)
        (action_tile "add" "(note_add)")
        (action_tile "list" "(if(= $reason 4)(note_ok))")
        (action_tile "cancel" "(done_dialog 0)")
        (action_tile "sdel" "(note_lst_sdel)")
        (action_tile "alldel" "(note_lst_alldel)")
        (action_tile "about" "(note_about)")
        (action_tile "txtin" "(done_dialog 1)")
        (action_tile "txtout" "(note_out)")
        (setq re (start_dialog))
        (if (= re 1) (shiqua))
        (unload_dialog dclid)
        (vl-file-delete dclname)
        (prin1)
    )
    (caldhk)
)

wayne_myles

yshf 发表于 2019-1-10 07:19
只需要将：
    (if (member "geomcal.arx" (arx)) nil
        (arxload "geomcal.arx" nil)

顺便再请教大大一个问题!!
历史记录区域我希望多显示几条历史
请问如何加宽历史记录区域如下图所示!!!
谢谢

yshf

将源程序：
"  :boxed_column{label=\"历史记录\";\n"
         "     :list_box{key=\"list\";}\n"
         "  }\n"
改为：
"  :boxed_column{label=\"历史记录\";\n"
         "     :list_box{key=\"list\";height=25;}\n"
         "  }\n"
其中的数字25，可试着调整到满意为止。

wayne_myles

yshf 发表于 2019-1-10 21:00
将源程序：
"  :boxed_column{label=\"历史记录\";\n"
         "     :list_box{key=\"list\";}\n"

好的 谢谢大大再次出手相助!!!这下完美了!!!!

lanbior

厉害了，学习学习

664571221

你可以吧最后的代码在发一遍吗，我这里显示多余的括号

wayne_myles

664571221 发表于 2019-1-13 08:53
你可以吧最后的代码在发一遍吗，我这里显示多余的括号

;;;表达式计算器
(prompt "\n >>>欢迎使用表达式计算器，命令: wwcalc <<<")
(defun c:ca ( / oldch1)
    (vl-load-com)
     (if (< (atof (substr (getvar "acadver") 1 4)) 19)
        (setq calwjm "geomcal.arx")
        (setq calwjm "geomcal.crx")
    )
    (if (member calwjm (arx))
        nil
        (arxload calwjm nil)
    )
    ;;; 灰显控件
    (defun gps->dcl-disablectrls (keylist / key)
        (foreach key keylist (mode_tile key 1))
    )
    ;;;激活控件
    (defun gps->dcl-enablectrls (keylist / key)
        (foreach key keylist (mode_tile key 0))
    )
    ;;;设置剪切板
    (defun gxl-copytoclipboard(text / clip_board)
        (setq clip_board (vlax-get-property (vlax-get (vlax-create-object "htmlfile") 'parentwindow) 'clipboarddata))
        (vlax-invoke clip_board 'setdata "text" text)
        (vlax-release-object clip_board)
        text
    )
    ;;;关于
    (defun note_about ()
        (alert
            (strcat
                "────────────────────────────\n"
                "表达式计算器 V1.0 for AutoCAD2014\n"
                "wowan1314 ,yshf改进 2014年5月13日\n"
                "────────────────────────────\n"
                "程序简介<表达式写法参考cal命令>:\n"
                "1.表达式计算器,并将计算过程存在图形文件中.方便查看.\n"
                "2.作者尽力将本程序做得完善,但不会因本软件的错失\n"
                "  而造成的损失承担任何责任。\n"
                "3.程序还无法增加自定义函数，等待您的参与"
            )
        )
    )
    ;;;计算
    (defun note_add( / note time mmm)
        (if (/= (setq note (get_tile "edit")) "")
            (progn
                (setq mmm (vl-catch-all-apply 'c:cal (list note)))
                (if
                    (null mmm)
                    (progn (mode_tile "edit" 2)(alert "请检查表达式!"))
                    (progn
                        (setq time (menucmd "M=$(edtime,$(getvar,date),YYYY_MODD_HHMMSS)"))
                        (setq mmm (vl-princ-to-string mmm))
                        (vlax-ldata-put "#wwcalc#" time (strcat note "=" mmm))
                        (gxl-copytoclipboard mmm)
                        (setq oldch1 mmm)
                        (note_fill_lst)
                    )
                )
            )
            (progn
                (mode_tile "edit" 2)
                (alert "输入计算表达式!")
            )
        )
    )
    ;;;dcl赋值
    (defun note_fill_lst( / n)
        (setq #notedataall(vlax-ldata-list "#wwcalc#") #notedata (mapcar 'cdr #notedataall))
        (if oldch1 (set_tile "edit" oldch1))
        (start_list "list")
        (if #notedataall
            (progn
                (foreach n #notedataall
                    (add_list (cdr n))
                )
                (gps->dcl-enablectrls '("sdel" "alldel"))
            )
            (gps->dcl-disablectrls '("sdel" "alldel"))
        )
        (end_list)
        (set_tile "list" "0")
        (mode_tile "edit" 2)
    )
    ;;;单删
    (defun note_lst_sdel( / get n)
        (if (and #notedataall (/= "" (setq get (get_tile "list"))))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (vlax-ldata-delete "#wwcalc#" (car n))
                (note_fill_lst)
            )
        )
    )
    ;;;全删
    (defun note_lst_alldel( / n)
        (foreach n #notedataall (vlax-ldata-delete "#wwcalc#" (car n)))
        (note_fill_lst)
    )
    ;;;双击list.
    (defun note_ok( / get n)
        (if (/= "" (setq get (get_tile "list")))
            (progn
                (setq n (nth (atoi get) #notedataall))
                (gxl-copytoclipboard (cdr n))
                (set_tile "edit" (cdr n))(mode_tile "edit" 2)
            )
        )
    )
    ;;拾取内容
    (defun shiqua (/ ent1 ent2 entdata tmlist entlist textzs)
        (while (null (setq ent1 (nentsel ))))
        (if ent1
            (progn(setq oldch1 (cdr(assoc 1(entget(car ent1)))))
                (caldhk))
        )
    )
    ;end shiqu1
    ;;;
    (defun caldhk ( / #notedata #notedataall dclid dclname filen fn get n note stream tempname time re)
        (setq dclname
            (cond
                ((setq tempname (vl-filename-mktemp "gps-dcl-tmp.dcl") filen (open tempname "w"))
                    (foreach stream
                        '(
                            "ibutton:button{width=12;fixed_width=true;}\n"
                            "wwcalc:dialog{label=\"  \";\n"
                            "  :boxed_row{label=\"输入计算表达式\";\n"
                            "     :edit_box{key=\"edit\"; allow_accept=true;}\n"
                            "  :ibutton{label=\"运算\";key=\"add\";is_default = true;}\n"
                            "  }\n"
                            "  :boxed_column{label=\"历史记录\";\n"
                            "  :list_box{key=\"list\";height=17;}\n"
                            "  }\n"
                            "  :image {color = 194 ;height = 0.1 ;}\n"
                            "  :row{\n"
                            "  :ibutton{label=\"拾取\";key=\"txtin\";}\n"
                            "  :ibutton{label=\"单删\";key=\"sdel\";}\n"
                            "  :ibutton{label=\"全删\";key=\"alldel\";}\n"
                            "  :ibutton{is_cancel=true;label=\"取消\";}\n"
                           
                            "  }\n"
                            "}\n"
                        )
                        (princ stream filen)
                    )
                    (close filen)
                    tempname
                )
            )
        )
        (setq dclid (load_dialog dclname))
        (if (not(new_dialog "wwcalc" dclid))
            (progn (alert "dcl对话框未加载.")(exit))
        )
        (note_fill_lst)
        (action_tile "add" "(note_add)")
        (action_tile "list" "(if(= $reason 4)(note_ok))")
        (action_tile "cancel" "(done_dialog 0)")
        (action_tile "sdel" "(note_lst_sdel)")
        (action_tile "alldel" "(note_lst_alldel)")
        (action_tile "about" "(note_about)")
        (action_tile "txtin" "(done_dialog 1)")
        (action_tile "txtout" "(note_out)")
        (setq re (start_dialog))
        (if (= re 1) (shiqua))
        (unload_dialog dclid)
        (vl-file-delete dclname)
        (prin1)
    )
    (caldhk)
)

pengfei2010

表达式计算，挺不错的，不过 不知道 什么地方 用得上