阿拉伯数字与中文数字互转

danier

三个函数
1、正则表达式；
2、阿拉伯数字转中文数字；
3、中文数字转阿拉伯数字。
有需求自取！！！

2. ;;;公共函数库-字符串操作
   
3. ;;;目录
   
4. ;;;1、正则表达式：L-string-regex(str1 str2 global ignorecase method pattern)
   
5. ;;;2、集合转列表：convert-IMatchCollection-to-list
   
6. ;;;3、阿拉伯数字转汉字数字：L-string-arabictocn
   
7. ;;;4、中文数字转阿拉伯数字：L-string-cntoarabic
   
8. ;;;
   
9. 
   
10. ;;;-----------------------------------------------------------;;
    
11. ;;; 正则表达式                                                               ;;
    
12. ;;; L-string-regex                                            ;;
    
13. ;;; 输入：
    
14. ;;; str___字符串
    
15. ;;; global___1 or 0, 指明模式是匹配整个字符串中所有与之相符的地方还是只匹配第一次出现的地方。
    
16. ;;; ignorecase___1 or 0, 指明模式匹配是否大小写敏感。
    
17. ;;; method___"Execute"、"Replace"、"Test"
    
18. ;;; pattern___正则表达式
    
19. ;;; 输出：列表、字符串、bool
    
20. ;;; 示例：
    
21. ;;; (setq str "liguiming1234567890" global 1 ignorecase 1 method "Execute")
    
22. ;;; (L-string-regex "liguiming1234567890" 1 1 "Execute" "")
    
23. ;;;-----------------------------------------------------------;;
    
24. (defun L-string-regex(str1 str2 global ignorecase method pattern)
    
25.         (VL-LOAD-COM)
    
26.         ;;引用正则表达式控件
    
27.         (setq regex (vlax-create-object "Vbscript.RegExp"))
    
28.         (vlax-put-property regex "Global" global)
    
29.         (vlax-put-property regex "IgnoreCase" ignorecase)
    
30.         (vlax-put-property regex "Pattern" pattern)
    
31.         (cond
    
32.                 ((= method "Execute") (vlax-invoke-method  regex method str1))
    
33.                 ((= method "Replace") (vlax-invoke-method  regex method str1 str2))
    
34.                 ((= method "Test") (vlax-invoke-method  regex method str1))
    
35.                 (t nil)
    
36.         )
    
37.        
    
38. )
    
39. 
    
40. 
    
