;; ============================================================
;; SSG_TEXTTOOLS.LSP - Text-Werkzeuge
;;
;; Ursprung: ACADSST/MENU/CHGTEXT.LSP (Suchen/Ersetzen), PARTEXT.LSP
;; (Tbpl: parallel beschriften), ALTHOEHE.LSP (Tsz), ALTSTIL.LSP (Ts).
;; Neu geschrieben im ssg-Stil (Undo-Gruppe, i18n, ssg-in-*).
;;
;; Befehle:
;;   SSG_TEXT_ERSETZEN   Zeichenketten in TEXT, MTEXT und Block-
;;                       Attributen suchen/ersetzen (mit Vorschau)
;;   SSG_TEXT_PARALLEL   Text parallel zu Linie/Polylinie/Bogen setzen
;;                       (lesbar ausgerichtet, mit Abstand zur Linie)
;;   SSG_TEXT_HOEHE      Texthoehe von TEXT/MTEXT aendern
;;   SSG_TEXT_STIL       Textstil von TEXT/MTEXT aendern
;;
;; Arbeitet in der XY-Ebene des Welt-KS (Textrotation = WKS-Winkel).
;; Setzt ssg_core.lsp, ssg_lang.lsp, ssg_input.lsp und ssg_blocktools.lsp
;; (ssg-bt-wert-neu, ssg-bt-attr-ersetzen-ent) voraus.
;; ============================================================

(vl-load-com)

;; ------------------------------------------------------------
;; REINE HILFSFUNKTIONEN (in test_unit getestet)
;; ------------------------------------------------------------

;; Winkel (Bogenmass) so drehen, dass ein Text lesbar bleibt: Winkel im
;; Bereich (90 Grad, 270 Grad] werden um 180 Grad gedreht. Ergebnis in
;; [0, 2*pi).
(defun ssg-tt-lesbarer-winkel (a)
  (setq a (rem a (* 2.0 pi)))
  (if (< a 0.0) (setq a (+ a (* 2.0 pi))))
  (if (and (> a (+ (/ pi 2.0) 1e-9))
           (<= a (+ (* 1.5 pi) 1e-9)))
    (setq a (- a pi))
  )
  (if (< a 0.0) (setq a (+ a (* 2.0 pi))))
  a
)

;; Punkt um abstand in Richtung winkel verschieben (2D, Z bleibt erhalten)
(defun ssg-tt-versetzt (p winkel abstand)
  (list (+ (car p) (* abstand (cos winkel)))
        (+ (cadr p) (* abstand (sin winkel)))
        (if (caddr p) (caddr p) 0.0))
)

;; ------------------------------------------------------------
;; AUSWAHL
;; ------------------------------------------------------------

;; Auswahlsatz der angegebenen Typen holen (z.B. "TEXT,MTEXT,INSERT").
;; alle-p = T -> alle im aktuellen Layout, nil -> Benutzerwahl
(defun ssg-tt-ss-holen (alle-p typen)
  (if alle-p
    (ssget "_X" (list (cons 0 typen) (cons 410 (getvar "CTAB"))))
    (ssget (list (cons 0 typen)))
  )
)

;; Auswahlsatz -> Liste von Entity-Namen mit Typ-Filter ("TEXT" "MTEXT" ...)
(defun ssg-tt-ss-liste (ss typen / i ent res)
  (if ss
    (progn
      (setq i 0)
      (while (setq ent (ssname ss i))
        (if (member (cdr (assoc 0 (entget ent))) typen)
          (setq res (cons ent res))
        )
        (setq i (1+ i))
      )
    )
  )
  (reverse res)
)

;; ------------------------------------------------------------
;; SUCHEN / ERSETZEN
;; ------------------------------------------------------------

