;; =====================================================================
;; ExportText.lsp - eksport tresci zaznaczonych tekstow do pliku TXT
;; Polecenie: EXPORTTEXT
;; AutoCAD / GstarCAD (AutoLISP). Opis i instalacja:
;; https://fixcontrol.pl/narzedzia/skrypty-autocad
;;
;; Po kazdym tekscie w pliku jest wiersz "@" (separator).
;; Z tekstow wielowierszowych (MTEXT) usuwane jest formatowanie.
;; =====================================================================

;; tresc MTEXT bez kodow formatowania; \P (nowy akapit) -> nowy wiersz
(defun ExportText-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)))
          ((= nxt "P") (setq result (strcat result "\n") i (+ i 2)))
          ((= nxt "~") (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")   ; ulamek \S1^2; -> 1/2
            (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             ; kody z parametrem zakonczonym srednikiem (\f, \H, \C, \A, \W, \Q, \T, \p ...)
            (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:ExportText (/ ss f file i ent txtContent txtList cleanText)
  (vl-load-com)

  (prompt "\nSelect text objects to export: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))

  (if ss
    (progn
      (setq file (getfiled "Select output file" "" "txt" 1))
      (if file
        (progn
          (setq i 0)
          (repeat (sslength ss)
            (setq ent (ssname ss i))
            (setq i (1+ i))
            (setq cleanText
              (if (= (cdr (assoc 0 (entget ent))) "MTEXT")
                (ExportText-clean (vla-get-TextString (vlax-ename->vla-object ent)))
                (cdr (assoc 1 (entget ent)))
              )
            )
            (if (/= cleanText "")
              (setq txtList (cons cleanText txtList)))
          )
          (setq txtList (reverse txtList))

          (setq f (open file "w"))
          (foreach txt txtList
            (write-line txt f)
            (write-line "@" f)
          )
          (close f)
          (prompt (strcat "\nExported " (itoa (length txtList)) " texts to: " file))
        )
        (prompt "\nFile selection canceled.")
      )
    )
    (prompt "\nNo text objects selected.")
  )
  (princ)
)

(princ "\nEXPORTTEXT loaded. Type EXPORTTEXT to run.")
(princ)