41. (defun convert-IMatchCollection-to-list (matches)
    
42.   (setq l (list))
    
43.   (setq i 0)
    
44.   (while (< i (vlax-get-property matches 'Count))
    
45.     (setq l (cons (vlax-get-property matches 'Item i) l))
    
46.     (setq i (1+ i))
    
47.   )
    
48.   l
    
49. )
    
50. 
    
51. ;;;-----------------------------------------------------------;;
    
52. ;;; 阿拉伯数字转中文数字                                                   
    
53. ;;; L-string-arabictocn                                            
    
54. ;;; 输入：整数
    
55. ;;; 输出：中文数字字符串
    
56. ;;; 示例：
    
57. (defun L-string-arabictocn (arabic / cn weight digits units section section-units z arabic)
    
58. ; 保存转换后的中文数字
    
59. (setq cn "")
    
60. ; 当前位的权重
    
61. (setq weight 1)
    
62. ; 中文数字的字符串数组
    
63. (setq digits '("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))
    
64. ; 中文数字的单位字符串数组
    
65. (setq units '("" "十" "百" "千"))
    
66. ; 中文数字的节权位符字符串数组
    
67. (setq section-units '("" "万" "亿"))
    
68. ; 当前处理的节的编号
    
69. (setq section 0)
    
70. (setq z 0)
    
71. (while (/= arabic 0)
    
72.         ; 获取当前数字的个位数
    
73.         (setq digit (rem arabic 10))
    
74.         ; 将当前数字缩小 10 倍，准备处理下一个数字
    
75.         (setq arabic (fix (/ arabic 10)))
    
76.         (if (= weight 1) (progn (setq cn (strcat (nth section section-units) cn)) (setq section (1+ section))))
    
77.         (cond
    
78.                 ((= digit 0)
    
79.                         ; 如果前面还没有数字或前面的数字是零或当前处理的数字是节权位符
    
80.                         (if (and (/= (substr cn 1 1) "零") (/= z 0))
    
81.                                 ; 在结果前面加上零
    
82.                                 (progn (setq cn (strcat (nth 0 digits) cn) ) (setq z 0))
    
83.                         )
    
84.                 )
    
85.                 ; 否则在结果前面加上当前数字和单位
    
86.                 (t (progn (setq cn (strcat (nth digit digits) (nth (fix (+ (/ (log weight) (log        10)) 0.5)) units) cn)) (setq z 1)))
    
87.         )
    
88.         (setq weight (if (= weight 1000) (progn (setq z 0 ) 1) (* weight 10))) ; 更新当前位的权重
    
89. )
    
90. ; 十位处理
    
91. (if (=(L-string-regex cn "" 1 1 "Test" "一十") :vlax-true) (L-string-regex cn "十" 0 1 "Replace" "一十"))
    
92. )
    
93. 
    
94. 
    
95. ;;;-----------------------------------------------------------;;
    
96. ;;; 中文数字转阿拉伯数字                                                
    
97. ;;; L-string-cntoarabic                                          
    
98. ;;; 输入：中文数字字符串
    
99. ;;; 输出：整数
    
100. ;;; 示例：
     
101. (defun L-string-cntoarabic(cn / ch-num arabic-num bit-units units section-units section bitvalue weight result i j cn)
     
102.   (setq ch-num "零一二三四五六七八九")
     
103.   (setq arabic-num '(0 1 2 3 4 5 6 7 8 9))
     
104.   (setq bit-units "十百千")
     
105.   (setq units '(10 100 1000))
     
106.   (setq section-units "万亿")
     
107.   (setq section '(10000 100000000))
     
108.   (setq bitvalue 1)
     
109.   (setq weight 1)
     
110.   (setq result 0)
     
111.   (if (= (L-string-regex cn "" 1 1 "Test" "^十") :vlax-true) (setq cn (L-string-regex cn "一十" 0 1 "Replace" "十")))
     
112.   (setq i 0)
     
113.   (setq j 0)
     
114.   (while (and (setq c1 (nth j (reverse (vl-string->list cn)))) (setq c2 (nth (1+ j) (reverse (vl-string->list cn)))))
     
115.           (cond
     
116.                   ((and (vl-string-position c1 ch-num) (setq i (vl-string-position c2 ch-num)))
     
117.                                   (progn
     
118.                                           (if (= (rem i 2) 0)
     
119.                                                   (progn
     
120.                                                           (setq i (/ i 2))
     
121.                                                           (setq result (+ result (* (* (nth i arabic-num) bitvalue) weight) ))
     
122.                                                   )
     
123.                                           )
     
124.                                   )
     
125.                   )
     
126.                   ((and (vl-string-position c1 bit-units) (setq i (vl-string-position c2 bit-units)))
     
127.                                   (progn
     
128.                                           (if (= (rem i 2) 0)
     
129.                                                   (progn
     
130.                                                           (setq i (/ i 2))
     
131.                                                           (setq bitvalue (nth i units))
     
132.                                                   )
     
133.                                           )
     
134.                                   )
     
135.                   )
     
136.                   ((and (vl-string-position c1 section-units) (setq i (vl-string-position c2 section-units)))
     
137.                             (progn
     
138.                                     (if (= (rem i 2) 0)
     
139.                                                   (progn
     
140.                                                           (setq i (/ i 2))
     
141.                                                           (setq weight (nth i section))
     
142.                                                           (setq bitvalue 1)
     
143.                                                   )
     
144.                                           )
     
145.                                   )
     
146.                   )
     
147.                   (t nil)
     
148.           )
     
149.           (setq j (+ j 2))
     
150.   )
     
151.   result
     
152. )
     
153. 
     
154. 
     

;;;公共函数库-字符串操作<br /> ;;;目录<br /> ;;;1、正则表达式：L-string-regex(str1 str2 global ignorecase method pattern)<br /> ;;;2、集合转列表：convert-IMatchCollection-to-list<br /> ;;;3、阿拉伯数字转汉字数字：L-string-arabictocn<br /> ;;;4、中文数字转阿拉伯数字：L-string-cntoarabic<br /> ;;;<br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 正则表达式                                                               ;;<br /> ;;; L-string-regex                                            ;;<br /> ;;; 输入：<br /> ;;; str___字符串<br /> ;;; global___1 or 0, 指明模式是匹配整个字符串中所有与之相符的地方还是只匹配第一次出现的地方。<br /> ;;; ignorecase___1 or 0, 指明模式匹配是否大小写敏感。<br /> ;;; method___"Execute"、"Replace"、"Test"<br /> ;;; pattern___正则表达式<br /> ;;; 输出：列表、字符串、bool<br /> ;;; 示例：<br /> ;;; (setq str "liguiming1234567890" global 1 ignorecase 1 method "Execute")<br /> ;;; (L-string-regex "liguiming1234567890" 1 1 "Execute" "")<br /> ;;;-----------------------------------------------------------;;<br /> (defun L-string-regex(str1 str2 global ignorecase method pattern)<br />         (VL-LOAD-COM)<br />         ;;引用正则表达式控件<br />         (setq regex (vlax-create-object "Vbscript.RegExp"))<br />         (vlax-put-property regex "Global" global)<br />         (vlax-put-property regex "IgnoreCase" ignorecase)<br />         (vlax-put-property regex "Pattern" pattern)<br />         (cond<br />                 ((= method "Execute") (vlax-invoke-method  regex method str1))<br />                 ((= method "Replace") (vlax-invoke-method  regex method str1 str2))<br />                 ((= method "Test") (vlax-invoke-method  regex method str1))<br />                 (t nil)<br />         )<br />         <br /> )<br /> <br /> <br /> (defun convert-IMatchCollection-to-list (matches)<br />   (setq l (list))<br />   (setq i 0)<br />   (while (< i (vlax-get-property matches 'Count))<br />     (setq l (cons (vlax-get-property matches 'Item i) l))<br />     (setq i (1+ i))<br />   )<br />   l<br /> )<br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 阿拉伯数字转中文数字                                                    <br /> ;;; L-string-arabictocn                                            <br /> ;;; 输入：整数<br /> ;;; 输出：中文数字字符串<br /> ;;; 示例：<br /> (defun L-string-arabictocn (arabic / cn weight digits units section section-units z arabic)<br /> ; 保存转换后的中文数字<br /> (setq cn "") <br /> ; 当前位的权重<br /> (setq weight 1) <br /> ; 中文数字的字符串数组<br /> (setq digits '("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))<br /> ; 中文数字的单位字符串数组<br /> (setq units '("" "十" "百" "千")) <br /> ; 中文数字的节权位符字符串数组<br /> (setq section-units '("" "万" "亿")) <br /> ; 当前处理的节的编号<br /> (setq section 0)<br /> (setq z 0)<br /> (while (/= arabic 0)<br />         ; 获取当前数字的个位数<br />         (setq digit (rem arabic 10))<br />         ; 将当前数字缩小 10 倍，准备处理下一个数字 <br />         (setq arabic (fix (/ arabic 10)))<br />         (if (= weight 1) (progn (setq cn (strcat (nth section section-units) cn)) (setq section (1+ section))))<br />         (cond<br />                 ((= digit 0)<br />                         ; 如果前面还没有数字或前面的数字是零或当前处理的数字是节权位符<br />                         (if (and (/= (substr cn 1 1) "零") (/= z 0))<br />                                 ; 在结果前面加上零<br />                                 (progn (setq cn (strcat (nth 0 digits) cn) ) (setq z 0))<br />                         )<br />                 )<br />                 ; 否则在结果前面加上当前数字和单位<br />                 (t (progn (setq cn (strcat (nth digit digits) (nth (fix (+ (/ (log weight) (log        10)) 0.5)) units) cn)) (setq z 1)))<br />         )<br />         (setq weight (if (= weight 1000) (progn (setq z 0 ) 1) (* weight 10))) ; 更新当前位的权重<br /> )<br /> ; 十位处理<br /> (if (=(L-string-regex cn "" 1 1 "Test" "一十") :vlax-true) (L-string-regex cn "十" 0 1 "Replace" "一十"))<br /> )<br /> <br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 中文数字转阿拉伯数字                                                 <br /> ;;; L-string-cntoarabic                                           <br /> ;;; 输入：中文数字字符串<br /> ;;; 输出：整数<br /> ;;; 示例：<br /> (defun L-string-cntoarabic(cn / ch-num arabic-num bit-units units section-units section bitvalue weight result i j cn)<br />   (setq ch-num "零一二三四五六七八九")<br />   (setq arabic-num '(0 1 2 3 4 5 6 7 8 9))<br />   (setq bit-units "十百千")<br />   (setq units '(10 100 1000))<br />   (setq section-units "万亿")<br />   (setq section '(10000 100000000))<br />   (setq bitvalue 1)<br />   (setq weight 1)<br />   (setq result 0)<br />   (if (= (L-string-regex cn "" 1 1 "Test" "^十") :vlax-true) (setq cn (L-string-regex cn "一十" 0 1 "Replace" "十")))<br />   (setq i 0)<br />   (setq j 0)<br />   (while (and (setq c1 (nth j (reverse (vl-string->list cn)))) (setq c2 (nth (1+ j) (reverse (vl-string->list cn)))))<br />           (cond<br />                   ((and (vl-string-position c1 ch-num) (setq i (vl-string-position c2 ch-num)))<br />                                   (progn<br />                                           (if (= (rem i 2) 0)<br />                                                   (progn<br />                                                           (setq i (/ i 2))<br />                                                           (setq result (+ result (* (* (nth i arabic-num) bitvalue) weight) ))<br />                                                   )<br />                                           )<br />                                   )<br />                   )<br />                   ((and (vl-string-position c1 bit-units) (setq i (vl-string-position c2 bit-units)))<br />                                   (progn<br />                                           (if (= (rem i 2) 0)<br />                                                   (progn<br />                                                           (setq i (/ i 2))<br />                                                           (setq bitvalue (nth i units))<br />                                                   )<br />                                           )<br />                                   )<br />                   )<br />                   ((and (vl-string-position c1 section-units) (setq i (vl-string-position c2 section-units)))<br />                             (progn<br />                                     (if (= (rem i 2) 0)<br />                                                   (progn<br />                                                           (setq i (/ i 2))<br />                                                           (setq weight (nth i section))<br />                                                           (setq bitvalue 1)<br />                                                   )<br />                                           )<br />                                   )<br />                   )<br />                   (t nil)<br />           )<br />           (setq j (+ j 2))<br />   )<br />   result<br /> )<br /> <br /> <br />

tryhi

(L-string-cntoarabic "一千零八十万八千七百六十七")
试了结果不对，返回10808707

试试我的汉字、数字互转函数
http://bbs.mjtd.com/thread-169872-1-1.html

如果缺少try-StrRegExpReplace、try-StrRegExp函数的话：
http://bbs.mjtd.com/thread-169835-1-1.html

danier

感谢大佬指出错误，已初步测试，应该没啥问题了

1. ;;;公共函数库-字符串操作
   
2. ;;;目录
   
3. ;;;1、正则表达式：L-string-regex(str1 str2 global ignorecase method pattern)
   
4. ;;;2、集合转列表：convert-IMatchCollection-to-list
   
5. ;;;3、阿拉伯数字转汉字数字：L-string-arabictocn
   
6. ;;;4、中文数字转阿拉伯数字：L-string-cntoarabic
   
7. ;;;
   
8. 
   
9. ;;;-----------------------------------------------------------;;
   
10. ;;; 正则表达式                                                               ;;
    
11. ;;; L-string-regex                                            ;;
    
12. ;;; 输入：
    
13. ;;; str___字符串
    
14. ;;; global___1 or 0, 指明模式是匹配整个字符串中所有与之相符的地方还是只匹配第一次出现的地方。
    
15. ;;; ignorecase___1 or 0, 指明模式匹配是否大小写敏感。
    
16. ;;; method___"Execute"、"Replace"、"Test"
    
17. ;;; pattern___正则表达式
    
18. ;;; 输出：列表、字符串、bool
    
19. ;;; 示例：
    
20. ;;; (setq str "liguiming1234567890" global 1 ignorecase 1 method "Execute")
    
21. ;;; (L-string-regex "liguiming1234567890" 1 1 "Execute" "")
    
22. ;;;-----------------------------------------------------------;;
    
23. (defun L-string-regex(str1 str2 global ignorecase method pattern)
    
24.         (VL-LOAD-COM)
    
25.         ;;引用正则表达式控件
    
26.         (setq regex (vlax-create-object "Vbscript.RegExp"))
    
27.         (vlax-put-property regex "Global" global)
    
28.         (vlax-put-property regex "IgnoreCase" ignorecase)
    
29.         (vlax-put-property regex "attern" pattern)
    
30.         (cond
    
31.                 ((= method "Execute") (vlax-invoke-method  regex method str1))
    
32.                 ((= method "Replace") (vlax-invoke-method  regex method str1 str2))
    
33.                 ((= method "Test") (vlax-invoke-method  regex method str1))
    
34.                 (t nil)
    
35.         )
    
36.        
    
37. )
    
38. 
    
39. 
    
40. (defun convert-IMatchCollection-to-list (matches)
    
41.   (setq l (list))
    
42.   (setq i 0)
    
43.   (while (< i (vlax-get-property matches 'Count))
    
44.     (setq l (cons (vlax-get-property matches 'Item i) l))
    
45.     (setq i (1+ i))
    
46.   )
    
47.   l
    
48. )
    
49. 
    
50. ;;;-----------------------------------------------------------;;
    
51. ;;; 阿拉伯数字转中文数字                                                   
    
52. ;;; L-string-arabictocn                                            
    
53. ;;; 输入：整数
    
54. ;;; 输出：中文数字字符串
    
55. ;;; 示例：
    
56. (defun L-string-arabictocn (arabic / cn weight digits units section section-units z arabic)
    
57. ; 保存转换后的中文数字
    
58. (setq cn "")
    
59. ; 当前位的权重
    
60. (setq weight 1)
    
61. ; 中文数字的字符串数组
    
62. (setq digits '("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))
    
63. ; 中文数字的单位字符串数组
    
64. (setq units '("" "十" "百" "千"))
    
65. ; 中文数字的节权位符字符串数组
    
66. (setq section-units '("" "万" "亿"))
    
67. ; 当前处理的节的编号
    
68. (setq section 0)
    
69. (setq z 0)
    
70. (while (/= arabic 0)
    
71.         ; 获取当前数字的个位数
    
72.         (setq digit (rem arabic 10))
    
73.         ; 将当前数字缩小 10 倍，准备处理下一个数字
    
74.         (setq arabic (fix (/ arabic 10)))
    
75.         (if (= weight 1) (progn (setq cn (strcat (nth section section-units) cn)) (setq section (1+ section))))
    
76.         (cond
    
77.                 ((= digit 0)
    
78.                         ; 如果前面还没有数字或前面的数字是零或当前处理的数字是节权位符
    
79.                         (if (and (/= (substr cn 1 1) "零") (/= z 0))
    
80.                                 ; 在结果前面加上零
    
81.                                 (progn (setq cn (strcat (nth 0 digits) cn) ) (setq z 0))
    
82.                         )
    
83.                 )
    
84.                 ; 否则在结果前面加上当前数字和单位
    
85.                 (t (progn (setq cn (strcat (nth digit digits) (nth (fix (+ (/ (log weight) (log        10)) 0.5)) units) cn)) (setq z 1)))
    
86.         )
    
87.         (setq weight (if (= weight 1000) (progn (setq z 0 ) 1) (* weight 10))) ;更新当前位的权重
    
88. )
    
89. ; 十位处理
    
90. (if (=(L-string-regex cn "" 1 1 "Test" "^一十") :vlax-true) (setq cn (L-string-regex cn "十" 0 1 "Replace" "一十")))
    
91. cn
    
92. )
    
93. 
    
94. 
    
95. ;;;-----------------------------------------------------------;;
    
96. ;;; 中文数字转阿拉伯数字                                                
    
97. ;;; L-string-cntoarabic                                          
    
98. ;;; 输入：中文数字字符串
    
99. ;;; 输出：整数
    
100. ;;; 示例：
     
101. (defun L-string-cntoarabic(cn / ch-num arabic-num bit-units units section-units section bitvalue weight result i j cn)
     
102.   (setq ch-num "零一二三四五六七八九")
     
103.   (setq arabic-num '(0 1 2 3 4 5 6 7 8 9))
     
104.   (setq bit-units "十百千")
     
105.   (setq units '(10 100 1000))
     
106.   (setq section-units "万亿")
     
107.   (setq section '(10000 100000000))
     
108.   (setq bitvalue 1)
     
109.   (setq weight 1)
     
110.   (setq result 0)
     
111.   (if (= (L-string-regex cn "" 1 1 "Test" "^十") :vlax-true) (setq cn (L-string-regex cn "一十" 0 1 "Replace" "十")))
     
112.   (setq i 1)
     
113.   (while (/= (setq c1 (substr (L-string-reverse cn) i 2)) "")
     
114.           (cond
     
115.                   ((setq n (L-string-position ch-num c1))
     
116.                           (setq result (+ result (* (* (nth n arabic-num) bitvalue) weight) ))
     
117.                   )
     
118.                   ((setq n (L-string-position bit-units c1))
     
119.                                 (setq bitvalue (nth n units))
     
120.                   )
     
121.                   ((setq n (L-string-position section-units c1))
     
122.                                   (setq weight (nth n section))
     
123.                                   (setq bitvalue 1)
     
124.                   )
     
125.                   (t nil)
     
126.           )
     
127.           (setq i (+ i 2))
     
128.   )
     
129.   result
     
130. )
     
131. 
     
132. ;;;-----------------------------------------------------------;;
     
133. ;;; 判断字符在字符串中的位置（中文字符占位调整为1位）                                                
     
134. ;;; L-string-position                                          
     
135. ;;; 输入：
     
136. ;;; 输出：
     
137. ;;; 示例：
     
138. (defun L-string-position(str s / i n loop)
     
139.         (setq i 1)
     
140.         (setq n 0)
     
141.         (setq loop t)
     
142.         (while loop
     
143.                 (cond
     
144.                         ((> i (strlen str)) (setq loop nil)(setq n nil))
     
145.                         ((>= (ascii (substr str i 1)) 128)
     
146.                                 (if (= (substr str i 2) s)
     
147.                                         (setq loop nil)
     
148.                                         (progn (setq i (+ i 2)) (setq n (1+ n)))
     
149.                                 )
     
150.                         )
     
151.                         (t
     
152.                                 (if (= (substr str i 1) s)
     
153.                                         (setq loop nil)
     
154.                                         (progn (setq i (+ i 1)) (setq n (1+ n)))
     
155.                                 )
     
156.                         )
     
157.                 )
     
158.         )
     
159.         n
     
160. )
     
161. 
     
162. ;;;-----------------------------------------------------------;;
     
163. ;;; 字符串的元素顺序倒置后返回                                             
     
164. ;;; L-string-position                                          
     
165. ;;; 输入：
     
166. ;;; 输出：
     
167. ;;; 示例：
     
168. (defun L-string-reverse(str / i res loop)
     
169.         (setq i 1)
     
170.         (setq res "")
     
171.         (setq loop t)
     
172.         (while loop
     
173.                 (cond
     
174.                         ((> i (strlen str)) (setq loop nil))
     
175.                         ((>= (ascii (substr str i 1)) 128)
     
176.                                 (setq res (strcat (substr str i 2) res))
     
177.                                 (setq i (+ i 2))
     
178.                         )
     
179.                         (t
     
180.                                         (setq res (strcat (substr str i 1) res))
     
181.                                         (setq i (+ i 1))
     
182.                         )
     
183.                 )
     
184.         )
     
185.         res
     
186. )
     
187. 
     
188. 
     

;;;公共函数库-字符串操作<br /> ;;;目录<br /> ;;;1、正则表达式：L-string-regex(str1 str2 global ignorecase method pattern)<br /> ;;;2、集合转列表：convert-IMatchCollection-to-list<br /> ;;;3、阿拉伯数字转汉字数字：L-string-arabictocn<br /> ;;;4、中文数字转阿拉伯数字：L-string-cntoarabic<br /> ;;;<br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 正则表达式                                                               ;;<br /> ;;; L-string-regex                                            ;;<br /> ;;; 输入：<br /> ;;; str___字符串<br /> ;;; global___1 or 0, 指明模式是匹配整个字符串中所有与之相符的地方还是只匹配第一次出现的地方。<br /> ;;; ignorecase___1 or 0, 指明模式匹配是否大小写敏感。<br /> ;;; method___"Execute"、"Replace"、"Test"<br /> ;;; pattern___正则表达式<br /> ;;; 输出：列表、字符串、bool<br /> ;;; 示例：<br /> ;;; (setq str "liguiming1234567890" global 1 ignorecase 1 method "Execute")<br /> ;;; (L-string-regex "liguiming1234567890" 1 1 "Execute" "")<br /> ;;;-----------------------------------------------------------;;<br /> (defun L-string-regex(str1 str2 global ignorecase method pattern)<br />         (VL-LOAD-COM)<br />         ;;引用正则表达式控件<br />         (setq regex (vlax-create-object "Vbscript.RegExp"))<br />         (vlax-put-property regex "Global" global)<br />         (vlax-put-property regex "IgnoreCase" ignorecase)<br />         (vlax-put-property regex "<img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />attern" pattern)<br />         (cond<br />                 ((= method "Execute") (vlax-invoke-method  regex method str1))<br />                 ((= method "Replace") (vlax-invoke-method  regex method str1 str2))<br />                 ((= method "Test") (vlax-invoke-method  regex method str1))<br />                 (t nil)<br />         )<br />         <br /> )<br /> <br /> <br /> (defun convert-IMatchCollection-to-list (matches)<br />   (setq l (list))<br />   (setq i 0)<br />   (while (< i (vlax-get-property matches 'Count))<br />     (setq l (cons (vlax-get-property matches 'Item i) l))<br />     (setq i (1+ i))<br />   )<br />   l<br /> )<br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 阿拉伯数字转中文数字                                                    <br /> ;;; L-string-arabictocn                                            <br /> ;;; 输入：整数<br /> ;;; 输出：中文数字字符串<br /> ;;; 示例：<br /> (defun L-string-arabictocn (arabic / cn weight digits units section section-units z arabic)<br /> ; 保存转换后的中文数字<br /> (setq cn "") <br /> ; 当前位的权重<br /> (setq weight 1) <br /> ; 中文数字的字符串数组<br /> (setq digits '("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))<br /> ; 中文数字的单位字符串数组<br /> (setq units '("" "十" "百" "千")) <br /> ; 中文数字的节权位符字符串数组<br /> (setq section-units '("" "万" "亿")) <br /> ; 当前处理的节的编号<br /> (setq section 0)<br /> (setq z 0)<br /> (while (/= arabic 0)<br />         ; 获取当前数字的个位数<br />         (setq digit (rem arabic 10))<br />         ; 将当前数字缩小 10 倍，准备处理下一个数字 <br />         (setq arabic (fix (/ arabic 10)))<br />         (if (= weight 1) (progn (setq cn (strcat (nth section section-units) cn)) (setq section (1+ section))))<br />         (cond<br />                 ((= digit 0)<br />                         ; 如果前面还没有数字或前面的数字是零或当前处理的数字是节权位符<br />                         (if (and (/= (substr cn 1 1) "零") (/= z 0))<br />                                 ; 在结果前面加上零<br />                                 (progn (setq cn (strcat (nth 0 digits) cn) ) (setq z 0))<br />                         )<br />                 )<br />                 ; 否则在结果前面加上当前数字和单位<br />                 (t (progn (setq cn (strcat (nth digit digits) (nth (fix (+ (/ (log weight) (log        10)) 0.5)) units) cn)) (setq z 1)))<br />         )<br />         (setq weight (if (= weight 1000) (progn (setq z 0 ) 1) (* weight 10))) ;更新当前位的权重<br /> )<br /> ; 十位处理<br /> (if (=(L-string-regex cn "" 1 1 "Test" "^一十") :vlax-true) (setq cn (L-string-regex cn "十" 0 1 "Replace" "一十")))<br /> cn<br /> )<br /> <br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 中文数字转阿拉伯数字                                                 <br /> ;;; L-string-cntoarabic                                           <br /> ;;; 输入：中文数字字符串<br /> ;;; 输出：整数<br /> ;;; 示例：<br /> (defun L-string-cntoarabic(cn / ch-num arabic-num bit-units units section-units section bitvalue weight result i j cn)<br />   (setq ch-num "零一二三四五六七八九")<br />   (setq arabic-num '(0 1 2 3 4 5 6 7 8 9))<br />   (setq bit-units "十百千")<br />   (setq units '(10 100 1000))<br />   (setq section-units "万亿")<br />   (setq section '(10000 100000000))<br />   (setq bitvalue 1)<br />   (setq weight 1)<br />   (setq result 0)<br />   (if (= (L-string-regex cn "" 1 1 "Test" "^十") :vlax-true) (setq cn (L-string-regex cn "一十" 0 1 "Replace" "十")))<br />   (setq i 1)<br />   (while (/= (setq c1 (substr (L-string-reverse cn) i 2)) "")<br />           (cond<br />                   ((setq n (L-string-position ch-num c1))<br />                           (setq result (+ result (* (* (nth n arabic-num) bitvalue) weight) ))<br />                   )<br />                   ((setq n (L-string-position bit-units c1))<br />                                 (setq bitvalue (nth n units))<br />                   )<br />                   ((setq n (L-string-position section-units c1))<br />                                   (setq weight (nth n section))<br />                                   (setq bitvalue 1)<br />                   )<br />                   (t nil)<br />           )<br />           (setq i (+ i 2))<br />   )<br />   result<br /> )<br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 判断字符在字符串中的位置（中文字符占位调整为1位）                                                 <br /> ;;; L-string-position                                           <br /> ;;; 输入：<br /> ;;; 输出：<br /> ;;; 示例：<br /> (defun L-string-position(str s / i n loop)<br />         (setq i 1)<br />         (setq n 0)<br />         (setq loop t)<br />         (while loop<br />                 (cond<br />                         ((> i (strlen str)) (setq loop nil)(setq n nil))<br />                         ((>= (ascii (substr str i 1)) 128) <br />                                 (if (= (substr str i 2) s) <br />                                         (setq loop nil)<br />                                         (progn (setq i (+ i 2)) (setq n (1+ n)))<br />                                 )<br />                         )<br />                         (t<br />                                 (if (= (substr str i 1) s) <br />                                         (setq loop nil)<br />                                         (progn (setq i (+ i 1)) (setq n (1+ n)))<br />                                 )<br />                         )<br />                 )<br />         )<br />         n<br /> )<br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 字符串的元素顺序倒置后返回                                              <br /> ;;; L-string-position                                           <br /> ;;; 输入：<br /> ;;; 输出：<br /> ;;; 示例：<br /> (defun L-string-reverse(str / i res loop)<br />         (setq i 1)<br />         (setq res "")<br />         (setq loop t)<br />         (while loop<br />                 (cond<br />                         ((> i (strlen str)) (setq loop nil))<br />                         ((>= (ascii (substr str i 1)) 128)<br />                                 (setq res (strcat (substr str i 2) res))<br />                                 (setq i (+ i 2))<br />                         )<br />                         (t <br />                                         (setq res (strcat (substr str i 1) res))<br />                                         (setq i (+ i 1))<br />                         )<br />                 )<br />         )<br />         res<br /> )<br /> <br /> <br />

帝都划水王

今天 刚刚好天报销单用到数字转中文大写。可以参考下

pizi158545086

函数快捷键是什么，是需要再前面加快捷键函数吗？

紫苏炒黄瓜

不错，留个脚印

戏男

danier 发表于 2023-5-9 22:35
感谢大佬指出错误，已初步测试，应该没啥问题了

只会用lisp的，这种要怎么加载使用呀？