水果总量统计

树櫴希德

2. (defun zkwb (shiming / shibiao wengben0 wengben bbb chang wenglist list1 i)   ;炸开文本
   
3. (command "undo" "be")
   
4.          (setq shibiao (entget shiming))
   
5.    (setq wengben0 (assoc 1 shibiao))
   
6.    (setq wengben (cdr wengben0))
   
7.    (setq bbb nil chang (strlen wengben))
   
8.    (setq i 1)
   
9.    (setq wenglist nil)
   
10.    (while (< i chang)
    
11.           (setq wengge (substr wengben i 2))
    
12.           (setq wenglist (append wenglist (list wengge)))
    
13.           (setq i (+ i 2))
    
14.    )
    
15.   (setq list1 "")
    
16.   ;得到文本列表wenglist
    
17.   (foreach x wenglist
    
18.     (if (and  (>= (ascii x) 45) (<=  (ascii x) 59))
    
19.       (setq list1 (strcat list1 x))
    
20.       )   
    
21.     ) (princ)
    
22.   (atof list1)
    
23. )
    
24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
25. (defun c:tt11 ( / lst ent pts pt demj zmj i) ;求平均数
    
26. (setq lst (ssget '((0 . "text,mtext") (1 . "*[0-9]*")   )   )  )
    
27.   
    
28. (setq i 0)
    
29. (setq zmj 0.000)
    
30.   
    
31. (while  (< i (sslength lst))
    
32. 
    
33. (setq ent (ssname lst i))
    
34. 
    
35. 
    
36. (setq demj (zkwb ent))
    
37.   
    
38. 
    
39.   ;(setq demj (atof(cdr (assoc 1 (entget ent)))))
    
40.   
    
41.   
    
42. 
    
43.   
    
44.   
    
45.   
    
46. (setq zmj(+ zmj demj))
    
47. 
    
48. (setq i (+ i 1))
    
49.   
    
50.   
    
51.   )
    
52. (entmake (list (cons 0  "TEXT") (cons 1 (strcat "总和"(rtos zmj 2 3) "平均数" (rtos (/ zmj i) 2 3) )) (cons 10 (getpoint "\请输入总和插入点"))
    
53.                (cons 40 3)
    
54.                (cons 8 "总和")
    
55.                ))
    
56. (print zmj)
    
57.   (print (/ zmj i))
    
58.   (princ)
    
59. 
    
60. )
    

(defun zkwb (shiming / shibiao wengben0 wengben bbb chang wenglist list1 i)   ;炸开文本<br /> (command "undo" "be")<br />          (setq shibiao (entget shiming))<br />    (setq wengben0 (assoc 1 shibiao))<br />    (setq wengben (cdr wengben0))<br />    (setq bbb nil chang (strlen wengben))<br />    (setq i 1)<br />    (setq wenglist nil)<br />    (while (< i chang)<br />           (setq wengge (substr wengben i 2))<br />           (setq wenglist (append wenglist (list wengge)))<br />           (setq i (+ i 2))<br />    )<br />   (setq list1 "")<br />   ;得到文本列表wenglist<br />   (foreach x wenglist<br />     (if (and  (>= (ascii x) 45) (<=  (ascii x) 59))<br />       (setq list1 (strcat list1 x))<br />       )   <br />     ) (princ)<br />   (atof list1)<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:tt11 ( / lst ent pts pt demj zmj i) ;求平均数<br /> (setq lst (ssget '((0 . "text,mtext") (1 . "*[0-9]*")   )   )  )<br />   <br /> (setq i 0)<br /> (setq zmj 0.000)<br />   <br /> (while  (< i (sslength lst))<br /> <br /> (setq ent (ssname lst i))<br /> <br /> <br /> (setq demj (zkwb ent))<br />   <br /> <br />   ;(setq demj (atof(cdr (assoc 1 (entget ent)))))<br />   <br />   <br /> <br />   <br />   <br />   <br /> (setq zmj(+ zmj demj))<br /> <br /> (setq i (+ i 1))<br />   <br />   <br />   )<br /> (entmake (list (cons 0  "TEXT") (cons 1 (strcat "总和"(rtos zmj 2 3) "平均数" (rtos (/ zmj i) 2 3) )) (cons 10 (getpoint "\请输入总和插入点"))<br />                (cons 40 3)<br />                (cons 8 "总和")<br />                ))<br /> (print zmj)<br />   (print (/ zmj i))<br />   (princ)<br /> <br /> )<br />

树櫴希德

2. 
   
3. ;;--------------------------------------------主函数----------------------------------------------------;;
   
4. (defun xxexp (pat str key / end)
   
5.   ;(princ "\n ★"一刀屠文"(xxexp)(xxexpr) = 对字符串进行正则表达式测试及替换-by 梁雄啸.2007.7")
   
6.   (vl-load-com)
   
7.   (if (not *xxvbsexp)
   
8.     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
   
9.   )
   
10.   (vlax-put *xxvbsexp 'Pattern pat)
    
11.   (if (not key)(setq key ""))  
    
12.   (setq key (strcase key))
    
13.   (setq keys '(("I"  "IgnoreCase")("G"  "Global")("M"  "Multiline")))
    
14.   (mapcar '(lambda(x)
    
15.        (if (wcmatch key (strcat "*" (car x) "*"))
    
16.          (vlax-put *xxvbsexp (read(cadr x)) 0)
    
17.          (vlax-put *xxvbsexp (read(cadr x)) -1)
    
18.          ))
    
19.     keys)
    
20.   (setq matches (vlax-invoke *xxvbsexp 'Execute str))
    
21.   (vlax-for x matches (setq end (cons (vla-get-value x) end)))
    
22.   (reverse end)
    
23. )
    
24. ;;--------------------------------------------end----------------------------------------------------;;
    
25. ;;--------------------------------------------主函数----------------------------------------------------;;
    
26. ;; 用正则表达式替换字符
    
27. (defun xxexpr (pat str nstr key / end)
    
28.   ;(princ "\n ★"一刀屠文"(xxexp)(xxexpr) = 对字符串进行正则表达式测试及替换-by 梁雄啸.2007.7")
    
29.   (vl-load-com)
    
30.   (if (not *xxvbsexp)
    
31.     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
    
32.   )
    
33.   (vlax-put *xxvbsexp 'Pattern pat)
    
34.   (if (not key)(setq key ""))
    
35.   (setq key (strcase key))
    
36.   (setq keys '(("I"  "IgnoreCase")("G"  "Global")("M"  "Multiline")))
    
37.   (mapcar '(lambda(x)
    
38.        (if (wcmatch key (strcat "*" (car x) "*"))
    
39.          (vlax-put *xxvbsexp (read(cadr x)) 0)
    
40.          (vlax-put *xxvbsexp (read(cadr x)) -1)
    
41.          ))
    
42.     keys)
    
43.   (vlax-invoke *xxvbsexp 'replace str nstr)  
    
44. )
    
45. (defun c:xxexphlp()
    
46.   (alert
    
47.     "------------------"一刀屠文" = 对字符串进行正则表达式测试及替换--------------------
    
48. ------------------------------------by 梁雄啸.2007.7-------------------------------
    
49. 函数：(xxexp pat str key)
    
50. 功能 对字符串进行正则表达式匹配测试.
    
51. 参数: pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \\号要用\\\\替代.
    
52.      str = 字符串
    
53.      key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.
    
54.            "m"多行模式（Multiline），以上几个关键字可以组合使用，或用 "".
    
55. 返回: 返回匹配的字符列表，或无一匹配返回nil
    
56. 
    
57. 函数：(xxexpr pat str nstr key)
    
58. 功能 对字符串进行正则表达式替换.
    
59. 参数: pat = 同xxexp
    
60.      str = 被替换字符串
    
61.      nstr = 替换字符串
    
62.      key = 同xxexp
    
63. 返回 :返回替换后的字符串.
    
64.     "
    
65.    )
    
66. )
    
67. 
    
68. 
    
69. (princ)
    
70. ;;--------------------------------------------end----------------------------------------------------;;
    
71. (defun zkwb (shiming / shibiao wengben0 wengben bbb chang wenglist list1 i pat)   ;炸开文本
    
72. (command "undo" "be")
    
73.          (setq shibiao (entget shiming))
    
74.    (setq wengben0 (assoc 1 shibiao))
    
75.    (setq wengben (cdr wengben0))
    
76.   
    
77.   
    
78. (setq pat "[+|-]?\\d*\\.?\\d+(e[+|-]*\\d+)*")
    
79. (setq wenglist (xxexp pat wengben ""))
    
80.   
    
81.   ;得到文本列表wenglist
    
82.    (princ)
    
83.   (read  (car wenglist))
    
84. )
    
85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
86. (defun c:tt11 ( / lst ent pts pt demj zmj i) ;求平均数
    
87. (setq lst (ssget '((0 . "text,mtext") (1 . "*[0-9]*")   )   )  )
    
88.   
    
89. (setq i 0)
    
90. (setq zmj 0.000)
    
91.   
    
92. (while  (< i (sslength lst))
    
93. 
    
94. (setq ent (ssname lst i))
    
95. 
    
96. 
    
97. (setq demj (zkwb ent))
    
98.   
    
99. 
    
100.   ;(setq demj (atof(cdr (assoc 1 (entget ent)))))
     
101.   
     
102.   
     
103. 
     
104.   
     
105.   
     
106.   
     
107. (setq zmj(+ zmj demj))
     
108. 
     
109. (setq i (+ i 1))
     
110.   
     
111.   
     
112.   )
     
113. (entmake (list (cons 0  "TEXT") (cons 1 (strcat "总和"(rtos zmj 2 3) "平均数" (rtos (/ zmj i) 2 3) )) (cons 10 (getpoint "\请输入总和插入点"))
     
114.                (cons 40 3)
     
115.                (cons 8 "总和")
     
116.                ))
     
117. (print zmj)
     
118.   (print (/ zmj i))
     
119.   (princ)
     
120. 
     
121. )

<br /> ;;--------------------------------------------主函数----------------------------------------------------;;<br /> (defun xxexp (pat str key / end)<br />   ;(princ "\n ★"一刀屠文"(xxexp)(xxexpr) = 对字符串进行正则表达式测试及替换-by 梁雄啸.2007.7")<br />   (vl-load-com)<br />   (if (not *xxvbsexp)<br />     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))<br />   )<br />   (vlax-put *xxvbsexp 'Pattern pat)<br />   (if (not key)(setq key ""))  <br />   (setq key (strcase key))<br />   (setq keys '(("I"  "IgnoreCase")("G"  "Global")("M"  "Multiline")))<br />   (mapcar '(lambda(x)<br />        (if (wcmatch key (strcat "*" (car x) "*"))<br />          (vlax-put *xxvbsexp (read(cadr x)) 0)<br />          (vlax-put *xxvbsexp (read(cadr x)) -1)<br />          ))<br />     keys)<br />   (setq matches (vlax-invoke *xxvbsexp 'Execute str))<br />   (vlax-for x matches (setq end (cons (vla-get-value x) end)))<br />   (reverse end) <br /> )<br /> ;;--------------------------------------------end----------------------------------------------------;;<br /> ;;--------------------------------------------主函数----------------------------------------------------;;<br /> ;; 用正则表达式替换字符<br /> (defun xxexpr (pat str nstr key / end)<br />   ;(princ "\n ★"一刀屠文"(xxexp)(xxexpr) = 对字符串进行正则表达式测试及替换-by 梁雄啸.2007.7")<br />   (vl-load-com)<br />   (if (not *xxvbsexp)<br />     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))<br />   )<br />   (vlax-put *xxvbsexp 'Pattern pat)<br />   (if (not key)(setq key ""))<br />   (setq key (strcase key))<br />   (setq keys '(("I"  "IgnoreCase")("G"  "Global")("M"  "Multiline")))<br />   (mapcar '(lambda(x)<br />        (if (wcmatch key (strcat "*" (car x) "*"))<br />          (vlax-put *xxvbsexp (read(cadr x)) 0)<br />          (vlax-put *xxvbsexp (read(cadr x)) -1)<br />          ))<br />     keys)<br />   (vlax-invoke *xxvbsexp 'replace str nstr)  <br /> )<br /> (defun c:xxexphlp()<br />   (alert<br />     "------------------"一刀屠文" = 对字符串进行正则表达式测试及替换--------------------<br /> ------------------------------------by 梁雄啸.2007.7-------------------------------<br /> 函数：(xxexp pat str key)<br /> 功能 对字符串进行正则表达式匹配测试. <br /> 参数: pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \\号要用\\\\替代.<br />      str = 字符串<br />      key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.<br />            "m"多行模式（Multiline），以上几个关键字可以组合使用，或用 "".<br /> 返回: 返回匹配的字符列表，或无一匹配返回nil<br /> <br /> 函数：(xxexpr pat str nstr key)<br /> 功能 对字符串进行正则表达式替换. <br /> 参数: pat = 同xxexp<br />      str = 被替换字符串<br />      nstr = 替换字符串<br />      key = 同xxexp<br /> 返回 :返回替换后的字符串.<br />     "<br />    )<br /> )<br /> <br /> <br /> (princ)<br /> ;;--------------------------------------------end----------------------------------------------------;;<br /> (defun zkwb (shiming / shibiao wengben0 wengben bbb chang wenglist list1 i pat)   ;炸开文本<br /> (command "undo" "be")<br />          (setq shibiao (entget shiming))<br />    (setq wengben0 (assoc 1 shibiao))<br />    (setq wengben (cdr wengben0))<br />   <br />   <br /> (setq pat "[+|-]?\\d*\\.?\\d+(e[+|-]*\\d+)*")<br /> (setq wenglist (xxexp pat wengben ""))<br />   <br />   ;得到文本列表wenglist<br />    (princ)<br />   (read  (car wenglist))<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:tt11 ( / lst ent pts pt demj zmj i) ;求平均数<br /> (setq lst (ssget '((0 . "text,mtext") (1 . "*[0-9]*")   )   )  )<br />   <br /> (setq i 0)<br /> (setq zmj 0.000)<br />   <br /> (while  (< i (sslength lst))<br /> <br /> (setq ent (ssname lst i))<br /> <br /> <br /> (setq demj (zkwb ent))<br />   <br /> <br />   ;(setq demj (atof(cdr (assoc 1 (entget ent)))))<br />   <br />   <br /> <br />   <br />   <br />   <br /> (setq zmj(+ zmj demj))<br /> <br /> (setq i (+ i 1))<br />   <br />   <br />   )<br /> (entmake (list (cons 0  "TEXT") (cons 1 (strcat "总和"(rtos zmj 2 3) "平均数" (rtos (/ zmj i) 2 3) )) (cons 10 (getpoint "\请输入总和插入点"))<br />                (cons 40 3)<br />                (cons 8 "总和")<br />                ))<br /> (print zmj)<br />   (print (/ zmj i))<br />   (princ)<br /> <br /> )

烟盒迷唇

效果不错啊

czb203

感谢楼主分享！！！