提取文本数字并计算写入的程序

yangist

本人近期在工作中遇到大量   "钢板 δ10-200x100"  类似的运算,
要运算后写入已存在的单行文本单件重量   "xx"  中,
本人水平有限,请好心人帮忙写个程序,谢谢!
计算公式:  xx=10x200x100x0.001x0.001x7.85

vectra

1. (defun c:tt (/ a b n3 s1 ss)
   
2.   (princ "\n选择文字: ")
   
3. 
   
4.   (if (and
   
5.   (setq ss (ssget ":S" '((0 . "*TEXT"))))
   
6.   (setq n3 (entget (setq s1 (car (entsel "\n写入数值: ")))))
   
7.       )
   
8.     (progn
   
9.       (setq a (cdr (assoc 1 (entget (ssname ss 0))))
   
10.       b (apply '* (mapcar 'read (split-numbers a)))
    
11.       b (* b 0.001 0.001 7.85)
    
12.       )
    
13. 
    
14.       (entmod (subst (cons 1 (rtos b 2 2)) (assoc 1 n3) n3))
    
15.       (entupd s1)
    
16.     )
    
17.   )
    
18.   (princ)
    
19. )
    
20. 
    
21. (defun split-numbers (str / buff l2)
    
22.   (setq str (vl-string->list str))
    
23.   (while str
    
24.     (if  (< 47 (car str) 58)
    
25.       (setq buff (cons (car str) buff))
    
26.       (if buff
    
27.   (setq l2   (cons (vl-list->string (reverse buff)) l2)
    
28.         buff nil
    
29.   )
    
30.       )
    
31.     )
    
32.     (setq str (cdr str))
    
33.   )
    
34.   (if buff
    
35.     (setq l2 (cons (vl-list->string (reverse buff)) l2))
    
36.   )
    
37.   (reverse l2)
    
38. )

(defun c:tt (/ a b n3 s1 ss)<br />   (princ "\n选择文字: ")<br /> <br />   (if (and<br />   (setq ss (ssget ":S" '((0 . "*TEXT"))))<br />   (setq n3 (entget (setq s1 (car (entsel "\n写入数值: ")))))<br />       )<br />     (progn<br />       (setq a (cdr (assoc 1 (entget (ssname ss 0))))<br />       b (apply '* (mapcar 'read (split-numbers a)))<br />       b (* b 0.001 0.001 7.85)<br />       )<br /> <br />       (entmod (subst (cons 1 (rtos b 2 2)) (assoc 1 n3) n3))<br />       (entupd s1)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> (defun split-numbers (str / buff l2)<br />   (setq str (vl-string->list str))<br />   (while str<br />     (if  (< 47 (car str) 58)<br />       (setq buff (cons (car str) buff))<br />       (if buff<br />   (setq l2   (cons (vl-list->string (reverse buff)) l2)<br />         buff nil<br />   )<br />       )<br />     )<br />     (setq str (cdr str))<br />   )<br />   (if buff<br />     (setq l2 (cons (vl-list->string (reverse buff)) l2))<br />   )<br />   (reverse l2)<br /> )

xyp1964

2. ;; (abc "钢板 δ10-200x100")
   
3. (defun abc (tx / lst)
   
4.   (setq lst (xyp-HzEngNum+- tx 3))
   
5.   ;(strcat "xx=" (xyp-strcat lst "x") "x0.001x0.001x7.85")
   
6.   (apply '* (append (mapcar 'atoi lst) '(0.001 0.001 7.85)))
   
7. )

;; (abc "钢板 δ10-200x100")<br /> (defun abc (tx / lst)<br />   (setq lst (xyp-HzEngNum+- tx 3))<br />   ;(strcat "xx=" (xyp-strcat lst "x") "x0.001x0.001x7.85")<br />   (apply '* (append (mapcar 'atoi lst) '(0.001 0.001 7.85)))<br /> )

自贡黄明儒

http://bbs.xdcad.net/thread-669968-1-1.html
〈钢板重量计算器>

fl202

(setq txt1 "钢板 δ120-2300x1400")
(setq n (vl-string-search "δ" txt1))
(setq txt2 (substr txt1 (+ n 3)))
(setq k (vl-string-search "-" txt2) i (vl-string-search "x" txt2) )
(setq txt3 (substr txt2 1 k) )
(setq txt4 (substr txt2 (+ 2 k) (- i k 1) ) )
(setq txt5 (substr txt2 (+ i 2) ))
(setq txt6 (rtos (* (atof txt3) (atof txt4) (atof txt5) 0.001 0.001 7.85) 2 4 ))

"3033.24"

yangist

fl202 发表于 2015-2-5 09:12
(setq txt1 "钢板 δ120-2300x1400")
(setq n (vl-string-search "δ" txt1))
(setq txt2 (substr txt1 ( ...

这个太有局限性了 我想要个能通用的:
比如:
钢板δ10x100x200
钢板δ10-100x200
钢板10-100x200
δ10-100x200
t10-100x200
钢板t10-100x200
钢板t10x100x200

钢板t10*100*200

因为每个人的习惯都不一样...

yangist

自贡黄明儒 发表于 2015-2-5 08:59
http://bbs.xdcad.net/thread-669968-1-1.html
〈钢板重量计算器>

谢谢,看到了,根据帖子的内容 我编了个程序
可惜用不了,提示参数类型错误
能帮我改改吗,谢谢
;;;提取数值计算========================
(DEFUN C:tt ( / ss ent dxf1 txt txt1 txt2 txt3 s s1 n3)
  ;(princ "\n选择标注: ")
  ;(setq ss (ssget ":S" '((0 . "Text")))
   ;     ent (entget (ssname ss 0))
   ;     a (cdr (assoc 1 ent))
  ; )
  (setq a "钢板 δ12-230x140")
  (setq b  (SplitInstead a))
  (setq b1 (atof (car b) 2 1))
  (setq b2 (atof (cadr b) 2 1))
  (setq b3 (atof (caddr b) 2 1))
  (setq s (rtos (* b1 b2 b3 0.001 0.001 7.85) 2 1))

  (setq n3 (entget (setq s1 (car (entsel "\n写入数值: ")))))
  (entmod (subst (cons 1 s) (assoc 1 n3) n3))
  (entupd s1)
  (princ)
)

;;;字符串中非数字用空格替代
(defun SplitInstead (a / B C D)
    (setq d "")
    (while (/= a "")
      (setq c (substr a 1 1))
      (setq b (ascii c))
      (setq a (substr a 2 (strlen a)))
      (if (or (and (> b 47) (< b 58)) (= b 46))
        (setq d (strcat d c))
        (setq d (strcat d " "))
      )
    )
  )
;;;===================================

yangist

xyp1964 发表于 2015-2-5 08:32

院长大人 能帮楼上我自己写的程序调试下吗
您写的这个我用不来啊 o(╯□╰)o

yangist

vectra 发表于 2015-2-5 16:26

谢谢,非常好用,最佳答案
就是 钢板t10-200x100 计算结果是正确的
而 钢板δ10-200x100 计算结果就错了 可能和δ有关
另外碰到小数点 "." 时也会计算错误,这样可是会很危险哦
不知道能不能调整下,谢谢!

vectra

“钢板t10-200x100” 和 “钢板δ10-200x100”测试结果均为1.57

第24行

1. (if        (< 47 (car str) 58)

(if        (< 47 (car str) 58)

修改为

1. (if        (or (= 46 (car str)) (< 47 (car str) 58))

(if        (or (= 46 (car str)) (< 47 (car str) 58))

以增加对点号处理