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
)
)
)