社区 › AutoLISP/Visual LISP 编程技术 › 将纯数字字符翻译成汉字数字

gbhsu 发表于 2011-9-8 12:05:55

将纯数字字符翻译成汉字数字

本帖最后由 gbhsu 于 2011-9-8 16:56 编辑

;;;本人原创:将纯数字转变为汉字数字字符
;;;快过中秋了,给大家送点小礼物
;;;原想将cmd+num升级版发出来的,由于工作量大,且要增加不少命令
;;;看来是来不及了
;;;现将前不久鼓捣的一个小子程贴出来大家讨论一下
;;;数字大了,可能有点小问题,正如林子大了,什么鸟都有一样
;;;大家帮忙赶一赶
;;;e.g.(hsu:num2ch "123")"一百二十三"
;;;因在cad中的数值文字是以字符的形式存在的
;;;测试命令为" tt" 专为戏男而编!
(defun c:tt(/ numstr)
      (setq numstr (getstring "\n请输入数字字符:"))
       (ifnumstr (hsu:num2chnumstr))
)

(defun hsu:num2ch(str / len strlist hzlist strch listi i j name)
       (vl-load-com)
       (setq len (strlen str)i 0 hzlist '()listi '())
       (setq strlist (reverse(VL-STRING->LIST str)))
(while strlist
    (if (or(= i 4)(= i len))
      (progn
      (setq i 0)
      (setq hzlist (append (list listi) hzlist))
      (setq listi'())
      )
      (progn
      (setq i (+ i 1))
      (setq listi (append (list(car strlist)) listi))
      (setq strlist (cdr strlist))
      );progn
      );if
    );repeat
(if listi (setq hzlist (append (list listi) hzlist)))
(setq hzlist (reverse hzlist)i 0strch "" name "")
   ;hzlist
(foreach nhzlist
          (cond ((= i 1)(if(or
      (/=(nth 0 n)48)
      (/=(nth 1 n)48)
      (/=(nth 2 n)48)
      (/=(nth 3 n)48))
      (setq name "万")
      (setq name "零")))
                ((= i 2)(if(or
      (/=(nth 0 n)48)
      (/=(nth 1 n)48)
      (/=(nth 2 n)48)
      (/=(nth 3 n)48))
      (setq name "亿")
      (setq name "零")))

                ((= i 3)(if(or
      (/=(nth 0 n)48)
      (/=(nth 1 n)48)
      (/=(nth 2 n)48)
      (/=(nth 3 n)48))
      (setq name "兆")
      (setq name "零")))

   );cond
   (setq j i)
          (setq strch (strcat(hsu:num2hz n) name strch))
   (setq i (+ i 1))
    );foreach
    (setq len (strlen strch))
    (if(=(substr strch 1 4 )"一十")(setq strch (substr strch 3)))
         (while (vl-string-search"零零" strch)
                (setq strch(vl-string-subst "零""零零" strch)))
   strch
);defun
(defun hsu:num2hz(plist / string i)
      (vl-load-com)
      (setq i 0)
      (setq plist(reverse plist))
      (setq string '())
      (foreach n plist
      (setq string (append string
                            (list                           
         (cond
      ((= n 48)"零")               
      ((= n 49)"一")
      ((= n 50)"二")
      ((= n 51)"三")
      ((= n 52)"四")
      ((= n 53)"五")
      ((= n 54)"六")
      ((= n 55)"七")
      ((= n 56)"八")
      ((= n 57)"九")
      );cond
            
                                    (cond
                                    ((and(<= j 3)(= i 0))(if(/=(nth (+ i 1) plist)48)"十" ""))
      ((and(<= j 3)(= i 1))(if(/=(nth (+ i 1) plist)48)"百" ""))
      ((and(<= j 3)(= i 2))(if(/=(nth (+ i 1) plist)48)"千" ""))
                                    ((and(<= j 3)(= i 3))(if(/=(nth (+ i 1) plist)48)"万" ""))
                                    ((and(<= j 3)(= i 4))(if(/=(nth (+ i 1) plist)48)"亿" ""))
      ((and(<= j 3)(= i 5))(if(/=(nth (+ i 1) plist)48)"兆" ""))
      (if(> j 3)"")
               );cond
      
            
         );list
   );cond
       );setq
(setq i (+ i 1))
);foreach
      
(while(or(eq(car string)"零")(eq(car string)""))(setq string(cdr string)))
(setq string(apply 'strcat(cdr (reverse string))))   
);defun

hdlyt11 发表于 2011-9-8 12:28:22

呵呵，真的不错哦，

gbhsu 发表于 2011-9-8 12:36:11

板凳

本帖最后由 gbhsu 于 2011-9-8 12:42 编辑

呵呵,沙发有人抢了,自已坐板凳吧!

kwok 发表于 2011-9-8 13:06:39

lsp功能真强大......

戏男 发表于 2011-9-8 14:26:05

你真是个人才啊 这也能做得到

戏男 发表于 2011-9-8 14:33:50

好象不行哦

gbhsu 发表于 2011-9-8 15:38:16

本帖最后由 gbhsu 于 2011-9-8 15:41 编辑

戏男 发表于 2011-9-8 14:33 http://bbs.mjtd.com/static/image/common/back.gif
好象不行哦_$ (hsu:num2ch "123456789")
"一亿二千三百四十五万六千七百八十九"
_$

哪里不行?
是不是少函数?

mandala 发表于 2011-9-8 16:15:57

挺有意思的东西，支持。

lincctw_ccl 发表于 2011-9-8 16:17:46

樓主真是太有才了!!
可惜這lsp我用不上
不然效率提高是可期的

戏男 发表于 2011-9-8 16:30:43

我试了那个命令 不行啊num2ch 就这个命令

查看完整版本: 将纯数字字符翻译成汉字数字