;;; ==================================================================
;;;  TXT-IIC-EN.LSP  -  working on TEXT in bulk
;;;  Institute of Information Technology in Civil Engineering (IIC)
;;;  Hanoi University of Civil Engineering
;;;  https://iic.huce.edu.vn  -  Tel: 0989 427 809
;;; ------------------------------------------------------------------
;;;  Four commands:
;;;    TXC     add up the numbers held in the selected text
;;;    TXN     add or subtract an amount from EVERY selected number
;;;    TXL     align the selected text to one edge (left / right / centre)
;;;    TXH     change the text height in bulk
;;;
;;;  Why this file is needed: a quantity table on a drawing is usually
;;;  loose text rather than a real table. Totalling a column of 40
;;;  figures means retyping them into a calculator, and retyping goes
;;;  wrong. As for alignment, the JUSTIFYTEXT command in Express Tools
;;;  changes the JUSTIFICATION without MOVING the text, so the column
;;;  still looks ragged.
;;;
;;;  FOUR THINGS TO KNOW BEFORE RUNNING:
;;;    1. TXC only adds lines that ARE numbers. A line holding letters is
;;;       skipped, and the command PRINTS how many were skipped so nobody
;;;       assumes everything was counted. "12.5 m2" is skipped because of
;;;       the m2.
;;;    2. The decimal separator must be a FULL STOP. The line "12,5" is
;;;       SKIPPED ENTIRELY - measured on the 2027 release: it becomes
;;;       neither 12.5 nor 12, it drops out of the sum altogether. This
;;;       is the worst trap in any comma-decimal locale, because the
;;;       total still looks perfectly plausible.
;;;    3. TXL MOVES the text rather than changing its justification.
;;;       Afterwards each line keeps its own insertion point, with only
;;;       the X coordinate pulled to a common value.
;;;    4. Multiline text (MTEXT) carries formatting codes in its content,
;;;       for example "\A1;12.5". TXC strips leading \A...; codes, but
;;;       other codes still cause the line to be skipped - and it is
;;;       counted among the skipped lines.
;;;  Every command PRINTS how many lines it touched, so the result can
;;;  be checked.
;;;
;;;  Command names were checked before being chosen: the acad.pgp alias
;;;  file of the 2027 release has no TXC, TXN, TXL or TXH.
;;;
;;;  To load: type APPLOAD, pick this file, click Load.
;;;  Saved as UTF-8. If you edit it in Notepad, save it back as UTF-8.
;;; ==================================================================

(vl-load-com)

;;; ------------------------------------------------------------------
;;;  Strip a leading MTEXT formatting code: "\A1;12.5" -> "12.5"
;;; ------------------------------------------------------------------
(defun iic-clean (s / i)
  (if (and s (> (strlen s) 2) (= (substr s 1 1) "\\"))
    (progn
      (setq i (vl-string-search ";" s))
      (if i (substr s (+ i 2)) s)
    )
    s
  )
)

;;; ------------------------------------------------------------------
;;;  Turn a line of text into a number, or nil when it is not one.
;;;  distof returns nil on anything it cannot parse, so it doubles as
;;;  the test.
;;; ------------------------------------------------------------------
(defun iic-num (s / c)
  (setq c (iic-clean s))
  (if c
    (progn
      (setq c (vl-string-trim " \t" c))
      (if (= c "") nil (distof c 2))
    )
  )
)

;;; read / write the content of a text object
(defun iic-get (e) (cdr (assoc 1 (entget e))))
(defun iic-set (e s)
  (entmod (subst (cons 1 s) (assoc 1 (entget e)) (entget e)))
)

