;; =====================================================================
;; ExportTextToCSV.lsp - export texts from one layer to an Excel
;;                       (XLSX / XLS) or CSV file
;; Command: EXPORTTEXTTOCSV
;; AutoCAD / GstarCAD (AutoLISP). Description and installation:
;; https://fixcontrol.co/tools/autocad-lisp-scripts
;;
;; WHAT IT DOES:
;;   1. You click any object - its layer becomes the source layer.
;;   2. You select an area - only texts (TEXT, MTEXT) on the source
;;      layer are taken.
;;   3. A save dialog lets you choose the folder, name and file format:
;;        .xlsx / .xls - via Excel; cells are formatted as "Text",
;;                       so e.g. "1/2" or "+12.30" do not turn into
;;                       a date or a number,
;;        .csv         - one text = one row.
;;      If Excel is not installed, a CSV with the same name is saved.
;;   Each text = one row (column A, no header). MTEXT formatting is
;;   removed, line breaks become spaces.
;;
;; OPTIONS (SETTINGS at the start of the function below):
;;   fileSuffix - ending of the suggested file name (drawing name + ...)
;; =====================================================================

;; MTEXT content without formatting codes; \P (new paragraph) -> space
(defun ExportTextToCSV-clean (txt / result i len ch nxt j)
  (setq result "" i 1 len (strlen txt))
  (while (<= i len)
    (setq ch (substr txt i 1))
    (cond
      ((= ch "\\")
        (setq nxt (substr txt (1+ i) 1))
        (cond
          ((member nxt '("\\" "{" "}")) (setq result (strcat result nxt) i (+ i 2)))
          ((member nxt '("P" "~")) (setq result (strcat result " ") i (+ i 2)))
          ((member nxt '("L" "l" "O" "o" "K" "k" "N" "X")) (setq i (+ i 2)))
          ((= nxt "U") (setq result (strcat result (substr txt i 7)) i (+ i 7)))
          ((= nxt "S")
            (setq j (vl-string-search ";" txt i))
            (if j
              (setq result (strcat result (vl-string-translate "^#" "//" (substr txt (+ i 2) (- j i 1))))
                    i (+ j 2))
              (setq i (1+ len))))
          (t
            (setq j (vl-string-search ";" txt i))
            (if j (setq i (+ j 2)) (setq i (1+ len))))
        )
      )
      ((or (= ch "{") (= ch "}")) (setq i (1+ i)))
      (t (setq result (strcat result ch) i (1+ i)))
    )
  )
  result
)

(defun c:ExportTextToCSV ( / ss i obj txt lay refEnt fname rows fileSuffix)
  (vl-load-com)

  ;; ---- SETTINGS ----
  (setq fileSuffix "_texts")

  (setq refEnt (entsel "\nClick an object on the layer you want the texts from: "))
  (if refEnt
    (progn
      (setq lay (vla-get-Layer (vlax-ename->vla-object (car refEnt))))
      (prompt (strcat "\nSelected layer: " lay))

      (prompt "\nSelect the area with the texts: ")
      (setq ss (ssget '((0 . "TEXT,MTEXT"))))

      (if ss
        (progn
          (setq i 0 rows nil)
          (while (< i (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss i)))
            (if (= (strcase (vla-get-Layer obj)) (strcase lay))
              (progn
                (setq txt (vla-get-TextString obj))
                (if (= (vla-get-ObjectName obj) "AcDbMText")
                  (setq txt (ExportTextToCSV-clean txt))
                )
                (setq rows (cons (list txt) rows))
              )
            )
            (setq i (1+ i))
          )
          (setq rows (reverse rows))

          (if rows
            (progn
              (setq fname (getfiled "Save texts"
                                    (strcat (getvar 'DWGPREFIX) (vl-filename-base (getvar 'DWGNAME)) fileSuffix ".xlsx")
                                    "xlsx;xls;csv" 1))
              (if fname
                (if (setq fname (ExportTextToCSV-save fname rows nil))
                  (prompt (strcat "\nSaved " (itoa (length rows)) " texts to file: " fname))
                  (prompt "\nSaving failed.")
                )
                (prompt "\nSaving canceled.")
              )
            )
            (prompt (strcat "\nNo texts on layer " lay " in the selection."))
          )
        )
        (prompt "\nNo objects selected.")
      )
    )
    (prompt "\nNo reference object selected.")
  )
  (princ)
)

;; ---------------------------------------------------------------------
;; Save a table to a file. rows = list of rows, cells: text or number.
;; header = T -> the first row holds headers (bold in Excel).
;; .xlsx / .xls -> via Excel, .csv -> semicolon + decimal comma.
;; Without Excel a CSV with the same name is saved. Returns the path or nil.
;; ---------------------------------------------------------------------
(defun ExportTextToCSV-save (fname rows header / ext)
  (setq ext (vl-filename-extension fname))
  (if (not ext) (setq fname (strcat fname ".xlsx") ext ".xlsx"))
  (setq ext (strcase ext))
  (if (member ext '(".XLSX" ".XLS"))
    (if (ExportTextToCSV-save-excel fname rows header (if (= ext ".XLS") 56 51))
      fname
      (progn
        (setq fname (strcat (vl-filename-directory fname) "\\" (vl-filename-base fname) ".csv"))
        (princ (strcat "\nSaving via Excel failed - saving CSV instead: " fname))
        (ExportTextToCSV-save-csv fname rows)
      )
    )
    (ExportTextToCSV-save-csv fname rows)
  )
)

;; save via Excel (separate, hidden instance); fmt: 51 = xlsx, 56 = xls
(defun ExportTextToCSV-save-excel (fname rows header fmt / xl wb sh cells cell r c res)
  (setq xl (vl-catch-all-apply 'vlax-create-object '("Excel.Application")))
  (if (and xl (not (vl-catch-all-error-p xl)))
    (progn
      (setq res
        (vl-catch-all-apply
          '(lambda ()
             (vlax-put-property xl 'DisplayAlerts :vlax-false)
             (setq wb (vlax-invoke-method (vlax-get-property xl 'Workbooks) 'Add))
             (setq sh (vlax-get-property wb 'ActiveSheet))
             (setq cells (vlax-get-property sh 'Cells))
             (setq r 1)
             (foreach row rows
               (setq c 1)
               (foreach val row
                 (setq cell (vlax-get-property cells 'Item r c))
                 (if (= (type cell) 'VARIANT) (setq cell (vlax-variant-value cell)))
                 (cond
                   ((= (type val) 'STR)  (vlax-put-property cell 'NumberFormat "@"))
                   ((= (type val) 'REAL) (vlax-put-property cell 'NumberFormat "0.00"))
                 )
                 (vlax-put-property cell 'Value2 val)
                 (vlax-release-object cell)
                 (setq cell nil c (1+ c))
               )
               (setq r (1+ r))
             )
             (if header
               (vl-catch-all-apply
                 '(lambda ()
                    (vlax-put-property (vlax-get-property (vlax-get-property sh 'Range "1:1") 'Font) 'Bold :vlax-true)))
             )
             (vl-catch-all-apply
               '(lambda () (vlax-invoke-method (vlax-get-property sh 'Columns) 'AutoFit)))
             (vlax-invoke-method wb 'SaveAs fname fmt)
           )
        )
      )
      (if wb (vl-catch-all-apply 'vlax-invoke-method (list wb 'Close :vlax-false)))
      (vl-catch-all-apply 'vlax-invoke-method (list xl 'Quit))
      (foreach o (list cell cells sh wb xl)
        (if (and (= (type o) 'VLA-OBJECT) (not (vlax-object-released-p o)))
          (vlax-release-object o)
        )
      )
      (gc)
      (if (vl-catch-all-error-p res)
        (progn (princ (strcat "\nExcel error: " (vl-catch-all-error-message res))) nil)
        T
      )
    )
    (progn (princ "\nExcel is not available on this computer.") nil)
  )
)

;; save CSV: semicolon separator, decimal comma
(defun ExportTextToCSV-save-csv (fname rows / f line s)
  (if (setq f (open fname "w"))
    (progn
      (foreach row rows
        (setq line nil)
        (foreach val row
          (setq s
            (cond
              ((= (type val) 'REAL) (vl-string-translate "." "," (rtos val 2 2)))
              ((= (type val) 'INT) (itoa val))
              ((or (vl-string-search ";" val) (vl-string-search "\"" val))
               (strcat "\"" (ExportTextToCSV-dq val) "\""))
              (t val)
            )
          )
          (setq line (if line (strcat line ";" s) s))
        )
        (write-line (if line line "") f)
      )
      (close f)
      fname
    )
    (progn (princ (strcat "\nCannot write file: " fname)) nil)
  )
)

;; double the quotes (CSV)
(defun ExportTextToCSV-dq (s / p)
  (setq p 0)
  (while (setq p (vl-string-search "\"" s p))
    (setq s (strcat (substr s 1 p) "\"" (substr s (1+ p))) p (+ p 2))
  )
  s
)

(princ "\nEXPORTTEXTTOCSV loaded. Type EXPORTTEXTTOCSV to run.")
(princ)