;; =====================================================================
;; CountSymbols.lsp - count text symbols and put the quantities
;;                    into a table
;; Command: COUNTSYMBOLS
;; AutoCAD / GstarCAD (AutoLISP). Description and installation:
;; https://fixcontrol.co/tools/autocad-lisp-scripts
;;
;; WHAT IT DOES:
;;   1. You select texts (TEXT, MTEXT) - the script counts how many
;;      times each text (symbol) occurs.
;;   2. Asks for the mode [New/Existing] <New>:
;;      New        - the script creates the table: title, headers SYMBOL /
;;                   QTY, symbols in alphabetical order, TOTAL row at the
;;                   bottom. You enter the text height and pick the
;;                   insertion point (top-left corner of the table).
;;      Existing   - you pick an existing table; the first row = headers,
;;                   the column with the SYMBOL header holds the symbols,
;;                   the QTY / COUNT / QUANTITY (or ILOSC) column gets the
;;                   quantities (if missing, a QTY column is added at the end).
;;   The result is also listed on the command line. Everything can be
;;   undone with a single U.
;;
;; OPTIONS (SETTINGS at the start of the function below):
;;   tableTitle  - title of a new table ("" = no title, empty row only)
;;   textHeight  - default text height in a new table; the last value
;;                 entered is remembered until the program is closed
;;   addTotalRow - T = TOTAL row at the bottom of a new table, nil = none
;;   sortSymbols - T = symbols alphabetically, nil = in counting order
;; =====================================================================

