阿甘计算器怎么改一下能提取标注的数值呀
本帖最后由 xj6019 于 2020-4-23 11:00 编辑论坛找了几个版本的阿甘计算器,都是不能提取标注数值
以下代码求大佬赐教,怎么才能提取标注数值,我自己改了很多次,都没成功,无奈再次求助大神们吧,谢谢!!
;提取数字和运算符
(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))
(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
)
xj6019 发表于 2020-4-23 11:56
现在提取的数精确的太多了,得12位呢,导致后期的插入就没法用了,我觉得提取的标注精确到三四位足够了
把那句改为: (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))))
标注组码1是图面显示的数字,可以手动改,如果组码1是空格就等于42组码,就是真实数字 start4444 发表于 2020-4-23 11:09
(setq text (cdr (assoc 1 GL-ed))) >>> (if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (setq text (cd ...
现在提取的数精确的太多了,得12位呢,导致后期的插入就没法用了,我觉得提取的标注精确到三四位足够了 start4444 发表于 2020-4-23 11:09
(setq text (cdr (assoc 1 GL-ed))) >>> (if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (setq text (cd ...
大神你能帮这个帖子最后的问题一起解决下然后贴下代码吗我也很需要 (setq text (cdr (assoc 1 GL-ed))) >>> (if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (setq text (cdr (assoc 42 GL-ed))) (setq text (cdr (assoc 1 GL-ed)))) start4444 发表于 2020-4-23 11:09
(setq text (cdr (assoc 1 GL-ed))) >>> (if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (setq text (cd ...
漂亮!!只要小数点后3位,怎么控制? start4444 发表于 2020-4-23 13:29
把那句改为: (if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (setq text (atof (rtos (cdr (assoc 42 GL-ed ...
明白了,谢谢! “插算式” “插结果” 好像没用 对 确实还不行,我还在找原因,没明白怎么回事,为什么一插入就出错,有明白的也希望指点一二
start4444 发表于 2020-4-23 13:29
把那句改为: (if (= "DIMENSION" (cdr (assoc 0 GL-ed))) (setq text (atof (rtos (cdr (assoc 42 GL-ed ...
看回帖的有问的了,确实插入结果和算式提示出错,没法插入,要是有时间的话,再烦请看看
现在我倒是够用的,修修更好