(求助)请问有没 有各位大神，帮忙把阿甘计算器增加一个功能
本帖最后由 999999 于 2020-12-9 10:32 编辑请教一下各位大神，目前阿甘计算器，在CAD里第一次启动，计算器的输入框是空的，输入计算数值后，按ESC结束，重新启用计算器的时候，上一次计算的内容还在输入框内，请问如何使它结束计算器对话框后，之前输入计算的框内数值清空，或者按DELETE也可以删掉，如果这两个都能优化实现就最好
;计算器
;结果自动复制到剪贴板，支持天正文字、天正标高
(setq GL-precision 0);0为计算结果保留位数 自己根据需要修改
(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:CY(/ 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;height=1;key =\"5\";allow_accept = true;}"
" :button {"
" is_default = true ;"
" key = \"6\" ;"
" label = \"计算\" ;"
" width = 10 ;"
" }"
"}"
"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=30;height=5;}"
" 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 "")
(setqGL-result (strcat GL-result "+" num))
(setqGL-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,DIMENSION")))) ;只拾取文字、天正标高
(if ss
(progn
(setq i 0 Num "")
(repeat (sslength ss)
(setq en (ssname ss i))
(setq GL-ed (entget en))
(if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (setq text (atof (rtos (cdr (assoc 42 GL-ed)) 2 3))) (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 (if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (getvar "TEXTSTYLE") (cdr (assoc 7 GL-ed)));字体样式
la (cdr (assoc 8 GL-ed));图层
h (if (= "DIMENSION" (cdr (assoc 0 GL-ed)))(* (cdr (assoc 40 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget (cdr (assoc -1 GL-ed)))))))) (cdr (assoc 140 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget (cdr (assoc -1 GL-ed))))))))) (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
)
我研究了，没成功，你的问题再补充一下，重新打开自动清空，或者按DELETE也可以删掉，也会很方便，最好这两个都优化上
xj6019 发表于 2020-12-9 10:28
我研究了，没成功，你的问题再补充一下，重新打开自动清空，或者按DELETE也可以删掉，也会很方便，最好这两 ...
已经改了，你看一下，是不是那样 顶一下，期待解决 顶一下顶一下 顶一下，计算的时候很好用。 {:1_1:}努力，学习
页:
[1]