63 lines
2.7 KiB
Common Lisp
63 lines
2.7 KiB
Common Lisp
(defun c:unitcheck (/ setunits selectioncycling currunit domeasure testdist dochange newunit newunitnum)
|
|
(setq setunits (getvar "insunits"))
|
|
(setq selectioncycling (getvar "selectioncycling"))
|
|
|
|
(cond
|
|
((= setunits 0) (setq currunit "no units"))
|
|
((= setunits 1) (setq currunit "Inches"))
|
|
((= setunits 2) (setq currunit "Feet"))
|
|
((= setunits 3) (setq currunit "Miles"))
|
|
((= setunits 4) (setq currunit "Millimeters"))
|
|
((= setunits 5) (setq currunit "Centimeters"))
|
|
((= setunits 6) (setq currunit "Meters"))
|
|
((= setunits 7) (setq currunit "Kilometers"))
|
|
((= setunits 8) (setq currunit "Microinches"))
|
|
((= setunits 9) (setq currunit "Mils"))
|
|
((= setunits 10) (setq currunit "Yards"))
|
|
((= setunits 11) (setq currunit "Angstroms"))
|
|
((= setunits 12) (setq currunit "Nanometers"))
|
|
((= setunits 13) (setq currunit "Microns"))
|
|
((= setunits 14) (setq currunit "Decimeters"))
|
|
((= setunits 15) (setq currunit "Dekameters"))
|
|
((= setunits 16) (setq currunit "Hectometers"))
|
|
((= setunits 17) (setq currunit "Gigameters"))
|
|
((= setunits 18) (setq currunit "Astronomical Units"))
|
|
((= setunits 19) (setq currunit "Light Years"))
|
|
((= setunits 20) (setq currunit "Parsecs"))
|
|
((= setunits 21) (setq currunit "US Survey Feet"))
|
|
)
|
|
|
|
(initget 1 "Accept Verify")
|
|
(setq domeasure (getkword (strcat "Current units: " currunit " \n[Accept/Verify]")))
|
|
(princ domeasure)
|
|
|
|
(if
|
|
(= domeasure "Verify")
|
|
(progn
|
|
(setvar "selectioncycling" 0)
|
|
(setq testdist (getdist "\nMeasure now"))
|
|
(setvar "selectioncycling" selectioncycling)
|
|
|
|
(initget 1 "Yes No")
|
|
(setq dochange (getkword (strcat "Measurement: " (rtos testdist) " " currunit "\nAccept? [Yes/No]")))
|
|
(if
|
|
(= dochange "No")
|
|
(progn
|
|
(initget 1 "Inches Feet Millimeters Centimeters Decimeters Meters")
|
|
(setq newunit (getkword "Select new unit: [Inches/Feet/Millimeters/Centimeters/Decimeters/Meters]"))
|
|
|
|
(cond
|
|
((= newunit "Inches") (setq newunitnum 1))
|
|
((= newunit "Feet") (setq newunitnum 2))
|
|
((= newunit "Millimeters") (setq newunitnum 4))
|
|
((= newunit "Centimeters") (setq newunitnum 5))
|
|
((= newunit "Decimeters") (setq newunitnum 14))
|
|
((= newunit "Meters") (setq newunitnum 6))
|
|
)
|
|
(setvar "insunits" newunitnum)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(princ)
|
|
) |