;Combined by Igal Averbuh 2015
(vl-load-com); if not already loaded
; Copyright ©2005 - Marc'Antonio Alessi, Italy - All rights reserved
; http://xoomer.virgilio.it/alessi
;
; Function: ALE_IsRoman
;
; Version 1.01 - 19/07/2005
;
; Description: verify and convert a Roman number to integer
; > Based on Roman classic style > 499 = CDXCIX
;
; Arguments:
; In_Str: a valid Roman number - string
;
; Return Values: integer from 1 to 3999 or nil on error
;
; Example:
; (ALE_IsRoman "MMMDCCCLXXXVI") => 3886
; (ALE_IsRoman "IIAIV") => nil
; (ALE_IsRoman "VV") => nil
;
; Note:
; ----> I=1 V=5 X=10 L=50 C=100 D=500 M=1000
; ascii 73 86 88 76 67 68 77
;
(defun ALE_IsRoman (In_Str / ValLst OutVal TmpVal IntVal NumLst)
(if
(or
(not
(vl-every
'(lambda (LmbDat)
(vl-position LmbDat '(73 86 88 76 67 68 77))
)
(setq ValLst (vl-string->list In_Str))
)
)
(wcmatch In_Str
(strcat
"*IIII*,*VV*,*XXXX*,*LL*,*CCCC*,*DD*,*MMMM*,"
"*IVIV*,*IXIX*,*XLXL*,*XCXC*,*CDCD*,*CMCM*,"
"*IIMXCC*,*VX*,*DCM*,*CMM*,*IXIV*,*MCMC*,"
"*XCX*,*IVI*,*LM*,*LD*,*LC*"
)
)
)
nil ;(progn (princ "\nNot valid Roman numeral! ") nil)
(progn
(setq
OutVal 0 TmpVal 0
NumLst '(
(73 . 1) (86 . 5) (88 . 10) (76 . 50)
(67 . 100) (68 . 500) (77 . 1000)
)
)
(foreach ForElm (reverse ValLst)
(if (= 3999 OutVal 1)
OutVal
;(progn (princ "\nOut of range! ") nil)
)
)
)
)
;
; Copyright ©2005 - Marc'Antonio Alessi, Italy - All rights reserved
; http://xoomer.virgilio.it/alessi
;
; Function: ALE_Int->Roman
;
; Version 1.00 - 20/07/2005
;
; Description: convert an integer to Roman number
; > Based on Roman classic style > 499 = CDXCIX
;
; Arguments:
; IntVal: integer from 1 to 3999
;
; Return Values: Roman number - string - or nil on error
;
; Example:
; (ALE_Int->Roman 3886) => "MMMDCCCLXXXVI"
; (ALE_Int->Roman 0) => nil
; (ALE_Int->Roman 4000) => nil
;
;
(defun ALE_Int->Roman (IntVal / OutStr ValLst)
(if (>= 3999 IntVal 1)
(progn
(setq
OutStr ""
ValLst
'( ( (48 . "")(49 . "I")(50 . "II")(51 . "III")(52 . "IV")
(53 . "V")(54 . "VI")(55 . "VII")(56 . "VIII")(57 . "IX") )
( (48 . "")(49 . "X")(50 . "XX")(51 . "XXX")(52 . "XL")
(53 . "L")(54 . "LX")(55 . "LXX")(56 . "LXXX")(57 . "XC") )
( (48 . "")(49 . "C")(50 . "CC")(51 . "CCC")(52 . "CD")
(53 . "D")(54 . "DC")(55 . "DCC")(56 . "DCCC")(57 . "CM") )
( (48 . "")(49 . "M")(50 . "MM")(51 . "MMM") ) )
)
(foreach ForElm (reverse (vl-string->list (itoa IntVal)))
(setq
OutStr (strcat (cdr (assoc ForElm (car ValLst))) OutStr)
ValLst (cdr ValLst)
)
)
OutStr
)
)
)
(defun c:rm ( / TxtObj)
(if (setq TxtObj (vlax-Ename->Vla-Object (car (entsel "\nSelect Integer Text/Mtext to convert to Roman text: "))))
(vla-Put-textstring
TxtObj
(ALE_Int->Roman (atoi(vla-Get-textstring TxtObj)))
)
)
)
(defun c:ri (/ txt txtdata txtstr)
(setq
txt (car (entsel "\nSelect Roman Text/Mtext to convert to Integer text: "))
txtdata (entget txt)
txtstr (cdr (assoc 1 txtdata))
); setq
(entmod
(subst
(cons 1 (itoa (ALE_IsRoman txtstr))); put new value in place of:
(assoc 1 txtdata); old value, in:
txtdata; entity data list
); subst
); entmod
); defun
(defun c:ROM ()
(initget "Roman Integer")
(setq which
(cond
( (getkword
(strcat
"Convert to [Roman/Integer] : "
); strcat
); getkword
); User-entry condition
(which); User pressed Enter with previous choice -- use it
("Roman"); User pressed Enter without previous choice [first use] -- use initial default
); cond
); setq
(if (= which "Roman") (c:rm))
(if (= which "Integer") (c:ri))
); defun
(c:rom)
