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

danier 发表于 2023-5-9 16:59:16

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

;;;公共函数库-字符串操作
;;;目录
;;;1、正则表达式：L-string-regex(str1 str2 global ignorecase method pattern)
;;;2、集合转列表：convert-IMatchCollection-to-list
;;;3、阿拉伯数字转汉字数字：L-string-arabictocn
;;;4、中文数字转阿拉伯数字：L-string-cntoarabic
;;;

;;;-----------------------------------------------------------;;
;;; 正则表达式                                     ;;
;;; L-string-regex                                        ;;
;;; 输入：
;;; str___字符串
;;; global___1 or 0, 指明模式是匹配整个字符串中所有与之相符的地方还是只匹配第一次出现的地方。
;;; ignorecase___1 or 0, 指明模式匹配是否大小写敏感。
;;; method___"Execute"、"Replace"、"Test"
;;; pattern___正则表达式
;;; 输出：列表、字符串、bool
;;; 示例：
;;; (setq str "liguiming1234567890" global 1 ignorecase 1 method "Execute")
;;; (L-string-regex "liguiming1234567890" 1 1 "Execute" "")
;;;-----------------------------------------------------------;;
(defun L-string-regex(str1 str2 global ignorecase method pattern)
(VL-LOAD-COM)
;;引用正则表达式控件
(setq regex (vlax-create-object "Vbscript.RegExp"))
(vlax-put-property regex "Global" global)
(vlax-put-property regex "IgnoreCase" ignorecase)
(vlax-put-property regex "Pattern" pattern)
(cond
((= method "Execute") (vlax-invoke-methodregex method str1))
((= method "Replace") (vlax-invoke-methodregex method str1 str2))
((= method "Test") (vlax-invoke-methodregex method str1))
(t nil)
)

)