;; TEXT/MTEXT-Inhalte ersetzen (oder nur zaehlen). Rueckgabe: Anzahl Texte.
(defun ssg-tt-text-ersetzen-liste (ents suche ersatz teil-p probe-p
                                   / n obj alt neu)
  (setq n 0)
  (foreach ent ents
    (setq obj (vlax-ename->vla-object ent)
          alt (vla-get-textstring obj)
          neu (ssg-bt-wert-neu alt suche ersatz teil-p))
    (if neu
      (if probe-p
        (setq n (1+ n))
        (if (not (vl-catch-all-error-p
                   (vl-catch-all-apply 'vla-put-textstring (list obj neu))))
          (setq n (1+ n))
        )
      )
    )
  )
  n
)

;; Texte + Attribute in einem Auswahlsatz ersetzen/zaehlen.
;; Rueckgabe: (anzahl-texte . anzahl-attribute)
(defun ssg-tt-ersetzen-ss (ss suche ersatz teil-p probe-p)
  (cons
    (ssg-tt-text-ersetzen-liste
      (ssg-tt-ss-liste ss '("TEXT" "MTEXT")) suche ersatz teil-p probe-p)
    (ssg-bt-attr-ersetzen-liste
      (ssg-tt-ss-liste ss '("INSERT")) "*" suche ersatz teil-p probe-p)
  )
)

(defun c:SSG_TEXT_ERSETZEN ( / k-bereich k-modus alle-p ss suche ersatz modus teil-p z)
  (setq k-bereich (ssg-text "in-keys-bereich")
        k-modus   (ssg-text "in-keys-modus")
        alle-p    (= (ssg-in-keyword (ssg-text "tt-bereich") k-bereich
                       (ssg-in-first-word k-bereich))
                     (ssg-in-first-word k-bereich)))
  (if (not alle-p) (prompt (ssg-text "tt-auswahl")))
  (setq ss (ssg-tt-ss-holen alle-p "TEXT,MTEXT,INSERT"))
  (if (null ss)
    (prompt (ssg-text "tt-keine-objekte"))
    (progn
      (setq suche (ssg-in-string (ssg-text "tt-suche") nil))
      (if (or (null suche) (= suche ""))
        (prompt (ssg-text "tt-abgebrochen"))
        (progn
          (setq ersatz (ssg-in-string (ssg-text "tt-ersatz") "")
                modus  (ssg-in-keyword (ssg-text "tt-modus") k-modus
                         (ssg-in-first-word k-modus))
                teil-p (= modus (ssg-in-first-word k-modus)))
          (setq z (ssg-tt-ersetzen-ss ss suche ersatz teil-p T))
          (cond
            ((= 0 (+ (car z) (cdr z))) (prompt (ssg-text "tt-nichts")))
            ((ssg-in-yesno (ssg-textf "tt-frage" (list (car z) (cdr z))) T)
              (ssg-start (ssg-text "tt-ersetzen-titel") nil)
              (setq z (ssg-tt-ersetzen-ss ss suche ersatz teil-p nil))
              (ssg-end)
              (prompt (ssg-textf "tt-ergebnis" (list (car z) (cdr z)))))
            (t (prompt (ssg-text "tt-abgebrochen")))
          )
        )
      )
    )
  )
  (princ)
)

;; ------------------------------------------------------------
;; PARALLEL BESCHRIFTEN
;; ------------------------------------------------------------

;; Winkel der Kurve (Linie, Polylinie, Bogen, ...) am Punkt pt (WKS).
;; Rueckgabe: Winkel in Bogenmass oder nil, wenn nicht ermittelbar.
(defun ssg-tt-kurven-winkel (ent pt / obj cp param deriv)
  (setq obj (vlax-ename->vla-object ent))
  (setq cp (vl-catch-all-apply 'vlax-curve-getclosestpointto (list obj pt)))
  (if (or (vl-catch-all-error-p cp) (null cp))
    nil
    (progn
      (setq param (vl-catch-all-apply 'vlax-curve-getparamatpoint (list obj cp)))
      (if (or (vl-catch-all-error-p param) (null param))
        nil
        (progn
          (setq deriv (vl-catch-all-apply 'vlax-curve-getfirstderiv (list obj param)))
          (if (or (vl-catch-all-error-p deriv) (null deriv))
            nil
            (list (atan (cadr deriv) (car deriv)) cp)
          )
        )
      )
    )
  )
)

;; TEXT erzeugen (unten mittig, Gruppe 73 = 1 damit Gruppe 11 gilt)
(defun ssg-tt-text-machen (p hoehe string winkel)
  (entmake (list '(0 . "TEXT")
                 (cons 8  (getvar "CLAYER"))
                 (cons 7  (getvar "TEXTSTYLE"))
                 (cons 10 p)
                 (cons 11 p)
                 (cons 40 hoehe)
                 (cons 1  string)
                 (cons 50 winkel)
                 (cons 72 1)
                 (cons 73 1)))
)

(defun c:SSG_TEXT_PARALLEL ( / sel info a ar p text)
  (ssg-start (ssg-text "tt-parallel-titel") nil)
  (if (or (null *ssg-tt-hoehe*) (<= *ssg-tt-hoehe* 0.0))
    (setq *ssg-tt-hoehe* (if (> (getvar "TEXTSIZE") 0.0) (getvar "TEXTSIZE") 2.5))
  )
  (setq *ssg-tt-hoehe* (ssg-in-real (ssg-text "tt-hoehe") *ssg-tt-hoehe*))
  (if (null *ssg-tt-abstand*)
    (setq *ssg-tt-abstand* (* 0.5 *ssg-tt-hoehe*))
  )
  (setq *ssg-tt-abstand* (ssg-in-real (ssg-text "tt-abstand") *ssg-tt-abstand*))
  (while (setq sel (entsel (ssg-text "tt-parallel-waehlen")))
    (setq info (ssg-tt-kurven-winkel (car sel) (trans (cadr sel) 1 0)))
    (if (null info)
      (prompt (ssg-text "tt-parallel-keine-kurve"))
      (progn
        (setq a  (car info)
              ar (ssg-tt-lesbarer-winkel a)
              p  (ssg-tt-versetzt (cadr info) (+ ar (/ pi 2.0)) *ssg-tt-abstand*)
              text (ssg-in-string (ssg-text "tt-text") *ssg-tt-text*))
        (if (and text (/= text ""))
          (progn
            (setq *ssg-tt-text* text)
            (if (not (ssg-tt-text-machen p *ssg-tt-hoehe* text ar))
              (prompt (ssg-text "tt-parallel-fehler"))
            )
          )
        )
      )
    )
  )
  (ssg-end)
  (princ)
)

;; ------------------------------------------------------------
;; HOEHE / STIL AENDERN
;; ------------------------------------------------------------

(defun c:SSG_TEXT_HOEHE ( / ents hoehe n)
  (prompt (ssg-text "tt-auswahl"))
  (setq ents (ssg-tt-ss-liste (ssget '((0 . "TEXT,MTEXT"))) '("TEXT" "MTEXT")))
  (if (null ents)
    (prompt (ssg-text "tt-keine-objekte"))
    (progn
      (setq hoehe (ssg-in-real (ssg-text "tt-hoehe")
                    (if (> (getvar "TEXTSIZE") 0.0) (getvar "TEXTSIZE") nil)))
      (if (or (null hoehe) (<= hoehe 0.0))
        (prompt (ssg-text "tt-abgebrochen"))
        (progn
          (ssg-start (ssg-text "tt-hoehe-titel") nil)
          (setq n 0)
          (foreach ent ents
            (if (not (vl-catch-all-error-p
                       (vl-catch-all-apply 'vla-put-height
                         (list (vlax-ename->vla-object ent) hoehe))))
              (setq n (1+ n))
            )
          )
          (ssg-end)
          (prompt (ssg-textf "tt-geaendert" (list n)))
        )
      )
    )
  )
  (princ)
)

(defun c:SSG_TEXT_STIL ( / ents stil n)
  (prompt (ssg-text "tt-auswahl"))
  (setq ents (ssg-tt-ss-liste (ssget '((0 . "TEXT,MTEXT"))) '("TEXT" "MTEXT")))
  (if (null ents)
    (prompt (ssg-text "tt-keine-objekte"))
    (progn
      (setq stil (ssg-in-string (ssg-text "tt-stil") (getvar "TEXTSTYLE")))
      (cond
        ((or (null stil) (null (tblsearch "STYLE" stil)))
          (prompt (ssg-textf "tt-stil-fehlt" (list (if stil stil "")))))
        (t
          (ssg-start (ssg-text "tt-stil-titel") nil)
          (setq n 0)
          (foreach ent ents
            (if (not (vl-catch-all-error-p
                       (vl-catch-all-apply 'vla-put-stylename
                         (list (vlax-ename->vla-object ent) stil))))
              (setq n (1+ n))
            )
          )
          (ssg-end)
          (prompt (ssg-textf "tt-geaendert" (list n))))
      )
    )
  )
  (princ)
)

(princ)