[分享]：数字操作源码大集合

carrot1983

鉴于大家在工作中经常遇到文字中数字的操作。

虽然有些功能某些插件上都会有，但是当有需要之时，却又到处到解决办法。

所以，决定将文字中的数字操作源码集合在些。。。

对于自己有特别需求的。也可以自行修改，以便实现其功能。



大家可以积极回帖，最好是把自己与本主题相关，最好是源码。


先抛点砖头出来。。。

2. 
   
3. ;;written By carrot1983 2009-01-15
   
4. (defun C:TT1 (/ E1 E2 ELIST NEWVALUE PT1 PT2 REAL V1)
   
5.   (princ "\n递增减LSP程序用于编辑层高表")
   
6.   (setvar "dimzin" 0) ;_消零控制
   
7.   (setq E1 (car (entsel "\n单选层高表某一标高: ")))
   
8.   (setq REAL (getreal "\n输入增值: "))
   
9.   (setq PT1 (getpoint "\n输入基点: "))
   
10.   (while (setq PT2 (getpoint PT1 "\n指定点: "))
    
11.     (setq ELIST (entget E1))
    
12.     (setq V1 (cdr (assoc 1 ELIST)))
    
13.     (setq NEWVALUE (rtos (+ (read V1) REAL) 2 3)) ;_精确到小数点后面三位
    
14.     (entmake (subst (cons 1 NEWVALUE)
    
15.                     (assoc 1 ELIST)
    
16.                     ELIST
    
17.              )
    
18.     )
    
19.     (setq E2 (entlast))
    
20.     (print (cdr (assoc 1 (entget E2))))
    
21.     (command "._move" E2 "" "none" PT1 "none" PT2)
    
22.     (setq E1 E2)
    
23.     (setq PT1 PT2)
    
24.   )
    
25.   (princ)
    
26. )
    

<br /> ;;written By carrot1983 2009-01-15<br /> (defun C:TT1 (/ E1 E2 ELIST NEWVALUE PT1 PT2 REAL V1)<br />   (princ "\n递增减LSP程序用于编辑层高表")<br />   (setvar "dimzin" 0) ;_消零控制<br />   (setq E1 (car (entsel "\n单选层高表某一标高: ")))<br />   (setq REAL (getreal "\n输入增值: "))<br />   (setq PT1 (getpoint "\n输入基点: "))<br />   (while (setq PT2 (getpoint PT1 "\n指定点: "))<br />     (setq ELIST (entget E1))<br />     (setq V1 (cdr (assoc 1 ELIST)))<br />     (setq NEWVALUE (rtos (+ (read V1) REAL) 2 3)) ;_精确到小数点后面三位<br />     (entmake (subst (cons 1 NEWVALUE)<br />                     (assoc 1 ELIST)<br />                     ELIST<br />              )<br />     )<br />     (setq E2 (entlast))<br />     (print (cdr (assoc 1 (entget E2))))<br />     (command "._move" E2 "" "none" PT1 "none" PT2)<br />     (setq E1 E2)<br />     (setq PT1 PT2)<br />   )<br />   (princ)<br /> )<br />

2. 
   
3. ;;计算所有含数字的文字之和(不考虑负号)
   
4. ;;written By carrot1983 2009-01-16
   
5. (defun C:TT2 (/ E I NUM NUMLIST RESULT SS V1 X)
   
6.   ;;ZML184的递归函数
   
7.   (defun STRCAT+ (LST)
   
8.     (if        (= (length LST) 1)
   
9.       (strcat (car LST))
   
10.       (strcat (car LST) "+" (STRCAT+ (cdr LST)))
    
11.     )
    
12.   )
    
13.   ;;(TEST '("1" "2" "3" "4"))
    
14.   ;;->"1+2+3+4"
    
15.   (if (setq SS (ssget '((0 . "*TEXT*"))))
    
16.     (progn
    
17.       (setq NUMLIST '())
    
18.       (repeat (setq I (sslength SS))
    
19.         (setq E (ssname SS (setq I (1- I))))
    
20.         (setq V1 (cdr (assoc 1 (entget E))))
    
21.         ;;[通用函数]从文字中提取数字
    
22.         (setq NUM
    
23.                (read
    
24.                  (strcat
    
25.                    "("
    
26.                    (vl-list->string
    
27.                      (mapcar
    
28.                        '(lambda        (X)
    
29.                           (if (member X (vl-string->list ".0123456789"))
    
30.                             X
    
31.                             32
    
32.                           )
    
33.                         )
    
34.                        (vl-string->list V1)
    
35.                      )
    
36.                    )
    
37.                    ")"
    
38.                  )
    
39.                )
    
40.         )
    
41.         (if NUM
    
42.           (setq NUMLIST (append NUM NUMLIST))
    
43.         )
    
44.       )
    
45.       (if (setq RESULT (apply '+ NUMLIST)) ;_执行加法
    
46.         (progn
    
47.           (setq MSG (STRCAT+ (mapcar 'vl-princ-to-string NUMLIST)))
    
48.           (princ (strcat "\n>>>>>总和为: "
    
49.                          MSG
    
50.                          "= "
    
51.                          (vl-princ-to-string RESULT)
    
52.                  )
    
53.           )
    
54.         )
    
55.         (princ "\n>>>>>总和为: 0")
    
56.       )
    
57.     )
    
58.   )
    
59.   (princ)
    
60. )
    

<br /> ;;计算所有含数字的文字之和(不考虑负号)<br /> ;;written By carrot1983 2009-01-16<br /> (defun C:TT2 (/ E I NUM NUMLIST RESULT SS V1 X)<br />   ;;ZML184的递归函数<br />   (defun STRCAT+ (LST)<br />     (if        (= (length LST) 1)<br />       (strcat (car LST))<br />       (strcat (car LST) "+" (STRCAT+ (cdr LST)))<br />     )<br />   )<br />   ;;(TEST '("1" "2" "3" "4")) <br />   ;;->"1+2+3+4"<br />   (if (setq SS (ssget '((0 . "*TEXT*"))))<br />     (progn<br />       (setq NUMLIST '())<br />       (repeat (setq I (sslength SS))<br />         (setq E (ssname SS (setq I (1- I))))<br />         (setq V1 (cdr (assoc 1 (entget E))))<br />         ;;[通用函数]从文字中提取数字<br />         (setq NUM<br />                (read<br />                  (strcat<br />                    "("<br />                    (vl-list->string<br />                      (mapcar<br />                        '(lambda        (X)<br />                           (if (member X (vl-string->list ".0123456789"))<br />                             X<br />                             32<br />                           )<br />                         )<br />                        (vl-string->list V1)<br />                      )<br />                    )<br />                    ")"<br />                  )<br />                )<br />         )<br />         (if NUM<br />           (setq NUMLIST (append NUM NUMLIST))<br />         )<br />       )<br />       (if (setq RESULT (apply '+ NUMLIST)) ;_执行加法<br />         (progn<br />           (setq MSG (STRCAT+ (mapcar 'vl-princ-to-string NUMLIST)))<br />           (princ (strcat "\n>>>>>总和为: "<br />                          MSG<br />                          "= "<br />                          (vl-princ-to-string RESULT)<br />                  )<br />           )<br />         )<br />         (princ "\n>>>>>总和为: 0")<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

zml84

示例：

wkur

好东东，谢谢

Hawking_XU

好东西，顶