(defun c:CountSymbols (/ *error* acadDoc ss symDict i txt entry mode tableTitle textHeight addTotalRow sortSymbols)
  (vl-load-com)

  ;; ---- SETTINGS ----
  (setq tableTitle "SYMBOL SCHEDULE")
  (setq textHeight 40.0)
  (setq addTotalRow T)
  (setq sortSymbols T)

  (defun *error* (msg)
    (if (and acadDoc (equal (type acadDoc) 'VLA-OBJECT))
      (vla-endundomark acadDoc)
    )
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*,*QUIT*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acadDoc)

  ;; 1. texts to count
  (prompt "\nSelect texts to count: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if (null ss)
    (progn (alert "No texts selected!") (exit))
  )

  ;; 2. counting
  (setq symDict '())
  (setq i (sslength ss))
  (while (> i 0)
    (setq i (1- i))
    (setq txt (cdr (assoc 1 (entget (ssname ss i)))))
    (if (setq entry (assoc txt symDict))
      (setq symDict (subst (cons txt (1+ (cdr entry))) entry symDict))
      (setq symDict (cons (cons txt 1) symDict))
    )
  )
  (if sortSymbols
    (setq symDict (vl-sort symDict '(lambda (a b) (< (car a) (car b)))))
    (setq symDict (reverse symDict))
  )

  (princ "\n=== COUNT RESULT ===")
  (princ (strcat "\nFound " (itoa (length symDict)) " different texts:"))
  (foreach item symDict
    (princ (strcat "\n  " (car item) ": " (itoa (cdr item)) " pcs"))
  )

  ;; 3. new table or update an existing one
  (initget "New Existing")
  (setq mode (getkword "\nTable [New/Existing] <New>: "))
  (if (= mode "Existing")
    (CountSymbols-update acadDoc symDict)
    (CountSymbols-create acadDoc symDict tableTitle textHeight addTotalRow)
  )

  (vla-endundomark acadDoc)
  (princ)
)

;; new table inserted at the picked point (top-left corner)
(defun CountSymbols-create (acadDoc symDict title defHeight totalRow / h pt space tbl nRows r total item colW rowH)
  (if (not *CountSymbols-height*) (setq *CountSymbols-height* defHeight))
  (setq h (getreal (strcat "\nTable text height <" (rtos *CountSymbols-height* 2 2) ">: ")))
  (if h (setq *CountSymbols-height* h) (setq h *CountSymbols-height*))

  (setq pt (getpoint "\nPick the table insertion point (top-left corner): "))
  (if (not pt) (progn (princ "\nNo point picked - the table was not created.") (exit)))

  ;; the space the user is working in
  (setq space
    (if (and (= (getvar 'TILEMODE) 0) (= (getvar 'CVPORT) 1))
      (vla-get-paperspace acadDoc)
      (vla-get-modelspace acadDoc)
    )
  )

  ;; rows: title + headers + symbols (+ TOTAL)
  (setq nRows (+ 2 (length symDict) (if totalRow 1 0)))
  (setq rowH (* h 2.0))
  (setq colW (* h (max 8 (+ 2 (apply 'max (mapcar '(lambda (x) (strlen (car x))) symDict))))))
  (setq tbl (vla-addtable space (vlax-3d-point (trans pt 1 0)) nRows 2 rowH colW))
  (vl-catch-all-apply 'vla-setcolumnwidth (list tbl 1 (* h 8)))
  ;; do not regenerate the table after every cell (faster)
  (vl-catch-all-apply 'vla-put-regeneratetablesuppressed (list tbl :vlax-true))

  ;; text height for title, headers and data (2 + 4 + 1)
  (vl-catch-all-apply 'vla-settextheight (list tbl 7 h))

  ;; title (row 0 merged across both columns)
  (vl-catch-all-apply 'vla-mergecells (list tbl 0 0 0 1))
  (vla-settext tbl 0 0 title)

  ;; headers
  (vla-settext tbl 1 0 "SYMBOL")
  (vla-settext tbl 1 1 "QTY")

  ;; data
  (setq r 2 total 0)
  (foreach item symDict
    (vla-settext tbl r 0 (car item))
    (vla-settext tbl r 1 (itoa (cdr item)))
    (setq total (+ total (cdr item)) r (1+ r))
  )
  (if totalRow
    (progn
      (vla-settext tbl r 0 "TOTAL")
      (vla-settext tbl r 1 (itoa total))
    )
  )

  ;; text height and centring in every cell (in case the table did not apply it)
  (setq r 0)
  (repeat nRows
    (foreach c '(0 1)
      (vl-catch-all-apply 'vla-setcelltextheight (list tbl r c h))
      (vl-catch-all-apply 'vla-setcellalignment (list tbl r c 5)) ; 5 = middle centre
    )
    (setq r (1+ r))
  )

  (vl-catch-all-apply 'vla-put-regeneratetablesuppressed (list tbl :vlax-false))
  (princ (strcat "\nTable created: " (itoa (length symDict)) " symbols, " (itoa total) " pcs in total."))
)

;; write quantities into an existing table (row 0 = headers)
(defun CountSymbols-update (acadDoc symDict / ent tableObj symCol cntCol rowCount colCount colIndex headerText
                                              i symName symCnt checkValue)
  (prompt "\nSelect the table to update: ")
  (setq ent (car (entsel)))
  (if (not ent)
    (progn (alert "No table selected!") (exit))
  )
  (setq tableObj (vlax-ename->vla-object ent))
  (if (not (wcmatch (vla-get-objectname tableObj) "*Table"))
    (progn (alert "No table selected!") (exit))
  )

  ;; SYMBOL and quantity columns
  (setq symCol -1)
  (setq cntCol -1)
  (setq rowCount (vla-get-rows tableObj))
  (setq colCount (vla-get-columns tableObj))

  (princ "\n=== TABLE ANALYSIS ===")
  (princ (strcat "\nRows: " (itoa rowCount) ", Columns: " (itoa colCount)))

  (setq colIndex 0)
  (repeat colCount
    (setq headerText (strcase (vla-gettext tableObj 0 colIndex)))
    (princ (strcat "\nColumn " (itoa colIndex) ": '" headerText "'"))
    (cond
      ((wcmatch headerText "*SYMBOL*")
       (setq symCol colIndex)
       (princ " -> SYMBOL COLUMN"))
      ((or (wcmatch headerText "*COUNT*")
           (wcmatch headerText "*QTY*")
           (wcmatch headerText "*QUANTITY*")
           (wcmatch headerText "*ILOSC*"))
       (setq cntCol colIndex)
       (princ " -> QUANTITY COLUMN"))
    )
    (setq colIndex (1+ colIndex))
  )

  (if (= symCol -1)
    (progn (alert "Column with symbols (SYMBOL) not found!") (exit))
  )

  ;; no quantity column - add a new QTY column (width 80) at the end
  (if (= cntCol -1)
    (progn
      (vla-insertcolumns tableObj colCount 1 80.0)
      (setq cntCol colCount)
      (vla-settext tableObj 0 cntCol "QTY")
      (vla-setcolumnwidth tableObj cntCol 80.0)
      (princ (strcat "\nCreated a new QTY column at position: " (itoa cntCol)))
    )
    (princ (strcat "\nUsing the existing quantity column at position: " (itoa cntCol)))
  )

  (princ "\n=== UPDATING TABLE ===")
  (setq i 1)
  (while (< i rowCount)
    (setq symName (vla-gettext tableObj i symCol))
    (if (and symName (/= symName ""))
      (progn
        (setq symCnt (cdr (assoc symName symDict)))
        (if (not symCnt) (setq symCnt 0))
        (vl-catch-all-apply 'vla-settext (list tableObj i cntCol (itoa symCnt)))
        (setq checkValue (vla-gettext tableObj i cntCol))
        (princ (strcat "\nRow " (itoa i) ": '" symName "' -> " checkValue))
        (if (/= checkValue (itoa symCnt))
          (princ " WARNING: the value was not written!")
        )
      )
      (princ (strcat "\nRow " (itoa i) ": empty symbol, skipped"))
    )
    (setq i (1+ i))
  )
)

(princ "\nCOUNTSYMBOLS loaded. Type COUNTSYMBOLS to run.")
(princ)