;;; ------------------------------------------------------------------
;;;  TXC - add up the numbers
;;; ------------------------------------------------------------------
(defun c:TXC (/ ss i e v total n skip)
  (princ "\nSelect the text to add up: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if ss
    (progn
      (setq total 0.0 n 0 skip 0 i 0)
      (while (< i (sslength ss))
        (setq e (ssname ss i)
              v (iic-num (iic-get e)))
        (if v
          (setq total (+ total v) n (1+ n))
          (setq skip (1+ skip))
        )
        (setq i (1+ i))
      )
      (princ "\n")
      (princ (strcat "\n  Lines added   : " (itoa n)))
      (princ (strcat "\n  Lines skipped : " (itoa skip)))
      (princ (strcat "\n  TOTAL         : " (rtos total 2 3)))
      (if (> skip 0)
        (princ "\n  (a skipped line holds letters, or uses a comma as its decimal mark)")
      )
      (princ "\n")
      (setq *IIC-TOTAL* total)
    )
    (princ "\nNo text selected.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  TXN - add or subtract an amount from every number
;;; ------------------------------------------------------------------
(defun c:TXN (/ d ss i e v n skip)
  (setq d (getreal "\nAmount to add (a negative number subtracts): "))
  (if (null d) (progn (princ "\nNo amount given.") (exit)))
  (princ "\nSelect the text to change: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if ss
    (progn
      (setq n 0 skip 0 i 0)
      (while (< i (sslength ss))
        (setq e (ssname ss i)
              v (iic-num (iic-get e)))
        (if v
          (progn (iic-set e (rtos (+ v d) 2 2)) (setq n (1+ n)))
          (setq skip (1+ skip))
        )
        (setq i (1+ i))
      )
      (princ (strcat "\nChanged " (itoa n) " line(s), skipped " (itoa skip) "."))
    )
    (princ "\nNo text selected.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  TXL - align the text to a common X coordinate
;;; ------------------------------------------------------------------
(defun c:TXL (/ k ss i e p x mark lst n o)
  (initget "Left Right Centre")
  (setq k (getkword "\nAlign to which edge [Left/Right/Centre] <Left>: "))
  (if (null k) (setq k "Left"))
  (princ "\nSelect the text to align: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if ss
    (progn
      (setq lst nil i 0)
      (while (< i (sslength ss))
        (setq e (ssname ss i)
              p (cdr (assoc 10 (entget e))))
        (setq lst (cons (cons e (car p)) lst))
        (setq i (1+ i))
      )
      (setq mark (cdar lst))
      (foreach o lst
        (cond
          ((= k "Left") (if (< (cdr o) mark) (setq mark (cdr o))))
          ((= k "Right") (if (> (cdr o) mark) (setq mark (cdr o))))
        )
      )
      (if (= k "Centre")
        (progn
          (setq x 0.0)
          (foreach o lst (setq x (+ x (cdr o))))
          (setq mark (/ x (float (length lst))))
        )
      )
      (setq n 0)
      (foreach o lst
        (if (/= (cdr o) mark)
          (progn
            (command "_.MOVE" (car o) "" (list (cdr o) 0.0) (list mark 0.0))
            (setq n (1+ n))
          )
        )
      )
      (princ (strcat "\nAligned " (itoa (length lst)) " line(s) to the "
                     k " edge, moving " (itoa n) " of them."))
      (princ (strcat "\nX coordinate used: " (rtos mark 2 3)))
    )
    (princ "\nNo text selected.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  TXH - change text height in bulk
;;; ------------------------------------------------------------------
(defun c:TXH (/ h ss i e n)
  (setq h (getreal "\nNew text height: "))
  (if (or (null h) (<= h 0)) (progn (princ "\nThe height must be above 0.") (exit)))
  (princ "\nSelect the text to resize: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if ss
    (progn
      (setq n 0 i 0)
      (while (< i (sslength ss))
        (setq e (ssname ss i))
        (entmod (subst (cons 40 h) (assoc 40 (entget e)) (entget e)))
        (setq n (1+ n) i (1+ i))
      )
      (princ (strcat "\nSet " (itoa n) " line(s) to height " (rtos h 2 2) "."))
      (princ "\nNote: annotative text should have its scale changed, not its height.")
    )
    (princ "\nNo text selected.")
  )
  (princ)
)

(princ "\nTXT-IIC-EN loaded. Commands: TXC (add up), TXN (add/subtract), TXL (align), TXH (height).")
(princ)