added unitcheck

2019-11-15 21:13:26 +01:00
parent 68f4bccb59
commit 89b6d106f8
2 changed files with 127 additions and 1 deletions
--- a/scripts/unitCheck.lsp
+++ b/scripts/unitCheck.lsp
@@ -0,0 +1,60 @@
+(defun c:unitcheck (/ setunits currunit domeasure testdist dochange newunit newunitnum)
+    (setq setunits (getvar "insunits"))
+    
+    (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 Change")
+    (setq domeasure (getkword (strcat "Current units: " currunit " \n[Accept/Change]")))
+    (princ domeasure)
+
+    (if 
+        (= domeasure "Change")
+        (progn
+            (setq testdist (getdist "\nMeasure now"))
+
+            (initget 1 "Yes No")
+            (setq dochange (getkword (strcat "Measurement: " (rtos testdist) " " currunit "\nChange unit?  [Yes/No]")))
+            (if 
+                (= dochange "Yes")
+                (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)
+)