;; =====================================================================
;; DecreaseTextValue.lsp - odejmowanie wartosci od liczb w tekstach
;;                         (np. przeliczenie rzednych)
;; Polecenie: DECREASETEXTVALUE
;; AutoCAD / GstarCAD (AutoLISP). Opis i instalacja:
;; https://fixcontrol.pl/narzedzia/skrypty-autocad
;;
;; Liczba ujemna zwieksza wartosci. Wynik z przecinkiem, z liczba miejsc
;; po przecinku jak w oryginale; znak "+" na poczatku jest zachowany.
;; =====================================================================

;; liczba cyfr po kropce w napisie
(defun DTV-decimals (s / p n)
  (setq n 0)
  (if (setq p (vl-string-search "." s))
    (progn
      (setq p (+ p 2))
      (while (and (<= p (strlen s)) (wcmatch (substr s p 1) "#"))
        (setq n (1+ n) p (1+ p))
      )
    )
  )
  n
)

(defun c:DecreaseTextValue (/ *error* ss i ent txtVal numVal decrement decPrec prec newVal entData plus oldDimzin cnt)
  (vl-load-com)

  (defun *error* (msg)
    (if oldDimzin (setvar "DIMZIN" oldDimzin))
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\nBlad: " msg))
    )
    (princ)
  )

  ;; rtos bez obcinania zer (DIMZIN = 0), przywracane na koncu
  (setq oldDimzin (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)

  (setq decrement (getreal "\nPodaj wartosc zmniejszenia (domyslnie 0.1): "))
  (if (not decrement)
    (setq decrement 0.1)
  )
  (setq decPrec (DTV-decimals (vl-string-right-trim "." (vl-string-right-trim "0" (rtos (abs decrement) 2 6)))))

  (princ "\nZaznacz tekst do modyfikacji: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))

  (if ss
    (progn
      (setq cnt 0)
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i))))
        (setq txtVal (cdr (assoc 1 (entget ent))))

        ;; bez \P, spacji, przecinek -> kropka
        (setq txtVal (vl-string-subst "" "\\P" txtVal))
        (setq txtVal (vl-string-trim " " txtVal))
        (setq txtVal (vl-string-subst "." "," txtVal))
        (setq plus (= (substr txtVal 1 1) "+"))

        (if (numberp (setq numVal (vl-catch-all-apply 'read (list txtVal))))
          (progn
            (setq prec (max (DTV-decimals txtVal) decPrec))
            (setq newVal (rtos (- numVal decrement) 2 prec))
            (setq newVal (vl-string-subst "," "." newVal))
            (if (and plus (>= (- numVal decrement) 0))
              (setq newVal (strcat "+" newVal))
            )
            (setq entData (entget ent))
            (setq entData (subst (cons 1 newVal) (assoc 1 entData) entData))
            (entmod entData)
            (setq cnt (1+ cnt))
          )
          (princ (strcat "\nNie mozna przekonwertowac: " txtVal))
        )
      )
      (princ (strcat "\nZmodyfikowano " (itoa cnt) " obiektow tekstowych."))
    )
    (princ "\nNie zaznaczono zadnych obiektow tekstowych.")
  )
  (setvar "DIMZIN" oldDimzin)
  (princ)
)

(princ "\nDECREASETEXTVALUE loaded. Type DECREASETEXTVALUE to run.")
(princ)