品茗新秀 发表于 2014-5-17 21:05 static/image/common/back.gif
这一句没看懂 (setq str(rtos sk_n 2 8) lst'() i 0 lst2 "" )
一句谢谢都没有？
edata 发表于 2014-5-10 11:45 static/image/common/back.gif
向院长致敬
测试了一下，最好再改进一下
(defun int->str2(sk_n sk_flag / sk- A I K LST LST2 S SK_N->STR1 SK_N->STR2 STR)
(setq sk_n->str1(list(list 0 (if sk_flag "〇" "零"))
(list 1 (if sk_flag "一" "壹"))
(list 2 (if sk_flag "二" "贰"))
(list 3 (if sk_flag "三" "叁"))
(list 4 (if sk_flag "四" "肆"))
(list 5 (if sk_flag "五" "伍"))
(list 6 (if sk_flag "六" "陆"))
(list 7 (if sk_flag "七" "柒"))
(list 8 (if sk_flag "八" "捌"))
(list 9 (if sk_flag "九" "玖")))
sk_n->str2(list'(1 "")
(list 2 (if sk_flag "十" "拾"))
(list 3 (if sk_flag "百" "佰"))
(list 4 (if sk_flag "千" "仟"))
(list 5 "万")
(list 6 (if sk_flag "十万" "拾万"))
(list 7 (if sk_flag "百万" "佰万"))
(list 8 (if sk_flag "千万" "仟万"))
(list 9 "亿万")
(list 10 (if sk_flag "十亿" "拾亿"))
(list 11 (if sk_flag "百亿" "佰亿"))
(list 12 "万亿")
(list 13 "兆")))
(if (< sk_n 0)(setq sk_n(abs sk_n) sk- "负"))
(if(= sk_n 0)(setq lst2 "零")
(progn
(setq str(rtos sk_n 2 0) lst'() i 0 lst2 "" )
(while (/= (setq s(substr str (setq i(1+ i)) 1)) "")
(setq lst(cons s lst))
)
(setq lst(reverse lst) k (1+(length lst)))
(while(setq a(car lst))
(setq lst2(strcat lst2
(cond
((and (= a "1")(= (length lst) 2 ))(strcat(cadr(assoc (setq k(1- k)) sk_n->str2))))
((and (= a "0") (= k 2)) "")
((and (= a "0") (> k 1)(= (cadr lst) "0"))(setq k(1- k)) "")
((and (= a "0") (> k 1)(/= (cadr lst) "0"))(setq k(1- k)) "零")
(t (strcat(cadr(assoc (atoi a) sk_n->str1))(cadr(assoc (setq k(1- k)) sk_n->str2)))))
))
(setq lst(cdr lst))
)
(if sk-(setq lst2(strcat sk- lst2)))
lst2
)
)
)
;;;写文字程序
;;;输入实数整型范围
(defun c:tt(/ i p k)
(or(and (setq i(getreal "\nEnter integer number:"))(if (< i 0)(setq k t i (1+ i))(setq i(1- i))))(setq i 0))
(if i
(while (setq p (getpoint "\nInsert point:"))
(entmake (list '(0 . "TEXT")
(cons 1 (int->str2 (cond
((and (not k) (= i -1))(setq i (1+ i)))
(k (setq i (1- i)))
(t (setq i (1+ i))))
t
)
)
(cons 10 p)
(cons 40 50)
)
)
))
(princ)
)
(defun c:tt2(/ i p k)
(or(and (setq i(getreal "\nEnter integer number:"))(if (< i 0)(setq k t i (1+ i))(setq i(1- i))))(setq i 0))
(if i
(while (setq p (getpoint "\nInsert point:"))
(entmake (list '(0 . "TEXT")
(cons 1 (int->str2 (cond
((and (not k) (= i -1))(setq i (1+ i)))
(k (setq i (1- i)))
(t (setq i (1+ i))))
nil
)
)
(cons 10 p)
(cons 40 50)
)
)
))
(princ)
)