m.stangl
fcb4444ee1
Neue Module ssg_blocktools.lsp (SSG_BLOCK_COUNT, SSG_BLOCK_DELETE, SSG_ATTR_ERSETZEN) und ssg_texttools.lsp (SSG_TEXT_ERSETZEN, SSG_TEXT_PARALLEL, SSG_TEXT_HOEHE, SSG_TEXT_STIL) sowie der generische Eingabe-Wrapper ssg_input.lsp, dazu Menue-/Lade-Integration, zweisprachige Texte und Unit-Tests fuer die reinen Kerne. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
286 lines
9.7 KiB
Common Lisp
286 lines
9.7 KiB
Common Lisp
;; ============================================================
|
|
;; 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)
|