罗马数字转换器
从昨天开始我一直在做的事情，我想我会把它扔出去，看看你们怎么想。(defun c:roman ( / stnum stst)
(if (> (setq stnum (atoi (setq stst (getstring "\n Enter number between 1 (I) and 3999 (MMMCMXCIX): ")))) 0)
(rn stnum)
(rnrev stst))
)
(defun rnrev (st / sl st pout rn prt)
(setq sl (strlen (setq st (strcase st)))
pout 0
rn '(("MMM" . 3000) ("MM" . 2000) ("M" . 1000) ("CM" . 900) ("DCCC" . 800) ("DCC" . 700) ("DC" . 600) ("D" . 500) ("CD" . 400) ("CCC" . 300) ("CC" . 200) ("C" . 100) ("XC" . 90) ("LXXX" . 80) ("LXX" . 70) ("LX" . 60) ("L" . 50) ("XL" . 40) ("XXX" . 30) ("XX" . 20) ("X" . 10) ("IX" . 9) ("VIII" .("VII" . 7) ("VI" . 6) ("V" . 5) ("IV" . 4) ("III" . 3) ("II" . 2) ("I" . 1))); /setq
(while (and (> sl 0)
(cdr (assoc (substr st 1 1) rn))); /and
(cond
((setq prt(cdr (assoc (substr st 1 4) rn)))
(setq st (substr st 5))); /cond 1
((setq prt(cdr (assoc (substr st 1 3) rn)))
(setq st (substr st 4))); /cond 2
((setq prt(cdr (assoc (substr st 1 2) rn)))
(setq st (substr st 3))); /cond 3
((setq prt(cdr (assoc (substr st 1 1) rn)))
(setq st (substr st 2))); /cond 4
); /cond
(setq rn (cutlst rn prt)
sl (strlen st)
pout (+ pout prt)); /setq
); /while
(if (= sl 0)
(princ pout) (princ "Invalid format")); /if
(princ); silent exit
); /defun
(defun rn (gi / sl is gi numlst pout)
(setq sl (strlen (setq is (itoa gi)))
numlst (list "1" "2" "3" "4" "5" "6" "7" "8" "9")
pout "")
(if (and (> gi 0)
(< gi 4000))
(progn
(while (> sl 0)
(cond
((= sl 4)
(setq pout (strcat pout (nth (vl-position (substr is 1 1) numlst) (list "M" "MM" "MMM")))
sl 3)); /cond1
((= sl 3)
(setq pout (strcat pout (nth (vl-position (substr is 1 1) numlst) (list "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM")))
sl 2)); /cond2
((= sl 2)
(setq pout (strcat pout (nth (vl-position (substr is 1 1) numlst) (list "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC")))
sl 1)); /cond3
((= sl 1)
(setq pout (strcat pout (nth (vl-position (substr is 1 1) numlst) (list "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX")))
sl 0)); /cond4
); /cond
(setq is (substr is 2))
); /while
(princ pout)
); /progn
(princ "Number Invalid"); else
); /if
(princ)
); /defun
(defun cutlst (lst num / z)
(cond
((> num 900)
(setq num 1000)); /cond 1
((> num 90)
(setq num 100 )); /cond 2
((> num 9)
(setq num 10 ))); /cond 3
(setq lst (vl-remove-if
'(lambda (z) (>= (cdr z) num)) lst)); /setq
); /defun 很好的一张账单——效果很好。不知道你会在哪里使用它，但作为一个新奇的东西很好
哈哈，是的，我知道。它开始于我试图找出某个罗马数字的含义时。然后我找到了一个转换器，我决定自己做一个。在多次失败后，我终于成功了。
页:
[1]