Commandobill Posted June 10, 2009 Share Posted June 10, 2009 Something I've been working on since yesterday thought i'd throw it out there and see what you guys think. (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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 10, 2009 Share Posted June 10, 2009 Nice one Bill - it works well. Not sure where you'd use it, but great as a novelty Quote Link to comment Share on other sites More sharing options...
Commandobill Posted June 10, 2009 Author Share Posted June 10, 2009 Not sure where you'd use it, but great as a novelty Lol yeah i know. It started when i was trying to find out what a certain roman numeral meant. Then i found a converter and I decided to make my own. After many fails I finally got it. Quote Link to comment Share on other sites More sharing options...
FROSTEE3510 Posted March 14, 2023 Share Posted March 14, 2023 On 6/10/2009 at 12:50 PM, Commandobill said: Lol yeah i know. It started when i was trying to find out what a certain roman numeral meant. Then i found a converter and I decided to make my own. After many fails I finally got it. Thanks Commando for sharing this code. I know it has been over a decade since sharing, but it just came in handy for a manual I am working on and intend to use the roman numerals as part of the sheet numbering - I have to come up with a custom function to handle it due to how this manual is built in ACAD. As I tried the code out, I had an issue with a missing parentheses (it was a quick find) while erroring out on certain value types. The problematic value types are integers greater than nine and possessing zeros in the value, e.g. 108 and 1008. Below [and attached] is the patched version to rid it of that pesky bug. ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; ;; ROMAN NUMERAL CONVERTERS ;; ;; ALL credit and source material belongs to the following source: ;; Commandobill ;; https://www.cadtutor.net/forum/topic/11354-roman-numeral-converter/ ;; ;; Alterations made from original author and source material are as follows: ;; - Renamed vast majority most function and symbol names from original source due to OCD and personal practice to ;; digest source material. ;; - Patched the -ROMANNUMERAL function (rn function in original source) to handle zeros when input integer is ;; greater than a value of nine (9) and contains zeros, e.g. 108 and 1008. ;; ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % (defun c:ROMANNUMERALCONVERTER ( / intgen strgen ) (if (> (setq intgen (atoi (setq strgen (getstring "\n Enter number between 1 (I) and 3999 (MMMCMXCIX): ")))) 0) (-ROMANNUMERAL intgen) (-ROMANNUMERALREVERSE strgen) ) ) (defun -ROMANNUMERALREVERSE ( strgen / lenstr output par romnum strgen ) (setq lenstr (strlen (setq strgen (strcase strgen))) output 0 romnum '( ("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" . 8) ("VII" . 7) ("VI" . 6) ("V" . 5) ("IV" . 4) ("III" . 3) ("II" . 2) ("I" . 1) ) ) (while (and (> lenstr 0) (cdr (assoc (substr strgen 1 1) romnum)) ) (cond ( (setq par (cdr (assoc (substr strgen 1 4) romnum))) (setq strgen (substr strgen 5)) ) ( (setq par (cdr (assoc (substr strgen 1 3) romnum))) (setq strgen (substr strgen 4)) ) ( (setq par (cdr (assoc (substr strgen 1 2) romnum))) (setq strgen (substr strgen 3)) ) ( (setq par (cdr (assoc (substr strgen 1 1) romnum))) (setq strgen (substr strgen 2)) ) ) (setq romnum (-CUTLST romnum par) lenstr (strlen strgen) output (+ output par) ) ) (if (= lenstr 0) (princ output) (princ "Invalid format") ) (princ) ) (defun -ROMANNUMERAL ( intgen / intgen intstr numlst output lenstr ) (setq lenstr (strlen (setq intstr (itoa intgen))) numlst (list "1" "2" "3" "4" "5" "6" "7" "8" "9") output "" ) (if (and (> intgen 0) (< intgen 4000)) (progn (while (> lenstr 0) (cond ( (= lenstr 4) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "M" "MM" "MMM"))) lenstr 3 ) ) ( (= lenstr 3) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"))) lenstr 2 ) ) ( (= lenstr 2) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"))) lenstr 1 ) ) ( (= lenstr 1) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"))) lenstr 0 ) ) ) (setq intstr (substr intstr 2)) ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; START PATCH - alteration to original source material (if (= (substr intstr 1 1) "0") (while (and (> lenstr 0) (= (substr intstr 1 1) "0")) (setq intstr (substr intstr 2) lenstr (- lenstr 1) ) ) ) ;; END PATCH - alteration to original source material ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ) (princ output) ) (princ "Number Invalid") ) (princ) ) (defun -CUTLST ( lst num / z ) (cond ( (> num 900) (setq num 1000) ) ( (> num 90) (setq num 100 ) ) ( (> num 9) (setq num 10 ) ) ) (setq lst (vl-remove-if '(lambda (z) (>= (cdr z) num) ) lst ) ) ) Thanks again CommandoBill! This was an impressive approach to converting Roman Numerals - so simple that it's elegant. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted March 14, 2023 Share Posted March 14, 2023 I've took some of my free time to make it prettier (I mean code), and BTW. I don't understand last (vl-remove-if (function (lambda ( z ) (z) ...)) lst), so I removed that (z) ... ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; ;; ROMAN NUMERAL CONVERTERS ;; ;; ALL credit and source material belongs to the following source: ;; Commandobill ;; https://www.cadtutor.net/forum/topic/11354-roman-numeral-converter/ ;; ;; Alterations made from original author and source material are as follows: ;; - Renamed vast majority most function and symbol names from original source due to OCD and personal practice to ;; digest source material. ;; - Patched the -ROMANNUMERAL function (rn function in original source) to handle zeros when input integer is ;; greater than a value of nine (9) and contains zeros, e.g. 108 and 1008. ;; ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % (defun c:ROMANNUMERALCONVERTER ( / intgen strgen ) (if (> (setq intgen (atoi (setq strgen (getstring "\n Enter number between 1 (I) and 3999 (MMMCMXCIX): ")))) 0) (-ROMANNUMERAL intgen) (-ROMANNUMERALREVERSE strgen) ) ) (defun -ROMANNUMERALREVERSE ( strgen / lenstr output par romnum ) (setq lenstr (strlen (setq strgen (strcase strgen))) output 0 romnum '( ("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" . 8) ("VII" . 7) ("VI" . 6) ("V" . 5) ("IV" . 4) ("III" . 3) ("II" . 2) ("I" . 1) ) ) (while (and (> lenstr 0) (cdr (assoc (substr strgen 1 1) romnum)) ) (cond ( (setq par (cdr (assoc (substr strgen 1 4) romnum))) (setq strgen (substr strgen 5)) ) ( (setq par (cdr (assoc (substr strgen 1 3) romnum))) (setq strgen (substr strgen 4)) ) ( (setq par (cdr (assoc (substr strgen 1 2) romnum))) (setq strgen (substr strgen 3)) ) ( (setq par (cdr (assoc (substr strgen 1 1) romnum))) (setq strgen (substr strgen 2)) ) ) (setq romnum (-CUTLST romnum par) lenstr (strlen strgen) output (+ output par) ) ) (if (= lenstr 0) (princ output) (princ "Invalid format") ) (princ) ) (defun -ROMANNUMERAL ( intgen / intstr numlst output lenstr ) (setq lenstr (strlen (setq intstr (itoa intgen))) numlst (list "1" "2" "3" "4" "5" "6" "7" "8" "9") output "" ) (if (and (> intgen 0) (< intgen 4000)) (progn (while (> lenstr 0) (cond ( (= lenstr 4) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "M" "MM" "MMM")))) (setq lenstr 3) ) ( (= lenstr 3) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM")))) (setq lenstr 2) ) ( (= lenstr 2) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC")))) (setq lenstr 1) ) ( (= lenstr 1) (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX")))) (setq lenstr 0) ) ) (setq intstr (substr intstr 2)) ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; START PATCH - alteration to original source material (if (= (substr intstr 1 1) "0") (while (and (> lenstr 0) (= (substr intstr 1 1) "0")) (setq intstr (substr intstr 2) lenstr (- lenstr 1) ) ) ) ;; END PATCH - alteration to original source material ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % ) (princ output) ) (princ "Number Invalid") ) (princ) ) (defun -CUTLST ( lst num ) (cond ( (> num 900) (setq num 1000) ) ( (> num 90) (setq num 100 ) ) ( (> num 9) (setq num 10 ) ) ) (setq lst (vl-remove-if (function (lambda ( z ) (>= (cdr z) num) )) lst ) ) ) 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.