;**** NUMBER.LSP ;*** Written by Don J. Buschert (c) 1989 ; ; Email: don.buschert@sait.ab.ca ; buschert@spots.ab.ca ; AutoCAD Page: http://www.spots.ab.ca/~buschert/ ; ; Disclaimer: ; Permission to use, copy, modify, and distribute this software ; for any purpose and without fee is hereby granted, provided ; that the above copyright notice appears in all copies and ; that both that copyright notice and the limited warranty and ; restricted rights notice below appear in all supporting ; documentation. ; ; THIS PROGRAM IS PROVIDED "AS IS" AND WITH ALL FAULTS. THE AUTHOR ; SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR ; FITNESS FOR A PARTICULAR USE. THE AUTHOR ALSO DOES NOT WARRANT THAT ; THE OPERATION OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE. ; ; Version 1.0 02/16/89 ; ; This program allows the user to insert incremented numbers by ; digitizing only one location for each number. ; ;*** Function NUMBER ; (defun C:NUMBER ( / Olderr ;error handler ;incr ;Increment (global) nums ;Starting number ;prec ;Precision (global) ;txth ;Text height (global) txtl ;Text location dumm ;Dummy variable. ) (graphscr) (defun number_error (s) (if (/= s "Function cancelled.");if ^c occurs... (princ (strcat "\nError: " s)) ) (if olderr (setq *error* olderr)) (princ) ) (setq olderr *error*) (setq *error* number_error) (setvar "CMDECHO" 0) (command "UNDO" "M") (if (null txth)(setq txth (getvar "TEXTSIZE"))) (setq dumm (getdist (strcat "\nText height <" (rtos txth) ">: ") ) ) (if (null dumm)(setq dumm txth)) (setq txth dumm) (setq nums (getdist "\nStarting number: ")) (if (null prec)(setq prec 0)) (setq dumm (getint (strcat "\nPrecision to <" (itoa prec) "> decimals: ") ) ) (if (null dumm)(setq dumm prec)) (setq prec dumm) (setq nums (rtos nums 2 prec)) (if (null incr)(setq incr 1)) (setq dumm (getdist (strcat "\nIncrement <" (rtos incr) ">: "))) (if (null dumm)(setq dumm incr)) (setq incr dumm) (setq txtl (getpoint "\nText location: ")) (command "TEXT" "M" txtl txth "" nums) (setq nums (+ (atof nums) incr)) (setq nums (rtos nums 2 prec)) (setq dumm 1) (while (= dumm 1) (setq txtl (getpoint "\nText location: ")) (if (null txtl)(setq dumm 0)) (if (= dumm 1)(command "TEXT" "M" txtl txth "" nums)) (setq nums (+ (atof nums) incr)) (setq nums (rtos nums 2 prec)) ) (setq *error* Olderr) (princ) ) ; ;*** End of Program