(defun convert-IMatchCollection-to-list (matches)
(setq l (list))
(setq i 0)
(while (< i (vlax-get-property matches 'Count))
(setq l (cons (vlax-get-property matches 'Item i) l))
(setq i (1+ i))
)
l
)

;;;-----------------------------------------------------------;;
;;; 阿拉伯数字转中文数字
;;; L-string-arabictocn
;;; 输入：整数
;;; 输出：中文数字字符串
;;; 示例：
(defun L-string-arabictocn (arabic / cn weight digits units section section-units z arabic)
; 保存转换后的中文数字
(setq cn "")
; 当前位的权重
(setq weight 1)
; 中文数字的字符串数组
(setq digits '("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))
; 中文数字的单位字符串数组
(setq units '("" "十" "百" "千"))
; 中文数字的节权位符字符串数组
(setq section-units '("" "万" "亿"))
; 当前处理的节的编号
(setq section 0)
(setq z 0)
(while (/= arabic 0)
; 获取当前数字的个位数
(setq digit (rem arabic 10))
; 将当前数字缩小 10 倍，准备处理下一个数字
(setq arabic (fix (/ arabic 10)))
(if (= weight 1) (progn (setq cn (strcat (nth section section-units) cn)) (setq section (1+ section))))
(cond
((= digit 0)
; 如果前面还没有数字或前面的数字是零或当前处理的数字是节权位符
(if (and (/= (substr cn 1 1) "零") (/= z 0))
; 在结果前面加上零
(progn (setq cn (strcat (nth 0 digits) cn) ) (setq z 0))
)
)
; 否则在结果前面加上当前数字和单位
(t (progn (setq cn (strcat (nth digit digits) (nth (fix (+ (/ (log weight) (log 10)) 0.5)) units) cn)) (setq z 1)))
)
(setq weight (if (= weight 1000) (progn (setq z 0 ) 1) (* weight 10))) ; 更新当前位的权重
)
; 十位处理
(if (=(L-string-regex cn "" 1 1 "Test" "一十") :vlax-true) (L-string-regex cn "十" 0 1 "Replace" "一十"))
)

;;;-----------------------------------------------------------;;
;;; 中文数字转阿拉伯数字
;;; L-string-cntoarabic
;;; 输入：中文数字字符串
;;; 输出：整数
;;; 示例：
(defun L-string-cntoarabic(cn / ch-num arabic-num bit-units units section-units section bitvalue weight result i j cn)
(setq ch-num "零一二三四五六七八九")
(setq arabic-num '(0 1 2 3 4 5 6 7 8 9))
(setq bit-units "十百千")
(setq units '(10 100 1000))
(setq section-units "万亿")
(setq section '(10000 100000000))
(setq bitvalue 1)
(setq weight 1)
(setq result 0)
(if (= (L-string-regex cn "" 1 1 "Test" "^十") :vlax-true) (setq cn (L-string-regex cn "一十" 0 1 "Replace" "十")))
(setq i 0)
(setq j 0)
(while (and (setq c1 (nth j (reverse (vl-string->list cn)))) (setq c2 (nth (1+ j) (reverse (vl-string->list cn)))))
(cond
((and (vl-string-position c1 ch-num) (setq i (vl-string-position c2 ch-num)))
      (progn
      (if (= (rem i 2) 0)
      (progn
      (setq i (/ i 2))
      (setq result (+ result (* (* (nth i arabic-num) bitvalue) weight) ))
      )
      )
      )
)
((and (vl-string-position c1 bit-units) (setq i (vl-string-position c2 bit-units)))
(progn
(if (= (rem i 2) 0)
      (progn
      (setq i (/ i 2))
      (setq bitvalue (nth i units))
      )
      )
      )
)
((and (vl-string-position c1 section-units) (setq i (vl-string-position c2 section-units)))
   (progn
      (if (= (rem i 2) 0)
      (progn
      (setq i (/ i 2))
      (setq weight (nth i section))
      (setq bitvalue 1)
      )
      )
      )
)
(t nil)
)
(setq j (+ j 2))
)
result
)

tryhi 发表于 2023-5-9 17:20:26

(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 发表于 2023-5-9 22:35:12

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

;;;公共函数库-字符串操作
;;;目录
;;;1、正则表达式：L-string-regex(str1 str2 global ignorecase method pattern)
;;;2、集合转列表：convert-IMatchCollection-to-list
;;;3、阿拉伯数字转汉字数字：L-string-arabictocn
;;;4、中文数字转阿拉伯数字：L-string-cntoarabic
;;;

;;;-----------------------------------------------------------;;
;;; 正则表达式                                     ;;
;;; L-string-regex                                        ;;
;;; 输入：
;;; str___字符串
;;; global___1 or 0, 指明模式是匹配整个字符串中所有与之相符的地方还是只匹配第一次出现的地方。
;;; ignorecase___1 or 0, 指明模式匹配是否大小写敏感。
;;; method___"Execute"、"Replace"、"Test"
;;; pattern___正则表达式
;;; 输出：列表、字符串、bool
;;; 示例：
;;; (setq str "liguiming1234567890" global 1 ignorecase 1 method "Execute")
;;; (L-string-regex "liguiming1234567890" 1 1 "Execute" "")
;;;-----------------------------------------------------------;;
(defun L-string-regex(str1 str2 global ignorecase method pattern)
(VL-LOAD-COM)
;;引用正则表达式控件
(setq regex (vlax-create-object "Vbscript.RegExp"))
(vlax-put-property regex "Global" global)
(vlax-put-property regex "IgnoreCase" ignorecase)
(vlax-put-property regex "Pattern" pattern)
(cond
((= method "Execute") (vlax-invoke-methodregex method str1))
((= method "Replace") (vlax-invoke-methodregex method str1 str2))
((= method "Test") (vlax-invoke-methodregex method str1))
(t nil)
)

)

(defun convert-IMatchCollection-to-list (matches)
(setq l (list))
(setq i 0)
(while (< i (vlax-get-property matches 'Count))
(setq l (cons (vlax-get-property matches 'Item i) l))
(setq i (1+ i))
)
l
)

;;;-----------------------------------------------------------;;
;;; 阿拉伯数字转中文数字
;;; L-string-arabictocn
;;; 输入：整数
;;; 输出：中文数字字符串
;;; 示例：
(defun L-string-arabictocn (arabic / cn weight digits units section section-units z arabic)
; 保存转换后的中文数字
(setq cn "")
; 当前位的权重
(setq weight 1)
; 中文数字的字符串数组
(setq digits '("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))
; 中文数字的单位字符串数组
(setq units '("" "十" "百" "千"))
; 中文数字的节权位符字符串数组
(setq section-units '("" "万" "亿"))
; 当前处理的节的编号
(setq section 0)
(setq z 0)
(while (/= arabic 0)
; 获取当前数字的个位数
(setq digit (rem arabic 10))
; 将当前数字缩小 10 倍，准备处理下一个数字
(setq arabic (fix (/ arabic 10)))
(if (= weight 1) (progn (setq cn (strcat (nth section section-units) cn)) (setq section (1+ section))))
(cond
((= digit 0)
; 如果前面还没有数字或前面的数字是零或当前处理的数字是节权位符
(if (and (/= (substr cn 1 1) "零") (/= z 0))
; 在结果前面加上零
(progn (setq cn (strcat (nth 0 digits) cn) ) (setq z 0))
)
)
; 否则在结果前面加上当前数字和单位
(t (progn (setq cn (strcat (nth digit digits) (nth (fix (+ (/ (log weight) (log 10)) 0.5)) units) cn)) (setq z 1)))
)
(setq weight (if (= weight 1000) (progn (setq z 0 ) 1) (* weight 10))) ;更新当前位的权重
)
; 十位处理
(if (=(L-string-regex cn "" 1 1 "Test" "^一十") :vlax-true) (setq cn (L-string-regex cn "十" 0 1 "Replace" "一十")))
cn
)

;;;-----------------------------------------------------------;;
;;; 中文数字转阿拉伯数字
;;; L-string-cntoarabic
;;; 输入：中文数字字符串
;;; 输出：整数
;;; 示例：
(defun L-string-cntoarabic(cn / ch-num arabic-num bit-units units section-units section bitvalue weight result i j cn)
(setq ch-num "零一二三四五六七八九")
(setq arabic-num '(0 1 2 3 4 5 6 7 8 9))
(setq bit-units "十百千")
(setq units '(10 100 1000))
(setq section-units "万亿")
(setq section '(10000 100000000))
(setq bitvalue 1)
(setq weight 1)
(setq result 0)
(if (= (L-string-regex cn "" 1 1 "Test" "^十") :vlax-true) (setq cn (L-string-regex cn "一十" 0 1 "Replace" "十")))
(setq i 1)
(while (/= (setq c1 (substr (L-string-reverse cn) i 2)) "")
(cond
((setq n (L-string-position ch-num c1))
      (setq result (+ result (* (* (nth n arabic-num) bitvalue) weight) ))
)
((setq n (L-string-position bit-units c1))
(setq bitvalue (nth n units))
)
((setq n (L-string-position section-units c1))
      (setq weight (nth n section))
      (setq bitvalue 1)
)
(t nil)
)
(setq i (+ i 2))
)
result
)

;;;-----------------------------------------------------------;;
;;; 判断字符在字符串中的位置（中文字符占位调整为1位）
;;; L-string-position
;;; 输入：
;;; 输出：
;;; 示例：
(defun L-string-position(str s / i n loop)
(setq i 1)
(setq n 0)
(setq loop t)
(while loop
(cond
((> i (strlen str)) (setq loop nil)(setq n nil))
((>= (ascii (substr str i 1)) 128)
(if (= (substr str i 2) s)
(setq loop nil)
(progn (setq i (+ i 2)) (setq n (1+ n)))
)
)
(t
(if (= (substr str i 1) s)
(setq loop nil)
(progn (setq i (+ i 1)) (setq n (1+ n)))
)
)
)
)
n
)

;;;-----------------------------------------------------------;;
;;; 字符串的元素顺序倒置后返回
;;; L-string-position
;;; 输入：
;;; 输出：
;;; 示例：
(defun L-string-reverse(str / i res loop)
(setq i 1)
(setq res "")
(setq loop t)
(while loop
(cond
((> i (strlen str)) (setq loop nil))
((>= (ascii (substr str i 1)) 128)
(setq res (strcat (substr str i 2) res))
(setq i (+ i 2))
)
(t
(setq res (strcat (substr str i 1) res))
(setq i (+ i 1))
)
)
)
res
)

帝都划水王 发表于 2023-5-10 00:33:38

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

pizi158545086 发表于 2023-5-30 22:21:02

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

紫苏炒黄瓜 发表于 2023-5-31 11:49:36

不错，留个脚印

戏男发表于 2023-6-19 14:51:03

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

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

页: [1]

明经CAD社区's Archiver

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