;;;Change the first number in a text string by the user specified value. The ;;;new number is conformed to the units if precision specified by the user. ;;; ;;;If specified units of precision are greater than the precision of the original ;;;number zeros are added to the string to display them. Actual digits reflecting ;;;the precise number intended by the user cannot be determined by this routine. ;;; ;;;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. ;;; ;;;(uses UINT USTR) ;;; ;;; ;;; ;;;> Author: Henry C. Francis ;;;> 425 N. Ashe St. ;;;> Southern Pines, NC 28387 ;;;> http://paracadd.com ;;;> All rights reserved. ;;; ;;;> COPYRIGHT: 9-19-95 ;;;> EDITED: 09-27-2005 ;;; (DEFUN c:adjnum () ; luprc tele elem tstr cnt_1 cnt_2 pfx_str sfx_str (setq luprc (getvar "luprec")) (COMMAND ".undo" "m") (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded! ")) (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ")) (setq ndpl (uint 1 "" "Number of decimal places " ndpl)) (setvar "luprec" ndpl) (setq adjv (distof (ustr 1 "\nValue to change number by " (if adjv (rtos adjv) "" ) ;_ end of if nil ) ;_ end of ustr ) ;_ end of distof ) ;_ end of setq (while (setq tele (nentsel "\nSelect number to change ")) (setq elem (entget (car tele))) (setq tstr (cdr (assoc 1 elem))) ;;; (PRINC "\n(1) tstr = ") ;;; (PRINC tstr) ;;; (PRINC) (COND ((WCMATCH tstr "#\"*#*") (SETQ cnt_1 4)) ((WCMATCH tstr "##\"*#*") (SETQ cnt_1 5)) ((WCMATCH tstr "###\"*#*") (SETQ cnt_1 6)) (T (setq cnt_1 1 cnt_2 1 )) ) (while (and (/= (substr tstr cnt_1 1) "0") (/= (substr tstr cnt_1 1) "1") (/= (substr tstr cnt_1 1) "2") (/= (substr tstr cnt_1 1) "3") (/= (substr tstr cnt_1 1) "4") (/= (substr tstr cnt_1 1) "5") (/= (substr tstr cnt_1 1) "6") (/= (substr tstr cnt_1 1) "7") (/= (substr tstr cnt_1 1) "8") (/= (substr tstr cnt_1 1) "9") (< cnt_1 (strlen tstr)) ) ;_ end of and (if (wcmatch (substr tstr cnt_1 5) "%%###") (setq cnt_1 (+ cnt_1 5)) (setq cnt_1 (1+ cnt_1)) ) ;_ end of if ) ;_ end of while (while (or (= (substr tstr (+ cnt_1 cnt_2) 1) "0") (= (substr tstr (+ cnt_1 cnt_2) 1) "1") (= (substr tstr (+ cnt_1 cnt_2) 1) "2") (= (substr tstr (+ cnt_1 cnt_2) 1) "3") (= (substr tstr (+ cnt_1 cnt_2) 1) "4") (= (substr tstr (+ cnt_1 cnt_2) 1) "5") (= (substr tstr (+ cnt_1 cnt_2) 1) "6") (= (substr tstr (+ cnt_1 cnt_2) 1) "7") (= (substr tstr (+ cnt_1 cnt_2) 1) "8") (= (substr tstr (+ cnt_1 cnt_2) 1) "9") (and (=(substr tstr(+ cnt_1 cnt_2) 1) ".") (not(=(strlen tstr)(+ cnt_1 cnt_2))) ) ) ;_ end of or (setq cnt_2 (1+ cnt_2)) ) ;_ end of while (if (> cnt_1 1) (progn (setq pfx_str (substr tstr 1 (1- cnt_1))) (if (>= (strlen tstr) (+ cnt_1 cnt_2)) (setq sfx_str (substr tstr (+ cnt_1 cnt_2))) (setq sfx_str "") ) ;_ end of if ) ;_ end of progn (progn (if (>= (strlen tstr) (1+ cnt_2)) (setq sfx_str (substr tstr (1+ cnt_2))) (setq sfx_str "") ) ;_ end of if (setq pfx_str "") ) ;_ end of progn ) ;_ end of if (setq nstr (strcat pfx_str (if (and (eq pfx_str "") (eq sfx_str "")) ;;; (IF (EQ (STRLEN tstr) (STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl))) ;;; (rtos (+ (distof tstr 2) adjv) 2 ndpl) ;;; (IF (WCMATCH (rtos (+ (distof tstr 2) adjv) 2 ndpl) "*.*") ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) "000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) "00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))1) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) "0")) ;;; (T(rtos (+ (distof tstr 2) adjv) 2 ndpl)) ;;; ) ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))4) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) ".000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) ".00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) ".0")) ;;; (T(rtos (+ (distof tstr 2) adjv) 2 ndpl)) ;;; ) ;;; ) ;;; ) (PROGN ;;; (PRINC "\nOriginal text is just a positive number! ") ;;; (PRINC) (rtos (+ (distof tstr 2) adjv) 2 ndpl) ) ;;; (IF (EQ (STRLEN tstr) (STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl))) ;;; (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ;;; (IF (WCMATCH (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "*.*") ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))1) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "0")) ;;; (T(rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)) ;;; ) ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))4) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ".000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ".00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ".0")) ;;; (T(rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)) ;;; ) ;;; ) ;;; ) (if (and (eq (substr pfx_str (strlen pfx_str)) "-")(> cnt_1 1)(< (distof (substr tstr (1- cnt_1) (1+ cnt_2)) 2) 0)) (PROGN ;;; (PRINC "\nOriginal number is negative! ") ;;; (PRINC) (rtos (ABS(+ (distof (strcat (substr pfx_str (strlen pfx_str))(substr tstr cnt_1 cnt_2)) 2) adjv)) 2 ndpl) ) (PROGN ;;; (PRINC "\nOriginal number is positive! ") ;;; (PRINC) (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ) ) ) ;_ end of if sfx_str ) ;_ end of strcat ) ;_ end of setq ;;;(PRINC "\n(substr pfx_str (strlen pfx_str))=") ;;;(PRINC (IF (AND pfx_str (/= pfx_str ""))(substr pfx_str (strlen pfx_str))NIL)) ;;;(PRINC "\n(substr tstr cnt_1 cnt_2)=") ;;;(PRINC (substr tstr cnt_1 cnt_2)) ;;;(PRINC) (setq elem (subst (cons 1 nstr) (assoc 1 elem) elem ) ;_ end of subst ) ;_ end of setq (entmod elem) (entupd (cdr (assoc -1 elem))) (if incr_adjv (setq adjv (+ incr_adjv adjv))) ) ;_ end of while (setvar "luprec" luprc) (princ) ) ;_ end of DEFUN (DEFUN NINT ( decp chgby n / ) ; luprc tele elem tstr cnt_1 cnt_2 pfx_str sfx_str (setq luprc (getvar "luprec")) (setq ndpl decp) (setvar "luprec" ndpl) (setq adjv chgby) (setq elem (entget n)) (setq tstr (cdr (assoc 1 elem))) (setq cnt_1 1 cnt_2 1 ) ;_ end of setq (while (and (/= (substr tstr cnt_1 1) "0") (/= (substr tstr cnt_1 1) "1") (/= (substr tstr cnt_1 1) "2") (/= (substr tstr cnt_1 1) "3") (/= (substr tstr cnt_1 1) "4") (/= (substr tstr cnt_1 1) "5") (/= (substr tstr cnt_1 1) "6") (/= (substr tstr cnt_1 1) "7") (/= (substr tstr cnt_1 1) "8") (/= (substr tstr cnt_1 1) "9") (< cnt_1 (strlen tstr)) ) ;_ end of and (if (wcmatch (substr tstr cnt_1 5) "%%###") (setq cnt_1 (+ cnt_1 5)) (setq cnt_1 (1+ cnt_1)) ) ;_ end of if ) ;_ end of while (while (or (= (substr tstr (+ cnt_1 cnt_2) 1) "0") (= (substr tstr (+ cnt_1 cnt_2) 1) "1") (= (substr tstr (+ cnt_1 cnt_2) 1) "2") (= (substr tstr (+ cnt_1 cnt_2) 1) "3") (= (substr tstr (+ cnt_1 cnt_2) 1) "4") (= (substr tstr (+ cnt_1 cnt_2) 1) "5") (= (substr tstr (+ cnt_1 cnt_2) 1) "6") (= (substr tstr (+ cnt_1 cnt_2) 1) "7") (= (substr tstr (+ cnt_1 cnt_2) 1) "8") (= (substr tstr (+ cnt_1 cnt_2) 1) "9") (and (=(substr tstr(+ cnt_1 cnt_2) 1) ".") (not(=(strlen tstr)(+ cnt_1 cnt_2))) ) ) ;_ end of or (setq cnt_2 (1+ cnt_2)) ) ;_ end of while (if (> cnt_1 1) (progn (setq pfx_str (substr tstr 1 (1- cnt_1))) (if (>= (strlen tstr) (+ cnt_1 cnt_2)) (setq sfx_str (substr tstr (+ cnt_1 cnt_2))) (setq sfx_str "") ) ;_ end of if ) ;_ end of progn (progn (if (>= (strlen tstr) (1+ cnt_2)) (setq sfx_str (substr tstr (1+ cnt_2))) (setq sfx_str "") ) ;_ end of if (setq pfx_str "") ) ;_ end of progn ) ;_ end of if ;;; (PRINC "\n(2) tstr = ") ;;; (PRINC tstr) ;;; (PRINC) (setq nstr (strcat pfx_str (if (and (eq pfx_str "") (eq sfx_str "")) ;;; (IF (EQ (STRLEN tstr) (STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl))) ;;; (rtos (+ (distof tstr 2) adjv) 2 ndpl) ;;; (IF (WCMATCH (rtos (+ (distof tstr 2) adjv) 2 ndpl) "*.*") ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) "000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) "00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))1) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) "0")) ;;; ) ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))4) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) ".000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) ".00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof tstr 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof tstr 2) adjv) 2 ndpl) ".0")) ;;; ) ;;; ) ;;; ) (PROGN ;;; (PRINC "\nOriginal text is just a positive number! ") ;;; (PRINC) (rtos (+ (distof tstr 2) adjv) 2 ndpl) ) ;;; (IF (EQ (STRLEN tstr) (STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl))) ;;; (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ;;; (IF (WCMATCH (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "*.*") ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))1) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) "0")) ;;; ) ;;; (COND ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))4) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ".000")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))3) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ".00")) ;;; ((eq(-(STRLEN tstr)(STRLEN (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl)))2) ;;; (STRCAT (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ".0")) ;;; ) ;;; ) ;;; ) (if (and (eq (substr pfx_str (strlen pfx_str)) "-")(> cnt_1 1)(< (distof (substr tstr (1- cnt_1) (1+ cnt_2)) 2) 0)) (PROGN ;;; (PRINC "\nOriginal number is negative! ") ;;; (PRINC) (rtos (ABS(+ (distof (strcat (substr pfx_str (strlen pfx_str))(substr tstr cnt_1 cnt_2)) 2) adjv)) 2 ndpl) ) (PROGN ;;; (PRINC "\nOriginal number is positive! ") ;;; (PRINC) (rtos (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv) 2 ndpl) ) ) ) ;_ end of if sfx_str ) ;_ end of strcat ) ;_ end of setq ;;;(PRINC "\n(substr pfx_str (strlen pfx_str))=") ;;;(PRINC (IF (AND pfx_str (/= pfx_str ""))(substr pfx_str (strlen pfx_str))NIL)) ;;;(PRINC "\n(substr tstr cnt_1 cnt_2)=") ;;;(PRINC (substr tstr cnt_1 cnt_2)) ;;;(PRINC) (setq elem (subst (cons 1 nstr) (assoc 1 elem) elem ) ;_ end of subst ) ;_ end of setq (entmod elem) (entupd (cdr (assoc -1 elem))) (setvar "luprec" luprc) (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!***|;