;;;Changes station numbers by specified amount.  Station format, "+" in
;;;station format to the user specified linear units of precision.
;;;
;;;Metric stations are sensed by the presence of three digits after the
;;;'+' and before the decimal.
;;;
;;;If precision is reduced by the user it cannot be regained by this routine.
;;;The prior digits of higher precision are discarded and cannot be recovered
;;;except by the method they were originally obtained or other equal method.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 9-02-94
;;;>		   EDITED: 09-27-2005
;;;
(DEFUN C:ADJSTA (/ m_units)			;adjv tele chrs nsta
  (if stait nil (load "stait" "\nFile STAIT.LSP not loaded!"))
  (if ustr nil (load "ustr" "\nFile USTR.LSP not loaded!"))
  (if uint nil (load "uint" "\nFile UINT.LSP not loaded!"))
  (setq nn_old_err *error*)
  (setq	adjv (distof (ustr 1
			   "\nValue to change Sta. by "
			   (if adjv
			     (rtos adjv 2 2)
			     ""
			   ) ;_ end of if
			   nil
		     ) ;_ end of ustr
	     ) ;_ end of distof
  ) ;_ end of setq
  (setq c_lupr (getvar "luprec"))
  (setq	t_lupr (uint 1
		     ""
		     "Units of precision? "
		     (if t_lupr
		       t_lupr
		       2
		     ) ;_ end of if
	       ) ;_ end of uint
  ) ;_ end of setq
  (setvar "luprec" t_lupr)
  (princ "\nSelect a number string to change: ")
  (while
    (setq tele (nentsel "\nSelect station to change "))
     (setq elem (entget (car tele)))
     (setq tstr (cdr (assoc 1 elem)))
     (setq cpos 1)
     (setq strl (strlen tstr))
     (while
       (and
	 (< cpos strl)
	 (setq chrs (substr tstr cpos 1))
	 (or
	   (eq "." chrs)
	   (not(eq (type (read "1")) (type (read chrs))))
	   (eq "+" chrs)
	   (eq "-" chrs)
	   (eq "," chrs)
	 ) ;_ end of or
       ) ;_ end of and
	(setq cpos (1+ cpos))
     ) ;_ end of while
     (setq cpoe cpos)
     (setq cpop cpos)
     (while
       (and
	 (setq chrs (substr tstr cpoe 1))
	 (not (> cpoe strl))
	 (or
	   (eq "." chrs)
	   (eq (type (read "1")) (type (read chrs)))
	   (eq "+" chrs)
	   (eq "-" chrs)
	   (eq "," chrs)
	 ) ;_ end of or
       ) ;_ end of and
	(setq cpoe (1+ cpoe))
     ) ;_ end of while
     (cond ((wcmatch tstr "*+###*") (setq m_units T))
	   ((wcmatch tstr "*+##*") (setq m_units nil))
     ) ;_ end of cond
     (if
       (eq (read "real") (type (read (substr tstr cpos cpoe))))
	(progn
	  (setq	nnum
		 (+ adjv
		    (distof
		      (substr tstr cpos (- cpoe cpos))
		    ) ;_ end of distof
		 ) ;_ end of +
	  ) ;_ end of setq
	  (setq	nstr
		 (strcat
		   (substr tstr 1 (1- cpos))
		   (rtos nnum)
		   (substr tstr cpoe)
		 ) ;_ end of strcat
	  ) ;_ end of setq
	) ;_ end of progn
	(progn
	  (while
	    (and
	      (not (> cpop strl))
	      (setq chrs (substr tstr cpop 1))
	      (not (eq "+" chrs))
	      (not (eq "-" chrs))
	      (not (eq "," chrs))
	    ) ;_ end of and
	     (setq cpop (1+ cpop))
	  ) ;_ end of while
	  (cond
	    ((eq "-" chrs)
	     (setq nsta "T")
	    )
	    ((or(eq "+" chrs)(eq "," chrs))
	     (setq nsta nil)
	    )
	  ) ;_ end of cond
	  (if nsta
	    (setq nnum
		   (+ adjv
		      (- 0
			 (distof
			   (if (not (>= cpop (1- strl)))
			     (strcat
			       (substr tstr cpos (- cpop cpos))
			       (substr tstr (1+ cpop) (- cpoe cpop 1))
			     ) ;_ end of strcat
			     (strcat
			       (substr tstr cpos (- cpoe cpos))
			       (substr tstr cpoe)
			     ) ;_ end of strcat
			   ) ;_ end of if
			 ) ;_ end of distof
		      ) ;_ end of -
		   ) ;_ end of +
	    ) ;_ end of setq
	    (setq nnum
		   (+ adjv
		      (distof
			(if (not (>= cpop (1- strl)))
			  (strcat
			    (substr tstr cpos (- cpop cpos))
			    (substr tstr (1+ cpop) (- cpoe cpop 1))
			  ) ;_ end of strcat
			  (strcat
			    (substr tstr cpos (- cpoe cpos))
			    (substr tstr cpoe)
			  ) ;_ end of strcat
			) ;_ end of if
		      ) ;_ end of distof
		   ) ;_ end of +
	    ) ;_ end of setq
	  ) ;_ end of if
	  (setq	nstr
		 (strcat
		   (substr tstr 1 (1- cpos))
		   (stait nnum t_lupr)
		   (substr tstr cpoe)
		 ) ;_ end of strcat
	  ) ;_ end of setq
	) ;_ end of progn
     ) ;_ end of if
     (setq elem
	    (subst (cons 1 nstr)
		   (assoc 1 elem)
		   elem
	    ) ;_ end of subst
     ) ;_ end of setq
     (entmod elem)
;     (COMMAND)
  ) ;_ end of while
  (setvar "luprec" c_lupr)
  (princ)
) ;_ end of DEFUN

;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
 ***Don't add text below the comment!***|;