Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

[MERGE] Gerüständerungen mergen

Browse Source
This commit is contained in:
Simon Hensch
2026-10-09 14:42:15 +02:00
parent d3ddcb9d59 c353c34f2c
commit ff456242e3
75 changed files with 16170 additions and 1099 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/Gefaellestrecke.lsp
+612 -65
View File
@@ -714,16 +714,161 @@
prev-hz
)
;; Dialog fuer Modus 3 (Linienzug), Teil 1: AUS-/EIN-Element Winkel+Seite -
;; ersetzt die vier Konsolenfragen (AUS-Winkel, AUS-Seite, EIN-Winkel,
;; EIN-Seite). Muss VOR der Segmentlaengen-Anpassung/Winkelberechnung
;; laufen (die braucht aus-dx/ein-dx aus vf-set-as-masse/-es-masse), darum
;; eigener, frueherer Dialog statt zusammen mit dem Winkel-Vorschlag.
;; prefill: Alist (("as-winkel" . "90"|"30") ("as-seite" . "links"|"rechts")
;; ("es-winkel" . ...) ("es-seite" . ...)) fuer den Edit-Nachbau, oder nil
;; fuer die Defaults (90/links) beim Neu-Bauen.
;; Rueckgabe: (as-winkel as-seite es-winkel es-seite) bei OK, 'ABBRUCH wenn
;; der Nutzer bewusst abbricht (Aufrufer bricht dann den GANZEN Befehl ab,
;; KEIN Rueckfall auf die Konsole), nil wenn der Dialog gar nicht gezeigt
;; werden konnte/durfte (GUI aus) - NUR dann Konsolen-Rueckfall.
(defun gf-dialog-linienzug-aus-ein (prefill / dcl-pfad dat ergebnis
dlg-aus-winkel dlg-aus dlg-ein-winkel dlg-ein
as-seite es-seite as-winkel es-winkel)
(if (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
(progn
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/gefaellestrecke.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "gefaellestrecke_linienzug" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil)
(progn
(set_tile "zusammenfassung" (ssg-text "gf-dlg-linienzug-vorlauf"))
(mode_tile "winkel" 1)
(start_list "aus_winkel")
(add_list "90")
(add_list "30")
(end_list)
(set_tile "aus_winkel"
(if (and prefill (equal (cdr (assoc "as-winkel" prefill)) "30")) "1" "0"))
(start_list "aus_seite")
(add_list (ssg-text "gf-dlg-links"))
(add_list (ssg-text "gf-dlg-rechts"))
(end_list)
(set_tile "aus_seite"
(if (and prefill (equal (cdr (assoc "as-seite" prefill)) "rechts")) "1" "0"))
(start_list "ein_winkel")
(add_list "90")
(add_list "30")
(end_list)
(set_tile "ein_winkel"
(if (and prefill (equal (cdr (assoc "es-winkel" prefill)) "30")) "1" "0"))
(start_list "ein_seite")
(add_list (ssg-text "gf-dlg-links"))
(add_list (ssg-text "gf-dlg-rechts"))
(end_list)
(set_tile "ein_seite"
(if (and prefill (equal (cdr (assoc "es-seite" prefill)) "rechts")) "1" "0"))
(action_tile "accept"
(strcat
"(setq dlg-aus-winkel (get_tile \"aus_winkel\"))"
"(setq dlg-aus (get_tile \"aus_seite\"))"
"(setq dlg-ein-winkel (get_tile \"ein_winkel\"))"
"(setq dlg-ein (get_tile \"ein_seite\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((= ergebnis 1)
(setq as-winkel (if (= dlg-aus-winkel "1") "30" "90"))
(setq as-seite (if (= dlg-aus "1") "rechts" "links"))
(setq es-winkel (if (= dlg-ein-winkel "1") "30" "90"))
(setq es-seite (if (= dlg-ein "1") "rechts" "links"))
(list as-winkel as-seite es-winkel es-seite)
)
(t 'ABBRUCH)
)
)
)
)
nil
)
)
;; Dialog fuer Modus 3, Teil 2: Gefaellewinkel-Bestaetigung VOR der
;; iterativen AS/ES-Korrekturschleife (die braucht den vom Nutzer
;; gewaehlten/bestaetigten Ausgangswinkel, berechnet selbst aber nicht
;; interaktiv weiter) - ersetzt die "Berechneten Winkel verwenden?"-Frage
;; samt optionalem manuellem Winkel. Ersetzt zugleich die SPAETERE finale
;; Einfuegen-Bestaetigung: nach diesem OK baut der Aufrufer direkt, ohne
;; weitere Rueckfrage (analog "dialog-bestaetigt" bei Modus 1/2) - die
;; Zusammenfassung mit dem Vorschlag genuegt als Entscheidungsgrundlage,
;; eine zweite Bestaetigung NACH der (rein automatischen) Korrekturschleife
;; waere redundant. Das AS/ES-Auswahlpaar wird hier nur noch ANGEZEIGT
;; (disabled), nicht erneut editierbar - es ist schon in die Segmentlaengen
;; eingerechnet.
;; zusammenfassung-zeilen: Liste bereits fertig formatierter Strings.
;; Rueckgabe: Gefaellewinkel (Grad) bei OK, 'ABBRUCH wenn der Nutzer bewusst
;; abbricht (Aufrufer bricht dann den GANZEN Befehl ab, KEIN Rueckfall auf
;; die Konsole), nil wenn der Dialog gar nicht gezeigt werden konnte/durfte
;; (GUI aus) - NUR dann Konsolen-Rueckfall (inkl. der spaeteren finalen
;; Einfuegen-Bestaetigung, die in diesem Fall unveraendert bleibt).
(defun gf-dialog-linienzug-winkel (zusammenfassung-zeilen winkel-vorschlag
as-winkel as-seite es-winkel es-seite /
dcl-pfad dat ergebnis dlg-winkel grade)
(if (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
(progn
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/gefaellestrecke.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "gefaellestrecke_linienzug" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil)
(progn
(set_tile "zusammenfassung" (ssg-join zusammenfassung-zeilen " | "))
(start_list "aus_winkel") (add_list as-winkel) (end_list)
(set_tile "aus_winkel" "0")
(start_list "aus_seite") (add_list as-seite) (end_list)
(set_tile "aus_seite" "0")
(start_list "ein_winkel") (add_list es-winkel) (end_list)
(set_tile "ein_winkel" "0")
(start_list "ein_seite") (add_list es-seite) (end_list)
(set_tile "ein_seite" "0")
(mode_tile "aus_winkel" 1) (mode_tile "aus_seite" 1)
(mode_tile "ein_winkel" 1) (mode_tile "ein_seite" 1)
(set_tile "winkel" (rtos winkel-vorschlag 2 3))
(action_tile "accept"
"(setq dlg-winkel (get_tile \"winkel\")) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((= ergebnis 1)
(setq grade (atof dlg-winkel))
(if (<= grade 0) (setq grade winkel-vorschlag))
grade
)
(t 'ABBRUCH)
)
)
)
)
nil
)
)
;; Hauptfunktion Modus 3
(defun gf-linienzug-modus ( /
ss n i j obj obj-liste kette segmente seg
startpunkt endpunkt-ref deltaH grade antwort idx
as-seite es-seite as-block es-block
gf-as-winkel gf-es-winkel
gf-as-winkel gf-es-winkel dlg-aus-ein dlg-winkel-erg
entry-hz exit-hz
first-idx last-idx neu-l
aktuell-frame nach-aus-pt
gf-nummer last-ent
gf-nummer last-ent gf-lz-insert
L-gf-str delta-l-gf laengen-liste first-l l-item
bL90 bL60 bL30 bR90 bR60 bR30
ein-hz-as rad-h-as rad-v-as xu-entry
@@ -787,29 +932,41 @@
(setq entry-hz (cadr (car segmente)))
(setq exit-hz (gf-exit-hz segmente))
;; AUS-Element: 30/90 (vor Seite), dann Seite (vor Winkelberechnung, da die
;; Laengenanpassung von der AS/ES-Masse abhaengt). Masse fuer Variante setzen.
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq gf-as-winkel (vf-frage-element-winkel "vf-winkel-aus-header"))
(princ (ssg-text "gf-seite-aus-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse gf-as-winkel as-seite)
;; AUS-/EIN-Element: 30/90 + Seite, in EINEM Dialog (vor Winkelberechnung,
;; da die Laengenanpassung von der AS/ES-Masse abhaengt). Rueckfall auf die
;; alten Konsolenfragen, wenn der Dialog nicht gezeigt werden kann/darf.
(setq dlg-aus-ein (gf-dialog-linienzug-aus-ein nil))
(if (eq dlg-aus-ein 'ABBRUCH)
(progn (princ (ssg-text "vfc-vorgang-abgebrochen")) (exit))
)
(if dlg-aus-ein
(setq gf-as-winkel (nth 0 dlg-aus-ein)
as-seite (nth 1 dlg-aus-ein)
gf-es-winkel (nth 2 dlg-aus-ein)
es-seite (nth 3 dlg-aus-ein))
(progn
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq gf-as-winkel (vf-frage-element-winkel "vf-winkel-aus-header"))
(princ (ssg-text "gf-seite-aus-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq as-seite (if (= antwort "2") "rechts" "links"))
;; EIN-Element: 30/90 + Seite
(princ (ssg-text "vf-winkel-ein-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq gf-es-winkel (vf-frage-element-winkel "vf-winkel-ein-header"))
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(princ (ssg-text "vf-winkel-ein-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq gf-es-winkel (vf-frage-element-winkel "vf-winkel-ein-header"))
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq es-seite (if (= antwort "2") "rechts" "links"))
)
)
(vf-set-as-masse gf-as-winkel as-seite)
(vf-set-es-masse gf-es-winkel es-seite)
(setq as-block (strcat "AS_Element_" gf-as-winkel "_" as-seite))
@@ -881,14 +1038,30 @@
(princ (ssg-text "gf-status-berechne-winkel"))
(setq grade (gf-winkel-berechnen segmente deltaH 1))
;; Manuelle Anpassung
(setq antwort
(getstring (ssg-textf "gf-prompt-winkel-verwenden"
(list (rtos grade 2 3) grad-zeichen))))
(if (= (strcase antwort) "N")
;; Manuelle Anpassung per Dialog (ersetzt zugleich die SPAETERE finale
;; Einfuegen-Bestaetigung, siehe gf-dialog-linienzug-winkel) - Rueckfall
;; auf die alten Konsolenfragen, wenn der Dialog nicht gezeigt werden
;; kann/darf; dann bleibt auch die spaetere Einfuegen-Bestaetigung aktiv.
(setq dlg-winkel-erg
(gf-dialog-linienzug-winkel
(list (ssg-textf "gf-status-zus-segmente" (list (length segmente)))
(ssg-textf "gf-status-zus-deltah" (list delta-sym (rtos deltaH 2 2))))
grade gf-as-winkel as-seite gf-es-winkel es-seite))
(if (eq dlg-winkel-erg 'ABBRUCH)
(progn (princ (ssg-text "vfc-vorgang-abgebrochen")) (exit))
)
(if dlg-winkel-erg
(setq grade dlg-winkel-erg)
(progn
(setq grade (getreal (ssg-text "gf-prompt-gefaellewinkel")))
(if (or (null grade) (<= grade 0)) (setq grade 3.0))
(setq antwort
(getstring (ssg-textf "gf-prompt-winkel-verwenden"
(list (rtos grade 2 3) grad-zeichen))))
(if (= (strcase antwort) "N")
(progn
(setq grade (getreal (ssg-text "gf-prompt-gefaellewinkel")))
(if (or (null grade) (<= grade 0)) (setq grade 3.0))
)
)
)
)
(setq grade (float grade))
@@ -953,8 +1126,9 @@
(princ (ssg-textf "gf-status-zus-ein-element" (list es-block)))
(princ "\n=========================================")
;; Bestaetigung
(setq antwort (getstring (ssg-text "gf-prompt-einfuegen")))
;; Bestaetigung - entfaellt, wenn der Dialog oben bereits bestaetigt hat
;; (dlg-winkel-erg ist dann eine Zahl, kein nil/'ABBRUCH).
(setq antwort (if dlg-winkel-erg "1" (getstring (ssg-text "gf-prompt-einfuegen"))))
(if (not (= antwort "2"))
(progn
;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern.
@@ -1004,15 +1178,20 @@
(- (sin rad-v-es))))
(setq sep-frame (make-frame-from-dir sep-endpunkt xu-exit))
;; EIN-Element: KS_EIN bleibt in X/Y auf dem Ketten-Pfad (sep-frame),
;; seine eigene Achse verlaeuft damit trivial durch diesen Punkt.
;; Die Z-Hoehe wird jedoch an KS_AUS gemessen, damit KS_AUS.Z exakt
;; auf endpunkt-ref.Z landet (garantiert die gewuenschte DeltaH).
;; EIN-Element: reine KS-zu-KS-Verkettung (wie bei Modus 1/2 in
;; gefaellestrecke-einfuegen) statt insert-block-mixed-to-ks mit
;; erzwungener Ziel-Z. sep-frame richtet KS_EIN des ES-Elements exakt
;; am Ketten-Pfad (Position UND Neigung) aus; die Endhoehe ergibt sich
;; danach von selbst aus KS_AUS, es wird nichts nachtraeglich
;; verschoben. Zwei vorherige Versuche waren beide falsch: endpunkt-ref
;; (Mausklick-Z, meist = Starthoehe) UND z-ref="KS_AUS" bei
;; insert-block-mixed-to-ks (zwang den BLOCKAUSGANG statt -eingang auf
;; die Zielhoehe, Rest-Versatz = Blockinnenhoehe KS_EIN<->KS_AUS,
;; ~65mm). endpunkt-ref/der zweite Mausklick dient weiterhin nur zur
;; groben deltaH-Schaetzung fuer den Winkel-Vorschlag im Dialog.
(setq es-aus-frame (insert-block-ks-to-ks es-block sep-frame))
(princ (ssg-textf "gf-status-ein-element-detail"
(list es-block (rtos (caddr endpunkt-ref) 2 1))))
(setq es-aus-frame
(insert-block-mixed-to-ks es-block sep-frame
(caddr endpunkt-ref) "KS_EIN" "KS_AUS"))
(list es-block (rtos (caddr sep-endpunkt) 2 1))))
(princ (ssg-textf "gf-status-z-hoehe-ks-aus" (list (rtos (caddr (car es-aus-frame)) 2 1))))
;; --- GF_N-Block erstellen ---
@@ -1052,27 +1231,37 @@
)
;; delta-l-gf bereits vor der Zusammenfassung berechnet
;; Block mit allen Attributen erstellen. Geruest fuer Einzelmodul/
;; Geruestoption sind in diesem Linienzug-Ablauf (Modus 3, keine DCL-
;; Eingabe) nicht abfragbar - bleiben auf Schema-Default.
(gf-block-erstellen
"gruppe" as-seite gf-nummer
(caddr startpunkt)
(caddr endpunkt-ref)
deltaH
delta-l-gf
L-gf-str
grade
;; n-separator/n-scanner = 0: interne Ketten-Separatoren zaehlen nicht;
;; die echte Anzahl setzt der Export aus platzierten Symbolen.
0
0
bL90 bL60 bL30
bR90 bR60 bR30
startpunkt last-ent nach-aus-pt entry-hz
(caddr (nth first-idx segmente))
es-seite "0" "Schoenenberger Geruest"
gf-as-winkel gf-es-winkel)
;; Block mit allen Attributen erstellen. HOEHE_BIS_mm kommt aus der
;; TATSAECHLICH gebauten Endhoehe (es-aus-frame), nicht aus der
;; geklickten endpunkt-ref.Z - sonst wiche das Attribut von der
;; echten Geometrie ab (derselbe Bug wie bei der ES-Platzierung oben).
;; Geruest fuer Einzelmodul/Geruestoption sind in diesem Linienzug-
;; Ablauf (Modus 3, keine DCL-Eingabe) nicht abfragbar - bleiben auf
;; Schema-Default.
(setq gf-lz-insert
(gf-block-erstellen
"gruppe" as-seite gf-nummer
(caddr startpunkt)
(caddr (car es-aus-frame))
deltaH
delta-l-gf
L-gf-str
grade
;; n-separator/n-scanner = 0: interne Ketten-Separatoren zaehlen nicht;
;; die echte Anzahl setzt der Export aus platzierten Symbolen.
0
0
bL90 bL60 bL30
bR90 bR60 bR30
startpunkt last-ent nach-aus-pt entry-hz
(caddr (nth first-idx segmente))
es-seite "0" "Schoenenberger Geruest"
gf-as-winkel gf-es-winkel))
;; Segmentliste + Startpunkt fuer den Doppelklick-Nachbau sichern (siehe
;; c:GEFAELLESTRECKE_EDIT) - ohne diese XDATA war eine per Linienzug
;; gebaute Streckengruppe bisher nicht editierbar.
(gf-lz-xdata-schreiben gf-lz-insert segmente startpunkt)
(princ "\n\n=========================================")
(princ (ssg-text "gf-status-fertig"))
@@ -1082,6 +1271,217 @@
)
)
;; Doppelklick-Nachbau fuer eine per GEFAELLESTRECKE_LINIENZUG (Modus 3)
;; gebaute Streckengruppe - Gegenstueck zu gf-rebuild (Modus 1/2), aufgerufen
;; aus c:GEFAELLESTRECKE_EDIT. Anders als beim Neu-Bauen (gf-linienzug-modus)
;; sind die Segmentlaengen hier bereits FINAL (AS-/ES-dx und Separator-
;; Abzuege sind laengst eingerechnet, siehe gf-lz-xdata-schreiben) - die
;; Segmentlisten-Anpassungsschleife aus gf-linienzug-modus entfaellt darum
;; komplett, nur AS-/ES-Winkel+Seite und der Gefaellewinkel bleiben ueber
;; dieselben zwei Dialoge editierbar (gf-dialog-linienzug-aus-ein/-winkel,
;; diesmal mit Prefill aus den Block-Attributen). Baut am gleichen
;; startpunkt neu, loescht den alten Block NACH erfolgreichem Neuaufbau.
;; segmente/startpunkt: aus gf-lz-xdata-lesen. alt-ent: der zu ersetzende
;; GF_n-Block. prefill: Alist wie gf-dialog-linienzug-aus-ein (AS/ES aus den
;; aktuellen Attributen des Blocks).
(defun gf-linienzug-rebuild (segmente startpunkt alt-ent prefill /
deltaH entry-hz exit-hz as-seite es-seite
gf-as-winkel gf-es-winkel as-block es-block
dlg-aus-ein dlg-winkel-erg grade
first-idx j seg end-z endpunkt-ref delta-l-gf
aktuell-frame nach-aus-pt ein-hz-as rad-h-as xu-entry
sep-endpunkt rad-h-es rad-v-es xu-exit sep-frame es-aus-frame
gf-nummer last-ent gf-lz-insert
L-gf-str laengen-liste first-l l-item
bL90 bL60 bL30 bR90 bR60 bR30
rad-v-korr ein-hz-as-k rad-h-as-k xu-as-meas
rad-h-es-k xu-es-meas dz-as-ist dz-es-ist
dH-korr grade-prev iter)
(if (or (null segmente) (< (length segmente) 1))
(progn (alert (ssg-text "gf-alert-keine-kette")) (exit))
)
(setq entry-hz (cadr (car segmente)))
(setq exit-hz (gf-exit-hz segmente))
;; AUS-/EIN-Element, vorbelegt aus den aktuellen Attributen
(setq dlg-aus-ein (gf-dialog-linienzug-aus-ein prefill))
(if (eq dlg-aus-ein 'ABBRUCH)
(progn (princ (ssg-text "vfc-vorgang-abgebrochen")) (exit))
)
(if (null dlg-aus-ein)
(progn (alert (ssg-text "gf-alert-lz-edit-kein-dialog")) (exit))
)
(setq gf-as-winkel (nth 0 dlg-aus-ein)
as-seite (nth 1 dlg-aus-ein)
gf-es-winkel (nth 2 dlg-aus-ein)
es-seite (nth 3 dlg-aus-ein))
(vf-set-as-masse gf-as-winkel as-seite)
(vf-set-es-masse gf-es-winkel es-seite)
(setq as-block (strcat "AS_Element_" gf-as-winkel "_" as-seite))
(setq es-block (strcat "ES_Element_" gf-es-winkel "_" es-seite))
;; Index des ersten "Linie"-Segments (fuer die Label-Laenge) - KEINE
;; Laengenanpassung, die Segmentlaengen sind bereits final.
(setq first-idx -1 j 0)
(while (and (< j (length segmente)) (< first-idx 0))
(if (= (car (nth j segmente)) "Linie") (setq first-idx j))
(setq j (1+ j))
)
(if (< first-idx 0) (setq first-idx 0))
;; Ziel-Endhoehe aus dem Z-Attribut HOEHE_BIS_mm des alten Blocks (X/Y des
;; wirklichen Endpunkts wird erst NACH dem Bau aus der Geometrie selbst
;; bestimmt, siehe unten - sie ist nicht separat in der XDATA gespeichert
;; und nur fuer die Zusammenfassung/das Label relevant, nicht fuer den Bau
;; selbst, der komplett der Segmentliste folgt).
(setq end-z (atof (cond ((cdr (assoc "HOEHE_BIS_mm" (ssg-attrib-read alt-ent)))) ("0"))))
(setq deltaH (abs (- (caddr startpunkt) end-z)))
(princ (ssg-text "gf-status-berechne-winkel"))
(setq grade (gf-winkel-berechnen segmente deltaH 1))
(setq dlg-winkel-erg
(gf-dialog-linienzug-winkel
(list (ssg-textf "gf-status-zus-segmente" (list (length segmente)))
(ssg-textf "gf-status-zus-deltah" (list delta-sym (rtos deltaH 2 2))))
grade gf-as-winkel as-seite gf-es-winkel es-seite))
(if (eq dlg-winkel-erg 'ABBRUCH)
(progn (princ (ssg-text "vfc-vorgang-abgebrochen")) (exit))
)
(if (null dlg-winkel-erg)
(progn (alert (ssg-text "gf-alert-lz-edit-kein-dialog")) (exit))
)
(setq grade (float dlg-winkel-erg))
;; Winkelkorrektur (identisch zu gf-linienzug-modus)
(if (and *gf-L-ohne-as-es* (> *gf-L-ohne-as-es* 0.1))
(progn
(princ (ssg-text "gf-status-messe-absenkung"))
(setq grade-prev -999.0 iter 0)
(while (and (< iter 4) (> (abs (- grade grade-prev)) 0.001))
(setq grade-prev grade)
(setq rad-v-korr (* grade (/ pi 180.0)))
(setq ein-hz-as-k (- entry-hz
(vf-element-plan-turn (strcat "AS_Element_" gf-as-winkel "_" as-seite))))
(setq rad-h-as-k (* (float ein-hz-as-k) (/ pi 180.0)))
(setq xu-as-meas (list (cos rad-h-as-k) (sin rad-h-as-k) 0.0))
(setq rad-h-es-k (* (float exit-hz) (/ pi 180.0)))
(setq xu-es-meas (list (* (cos rad-h-es-k)(cos rad-v-korr))
(* (sin rad-h-es-k)(cos rad-v-korr))
(- (sin rad-v-korr))))
(setq dz-as-ist (gf-messe-dz-block as-block xu-as-meas))
(setq dz-es-ist (gf-messe-dz-block es-block xu-es-meas))
(setq dH-korr (- (float deltaH) dz-as-ist dz-es-ist (float *gf-sum-dz-bogen*)))
(if (and (> dH-korr 0.0) (< (/ dH-korr *gf-L-ohne-as-es*) 1.0))
(setq grade (* (asin (/ dH-korr *gf-L-ohne-as-es*)) (/ 180.0 pi)))
(progn
(princ (ssg-text "gf-warnung-korrektur-bereich"))
(setq grade-prev grade)
)
)
(setq iter (1+ iter))
)
(princ (ssg-textf "gf-status-korrigierter-winkel"
(list (rtos grade 2 3) grad-zeichen (itoa iter))))
)
)
;; Alten Block ERST NACH erfolgreichem Neuaufbau loeschen (siehe unten) -
;; die GF-Nummer/last-ent-Grenze muss aber VOR dem Neu-Einfuegen stehen.
(setq gf-nummer (gf-next-number))
(setq last-ent (ssg-lastent-ohne-attribute))
(setq ein-hz-as (- entry-hz
(vf-element-plan-turn (strcat "AS_Element_" gf-as-winkel "_" as-seite))))
(setq rad-h-as (* (float ein-hz-as) (/ pi 180.0)))
(setq xu-entry (list (cos rad-h-as) (sin rad-h-as) 0.0))
(setq aktuell-frame
(insert-block-mixed-to-ks as-block (make-frame-from-dir startpunkt xu-entry)
(caddr startpunkt) nil "KS_EIN"))
(setq nach-aus-pt (car aktuell-frame))
(setq aktuell-frame (gf-linienzug-einfuegen segmente grade aktuell-frame))
(setq sep-endpunkt
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car aktuell-frame) exit-hz grade 300 0))
(setq rad-h-es (* (float exit-hz) (/ pi 180.0)))
(setq rad-v-es (* (float grade) (/ pi 180.0)))
(setq xu-exit (list (* (cos rad-h-es)(cos rad-v-es))
(* (sin rad-h-es)(cos rad-v-es))
(- (sin rad-v-es))))
(setq sep-frame (make-frame-from-dir sep-endpunkt xu-exit))
;; Reine KS-zu-KS-Verkettung wie in gf-linienzug-modus (siehe dortiger
;; Kommentar) - end-z (gespeicherte Soll-Endhoehe) wird nur zur
;; deltaH-Schaetzung fuer die Winkelberechnung oben gebraucht, nicht hier.
(setq es-aus-frame (insert-block-ks-to-ks es-block sep-frame))
;; Echter Endpunkt (fuer DELTA_L-Attribut/Label) erst jetzt aus der
;; gebauten Geometrie bekannt - KS_AUS des ES-Elements.
(setq endpunkt-ref (car es-aus-frame))
(setq delta-l-gf
(sqrt (+ (expt (- (car endpunkt-ref) (car startpunkt)) 2)
(expt (- (cadr endpunkt-ref) (cadr startpunkt)) 2))))
(setq laengen-liste '() first-l t)
(foreach seg segmente
(if (= (car seg) "Linie")
(setq laengen-liste
(append laengen-liste (list (rtos (/ (caddr seg) 1000.0) 2 3))))
)
)
(setq L-gf-str "")
(foreach l-item laengen-liste
(if first-l
(progn (setq L-gf-str l-item) (setq first-l nil))
(setq L-gf-str (strcat L-gf-str "," l-item))
)
)
(setq bL90 0 bL60 0 bL30 0 bR90 0 bR60 0 bR30 0)
(foreach seg segmente
(if (= (car seg) "Bogen")
(cond
((and (= (nth 4 seg) "links") (= (nth 3 seg) 90)) (setq bL90 (1+ bL90)))
((and (= (nth 4 seg) "links") (= (nth 3 seg) 60)) (setq bL60 (1+ bL60)))
((and (= (nth 4 seg) "links") (= (nth 3 seg) 30)) (setq bL30 (1+ bL30)))
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 90)) (setq bR90 (1+ bR90)))
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 60)) (setq bR60 (1+ bR60)))
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 30)) (setq bR30 (1+ bR30)))
)
)
)
(setq gf-lz-insert
(gf-block-erstellen
"gruppe" as-seite gf-nummer
(caddr startpunkt)
(caddr endpunkt-ref)
deltaH
delta-l-gf
L-gf-str
grade
0 0
bL90 bL60 bL30
bR90 bR60 bR30
startpunkt last-ent nach-aus-pt entry-hz
(caddr (nth first-idx segmente))
es-seite "0" "Schoenenberger Geruest"
gf-as-winkel gf-es-winkel))
(gf-lz-xdata-schreiben gf-lz-insert segmente startpunkt)
;; Alten Block erst jetzt entfernen - der Neuaufbau ist bereits vollstaendig
;; abgeschlossen, ein Fehler davor haette ihn stehen gelassen.
(if (and alt-ent (entget alt-ent)) (entdel alt-ent))
(princ "\n\n=========================================")
(princ (ssg-text "gf-status-fertig"))
(princ "\n=========================================")
gf-lz-insert
)
;; ============================================================
;; TEIL 4.5: GF-BLOCK-SYSTEM (Nummerierung, Label, Attribute)
;; ============================================================
@@ -1704,6 +2104,124 @@
)
)
;; ============================================================
;; XDATA fuer den Linienzug-Nachbau (Modus 3, App "SSG_GF_LZ").
;; Die Segmentliste (gf-analysiere-kette) hat variable Laenge - anders als
;; gf-xdata-schreiben (feste Skalare fuer Modus 1/2) braucht sie ein eigenes
;; String-Format + Chunking (255-Byte-Limit je 1000-Gruppe), analog zur
;; Sepliste-XDATA in ssg_ks_insert.lsp (ssg-sepliste-chunk-string/-split-feld/
;; -explode-chars werden von dort wiederverwendet statt dupliziert).
;; AS-/ES-Winkel+Seite stehen bereits als Attribute (WINKEL_AS/SEITE_AS/
;; WINKEL_ES/SEITE_ES) auf dem Block - nur die Segmentliste UND der gebaute
;; Startpunkt (fuer den Neuaufbau-Ursprung) fehlen dort und muessen hier
;; gesichert werden.
;; ============================================================
(if (null *gf-lz-xdata-app*) (setq *gf-lz-xdata-app* "SSG_GF_LZ"))
;; Ein Segment "(Typ hz laenge winkel seite)" -> "Typ:hz:laenge:winkel:seite".
(defun gf-segment->string (seg)
(strcat (nth 0 seg) ":" (rtos (float (nth 1 seg)) 2 4) ":"
(rtos (float (nth 2 seg)) 2 4) ":" (itoa (fix (nth 3 seg))) ":"
(nth 4 seg))
)
;; Gegenstueck: "Typ:hz:laenge:winkel:seite" -> (Typ hz laenge winkel seite).
(defun gf-string->segment (s / feld)
(setq feld (ssg-sepliste-split-feld s ":"))
(if (= (length feld) 5)
(list (nth 0 feld) (atof (nth 1 feld)) (atof (nth 2 feld))
(atoi (nth 3 feld)) (nth 4 feld))
nil
)
)
;; Segmentliste -> ein einzelner kommagetrennter String.
(defun gf-segmente->string (segmente / out first)
(setq out "" first t)
(foreach seg segmente
(if first
(progn (setq out (gf-segment->string seg)) (setq first nil))
(setq out (strcat out "," (gf-segment->string seg)))
)
)
out
)
;; Gegenstueck zu gf-segmente->string - nutzt denselben Zeichen-Explode wie
;; die Sepliste (ssg_ks_insert.lsp), da Segment-Trenner "," mit dem inneren
;; Feld-Trenner ":" nicht kollidiert.
(defun gf-string->segmente (s / out teile eintraege seg)
(setq out '())
(if (> (strlen s) 0)
(progn
(setq eintraege '() teile "")
(foreach c (ssg-sepliste-explode-chars s)
(if (= c ",")
(progn (setq eintraege (cons teile eintraege)) (setq teile ""))
(setq teile (strcat teile c))
)
)
(setq eintraege (reverse (cons teile eintraege)))
(foreach eintrag eintraege
(if (setq seg (gf-string->segment eintrag)) (setq out (cons seg out)))
)
)
)
(reverse out)
)
;; Segmentliste + Nachbau-Startpunkt als XDATA schreiben. Marker "linienzug"
;; als erster Wert (Platz fuer kuenftige Varianten, analog SSG_VF_EDIT).
(defun gf-lz-xdata-schreiben (ent segmente startpunkt / chunks appentry)
(if (and ent segmente)
(progn
(regapp *gf-lz-xdata-app*)
(setq chunks
(ssg-sepliste-chunk-string
(strcat (rtos (car startpunkt) 2 4) ";" (rtos (cadr startpunkt) 2 4) ";"
(rtos (caddr startpunkt) 2 4) ";" (gf-segmente->string segmente))
250))
(setq appentry
(cons *gf-lz-xdata-app*
(cons (cons 1000 "linienzug")
(mapcar (function (lambda (c) (cons 1000 c))) chunks))))
(entmod (append (entget ent) (list (list -3 appentry))))
)
)
ent
)
;; XDATA lesen -> (startpunkt segmente) oder nil (kein/unbekanntes Linienzug-
;; XDATA am Entity).
(defun gf-lz-xdata-lesen (ent / xd app-data werte roh teile sp-x sp-y sp-z rest)
(setq xd (entget ent (list *gf-lz-xdata-app*)))
(setq app-data (cdr (assoc -3 xd)))
(if app-data
(progn
(setq werte (mapcar 'cdr (cdr (car app-data))))
(if (and werte (= (car werte) "linienzug"))
(progn
(setq roh (apply 'strcat (cdr werte)))
(setq teile (ssg-sepliste-split-feld roh ";"))
(if (>= (length teile) 4)
(progn
(setq sp-x (atof (nth 0 teile)) sp-y (atof (nth 1 teile))
sp-z (atof (nth 2 teile)))
;; Rest nach dem 3. ";" wieder zusammenfuegen (Segmentliste
;; selbst enthaelt kein ";").
(setq rest (nth 3 teile))
(list (list sp-x sp-y sp-z) (gf-string->segmente rest))
)
nil
)
)
nil
)
)
nil
)
)
;; ============================================================
;; TEIL 6: HAUPTBEFEHL
;; ============================================================
@@ -1994,7 +2512,8 @@
(defun c:GEFAELLESTRECKE_EDIT ( / ss ent ed bname startpunkt attribs xd
hz winkel as-winkel es-winkel z-start deltaL
as-seite hoehe-bis prefill dlg-werte)
as-seite hoehe-bis prefill dlg-werte
lz-xd lz-segmente lz-startpunkt lz-prefill)
;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf)
(setq ss (ssget "I"))
(if (and ss (= (sslength ss) 1)
@@ -2022,9 +2541,37 @@
(setq startpunkt (cdr (assoc 10 ed)))
(setq attribs (ssg-attrib-read ent))
;; Streckengruppe (mit Bogen) aus GEFAELLESTRECKE_LINIENZUG: eigener
;; Rebuild-Pfad ueber die Segmentliste in SSG_GF_LZ-XDATA (siehe
;; gf-linienzug-rebuild), NICHT ueber den einfachen gefaellestrecke-Dialog
;; unten - der kennt keine Segmentliste/Boegen. Streckengruppe OHNE diese
;; XDATA (Altbestand/VF-Kombi) bleibt wie bisher nicht editierbar.
(if (= (cond ((cdr (assoc "TYP" attribs))) ("")) "Streckengruppe")
(progn
(setq lz-xd (gf-lz-xdata-lesen ent))
(cond
(lz-xd
(setq lz-startpunkt (nth 0 lz-xd))
(setq lz-segmente (nth 1 lz-xd))
(setq lz-prefill
(list (cons "as-winkel" (cond ((cdr (assoc "WINKEL_AS" attribs))) ("90")))
(cons "as-seite" (cond ((cdr (assoc "SEITE_AS" attribs))) ("links")))
(cons "es-winkel" (cond ((cdr (assoc "WINKEL_ES" attribs))) ("90")))
(cons "es-seite" (cond ((cdr (assoc "SEITE_ES" attribs))) ("links")))))
(gf-linienzug-rebuild lz-segmente lz-startpunkt ent lz-prefill)
)
(t
(alert (ssg-textf "gf-edit-nur-einfach"
(list (cond ((cdr (assoc "TYP" attribs))) ("?")))))
)
)
(ssg-end)
(exit)
)
)
;; Nur einfache Gefaellestrecken (TYP "Gefaellestrecke") lassen sich ueber den
;; Dialog verlustfrei nachbauen. Streckengruppen (mit Bogen / Linienzug / VF)
;; wuerden beim Neuaufbau ihre Bogengeometrie verlieren -> abbrechen.
;; Dialog verlustfrei nachbauen.
(if (/= (cond ((cdr (assoc "TYP" attribs))) ("")) "Gefaellestrecke")
(progn
(alert (ssg-textf "gf-edit-nur-einfach"
Lisp/KreiselInsert.lsp
+13 -9
View File
@@ -691,21 +691,25 @@
;; ============================================================
;; Kreisel per Script einfuegen (Insert)
;; pt : Einfuegepunkt (x y z)
;; abstand : Abstand in mm
;; rotation : Drehwinkel in Grad
;; typ : Kreiselart ("STANDARD", "PIN", ...)
;; hoehe : Hoehe in mm (oder nil fuer Z aus pt)
;; pt : Einfuegepunkt (x y z)
;; abstand : Abstand in mm
;; rotation : Drehwinkel in Grad
;; typ : Kreiselart ("STANDARD", "PIN", ...)
;; hoehe : Hoehe in mm (oder nil fuer Z aus pt)
;; drehrichtung : "GUZ"/"UZS" (optional, nil -> Default aus *kreisel-attrib-defs*)
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
(defun kreisel-insert-script (pt abstand rotation typ hoehe / z blockEnt)
(defun kreisel-insert-script (pt abstand rotation typ hoehe drehrichtung
/ z blockEnt attribs)
(ssg-start (ssg-text "kreisel-start-script-insert") '(("OSMODE") ("CECOLOR")))
(if (null typ) (setq typ "STANDARD"))
(setq z (if hoehe hoehe
(if (and pt (caddr pt)) (caddr pt) *kreisel-default-hoehe*)))
(setq attribs (list (cons "KREISELART" typ)
(cons "HOEHE" (rtos z 2 0))))
(if drehrichtung
(setq attribs (cons (cons "DREHRICHTUNG" drehrichtung) attribs)))
(setq blockEnt
(draw-module (list (car pt) (cadr pt) z) abstand rotation
(list (cons "KREISELART" typ)
(cons "HOEHE" (rtos z 2 0)))))
(draw-module (list (car pt) (cadr pt) z) abstand rotation attribs))
(ssg-end)
blockEnt
)
Lisp/README.md
+265 -54
View File
@@ -15,14 +15,17 @@ _MENULOAD → menu/SSG_LIB.mnu auswaehlen
```
BricsCAD laedt daraufhin automatisch `SSG_LIB.mnl`, welches alle Module
per `ssg-ensure` initialisiert (Kern: ssg_core/lang/dbg/dialog/layer, dann
alle Feature-Module). Details: siehe `../CLAUDE.md` Abschnitt "Lademechanismus".
per `ssg-ensure` initialisiert. Kern-Reihenfolge (muss vor den Feature-Modulen
stehen): `ssg_core`, `ssg_lang`, `ssg_dbg`, `ssg_dialog`, `ssg_layer`, `ssg_id`,
`ssg_ks_insert` (Letzteres wird von Gefaellestrecke UND VarioFoerderer genutzt).
Details: siehe `../CLAUDE.md` Abschnitt "Lademechanismus".
**Manuell laden (Notfall / Entwicklung):**
**Manuell laden (Notfall / Entwicklung, z.B. fuer .scr-Testskripte):**
```lisp
(load (strcat (getenv "DXFMAKRO") "/Lisp/ssg_load.lsp"))
```
`ssg_load.lsp` laedt alle Module in der richtigen Reihenfolge ohne Menueabhaengigkeit.
`ssg_load.lsp` ist der Headless-Loader (genutzt von `tests/test_unit.scr` u.ae.)
und laedt dieselbe Kern-Reihenfolge wie `SSG_LIB.mnl`, ohne Menueabhaengigkeit.
---
@@ -35,16 +38,22 @@ am Label-Anfang, bei Submenue-Schliessern hinter dem `<-` (`[<-~Label]`).
| Menuebereich | Eintraege | Definiert in |
| --- | --- | --- |
| ILS ▸ Foerderer | Durch TEF angetriebene Strecke; Kurven 90/60/30 links/rechts angetrieben Aussen + Innen (12) | `SSG_LIB_Commands.lsp` |
| ILS ▸ Gefaellestrecke | Kurven 90/60/30 links/rechts Gefaellestrecke (6) | `SSG_LIB_Commands.lsp` |
| Omniflo ▸ TEF Elemente | UmlenkR/L, AntriebL/R, TEF Gerade, KettenFoerderer (6) | `OmniModulInsert.lsp` |
| Omniflo ▸ Anbaugruppen | `OMNI_KettenFoerderer` | `OmniModulInsert.lsp` |
| Omniflo ▸ Verbinder | alle `OMNI_TV_*` (18) | `OmniModulInsert.lsp` |
| Omniflo ▸ Boegen fuer Weichen | alle `OMNI_APBW_*` (14) | `OmniModulInsert.lsp` |
| ILS ▸ Zusatzmodule/Kurven | `ILS_ETF_Etagenfoerderer`, `ILS_K{90,60,30}{L,R}{A,I}` (12), `ILS_Gefaellestrecke` | `SSG_LIB_Commands.lsp` |
| Geruest | `GERUEST` (Gattertraeger-Platzhalter, derselbe Befehl wie Saeulen/Rohrabhaenger/Wandbefestigung) | `GeruestInsert.lsp` |
Aktiv (implementiert) sind u.a.: Kreisel, Eckrad, VarioFoerderer, EtageVarioFoerderer,
Gefaellestrecke, BTMT Be-/Entladung, Scanner/Separator, Omniflo Boegen (APB),
Aluprofil-Geraden (AP), alle Weichen (W90/W45/WP/WK/WKomb), Export (Sivas/CSV)
und die Tests.
`OMNI_TEF_*` (UmlenkR/L, AntriebL/R, TEF Gerade) sind entgegen frueherem Stand
**implementiert** (echtes `omni:insert-dxf`), nur `OMNI_KettenFoerderer` ist
weiterhin Dummy.
Aktiv (implementiert) sind u.a.: Kreisel, Eckrad, VarioFoerderer (Standard/Etage/
Linienzug), Gefaellestrecke, Geruest (Saeulen/Rohrabhaenger/Wandbefestigung/
Rohr-Geruest-Traeger), TRO-Marker, Connections, BTMT Be-/Entladung, Scanner/
Separator, Omniflo Boegen (APB)/TEF-Elemente/Aluprofil-Geraden (AP)/alle Weichen
(W90/W45/WP/WK/WKomb)/Ladeschleifen, Export (Sivas/CSV), Werkzeuge (Block-/
Text-Tools, Planquadrate) und die Tests.
---
@@ -181,7 +190,7 @@ Interne Parser-Funktionen (nicht direkt aufrufen):
### `ssg_lang.lsp` – Sprachumschaltung (Deutsch/Englisch)
Zentrale Textverwaltung fuer benutzersichtbare Meldungen. Kern-Modul, wird direkt nach `ssg_core` geladen. Wird schrittweise auf weitere Module ausgerollt (siehe `doc/translate.md`).
Zentrale Textverwaltung fuer benutzersichtbare Meldungen. Kern-Modul, wird direkt nach `ssg_core` geladen. Wird schrittweise auf weitere Module ausgerollt (siehe `doc/plan/translate.md`).
| Funktion | Beschreibung |
| --- | --- |
@@ -323,50 +332,155 @@ Benutzerfreundliche BricsCAD-Befehle für Layer-Operationen. Alle Befehle sicher
---
### `ssg_load.lsp` – Laderoutine
### `ssg_input.lsp` – Generische Eingabe-Wrapper
Lädt alle Module in der richtigen Reihenfolge. Ermittelt den Pfad automatisch über `findfile`. Ruft direkt nach `ssg_core.lsp` die Funktion `ssg-load-config` auf, damit die JSON-Konfiguration für alle nachfolgenden Module verfügbar ist.
---
### `VarioFoerderer.lsp` – Vario-Förderer
Kompatibilitäts-Wrapper, der `vf_core.lsp` lädt (Plugin-Dispatcher-Architektur; lädt seinerseits `vf_standard.lsp`, `vf_etage.lsp`, `vf_linienzug.lsp`). Parametrischer Generator für ILS Vario-Förderanlagen. Liest Block-Geometrie aus einer DWG-Bibliothek (`DXFM_BLOCKS`). Alle Konstanten (Abstände, Winkel, Skalierung) werden via `ssg-cfg-or` aus `component_defaults.json` (Sektion `vario`) gelesen.
**Befehl:** `c:FOERDERANLAGE` / `c:VarioFoerderer` – wählt zuerst den Anlagen-Typ (Standard/Etage/Linienzug):
- **Typ „standard“ + Werteingabe:** läuft über den DCL-Dialog
[`dcl/variofoerderer.dcl`](../dcl/variofoerderer.dcl) (zwei Dialoge, `vfs-standard-dialog-ablauf`
in `vf_standard.lsp`): Dialog 1 (`vfs-dialog-eingabe-basis`) erfasst deltaL, deltaH,
Förderrichtung (Auf/Ab), Einfügehöhe, Fahrtrichtung und Seite; anschließend berechnet
`berechne-standard` die gültigen Winkel-Varianten, und Dialog 2
(`vfs-dialog-winkel-verteilung`) lässt Winkel und L_GF-Verteilung (vorne/hinten) wählen.
Startpunkt (X/Y) wird wie bei der Gefällestrecke vorher in der Zeichnung gepickt.
- **Typ „standard“ + 3D-Linie**, sowie **Typ „etage“** und **„linienzug“** bleiben
vollständig interaktiv (Kommandozeile), unverändert gegenüber dem bisherigen Ablauf.
**Bearbeiten (`c:VARIOFOERDERER_EDIT`):** Doppelklick auf einen `VF_n`-Block – bzw.
Rechtsklick-Kontextmenü/`SSG_BLOCKEDIT` – öffnet dieselben Dialoge, vorbelegt mit den
aktuellen Parametern, und baut die Strecke bei OK am selben Startpunkt neu auf (neue
`VF_n`-Nummer). Da `VF_n`-Blöcke auch von Etage- und Linienzug-Anlagen erzeugt werden
(deren komplexere Geometrie ein einfacher Neuaufbau zerstören würde), markiert
`vfs-xdata-schreiben` nur per Standard-Dialog erstellte Blöcke mit XDATA (App
`SSG_VF_EDIT`, Fahrtrichtung `hz`); Blöcke ohne diese Markierung weist
`c:VARIOFOERDERER_EDIT` mit einer Meldung ab, statt sie zu verändern. Winkel und L_GF1
werden aus den Sivas-Attributen (`VF_WINKEL`, `L_GF_m`) vorbelegt (Verteilung stets als
„Eigene Werte“ mit dem exakten aktuellen L_GF1).
**Wichtige interne Funktionen** (werden auch von `Gefaellestrecke.lsp` genutzt):
Abfragen mit Vorgabewert (`<..>` im Prompt, Enter = Vorgabe). Steht neben den VF-spezifischen `vfl-in-*` (`vf_linienzug.lsp`); diese bleiben unveraendert. Kein Journal, aber ein optionaler Hook. ESC bricht wie ueblich ueber `*error*` ab.
| Funktion | Beschreibung |
| --- | --- |
| `init-bibliothek` | Block-Bibliothek aus DWG laden und Geometriedaten extrahieren |
| `ensure-block-loaded name` | Block aus Bibliothek in aktives Dokument laden (einmalig) |
| `insert-block-by-ks name ks-nr pt` | Block anhand Koordinatensystem-Punkt einfügen |
| `insert-inclined-scaled-block name laenge winkel pt` | Geneigten, skalierten Block einfügen |
| `insert-rotated-block-with-ks name rot pt` | Rotierten Block mit KS-Offset einfügen |
| `get-line-start-end-points ename` | Start- und Endpunkt einer LINE-Entity ermitteln |
| `punkt-differenz p1 p2` | Differenzvektor zweier Punkte |
| `ssg-in-real text default` | Reelle Zahl (`getreal`), Vorgabe ohne ueberfluessige Nullen angezeigt |
| `ssg-in-int text default` | Ganzzahl (`getint`) |
| `ssg-in-string text default` | String mit Leerzeichen; Enter ohne Eingabe liefert die Vorgabe (ohne Vorgabe `nil`) |
| `ssg-in-point text default base` | Punkt, `base` = Gummiband-Basispunkt oder `nil` |
| `ssg-in-dist text default base` | Abstand (`getdist`) |
| `ssg-in-keyword text schluessel default` | Schluesselwort im `initget`-Format, z.B. `"Alle Auswahl"` |
| `ssg-in-yesno text default` | Ja/Nein, **T = Ja**; `default` T = Enter bedeutet Ja. Woerter aus `ssg-text "in-yesno-keys"` |
| `ssg-in-default wert default`, `ssg-in-fmt-real`, `ssg-in-fmt-pt`, `ssg-in-prompt`, `ssg-in-first-word`, `ssg-in-second-word` | Reine Hilfsfunktionen (in `tests/test_unit.lsp` getestet) |
Hook (z.B. fuer ein Eingabe-Journal): `(setq *ssg-in-hook* 'meine-funktion)` mit `(defun meine-funktion (art prompt wert) ...)`; `art` ist `"REAL"`, `"INT"`, `"STRING"`, `"POINT"`, `"DIST"`, `"KEYWORD"` oder `"YESNO"`. Ein Hook, der einen Fehler wirft, wird abgeschaltet.
---
### `ssg_id.lsp` – Eindeutige Block-IDs
Jedes exportierbare Element bekommt ein Attribut `ID` mit einer eindeutigen,
vierstelligen Nummer. Kern-Modul (nach `ssg_layer`, vor `ssg_ks_insert`).
| Befehl / Funktion | Beschreibung |
| --- | --- |
| `c:IDGENERATE` | Weist dem zuletzt eingefuegten Block eine neue ID zu |
| `c:IDSCHECK` | Prueft alle Bloecke auf doppelte IDs und korrigiert sie |
| `ssg-id-format n` | Zahl als 4-stelligen String formatieren (`1` → `"0001"`) |
| `ssg-id-max` | Hoechste bereits vergebene ID in der Zeichnung |
| `ssg-id-generate ent` | Neue ID erzeugen und auf den Block setzen |
| `ssg-id-check-all` | Zeichnungsweit auf Doubletten pruefen und korrigieren |
| `ssg-id-collect-blocks` | Alle ID-faehigen INSERT-Entities sammeln (gleiche Muster wie `csv:collect-export-blocks`, inkl. Separator/Scanner/BTMT) |
---
### `ssg_ks_insert.lsp` – KS-Extraktion und Block-Einfuegeprimitiven
Gemeinsame Basis fuer VarioFoerderer (`vf_core.lsp`) UND Gefaellestrecke –
frueher in beiden Modulen dupliziert, jetzt einzige Quelle. Muss laut MNL **vor**
Gefaellestrecke/`vf_core` geladen sein; Kern-Modul.
| Funktion | Beschreibung |
| --- | --- |
| `vec-length v` | Laenge eines 3er-Vektors |
| `ks-line-axis laenge` | Achsenkennung (X/Y/Z) aus Linienlaenge der KS-Hilfslinie |
| `ks-normalize-name nm` | Historische KS-Blocknamen (`KSYS_EIN`/`-AUS`) auf `KS_EIN`/`KS_AUS` normalisieren |
| `ks-relativize` / `ks-absolutize` | KS-Punkte zwischen relativem und Welt-Koordinatensystem umrechnen |
| `ensure-block-loaded name` | Block aus der Bibliothek einmalig ins aktive Dokument laden |
| `extract-ks-from-block[-raw] name` | KS_EIN/KS_AUS-Punkte eines Blocks ermitteln (Cache `*ks-cache*`) |
| `insert-block-by-ks name ks-nr pt` | Block anhand KS-Punkt einfuegen (nur Rz-Rotation) |
| `insert-inclined-scaled-block` / `insert-rotated-block-with-ks` | Geneigten/rotierten Block mit KS-Offset einfuegen (Rz*Ry) |
---
### `ssg_blocktools.lsp` – Block-Werkzeuge
Ursprung: ACADSST `TOOLS.LSP` (`BLKANZAHL`, `BLKENTF`), `DINGEN2` (`g-bli`), `ssg.lsp` (`suchen-aendern`). Arbeitet im **aktuellen Layout-Reiter**. Blocknamen werden ueber den wirksamen Namen verglichen (dynamische Bloecke); Muster mit `wcmatch` (`*`, `?`, `#`, ohne Gross-/Kleinschreibung).
| Befehl | Beschreibung |
| --- | --- |
| `SSG_BLOCK_COUNT` | Block anklicken, `Name` fuer ein Muster, oder Enter fuer eine Statistik aller Bloecke |
| `SSG_BLOCK_DELETE` | Alle Einfuegungen eines Blocks/Musters loeschen; Rueckfrage (Vorgabe Nein), Einfuegungen auf gesperrten Layern bleiben stehen; eine Undo-Gruppe |
| `SSG_ATTR_ERSETZEN` | Attributwerte suchen/ersetzen: Bereich (Alle mit Blockname-Muster / Auswahl), Tag-Muster, Suchtext, Ersatz, Modus Teil (Teilstring) oder Gesamt (ganzer Wert). Zeigt vorab die Anzahl und fragt nach |
| Funktion | Beschreibung |
| --- | --- |
| `ssg-bt-inserts muster` | Entity-Liste aller Einfuegungen im Layout (optional nach Muster) |
| `ssg-bt-statistik muster` | `((NAME . ANZAHL) ...)` alphabetisch |
| `ssg-bt-attr-ersetzen-ent ent tag suche ersatz teil-p probe-p` | Attribute EINER Einfuegung ersetzen bzw. nur zaehlen (`probe-p`); Rueckgabe Anzahl |
| `ssg-bt-attr-ersetzen-liste ents tag suche ersatz teil-p probe-p` | Dasselbe fuer eine Entity-Liste |
| `ssg-bt-wert-neu wert suche ersatz teil-p` | Reiner Kern: neuer Wert oder `nil` (unveraendert); beachtet Gross-/Kleinschreibung |
| `ssg-bt-name-passt-p`, `ssg-bt-zaehle-namen`, `ssg-bt-muster-escape` | Reine Hilfsfunktionen (getestet) |
---
### `ssg_texttools.lsp` – Text-Werkzeuge
Ursprung: ACADSST `CHGTEXT.LSP`, `PARTEXT.LSP`, `ALTHOEHE.LSP`, `ALTSTIL.LSP`. Laden **nach** `ssg_blocktools` (nutzt `ssg-bt-wert-neu` und `ssg-bt-attr-ersetzen-liste`). Arbeitet in der XY-Ebene des Welt-KS.
| Befehl | Beschreibung |
| --- | --- |
| `SSG_TEXT_ERSETZEN` | Suchen/Ersetzen in TEXT, MTEXT **und** Block-Attributen; Bereich Alle (Layout) oder Auswahl; Vorschau mit Anzahl, Rueckfrage |
| `SSG_TEXT_PARALLEL` | Linie/Polylinie/Bogen anklicken, Text wird parallel (lesbar, nie auf dem Kopf) mit Abstand gesetzt; Hoehe, Abstand und letzter Text werden fuer die Sitzung gemerkt; Enter beendet |
| `SSG_TEXT_HOEHE` | Texthoehe gewaehlter TEXT/MTEXT aendern |
| `SSG_TEXT_STIL` | Textstil gewaehlter TEXT/MTEXT aendern (Stil muss existieren) |
Reine Kerne (getestet): `ssg-tt-lesbarer-winkel` (Winkel 90 Grad bis 270 Grad um 180 Grad drehen, Ergebnis in [0, 2 pi)), `ssg-tt-versetzt`.
Nicht uebernommen aus Walz: `Export`/`Import` von Texten (besser per Python/ezdxf), `KREISTXT`, `TXTBOXED`, `CHTEXT`/`ASCTEXT`/`PTEXT` (Autodesk 1990, durch BricsCAD-Standard ersetzt).
---
### `ssg_load.lsp` – Laderoutine
Headless-Loader fuer .scr-Testskripte (z.B. `tests/test_unit.scr`). Laedt alle
Kern- und Feature-Module in derselben Reihenfolge wie `SSG_LIB.mnl`, ohne
Menueabhaengigkeit. Ermittelt den Pfad automatisch über `findfile`. Ruft direkt
nach `ssg_core.lsp` die Funktion `ssg-load-config` auf, damit die JSON-Konfiguration
für alle nachfolgenden Module verfügbar ist.
---
### `VarioFoerderer.lsp` – Vario-Förderer (Wrapper)
Kompatibilitäts-Wrapper, der `vf_core.lsp` lädt (Plugin-Dispatcher-Architektur
über `*vf-typ-registry*`; lädt seinerseits `vf_konstanten.lsp`, `vf_standard.lsp`,
`vf_etage.lsp`, `vf_linienzug.lsp`, danach `vf_spec.lsp`). Parametrischer Generator
für ILS Vario-Förderanlagen (Typen Standard/Etage/Linienzug). Liest Block-Geometrie
aus einer DWG-Bibliothek (`DXFM_BLOCKS`) über die Primitiven aus `ssg_ks_insert.lsp`.
Alle Konstanten (Abstände, Winkel, Skalierung) werden über `ssg-cfg-or`
(`component_defaults.json`, Sektion `vario`) bzw. die zentralen `*vfk-*`-Konstanten
aus `vf_konstanten.lsp` gelesen.
**Befehl:** `c:FOERDERANLAGE` / `c:VarioFoerderer` – wählt zuerst den Anlagen-Typ (Standard/Etage/Linienzug):
- **Typ „standard“ und „etage“ + Werteingabe:** laufen über denselben,
typ-parametrisierten Dialog-Ablauf (`vf-dialog-ablauf` in `vf_core.lsp`;
`vfs-standard-dialog-ablauf`/`vfe-etage-dialog-ablauf` sind nur noch duenne
Wrapper darauf) mit den Dialogen `vfs-dialog-eingabe-basis`/
`vfs-dialog-winkel-verteilung` ([`dcl/variofoerderer.dcl`](../dcl/variofoerderer.dcl)):
Dialog 1 erfasst deltaL, Förderrichtung, Einfügehöhe/deltaH, Fahrtrichtung und
Seite/Motorseite; Dialog 2 lässt Winkel und L_GF-Verteilung (vorne/hinten) wählen.
Startpunkt (X/Y) wird vorher in der Zeichnung gepickt.
- **Typ „standard“/„etage“ + 3D-Linie** laufen ueber denselben Basis-Dialog statt
rein interaktiv auf der Konsole.
- **Typ „linienzug“** (Streckengruppe, `vf-linienzug-modus` in `vf_linienzug.lsp`)
hat drei Modi (manuell/Wizard, 3D-Objekte+Zielhoehe, Vorwaerts-Nachbau) und
zeichnet jede Eingabe in einem Journal auf (XDATA `SSG_VF_EDIT` am `VF_n`-Block);
Standard laeuft per Default ueber DCL-Dialoge (`VF_WIZARD_AN`/`VF_WIZARD_AUS`
schalten um). Details, Journal-Format, Headless-Modus (`*vfl-headless*`) und
Spec-basierter Bau ohne Dialog (`vf_spec.lsp`, `VF_SPEC_BAU`): siehe
[`../doc/variofoerderer.md`](../doc/variofoerderer.md) und `../CLAUDE.md`.
**Bearbeiten (`c:VARIOFOERDERER_EDIT`):** Doppelklick auf einen `VF_n`-Block – bzw.
Rechtsklick-Kontextmenü/`SSG_BLOCKEDIT` – dispatcht per XDATA-Marker
(`"standard"`/`"etage"`/`"linienzug"`) in den passenden Neuaufbau-Zweig
(`vfe-edit-ent` fuer Etage, `vfl-edit-ent` fuer Linienzug) und öffnet dieselben
Dialoge, vorbelegt mit den aktuellen Parametern; der Block wird am selben
Startpunkt neu aufgebaut (neue `VF_n`-Nummer). Altbestand-Blöcke ohne
Marker werden mit einer Meldung abgewiesen, statt sie zu verändern. Winkel und
L_GF1 werden aus den Sivas-Attributen (`VF_WINKEL`, `L_GF_m`) vorbelegt.
Die Block-Einfuege-Primitiven (`ensure-block-loaded`, `insert-block-by-ks`,
`insert-inclined-scaled-block`, `insert-rotated-block-with-ks` u.a.) sind seit
der Konsolidierung zentral in [`ssg_ks_insert.lsp`](#ssg_ks_insertlsp--ks-extraktion-und-block-einfuegeprimitiven)
definiert (von `vf_core.lsp`, `Gefaellestrecke.lsp` und `TEFInsert.lsp` genutzt).
Weitere interne Helfer: `init-bibliothek` (Block-Bibliothek aus DWG laden),
`get-line-start-end-points ename`, `punkt-differenz p1 p2`.
---
@@ -414,6 +528,19 @@ Der Neuaufbau läuft über `gf-rebuild` (nicht-interaktiv, ohne Konsolen-Rückfr
---
### `TEFInsert.lsp` – TEF-Geradenstuecke entlang einer Linie
**Befehl:** `c:TEF_FOERDERER_LINIE`. Zeichnet eine Linie zwischen zwei gewaehlten
Punkten und reiht darauf 1000-mm-TEF-Geradenelemente (`0_B10030` aus
`DXFM_OMNIFLO`) aneinander; ist die Linienlaenge kein exaktes Vielfaches,
wird ein zusaetzliches, zurueckverschobenes Element eingefuegt, sodass der
Foerderer exakt am Linienende endet (keine Luecke, kein abgeschnittenes
Element). Die Linie darf geneigt sein (3D) – Elemente werden dann analog zu
`vf_core.lsp`/`ssg_ks_insert.lsp` (Rz*Ry-Rotation) gekippt eingefuegt. Nicht
zu verwechseln mit den einzelnen `OMNI_TEF_*`-Befehlen in `OmniModulInsert.lsp`.
---
### `export.lsp` – Export-Funktionen
Sammelt INSERT-Blöcke aus der Zeichnung und exportiert sie als JSON oder ruft Python-Skripte für den Sivas-Export auf.
@@ -572,11 +699,16 @@ AutoLISP-Implementierung fuer alle Omniflo-Komponenten: Boegen, Weichen, Verbind
| Weichen | `OMNI_W90_*`, `OMNI_W45_*`, `OMNI_WP_*`, `OMNI_WK_*`, `OMNI_WKomb_*` | Omniflo-Weichen (Einfach/Doppel/Dreiwege, Delta, Stern) |
| Geraden | `OMNI_AP60`, `OMNI_AP110`, `OMNI_APG110` | Omniflo-Geradenstuecke |
| Ladeschleifen | `OMNI_LADESCHLEIFE_AP110` | Ladeschleife aus `omniflo_ladeschleifen.json` ueber DCL-Dialog (`dcl/omniflo_ladeschleifen.dcl`) einfuegen; Daten per `ssg-json-laden` (Beschreibungen enthalten Kommas). Blockdatei `<Sivasnr>.dwg` unter `DXFM_OMNIFLO` (`omni:insert-dxf` faellt auf `.dwg` zurueck, wenn keine `.dxf` existiert). Per `OMNI_EDIT` editierbar |
| TEF ⚠️ | `OMNI_TEF_UmlenkR/L`, `OMNI_TEF_AntriebL/R`, `OMNI_TEF_Gerade`, `OMNI_KettenFoerderer` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| TEF Elemente | `OMNI_TEF_UmlenkR/L`, `OMNI_TEF_AntriebL/R`, `OMNI_TEF_Gerade` | Feste TEF-Bauteile ohne Sivas-Auswahl, direkt per `omni:insert-dxf` an gewaehltem Punkt eingefuegt (Dateien unter `DXFM_OMNIFLO`) |
| Anbaugruppen ⚠️ | `OMNI_KettenFoerderer` | **Dummy** (noch nicht implementiert, im Menue ausgegraut); `OMNI_STOPPER`/`OMNI_SCANNER`/`OMNI_BUERSTENBREMSE` sind implementiert |
| Transferwagen ⚠️ | `OMNI_TV_*` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Bogenweichen ⚠️ | `OMNI_APBW_*` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Bearbeiten | `OMNI_EDIT` | Omniflo-Block selektieren und Attribute bearbeiten |
Daneben zeichnet [`TEFInsert.lsp`](#tefinsertlsp--tef-geradenstuecke-entlang-einer-linie) (`TEF_FOERDERER_LINIE`) eine
Kette von TEF-Geradenelementen (1000 mm) entlang einer frei gewaehlten Linie –
nicht zu verwechseln mit den einzelnen `OMNI_TEF_*`-Befehlen oben.
---
### `SSG_LIB_Commands.lsp` – BTMT, Sensoren, Dummy-Befehle, Konfiguration und SSG_BLOCKEDIT
@@ -623,6 +755,10 @@ Entladung" bzw. "BT - Beladung ..."/"Abwurf fuer Klammerbuegel ..."); im
Sivas-Export zusaetzlich in den Summenzaehlern "Anzahl aller BTBeladung"/
"Anzahl aller Abwurfstationen" der ILS-Automation-Zeile.
**Eingang-/Ausgang-Symbol:** `ILS_EINGANG_INSERT`/`ILS_AUSGANG_INSERT` nutzen
dieselbe `ils-insert-station`-Routine wie BTMT Be-/Entladung (frei platzierbar,
Blöcke `Eingang_<DIM>.dwg`/`Ausgang_<DIM>.dwg` in `data/ils`).
Registrierte Dummy-Befehle:
| Gruppe | Befehle |
@@ -643,11 +779,86 @@ Registrierte Dummy-Befehle:
**SSG_BLOCKEDIT** – Doppelklick/Kontextmenue-Dispatcher:
Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearbeitungsbefehl auf:
Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearbeitungsbefehl auf (Reihenfolge wichtig: `GR_*` **vor** dem Omniflo-Zweig, da Geruest-Bloecke ebenfalls ein TEILEART-Attribut tragen):
| Blockmuster | Aktion |
| --- | --- |
| `KREISEL_*` | `KreiselEdit` |
| `ECKRAD_*` | `BEDIT` (Block-Editor) |
| `GF_*` | `GEFAELLESTRECKE_EDIT` |
| `VF_*` | `VARIOFOERDERER_EDIT` |
| `GR_*` | Geruest – `BEDIT` (kein eigener Edit-Pfad; siehe `GeruestInsert.lsp`) |
| `TRO_*` | `TRO_EDIT` |
| Omniflo (TEILEART-Attribut, AP110*, numerisch) | `OMNI_EDIT` |
| Sonstige | `BEDIT` (Block-Editor) |
---
### `GeruestInsert.lsp` – Geruest-Baugruppen
Rohr-Geruest-Baugruppen (Saeulen, Rohrabhaenger, Wandbefestigung, Rohr-Geruest-Traeger)
aus [`data/json/geruest.json`](../data/json/geruest.json) bzw.
[`data/json/geruest_traeger.json`](../data/json/geruest_traeger.json) konfigurieren
und einfuegen. Die Dialogdefinition wird **zur Laufzeit erzeugt**
(`geruest-dcl-schreiben`, temporaere DCL-Datei) – es gibt keine feste
`dcl/geruest.dcl`, weil je Anbauteil ein eigenes Mengenfeld gebraucht wird.
Ausfuehrliche Beschreibung (Konfigurationen, Attribut-Schema, Querstreben/Muffe,
Traeger-Beschriftung): siehe `../CLAUDE.md` Abschnitt "AutoLISP-Module".
| Befehl | Beschreibung |
| --- | --- |
| `c:GERUEST` | Dialog ohne Vorgabe-Bereich (Dropdown Rohrabhaenger/Saeulen/Wandbefestigung) |
| `c:GERUEST_SAEULEN` / `c:GERUEST_ROHRABHAENGER` / `c:GERUEST_WANDBEFESTIGUNG` | Dialog mit vorgewaehltem Bereich (derselbe Dialog wie `GERUEST`) |
| `c:GERUEST_TRAEGER` | Eigener fester Dialog (`dcl/geruest_traeger.dcl`): Rohr-Geruest-Traeger mit Linien-Logik (Start-/Endpunkt oder Laenge, Laengenabzuege, Querstreben/Muffe-Verteilung) |
| `c:GERUEST_TRAEGER_BESCHRIFTEN` | Alle Traeger der Zeichnung neu beschriften (eigenes TEXT-Objekt, verknuepft per XDATA `SSG_GR_BESCHR`) |
Block-Praefix `GR_<id>_<timestamp>` – **nicht kosmetisch**: `SSG_BLOCKEDIT` muss
`GR_*` vor dem Omniflo-Zweig abfangen, da Geruest-Bloecke ebenfalls ein
TEILEART-Attribut tragen. Export-Pattern `pattern_geruest = GR_*` (`cfg/export.cfg`).
---
### `Tro_Edit.lsp` – TRO-Marker
TRO-Marker (Block `TRO_SYM_<Typ>`) fuer `sps_skel`/`lib/tro_annotate.py`.
| Befehl | Beschreibung |
| --- | --- |
| `c:TRO_INSERT` | Bestehende Blockdefinition an gewaehltem Punkt einfuegen, setzt ID/TYPE; bricht ab, wenn der Typ noch keine Blockdefinition in der Zeichnung hat (entsteht nur ueber `tro_annotate.py`) |
| `c:TRO_EDIT` | ID/TYPE eines bestehenden Markers per Dialog aendern |
Typliste kommt aus [`tro_types.lsp`](../Lisp/tro_types.lsp) (von
`tro_annotate.py --emit-lisp` nach `DXFM_LISP` geschrieben). `SSG_BLOCKEDIT`
leitet Blocknamen `TRO_*` zu `TRO_EDIT`.
---
### `Connection_Edit.lsp` – Verbindungen (SPS)
Verbindungslinien zwischen zwei Punkten/Bausteinen fuer SPS-Dokumentation.
| Befehl | Beschreibung |
| --- | --- |
| `c:CONNECTION_INSERT` | Verbindung zwischen zwei Punkten einfuegen (Laenge/Winkel/Mitte werden berechnet) |
| `c:CONNECTION_EDIT` | Bestehende Verbindung bearbeiten |
---
### `DrawPlanquadrate.lsp` – Planquadrat-Raster
Zeichnet auf Z=0 ein Planquadrat-Linienraster (senkrecht/waagerecht) im
Abstand/Zaehlschema der aktiven `[Planquadrate]`-Konfiguration aus
`cfg/export.cfg` – dieselbe Quelle wie `lib/export_planquadrat.py` fuer den
CSV-Export. Bereich und Ursprung kommen aus der **Bounding-Box** derselben
Blockmenge wie `EXPORTCSV` (`csv:collect-export-blocks`), nicht aus dem reinen
Einfuegepunkt oder den Zeichnungs-Extents. Lazy geladen ueber
`(ssg-ensure "DrawPlanquadrate")`, nicht Teil der Core-Ladereihenfolge.
| Befehl | Beschreibung |
| --- | --- |
| `c:DRAW_PLANQUADRATE` | Raster neu aufbauen (entfernt zuerst einen evtl. vorhandenen Block) |
| `c:DELETE_PLANQUADRATE` | Raster-Block entfernen |
| `c:PLANQUADRATE_TOGGLE` | Dispatcht auf Zeichnen bzw. Loeschen, je nachdem ob der Block existiert |
Das fertige Raster (Linien + Zaehl-Texte) wird zu einem einzigen Block
`ZZ_PLANQUADRATE` bei (0,0,0) zusammengefasst; Layer aus `cfg/layer.cfg`.
Lisp/ssg_blocktools.lsp
+311
View File
@@ -0,0 +1,311 @@
;; ============================================================
;; SSG_BLOCKTOOLS.LSP - Block-Werkzeuge fuer die aktuelle Zeichnung
;;
;; Ursprung: ACADSST/MENU/TOOLS.LSP (BLKANZAHL, BLKENTF), DINGEN2
;; (g-bli) und ssg.lsp (suchen-aendern) - neu geschrieben im ssg-Stil
;; (Undo-Gruppe, i18n, Ja/Nein-Rueckfrage, keine Globals).
;;
;; Befehle:
;; SSG_BLOCK_COUNT Einfuegungen zaehlen (ein Block, Namensmuster
;; oder Statistik aller Bloecke)
;; SSG_BLOCK_DELETE Alle Einfuegungen eines Blocks/Namensmusters
;; loeschen (mit Rueckfrage)
;; SSG_ATTR_ERSETZEN Attributwerte zeichnungsweit oder in einer
;; Auswahl suchen und ersetzen (mit Vorschau)
;;
;; Blocknamen werden ueber den WIRKSAMEN Namen verglichen (dynamische
;; Bloecke: EffectiveName statt "*U12"). Muster arbeiten mit wcmatch
;; (Platzhalter * ? #, ohne Beachtung der Gross-/Kleinschreibung).
;; Es wird nur der aktuelle Layout-Reiter (Modell ODER Papierbereich)
;; durchsucht.
;;
;; Setzt ssg_core.lsp, ssg_lang.lsp und ssg_input.lsp voraus.
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; REINE HILFSFUNKTIONEN (in test_unit getestet)
;; ------------------------------------------------------------
;; T, wenn name auf das wcmatch-Muster passt (ohne Gross-/Kleinschreibung).
;; muster nil oder "" -> alle Namen passen.
(defun ssg-bt-name-passt-p (name muster)
(if (or (null muster) (= muster ""))
T
(if (wcmatch (strcase name) (strcase muster)) T nil)
)
)
;; Liste von Namen -> Alist ((NAME . ANZAHL) ...), alphabetisch sortiert
;; (ohne Beachtung der Gross-/Kleinschreibung).
(defun ssg-bt-zaehle-namen (namen / alist eintrag)
(foreach name namen
(setq eintrag (assoc name alist))
(if eintrag
(setq alist (subst (cons name (1+ (cdr eintrag))) eintrag alist))
(setq alist (cons (cons name 1) alist))
)
)
(vl-sort alist '(lambda (a b) (< (strcase (car a)) (strcase (car b)))))
)
;; Sonderzeichen eines Blocknamens fuer wcmatch maskieren (Backquote), damit
;; ein per Pick gewaehlter Name nur sich selbst trifft.
(defun ssg-bt-muster-escape (name / res i c)
(setq res "" i 1)
(while (<= i (strlen name))
(setq c (substr name i 1))
(if (vl-string-search c "#@.*?~[],`")
(setq res (strcat res "`"))
)
(setq res (strcat res c)
i (1+ i))
)
res
)
;; Muster ohne Maskier-Backquotes (fuer Meldungen)
(defun ssg-bt-muster-anzeige (muster)
(ssg-str-replace-all "" "`" muster)
)
;; Neuer Attributwert oder nil, wenn der Wert unveraendert bleibt.
;; teil-p = T : suche wird als Teilstring ueberall ersetzt
;; teil-p = nil: nur ersetzen, wenn der GESAMTE Wert gleich suche ist
;; Leere suche aendert nichts. Gross-/Kleinschreibung wird beachtet.
(defun ssg-bt-wert-neu (wert suche ersatz teil-p)
(cond
((or (null suche) (= suche "") (null wert)) nil)
(teil-p
(if (vl-string-search suche wert)
(ssg-str-replace-all ersatz suche wert)
nil
)
)
((= wert suche) ersatz)
(t nil)
)
)
;; ------------------------------------------------------------
;; ZEICHNUNGSZUGRIFF
;; ------------------------------------------------------------
;; Wirksamer Blockname einer Einfuegung (dynamische Bloecke beachten)
(defun ssg-bt-effname (ent / res)
(setq res (vl-catch-all-apply 'vla-get-effectivename
(list (vlax-ename->vla-object ent))))
(if (vl-catch-all-error-p res)
(cdr (assoc 2 (entget ent)))
res
)
)
;; T, wenn der Layer der Entity gesperrt ist
(defun ssg-bt-layer-gesperrt-p (ent / lay)
(setq lay (tblsearch "LAYER" (cdr (assoc 8 (entget ent)))))
(and lay (= 4 (logand 4 (cdr (assoc 70 lay)))))
)
;; Alle Einfuegungen im aktuellen Layout, optional gefiltert nach Namensmuster.
;; Rueckgabe: Liste von Entity-Namen (kann leer sein).
(defun ssg-bt-inserts (muster / ss i ent res)
(setq ss (ssget "_X" (list '(0 . "INSERT") (cons 410 (getvar "CTAB")))))
(if ss
(progn
(setq i 0)
(while (setq ent (ssname ss i))
(if (ssg-bt-name-passt-p (ssg-bt-effname ent) muster)
(setq res (cons ent res))
)
(setq i (1+ i))
)
)
)
(reverse res)
)
;; Statistik: ((NAME . ANZAHL) ...) fuer alle Einfuegungen passend zum Muster
(defun ssg-bt-statistik (muster)
(ssg-bt-zaehle-namen (mapcar 'ssg-bt-effname (ssg-bt-inserts muster)))
)
;; Block per Pick oder Namensmuster waehlen.
;; Rueckgabe: Namensmuster (String) oder nil bei Enter ("alle").
(defun ssg-bt-muster-waehlen (text / sel ed)
(initget "Name")
(setq sel (entsel text))
(cond
((null sel) nil)
((= (type sel) 'STR)
(setq sel (getstring T (ssg-text "bt-prompt-muster")))
(if (= sel "") nil sel)
)
(t
(setq ed (entget (car sel)))
(if (= (cdr (assoc 0 ed)) "INSERT")
(ssg-bt-muster-escape (ssg-bt-effname (car sel)))
(progn (prompt (ssg-text "bt-kein-block")) nil)
)
)
)
)
;; Attribute EINER Einfuegung ersetzen (oder nur zaehlen, wenn probe-p).
;; tag = wcmatch-Muster fuer den Attribut-Tag ("*" = alle).
;; Rueckgabe: Anzahl betroffener Attribute.
(defun ssg-bt-attr-ersetzen-ent (ent tag suche ersatz teil-p probe-p
/ e ed neu n)
(setq n 0
e (entnext ent))
(while (and e
(= "ATTRIB" (cdr (assoc 0 (setq ed (entget e))))))
(if (and (ssg-bt-name-passt-p (cdr (assoc 2 ed)) tag)
(setq neu (ssg-bt-wert-neu (cdr (assoc 1 ed)) suche ersatz teil-p)))
(progn
(setq n (1+ n))
(if (not probe-p)
(entmod (subst (cons 1 neu) (assoc 1 ed) ed))
)
)
)
(setq e (entnext e))
)
(if (and (> n 0) (not probe-p)) (entupd ent))
n
)
;; Attribute einer Liste von Einfuegungen ersetzen. Rueckgabe: Anzahl.
(defun ssg-bt-attr-ersetzen-liste (ents tag suche ersatz teil-p probe-p / n)
(setq n 0)
(foreach ent ents
(setq n (+ n (ssg-bt-attr-ersetzen-ent ent tag suche ersatz teil-p probe-p)))
)
n
)
;; Auswahlsatz -> Liste von Entity-Namen (nur INSERT)
(defun ssg-bt-ss-inserts (ss / i ent res)
(if ss
(progn
(setq i 0)
(while (setq ent (ssname ss i))
(if (= (cdr (assoc 0 (entget ent))) "INSERT")
(setq res (cons ent res))
)
(setq i (1+ i))
)
)
)
(reverse res)
)
;; ------------------------------------------------------------
;; BEFEHLE
;; ------------------------------------------------------------
(defun c:SSG_BLOCK_COUNT ( / muster stat summe)
(setq muster (ssg-bt-muster-waehlen (ssg-text "bt-prompt-waehlen-count")))
(setq stat (ssg-bt-statistik muster))
(cond
((null stat)
(prompt (if muster
(ssg-textf "bt-count-keine" (list (ssg-bt-muster-anzeige muster)))
(ssg-text "bt-count-keine-alle")))
)
((and muster (null (cdr stat)))
(prompt (ssg-textf "bt-count-ergebnis" (list (cdar stat) (caar stat))))
)
(t
(setq summe 0)
(foreach z stat
(prompt (ssg-textf "bt-count-zeile" (list (car z) (cdr z))))
(setq summe (+ summe (cdr z)))
)
(prompt (ssg-textf "bt-count-summe" (list summe (length stat))))
)
)
(princ)
)
(defun c:SSG_BLOCK_DELETE ( / muster ents frei gesperrt n)
(setq muster (ssg-bt-muster-waehlen (ssg-text "bt-prompt-waehlen-delete")))
(if (null muster)
(prompt (ssg-text "bt-delete-kein-muster"))
(progn
(setq ents (ssg-bt-inserts muster))
(foreach ent ents
(if (ssg-bt-layer-gesperrt-p ent)
(setq gesperrt (cons ent gesperrt))
(setq frei (cons ent frei))
)
)
(cond
((null ents)
(prompt (ssg-textf "bt-count-keine" (list (ssg-bt-muster-anzeige muster)))))
((null frei)
(prompt (ssg-textf "bt-delete-alle-gesperrt" (list (length gesperrt)))))
((ssg-in-yesno (ssg-textf "bt-delete-frage" (list (length frei) (ssg-bt-muster-anzeige muster))) nil)
(ssg-start (ssg-text "bt-delete-titel") nil)
(setq n 0)
(foreach ent frei
(if (entdel ent) (setq n (1+ n)))
)
(ssg-end)
(prompt (ssg-textf "bt-delete-ergebnis" (list n)))
(if gesperrt
(prompt (ssg-textf "bt-delete-gesperrt" (list (length gesperrt)))))
)
(t (prompt (ssg-text "bt-abgebrochen")))
)
)
)
(princ)
)
(defun c:SSG_ATTR_ERSETZEN ( / k-bereich k-modus bereich ents muster tag suche ersatz modus teil-p n)
(setq k-bereich (ssg-text "in-keys-bereich")
k-modus (ssg-text "in-keys-modus")
bereich (ssg-in-keyword (ssg-text "bt-attr-bereich") k-bereich
(ssg-in-first-word k-bereich)))
(if (= bereich (ssg-in-first-word k-bereich))
(progn
(setq muster (ssg-in-string (ssg-text "bt-attr-muster") "*"))
(setq ents (ssg-bt-inserts muster))
)
(progn
(prompt (ssg-text "bt-attr-auswahl"))
(setq ents (ssg-bt-ss-inserts (ssget '((0 . "INSERT")))))
)
)
(cond
((null ents) (prompt (ssg-text "bt-attr-keine-bloecke")))
(t
(setq tag (ssg-in-string (ssg-text "bt-attr-tag") "*")
suche (ssg-in-string (ssg-text "bt-attr-suche") nil))
(if (or (null suche) (= suche ""))
(prompt (ssg-text "bt-abgebrochen"))
(progn
(setq ersatz (ssg-in-string (ssg-text "bt-attr-ersatz") "")
modus (ssg-in-keyword (ssg-text "bt-attr-modus") k-modus
(ssg-in-first-word k-modus))
teil-p (= modus (ssg-in-first-word k-modus)))
(setq n (ssg-bt-attr-ersetzen-liste ents tag suche ersatz teil-p T))
(cond
((= n 0) (prompt (ssg-text "bt-attr-nichts")))
((ssg-in-yesno (ssg-textf "bt-attr-frage" (list n (length ents))) T)
(ssg-start (ssg-text "bt-attr-titel") nil)
(setq n (ssg-bt-attr-ersetzen-liste ents tag suche ersatz teil-p nil))
(ssg-end)
(prompt (ssg-textf "bt-attr-ergebnis" (list n))))
(t (prompt (ssg-text "bt-abgebrochen")))
)
)
)
)
)
(princ)
)
(princ)
Lisp/ssg_core.lsp
+38
View File
@@ -1622,6 +1622,44 @@
)
;; ------------------------------------------------------------
;; DCL ZUR LAUFZEIT GENERIEREN
;; ------------------------------------------------------------
;; Escaped Anfuehrungszeichen in einem DCL-Label-String ("->''), damit ein
;; Label mit Anfuehrungszeichen (z.B. aus Nutzerdaten oder Zoll-Angaben) die
;; DCL-Zeile nicht vorzeitig beendet. Fachlich identisch zu
;; geruest-dcl-label (GeruestInsert.lsp), aber hier als generischer
;; Kernel-Helfer fuer jeden Aufrufer, der DCL-Text zusammenbaut.
(defun ssg-dcl-label-escape (text / i c out)
(setq i 0 out "")
(while (< i (strlen text))
(setq c (substr text (1+ i) 1))
(setq out (strcat out (if (= c "\"") "''" c)))
(setq i (1+ i))
)
out
)
;; Schreibt eine Liste von Textzeilen als temporaere DCL-Datei und liefert
;; deren Pfad zurueck (oder nil bei Fehler, z.B. wenn open scheitert). Der
;; Aufrufer ist fuer load_dialog/unload_dialog UND das Loeschen der Datei
;; (vl-file-delete) danach selbst verantwortlich - analog zum bestehenden
;; Muster in GeruestInsert.lsp (geruest-dcl-schreiben), hier nur als
;; generischer Baustein fuer WEITERE Aufrufer (GeruestInsert.lsp selbst
;; bleibt unveraendert, um dessen Code nicht anzufassen).
(defun ssg-dcl-temp-schreiben (praefix zeilen / pfad f)
(setq pfad (vl-filename-mktemp praefix nil ".dcl"))
(if (setq f (open pfad "w"))
(progn
(foreach zeile zeilen (write-line zeile f))
(close f)
pfad
)
nil
)
)
;; ------------------------------------------------------------
;; REKURSIVER JSON-PARSER
;; ------------------------------------------------------------
Lisp/ssg_input.lsp
+162
View File
@@ -0,0 +1,162 @@
;; ============================================================
;; SSG_INPUT.LSP - Generische Eingabe-Wrapper (ssg-in-*)
;;
;; Allgemeingueltige Abfragen mit Vorgabewert, Anzeige "<Vorgabe>" im
;; Prompt und Enter = Vorgabe (Idee von g_in/g_ky aus den ACADSST-
;; Makros). Steht NEBEN den VF-spezifischen vfl-in-* aus
;; vf_linienzug.lsp; diese bleiben unveraendert.
;;
;; Alle Funktionen liefern den eingegebenen Wert oder die Vorgabe.
;; ESC bricht wie ueblich ueber *error* ab (z.B. ssg-errhan).
;; Ist kein Wert eingegeben und keine Vorgabe da, ist die Rueckgabe nil.
;;
;; Optionaler Hook (z.B. fuer ein Eingabe-Journal):
;; (setq *ssg-in-hook* 'meine-funktion)
;; (defun meine-funktion (art prompt wert) ...) ;; art = "REAL" "INT"
;; ;; "STRING" "POINT"
;; ;; "DIST" "KEYWORD"
;; ;; "YESNO"
;; Ein Hook, der einen Fehler wirft, wird abgeschaltet.
;;
;; Setzt ssg_core.lsp (und fuer ssg-in-yesno ssg_lang.lsp) voraus.
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; REINE HILFSFUNKTIONEN (ohne Zeichnung, in test_unit getestet)
;; ------------------------------------------------------------
;; Vorgabe einsetzen, wenn kein Wert eingegeben wurde
(defun ssg-in-default (wert default)
(if wert wert default)
)
;; Reelle Zahl ohne ueberfluessige Nullen: 5.0 -> "5", 2.50 -> "2.5"
(defun ssg-in-fmt-real (v / s)
(setq s (rtos v 2 6))
(if (vl-string-position 46 s)
(progn
(while (= (substr s (strlen s)) "0")
(setq s (substr s 1 (1- (strlen s))))
)
(if (= (substr s (strlen s)) ".")
(setq s (substr s 1 (1- (strlen s))))
)
)
)
s
)
;; Punkt als "x,y,z" (fehlende Z-Werte als 0)
(defun ssg-in-fmt-pt (p)
(strcat (ssg-in-fmt-real (car p)) ","
(ssg-in-fmt-real (cadr p)) ","
(ssg-in-fmt-real (if (caddr p) (caddr p) 0.0)))
)
;; Prompt aufbauen: "<text> <default>: " bzw. "<text>: " ohne Vorgabe
(defun ssg-in-prompt (text default-str)
(strcat text
(if default-str (strcat " <" default-str ">") "")
": ")
)
;; Erstes Wort eines Schluesselwort-Strings: "Ja Nein" -> "Ja"
(defun ssg-in-first-word (schluessel / pos)
(if (setq pos (vl-string-search " " schluessel))
(substr schluessel 1 pos)
schluessel
)
)
;; Zweites Wort: "Ja Nein" -> "Nein"
(defun ssg-in-second-word (schluessel / pos)
(if (setq pos (vl-string-search " " schluessel))
(substr schluessel (+ pos 2))
""
)
)
;; ------------------------------------------------------------
;; HOOK
;; ------------------------------------------------------------
(defun ssg-in-notify (art text wert / res)
(if *ssg-in-hook*
(progn
(setq res (vl-catch-all-apply *ssg-in-hook* (list art text wert)))
(if (vl-catch-all-error-p res) (setq *ssg-in-hook* nil))
)
)
wert
)
;; ------------------------------------------------------------
;; ABFRAGEN
;; text = Prompt ohne Doppelpunkt, z.B. "\nHoehe"
;; ------------------------------------------------------------
(defun ssg-in-real (text default / w)
(setq w (getreal (ssg-in-prompt text (if default (ssg-in-fmt-real default)))))
(ssg-in-notify "REAL" text (ssg-in-default w default))
)
(defun ssg-in-int (text default / w)
(setq w (getint (ssg-in-prompt text (if default (itoa default)))))
(ssg-in-notify "INT" text (ssg-in-default w default))
)
;; String (mit Leerzeichen). Enter ohne Eingabe -> Vorgabe.
(defun ssg-in-string (text default / w)
(setq w (getstring T (ssg-in-prompt text default)))
(if (= w "") (setq w nil))
(ssg-in-notify "STRING" text (ssg-in-default w default))
)
;; Punkt. base = Gummiband-Basispunkt oder nil, default = Punkt oder nil.
(defun ssg-in-point (text default base / w)
(setq w (if base
(getpoint base (ssg-in-prompt text (if default (ssg-in-fmt-pt default))))
(getpoint (ssg-in-prompt text (if default (ssg-in-fmt-pt default))))
))
(ssg-in-notify "POINT" text (ssg-in-default w default))
)
;; Abstand. base = Basispunkt oder nil.
(defun ssg-in-dist (text default base / w)
(setq w (if base
(getdist base (ssg-in-prompt text (if default (ssg-in-fmt-real default))))
(getdist (ssg-in-prompt text (if default (ssg-in-fmt-real default))))
))
(ssg-in-notify "DIST" text (ssg-in-default w default))
)
;; Schluesselwort ohne Hook (intern, auch von ssg-in-yesno genutzt).
(defun ssg-in-keyword-raw (text schluessel default / w)
(initget 0 schluessel)
(setq w (getkword
(ssg-in-prompt
(strcat text " [" (vl-string-translate " " "/" schluessel) "]")
default)))
(ssg-in-default w default)
)
;; Schluesselwort. schluessel im initget-Format, z.B. "Alle Auswahl".
;; Rueckgabe: gewaehltes Schluesselwort (volle Schreibweise) oder default.
(defun ssg-in-keyword (text schluessel default)
(ssg-in-notify "KEYWORD" text (ssg-in-keyword-raw text schluessel default))
)
;; Ja/Nein-Abfrage, Rueckgabe T bei Ja, nil bei Nein (anders als ssg-ques,
;; das T fuer die NICHT-vorgegebene Antwort liefert).
;; default = T -> Enter bedeutet Ja, nil -> Enter bedeutet Nein.
;; Die Schluesselwoerter kommen aus ssg-text "in-yesno-keys" (z.B. "Ja Nein").
(defun ssg-in-yesno (text default / schluessel ja nein w)
(setq schluessel (ssg-text "in-yesno-keys")
ja (ssg-in-first-word schluessel)
nein (ssg-in-second-word schluessel))
(setq w (ssg-in-keyword-raw text schluessel (if default ja nein)))
(ssg-in-notify "YESNO" text (= w ja))
)
(princ)
Lisp/ssg_load.lsp
+5 -1
View File
@@ -28,6 +28,7 @@
(load (strcat base-path "ssg_dbg.lsp") "ssg_dbg.lsp nicht gefunden")
(load (strcat base-path "ssg_dialog.lsp") "ssg_dialog.lsp nicht gefunden")
(load (strcat base-path "ssg_layer.lsp") "ssg_layer.lsp nicht gefunden")
(load (strcat base-path "ssg_input.lsp") "ssg_input.lsp nicht gefunden")
;; Gemeinsame KS-Extraktion + Einfuegeprimitiven - MUSS vor VarioFoerderer
;; und Gefaellestrecke geladen werden (beide nutzen sie).
(load (strcat base-path "ssg_ks_insert.lsp") "ssg_ks_insert.lsp nicht gefunden")
@@ -39,7 +40,10 @@
(load (strcat base-path "Tro_Edit.lsp") "Tro_Edit.lsp nicht gefunden")
(load (strcat base-path "Connection_Edit.lsp") "Connection_Edit.lsp nicht gefunden")
(load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, OmniModulInsert, SSG_LIB_Commands")
;; Werkzeuge: ssg_texttools nutzt ssg_blocktools, beide nutzen ssg_input
(load (strcat base-path "ssg_blocktools.lsp") "ssg_blocktools.lsp nicht gefunden")
(load (strcat base-path "ssg_texttools.lsp") "ssg_texttools.lsp nicht gefunden")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, ssg_input, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, OmniModulInsert, SSG_LIB_Commands, ssg_blocktools, ssg_texttools")
(princ)
)
Lisp/ssg_texttools.lsp
+285
View File
@@ -0,0 +1,285 @@
;; ============================================================
;; 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)
Lisp/vf_core.lsp
+229 -333
View File
@@ -80,6 +80,11 @@
;; Von den Menue-Wrappern gesetzt, damit die Konsolen-/Dialog-Frage
;; entfaellt. nil = interaktiv fragen (Direktaufruf VarioFoerderer).
(if (null *vf-vorauswahl-eingabemodus*) (setq *vf-vorauswahl-eingabemodus* nil))
;; Vorauswahl des Linienzug-Modus (1-5): von jedem der fuenf Linienzug-
;; Menue-Wrapper (c:LinienzugVarioFoerdererManuell/-Zielhoehe/-Stueckweise,
;; c:QcLinieMitGf/-UForm) gesetzt - der frueher hier noetige Modus-Dialog/
;; Konsolen-Fallback ist dadurch komplett entfallen (siehe c:VarioFoerderer).
(if (null *vf-vorauswahl-linienzug-modus*) (setq *vf-vorauswahl-linienzug-modus* nil))
;; Registriert einen Foerderanlagen-Typ.
;; berechne-fn: '(lambda (deltaL deltaH richtung seite) ...)
@@ -703,36 +708,23 @@
(setq i (1+ i)))
eingabe)
(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
deltaL deltaH deltaX deltaY richtung antwort hz-winkel)
;; Eingabemodus: von einem Menue-Wrapper vorbelegt (dann keine Frage) oder
;; interaktiv. Die Vorauswahl gilt nur EINMAL und wird hier verbraucht,
;; damit ein spaeterer Direktaufruf wieder fragt.
(if *vf-vorauswahl-eingabemodus*
(setq antwort *vf-vorauswahl-eingabemodus*
*vf-vorauswahl-eingabemodus* nil)
;; 3D-Linie picken und daraus deltaL/deltaH/richtung/hz/startpunkt (inkl. Z)
;; ableiten - fuer den GUI-Ablauf (vf-dialog-ablauf): ersetzt dort die
;; separate Startpunkt-Auswahl UND liefert die Geometrie-Felder als Prefill
;; fuer den Basis-Dialog (vfs-dialog-eingabe-basis). Rueckgabe: (deltaL
;; deltaH richtung startpunkt hz) oder nil, wenn keine gueltige Linie
;; gewaehlt wurde (Aufrufer bricht dann ab, statt wie frueher per (exit)
;; die ganze Befehlssitzung zu beenden).
(defun vfc-3dlinie-erfassen ( / line-points startpunkt endpunkt differenz
deltaL deltaH deltaX deltaY richtung hz-winkel)
(princ (ssg-text "vfc-modus-3dlinie-header"))
(command "BKS" "W")
(princ (ssg-text "vfc-bks-weltkoordinaten"))
(setq line-points
(get-line-start-end-points (ssg-text "vfc-bitte-3dlinie-foerderstrecke")))
(if (null line-points)
(progn (alert (ssg-text "vfc-alert-keine-gueltige-linie")) nil)
(progn
(princ (ssg-text "vfc-eingabemodus-header"))
(princ (ssg-text "vfc-eingabemodus-3dlinie"))
(princ (ssg-text "vfc-eingabemodus-werte"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
)
)
(cond
((= antwort "1") (setq eingabe-modus "Linie"))
((= antwort "2") (setq eingabe-modus "Wert"))
(t (setq eingabe-modus "Linie") (princ (ssg-text "vfc-modus-3dlinie-fallback")))
)
(if (= eingabe-modus "Linie")
(progn
(princ (ssg-text "vfc-modus-3dlinie-header"))
(command "BKS" "W")
(princ (ssg-text "vfc-bks-weltkoordinaten"))
(setq line-points
(get-line-start-end-points (ssg-text "vfc-bitte-3dlinie-foerderstrecke")))
(if (null line-points)
(progn (alert (ssg-text "vfc-alert-keine-gueltige-linie")) (exit))
)
(setq startpunkt (car line-points)
endpunkt (cadr line-points))
(setq differenz (punkt-differenz startpunkt endpunkt))
@@ -750,41 +742,14 @@
(progn (setq richtung "Ab") (setq deltaH (abs deltaH))
(princ (ssg-text "vfc-foerderrichtung-ab")))
)
)
(progn
(princ (ssg-text "vfc-modus-werteingabe-header"))
(setq deltaL (getreal (ssg-textf "vfc-prompt-delta-l" (list (chr 916)))))
(if (null deltaL) (setq deltaL 15000))
(setq deltaH (getreal (ssg-textf "vfc-prompt-delta-h" (list (chr 916)))))
(if (null deltaH) (setq deltaH 3000))
;; Foerderrichtung bleibt eine einfache Auf/Ab-Frage - die horizontale
;; Zwischenstrecke ist geometrisch NUR bei "Ab" ueberhaupt erreichbar
;; (die festen 3-Grad-Elemente wirken immer absenkend) und wird daher
;; erst SPAETER, nach Bibliotheks-Init, als Zusatzoption in der
;; Winkel-Auswahl angeboten (siehe c:VarioFoerderer) - einheitlich fuer
;; Werteingabe UND 3D-Linie.
(princ (ssg-text "vfc-foerderrichtung-menu"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf"))
(setq startpunkt (getpoint (ssg-text "vfc-prompt-startpunkt-aus")))
(if (null startpunkt) (setq startpunkt '(0 0 0)))
;; Horizontale Fahrtrichtung waehlen (analog Gefaellestrecke Modus 1)
(princ (ssg-text "vfc-fahrtrichtung-header"))
(princ (ssg-textf "vfc-fahrtrichtung-0" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-90" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-180" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-270" (list grad-zeichen)))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(cond
((= antwort "2") (setq hz-winkel 90.0))
((= antwort "3") (setq hz-winkel 180.0))
((= antwort "4") (setq hz-winkel 270.0))
(t (setq hz-winkel 0.0))
)
(princ (ssg-textf "vfc-fahrtrichtung-ergebnis" (list (rtos hz-winkel 2 1) grad-zeichen)))
;; Einfuegehoehe (Z des Startpunkts) wird NICHT mehr hier auf der
;; Konsole abgefragt - sie geht als Prefill "einfuegehoehe" in den
;; Basis-Dialog (vfs-dialog-eingabe-basis) ein, der dasselbe Feld
;; ohnehin per GUI anzeigt und ueberschreibbar macht (Vorschlag = Z
;; des Linien-Startpunkts, wie zuvor beim getreal-Prompt).
(list deltaL deltaH richtung startpunkt hz-winkel)
)
)
(list deltaL deltaH richtung startpunkt hz-winkel eingabe-modus)
)
;; ============================================================
@@ -1055,26 +1020,144 @@
(list vf-insert vf-endpunkt)
)
;; Neuanlage (Menue/Konsole -> Dialog) fuer einen Registry-Typ: Startpunkt
;; (X/Y) picken, Basis-Dialog, dann vf-dialog-berechnen-einfuegen.
;; Startpunkt der Anlage per Dialog waehlen (Punktwahl-Button + Anzeige,
;; dcl/variofoerderer.dcl Tile vfc_startpunkt) - dasselbe "Schliessen-
;; Picken-Neu-Zeigen"-Muster wie der Linienzug-Wizard
;; (vflw-gruppe-punkt-hoehe-impl, vf_linienzug.lsp:697), aber ohne dessen
;; Wizard-Pending-Queue: der Punkt wird direkt zurueckgegeben. kopf/
;; pt_anzeige kommen per set_tile aus ssg-text - anders als
;; vfc-dialog-typ-waehlen also KEIN *ssg-lang*-Gate noetig, der Dialog
;; funktioniert in jeder Sprache. Rueckgabe: Punkt (Liste X Y Z) oder nil,
;; wenn kein Dialog gezeigt werden konnte/durfte (GUI aus) ODER abgebrochen
;; wurde - der Aufrufer (vf-dialog-ablauf) faellt dann auf den alten
;; Konsolen-getpoint zurueck.
(defun vfc-dialog-startpunkt-waehlen (kopf-key / dcl-pfad dat ergebnis gpunkt fertig)
(if (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
(progn
(setq fertig nil)
(while (not fertig)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vfc_startpunkt" dat))
(progn
(if (and dat (>= dat 0)) (unload_dialog dat))
(setq fertig t gpunkt nil)
)
(progn
(set_tile "kopf" (ssg-text "vfc-dlg-startpunkt-kopf"))
(if gpunkt
(set_tile "pt_anzeige"
(strcat "X=" (rtos (car gpunkt) 2 1)
" Y=" (rtos (cadr gpunkt) 2 1)
" Z=" (rtos (caddr gpunkt) 2 1)))
)
(action_tile "pick" "(done_dialog 2)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((= ergebnis 2) (setq gpunkt (getpoint (ssg-text kopf-key))))
((= ergebnis 1) (setq fertig t))
(t (setq fertig t gpunkt nil))
)
)
)
)
gpunkt
)
nil
)
)
;; Neuanlage (Menue/Konsole -> Dialog) fuer einen Registry-Typ. Zwei
;; Eingabemodi fuer die Geometrie (deltaL/deltaH/richtung/hz/Startpunkt):
;; "1" 3D-Linie: Linie picken (vfc-3dlinie-erfassen), die abgeleiteten
;; Werte gehen als Prefill in den Basis-Dialog - NUR Seite/
;; Motorseite/Darstellung/Geruest bleiben dort fuer den Anwender offen.
;; "2" Werte: wie bisher Startpunkt (X/Y) picken, Basis-Dialog ohne
;; Geometrie-Prefill (Defaults).
;; Eingabemodus kommt per Vorauswahl (Menue-Wrapper c:StandardVarioFoerderer3D
;; / c:EtageVarioFoerderer3D setzen *vf-vorauswahl-eingabemodus* "1"/"2") oder
;; wird - wie zuvor im Konsolen-Ablauf - interaktiv erfragt; die Vorauswahl
;; gilt nur einmal. Ersetzt den frueheren Rueckfall auf den rein interaktiven
;; Konsolen-Ablauf (vf-eingabe-abfragen, entfernt) fuer die 3D-Linie: dieser
;; lief komplett an der GUI vorbei und fragte Seite/Fahrtrichtung/etc. erneut
;; auf der Kommandozeile ab, obwohl der Basis-Dialog dieselben Felder laengst
;; per GUI anbietet.
(defun vf-dialog-ablauf (typ vf-nummer horizontal-p / eingabe deltaL deltaH richtung
z-start hz seite startpunkt startpunkt-xy dim
geruest-einzelmodul geruest-typ motorseite)
(setq startpunkt-xy (getpoint (ssg-text "vfc-prompt-startpunkt-aus")))
(if (null startpunkt-xy) (setq startpunkt-xy '(0 0 0)))
(setq eingabe (vfs-dialog-eingabe-basis nil))
(if (null eingabe)
geruest-einzelmodul geruest-typ motorseite
antwort dlg-modus linie-erg basis-prefill abbruch)
(setq abbruch nil)
(if *vf-vorauswahl-eingabemodus*
(setq antwort *vf-vorauswahl-eingabemodus*
*vf-vorauswahl-eingabemodus* nil)
(progn
(setq dlg-modus (vfc-dialog-eingabemodus-waehlen))
(cond
((eq dlg-modus 'ABBRUCH) (setq antwort "2" abbruch t))
(dlg-modus (setq antwort dlg-modus))
(t
;; Dialog nicht verfuegbar/nicht erlaubt (GUI aus, andere Sprache)
;; - alte Konsolen-Abfrage unveraendert.
(princ (ssg-text "vfc-eingabemodus-header"))
(princ (ssg-text "vfc-eingabemodus-3dlinie"))
(princ (ssg-text "vfc-eingabemodus-werte"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
)
)
)
)
(if (not abbruch)
(if (= antwort "1")
(progn
(setq linie-erg (vfc-3dlinie-erfassen))
(if (null linie-erg)
(setq abbruch t)
(progn
(setq deltaL (nth 0 linie-erg)
deltaH (nth 1 linie-erg)
richtung (nth 2 linie-erg)
startpunkt (nth 3 linie-erg)
hz (nth 4 linie-erg))
(setq basis-prefill
(list (cons "deltaL" deltaL) (cons "deltaH" deltaH) (cons "richtung" richtung)
(cons "einfuegehoehe" (caddr startpunkt)) (cons "hz" hz)))
)
)
)
(progn
(setq startpunkt-xy (vfc-dialog-startpunkt-waehlen "vfc-prompt-startpunkt-aus"))
(if (null startpunkt-xy)
(setq startpunkt-xy (getpoint (ssg-text "vfc-prompt-startpunkt-aus"))))
(if (null startpunkt-xy) (setq startpunkt-xy '(0 0 0)))
(setq startpunkt startpunkt-xy)
(setq basis-prefill nil)
)
)
)
(if abbruch
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(vf-basis-eingabe-entpacken eingabe)
(setq startpunkt (list (car startpunkt-xy) (cadr startpunkt-xy) z-start))
;; Gewaehlte Dimension (2D/3D) + Motorseite fuer den Bau erzwingen, danach zurueck.
(setq *ssg-ils-dim* dim)
(setq *vf-motorseite* motorseite)
(vf-dialog-berechnen-einfuegen typ vf-nummer deltaL deltaH richtung startpunkt hz seite nil
geruest-einzelmodul geruest-typ horizontal-p)
(setq *ssg-ils-dim* nil)
(setq *vf-motorseite* nil)
(setq eingabe (vfs-dialog-eingabe-basis basis-prefill))
(if (null eingabe)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(vf-basis-eingabe-entpacken eingabe)
;; X/Y kommen aus dem Linien-Startpunkt (Modus 1) oder der
;; separaten Punktwahl (Modus 2); Z immer aus dem Basis-Dialog
;; (dort vorbelegt, aber ueberschreibbar).
(setq startpunkt (list (car startpunkt) (cadr startpunkt) z-start))
;; Gewaehlte Dimension (2D/3D) + Motorseite fuer den Bau erzwingen, danach zurueck.
(setq *ssg-ils-dim* dim)
(setq *vf-motorseite* motorseite)
(vf-dialog-berechnen-einfuegen typ vf-nummer deltaL deltaH richtung startpunkt hz seite nil
geruest-einzelmodul geruest-typ horizontal-p)
(setq *ssg-ils-dim* nil)
(setq *vf-motorseite* nil)
)
)
)
)
)
@@ -1108,14 +1191,14 @@
)
;; ============================================================
;; TEIL 11b: DIALOG-AUSWAHL FUER TYP/LINIENZUG-MODUS (Radio-Buttons)
;; TEIL 11b: DIALOG-AUSWAHL FUER TYP (Radio-Buttons)
;; ============================================================
;; Ersetzen die beiden Konsolen-Listen am Anfang von c:VarioFoerderer durch
;; Radio-Button-Dialoge (dcl/variofoerderer.dcl, vfc_typ/vfc_linienzug_modus)
;; - alle Optionen sofort sichtbar statt Dropdown. WICHTIG: Radio-Button-
;; Ersetzt die Konsolen-Liste am Anfang von c:VarioFoerderer durch einen
;; Radio-Button-Dialog (dcl/variofoerderer.dcl, vfc_typ) - alle Optionen
;; sofort sichtbar statt Dropdown. WICHTIG: Radio-Button-
;; Labels sind im DCL fest auf Deutsch einprogrammiert (set_tile kann das
;; Label eines radio_button nicht setzen, nur den Zustand - siehe DCL-
;; Kommentar). Beide Funktionen geben deshalb nur dann etwas anderes als nil
;; Kommentar). Die Funktion gibt deshalb nur dann etwas anderes als nil
;; zurueck, wenn GUI erlaubt ist (Tests: ssg-gui-aus) UND Deutsch aktiv ist -
;; sonst faellt der Aufrufer automatisch auf die alte, vollstaendig
;; uebersetzte Konsolen-Liste zurueck (unveraendert im Code stehen
@@ -1161,35 +1244,30 @@
)
)
;; "Zurueck" springt zur Anlagen-Typ-Frage zurueck - Rueckgabe 'ZURUECK, vom
;; Aufrufer (c:VarioFoerderer) ausgewertet (dort erneuter Aufruf von
;; vfc-dialog-typ-waehlen statt hier lokal aufzuloesen).
(defun vfc-dialog-linienzug-modus-waehlen ( / dcl-pfad dat gmodus ergebnis)
;; Eingabemodus (3D-Linie / Werte manuell) per Dialog waehlen - ersetzt die
;; fruehere getstring-Konsolenabfrage in vf-dialog-ablauf. Gleiches Muster/
;; gleiche Einschraenkung wie vfc-dialog-typ-waehlen: nur bei aktiver GUI und
;; Deutsch, sonst nil (Aufrufer faellt dann auf die alte Konsolen-Abfrage
;; zurueck). Keine "Zurueck"-Taste noetig (direkt nach der Typ-Wahl, die
;; selbst schon ein "Zurueck" hat). Rueckgabe: "1" (3D-Linie), "2" (Werte)
;; oder 'ABBRUCH.
(defun vfc-dialog-eingabemodus-waehlen ( / dcl-pfad dat gmodus ergebnis)
(if (and (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
(= *ssg-lang* "de_DE"))
(progn
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vfc_linienzug_modus" dat))
(if (not (new_dialog "vfc_eingabemodus" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil)
(progn
(set_tile "modus_1" "1")
(set_tile "modus_3dlinie" "1")
(action_tile "accept"
"(setq gmodus (cond ((= (get_tile \"modus_2\") \"1\") 2)
((= (get_tile \"modus_3\") \"1\") 3)
((= (get_tile \"modus_4\") \"1\") 4)
((= (get_tile \"modus_5\") \"1\") 5)
(t 1)))
"(setq gmodus (if (= (get_tile \"modus_werte\") \"1\") \"2\" \"1\"))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "back" "(done_dialog 2)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((= ergebnis 1) gmodus)
((= ergebnis 2) 'ZURUECK)
(t 'ABBRUCH)
)
(if (= ergebnis 1) gmodus 'ABBRUCH)
)
)
)
@@ -1200,20 +1278,14 @@
;; ============================================================
;; TEIL 12: DISPATCHER c:VarioFoerderer
;; ============================================================
;; Erzwungener QC-Modus (Linienzug-Modus 4/5, vfc-dialog-linienzug-modus-
;; waehlen/Konsolen-Fallback unten): "4"/"5" waehrend des naechsten
;; Erzwungener QC-Modus (Linienzug-Modus 4/5, siehe *vf-vorauswahl-linienzug-
;; modus* oben/c:QcLinieMitGf*): "4"/"5" waehrend des naechsten
;; vf-linienzug-modus-Laufs, sonst nil. Von vf-linienzug-modus (vf_linienzug.
;; lsp, spaeter geladen) gelesen/geleert - globale Vorab-Deklaration hier,
;; damit sie unabhaengig von der Lade-Reihenfolge existiert.
(if (not (boundp '*vfl-forciere-qc-modus*)) (setq *vfl-forciere-qc-modus* nil))
(defun c:VarioFoerderer ( / typ-eintr anlage-typ berechne-fn einfuege-fn
eingabe deltaL deltaH richtung startpunkt seite hz
eingabe-modus ergebnis ergebnis-liste gueltige-winkel
horizontal-info
best-winkel L_GF L_GF1 L_GF2 L_VF
idx eintrag wahl antwort verteilung-modus
n-scanner vf-nummer hoehe-von hoehe-bis lastEnt
staustrecke-basis vf-insert dlg-typ dlg-modus zurueck-zu-typ)
idx wahl vf-nummer dlg-typ zurueck-zu-typ)
(princ "\n=========================================")
(princ (ssg-text "vfc-banner-titel"))
@@ -1272,24 +1344,13 @@
;; Kette mit gemischten GF/VF-Segmenten), passt nicht in das berechne-fn/
;; einfuege-fn-Schema fuer ein einzelnes durchgehendes Segment - siehe
;; vf_linienzug.lsp. Dispatcht hier direkt und beendet den Standard-Ablauf.
;; Jeder Aufrufer (Menue-Wrapper c:LinienzugVarioFoerderer*/c:QcLinieMitGf*)
;; setzt *vf-vorauswahl-linienzug-modus* VOR dem Aufruf - der frueher
;; hier gefuehrte Modus-Dialog/Konsolen-Fallback ist dadurch entfallen.
(if (= anlage-typ "linienzug")
(progn
(setq dlg-modus (vfc-dialog-linienzug-modus-waehlen))
(cond
((eq dlg-modus 'ABBRUCH) (exit))
((eq dlg-modus 'ZURUECK) (setq zurueck-zu-typ t))
(dlg-modus (setq wahl dlg-modus))
(t
;; Dialog nicht verfuegbar/nicht erlaubt - alte Konsolen-Liste.
(princ (ssg-text "vfc-linienzug-modus-header"))
(princ (ssg-text "vfc-linienzug-modus-1"))
(princ (ssg-text "vfc-linienzug-modus-2"))
(princ (ssg-text "vfc-linienzug-modus-3"))
(princ (ssg-text "vfc-linienzug-modus-4"))
(princ (ssg-text "vfc-linienzug-modus-5"))
(setq wahl (getint (ssg-text "prompt-wahl-1-5")))
)
)
(setq wahl *vf-vorauswahl-linienzug-modus*
*vf-vorauswahl-linienzug-modus* nil)
(if (not zurueck-zu-typ)
(progn
;; Konsolen-Nummer -> interne Funktion:
@@ -1321,215 +1382,26 @@
(setq vf-nummer (vf-next-number))
(princ (ssg-textf "vfc-naechste-vf-nummer" (list (itoa vf-nummer))))
;; 2b. Standard- ODER Etage-Typ + Werteingabe -> DCL-Dialog
;; (dcl/variofoerderer.dcl; Standard: vfs-standard-dialog-ablauf in
;; vf_standard.lsp, Etage: vfe-etage-dialog-ablauf in vf_etage.lsp - beide
;; nutzen dieselben Dialoge vfs-dialog-eingabe-basis/-winkel-verteilung).
;; 3D-Linie-Eingabe und der Typ Linienzug bleiben unveraendert interaktiv
;; (fallen unten in den Konsolen-Ablauf, der die Eingabemodus-Frage erneut
;; stellt - siehe vf-eingabe-abfragen).
;; 2b. Standard- ODER Etage-Typ -> DCL-Dialog (dcl/variofoerderer.dcl;
;; Standard: vfs-standard-dialog-ablauf in vf_standard.lsp, Etage:
;; vfe-etage-dialog-ablauf in vf_etage.lsp - beide duenne Wrapper um
;; vf-dialog-ablauf). Die Eingabemodus-Frage (3D-Linie vs. Werte) stellt
;; vf-dialog-ablauf selbst, VOR dem Basis-Dialog - bei 3D-Linie gehen
;; deltaL/deltaH/Richtung/Einfuegehoehe als Prefill in denselben
;; Basis-Dialog ein, den auch die Werteingabe nutzt (siehe dortiger
;; Kopfkommentar). Damit entfaellt der fruehere rein interaktive
;; Konsolen-Ablauf (Schritte 3-11, vf-eingabe-abfragen) komplett - er lief
;; bei 3D-Linie an der GUI vorbei und fragte Seite/Fahrtrichtung/Verteilung
;; erneut auf der Kommandozeile ab, obwohl der Dialog dieselben Felder
;; laengst per GUI anbietet.
(if (member anlage-typ '("standard" "etage"))
(progn
;; Eingabemodus: Vorauswahl (Menue-Wrapper) hat Vorrang, sonst fragen.
(if *vf-vorauswahl-eingabemodus*
(setq antwort *vf-vorauswahl-eingabemodus*)
(progn
(princ (ssg-text "vfc-eingabemodus-header"))
(princ (ssg-text "vfc-eingabemodus-3dlinie"))
(princ (ssg-text "vfc-eingabemodus-werte"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
)
)
(if (= antwort "2")
(progn
(if (= anlage-typ "etage")
(vfe-etage-dialog-ablauf vf-nummer)
(vfs-standard-dialog-ablauf vf-nummer))
(exit)
)
)
)
)
;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt) - richtung
;; steht bei beiden Eingabemodi (Werteingabe UND 3D-Linie) bereits fest.
(setq eingabe (vf-eingabe-abfragen))
(setq deltaL (nth 0 eingabe)
deltaH (nth 1 eingabe)
richtung (nth 2 eingabe)
startpunkt (nth 3 eingabe)
hz (nth 4 eingabe)
eingabe-modus (nth 5 eingabe))
;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht)
(princ (ssg-text "vfc-seite-header"))
(princ (ssg-text "vfc-seite-rechts"))
(princ (ssg-text "vfc-seite-links"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2") (setq seite "links") (setq seite "rechts"))
(princ (ssg-textf "vfc-seite-gewaehlt" (list seite)))
;; 5. Typ-spezifische Berechnung (init + Winkelsuche)
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
(setq ergebnis-liste (cadddr ergebnis))
;; 5b. Horizontale Zwischenstrecke als Zusatzoption: geometrisch NUR bei
;; "Ab" ueberhaupt erreichbar (die festen 3-Grad-Elemente wirken immer
;; absenkend) - "Auf" wird deshalb gar nicht erst geprueft. Gilt einheitlich
;; fuer Werteingabe UND 3D-Linie, da richtung hier in jedem Fall feststeht.
;; Bibliothek ist durch den berechne-fn-Aufruf oben bereits initialisiert.
(if (and (= anlage-typ "standard") (= richtung "Ab"))
(progn
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" nil))
(if (and horizontal-info (caddr horizontal-info))
(progn
(setq ergebnis-liste
(append ergebnis-liste
(list (list 0 (car horizontal-info) (cadr horizontal-info) T))))
(princ (ssg-textf "vfc-hinweis-horizontal-moeglich" (list (chr 176) (chr 916))))
)
(setq horizontal-info nil)
)
)
)
;; Konfiguration (nach ssg_core-Init verfuegbar).
(setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
;; 7. Gueltige Winkel ermitteln
(setq gueltige-winkel
(mapcar 'car
(vl-remove-if-not
(function (lambda (e) (and (nth 3 e)
(numberp (nth 1 e)) (numberp (nth 2 e))
(>= (nth 1 e) 0) (>= (nth 2 e) 0))))
ergebnis-liste)))
(if (null gueltige-winkel)
(progn
(alert (ssg-textf "vfc-alert-kein-winkel"
(list (chr 916) (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(if (= anlage-typ "etage")
(vfe-etage-dialog-ablauf vf-nummer)
(vfs-standard-dialog-ablauf vf-nummer))
(exit)
)
)
;; 8. Winkelauswahl (automatisch oder interaktiv)
;; Sentinel-Winkel 0 = horizontale Zwischenstrecke (Schritt 6/11 bei 0
;; Grad, Boegen fest auf_3/ab_3) - siehe berechne-horizontale-mitte.
(if (= (length gueltige-winkel) 1)
(progn
(setq best-winkel (car gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(if (= best-winkel 0)
(princ (ssg-text "vfc-einzige-variante-horizontal"))
(princ (ssg-textf "vfc-einziger-winkel" (list (itoa best-winkel) (chr 176))))
)
)
(progn
(princ (ssg-text "vfc-mehrere-winkel-header"))
(setq idx 1)
(foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste))
(if (= w 0)
(princ (ssg-textf "vfc-winkel-option-horizontal"
(list idx (chr 176)
(rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
(princ (ssg-textf "vfc-winkel-option"
(list idx (itoa w) (chr 176)
(rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
)
(setq idx (1+ idx))
)
(setq wahl (getint (ssg-textf "vfc-prompt-winkel-waehlen"
(list (length gueltige-winkel)))))
(if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
(setq wahl 1))
(setq best-winkel (nth (1- wahl) gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
)
)
(princ "\n\n=========================================")
(if (= best-winkel 0)
(princ (ssg-textf "vfc-zus-horizontal"
(list (rtos L_GF 2 2) (rtos L_VF 2 2))))
(princ (ssg-textf "vfc-zus-winkel"
(list (itoa best-winkel) (chr 176) (rtos L_GF 2 2) (rtos L_VF 2 2))))
)
(princ "\n=========================================")
;; 9. L_GF Verteilung
(princ (ssg-text "vfc-gf-verteilung-header"))
(princ (ssg-text "vfc-gf-verteilung-1"))
(princ (ssg-text "vfc-gf-verteilung-2"))
(princ (ssg-text "vfc-gf-verteilung-3"))
(princ (ssg-text "vfc-gf-verteilung-4"))
(setq verteilung-modus (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(if (= verteilung-modus "") (setq verteilung-modus "1"))
(cond
((= verteilung-modus "1")
(setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
((= verteilung-modus "2")
(setq L_GF1 (float staustrecke-basis))
(setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "3")
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "4")
(setq L_GF1 (getreal (ssg-textf "vfc-prompt-lgf1-vorne"
(list (rtos (/ L_GF 2.0) 2 2)))))
(if (null L_GF1) (setq L_GF1 (/ L_GF 2.0)))
(setq L_GF2 (max 0.0 (- L_GF L_GF1)))
(princ (ssg-textf "vfc-lgf2-hinten" (list (rtos L_GF2 2 2)))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(princ (ssg-textf "vfc-zus-lgf" (list (rtos L_GF1 2 2) (rtos L_GF2 2 2))))
;; Scanner-Anzahl wird nicht mehr abgefragt (Attribut ANZAHL_SCANNER bleibt 0).
(setq n-scanner 0)
;; 11. Bestaetigung
(princ (ssg-text "vfc-einfuegen-frage"))
(princ (ssg-text "vfc-einfuegen-optionen"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "1")
(progn
;; Hoehenangaben fuer Attribute und Beschriftung
(setq hoehe-von (caddr startpunkt))
(setq hoehe-bis (cond
((= richtung "Auf") (+ hoehe-von deltaH))
((= richtung "Ab") (- hoehe-von deltaH))
(t hoehe-von)))
;; lastEnt VOR der Einfuegung merken
(setq lastEnt (ssg-lastent-ohne-attribute))
;; Typ-spezifische Einfuegung
(apply einfuege-fn
(list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz))
;; Gemeinsame VF_*-Block-Erstellung
;; Geruest fuer Einzelmodul/Geruestoption sind in diesem interaktiven
;; Konsolen-Ablauf (Etage/Linienzug) nicht abfragbar - bleiben auf
;; Schema-Default (analog Kreisel: nur ueber Dialog editierbar).
(setq vf-insert
(vf-block-erstellen anlage-typ seite vf-nummer n-scanner
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
richtung best-winkel startpunkt lastEnt hz
"0" "Schoenenberger Geruest"))
;; Standard- UND Etage-Bloecke aus dem interaktiven Konsolen-Ablauf mit der
;; SSG_VF_EDIT-XDATA markieren - sie sind (wie die Dialog-Variante) aus
;; Attributen + hz verlustfrei rekonstruierbar, also per Doppelklick
;; (c:VARIOFOERDERER_EDIT) editierbar. Linienzug bleibt unmarkiert.
(if (and vf-insert (member anlage-typ '("standard" "etage")))
(vf-edit-xdata-schreiben vf-insert anlage-typ hz))
(princ "\n=========================================")
)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
)
nil
)
@@ -1540,7 +1412,6 @@
;; Menue-Wrapper: jeder feste Endpunkt der VarioFoerderer-Erzeugung ist
;; direkt aufrufbar (Typ + Eingabemodus vorbelegt, keine Rueckfrage).
;; Nur der Linienzug fragt intern noch Modus 1/2/3 (komplexer Fall).
;; Eingabemodus-Vorauswahl: "2" = Werte manuell (DCL-Dialog),
;; "1" = aus 3D-Linie (Linie picken).
@@ -1568,9 +1439,34 @@
(c:VarioFoerderer)
)
;; --- Linienzug (bleibt interaktiv: fragt Modus 1/2/3) ---
(defun c:LinienzugVarioFoerderer ()
(setq *vf-vorauswahl-typ* "linienzug")
;; --- Linienzug/Streckengruppe (Modus 1/2/3, Typ+Modus vorbelegt) ---
(defun c:LinienzugVarioFoerdererManuell ()
(setq *vf-vorauswahl-typ* "linienzug"
*vf-vorauswahl-linienzug-modus* 1)
(c:VarioFoerderer)
)
(defun c:LinienzugVarioFoerdererZielhoehe ()
(setq *vf-vorauswahl-typ* "linienzug"
*vf-vorauswahl-linienzug-modus* 2)
(c:VarioFoerderer)
)
(defun c:LinienzugVarioFoerdererStueckweise ()
(setq *vf-vorauswahl-typ* "linienzug"
*vf-vorauswahl-linienzug-modus* 3)
(c:VarioFoerderer)
)
;; --- QC-Linie (Linienzug-Modus 4/5, Typ+Modus vorbelegt) ---
;; Menue: ILS -> Gefaellestrecke (gehoeren inhaltlich dorthin, technisch
;; weiterhin ueber den Linienzug-Ablauf/*vfl-forciere-qc-modus* gebaut).
(defun c:QcLinieMitGf ()
(setq *vf-vorauswahl-typ* "linienzug"
*vf-vorauswahl-linienzug-modus* 4)
(c:VarioFoerderer)
)
(defun c:QcLinieMitGfUForm ()
(setq *vf-vorauswahl-typ* "linienzug"
*vf-vorauswahl-linienzug-modus* 5)
(c:VarioFoerderer)
)
Lisp/vf_linienzug.lsp
+105 -23
View File
@@ -1033,7 +1033,17 @@
;; "Neue Linie: GF" - Separator VOR/NACH (2 Ja/Nein-Toggles in einem
;; Bildschirm). Siehe dcl/vf_linienzug_wizard.dcl (vflw_sep_gf).
(defun vflw-gruppe-sep-gf-impl ( / dat ergebnis gsepvor gsepnach)
;; es-folgt-sep: T, wenn dieses GF-Stueck das Kettenende MIT ES-Element ist
;; (gf-kettenende-antwort steht beim Aufruf schon fest, siehe Aufrufer) -
;; dann baut vfl-insert-es-element ohnehin IMMER seinen eigenen Separator
;; VOR dem ES-Block, ein zusaetzlicher "Separator NACH" waere ein zweiter,
;; direkt anschliessender Separator. Statt die Frage zu stellen und die
;; Antwort hinterher zu verwerfen (Nutzer-Feedback 2026-10-08: verwirrend),
;; wird die Kachel hier direkt deaktiviert+abgehakt - der bestehende
;; Konsolen-/Sicherheitsnetz-Pfad (siehe Aufrufer, "ueberschrieben"-Meldung)
;; bleibt UNVERAENDERT bestehen (deckt weiterhin den reinen Konsolen-Fall ab,
;; wo diese Dialog-Funktion gar nicht laeuft).
(defun vflw-gruppe-sep-gf-impl (es-folgt-sep / dat ergebnis gsepvor gsepnach)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_sep_gf" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
@@ -1041,6 +1051,7 @@
(set_tile "kopf" (vflw-clean (ssg-text "vfl-sep-gf-header")))
(set_tile "sepvor" "0")
(set_tile "sepnach" "0")
(if es-folgt-sep (mode_tile "sepnach" 1))
(action_tile "accept"
"(setq gsepvor (get_tile \"sepvor\")) (setq gsepnach (get_tile \"sepnach\")) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
@@ -1516,11 +1527,11 @@
(princ))
;; "Naechstes Element waehlen" - Hauptmenue des Linienzug-Aufbaus (Modus 1).
;; Kettenanfang (frame=nil): alle 6 Optionen waehlbar, Vario-Kurve inklusive
;; (kann nur als allererstes Kettenglied gewaehlt werden - siehe Kommentar an
;; der Aufrufstelle). Sonst (Frame vorhanden): Vario-Kurve per mode_tile
;; deaktiviert, die uebrigen 5 Optionen behalten dieselbe Reihenfolge/
;; Bedeutung wie im Konsolen-Menue, nur ohne die Luecke. Pusht die
;; Kettenanfang (frame=nil): alle 5 Radio-Optionen waehlbar, Vario-Kurve
;; inklusive (kann nur als allererstes Kettenglied gewaehlt werden - siehe
;; Kommentar an der Aufrufstelle). Sonst (Frame vorhanden): Vario-Kurve per
;; mode_tile deaktiviert, die uebrigen 4 Optionen behalten dieselbe
;; Reihenfolge/Bedeutung wie im Konsolen-Menue, nur ohne die Luecke. Pusht die
;; POSITIONELLE Antwort ("1".."6" bzw. "1".."5"), identisch zur bisherigen
;; Konsolen-Nummerierung, damit Journal/Replay unveraendert bleiben - die
;; Radio-Buttons selbst tragen daher STABILE, kontextunabhaengige Keys
@@ -1531,9 +1542,20 @@
;; - eindeutig als VF erkannt (Startpunkt liegt auf einer bestehenden
;; VF-Kette) macht "GF-Bogen"/"Neue Linie: GF" als DIREKTE Fortsetzung keinen
;; Sinn (kein GF-Baustein wird an dieser Stelle einfach an ein VF-Teil
;; angeflanscht) - diese beiden Optionen werden dann ausgegraut. "Neue Linie
;; BIS Kettenende" bleibt immer waehlbar (hat ihre eigene GF/VF-Erkennung).
(defun vflw-gruppe-naechstes-element-impl (kettenanfang familie / dat ergebnis slot gwahl)
;; angeflanscht) - diese beiden Optionen werden dann ausgegraut.
;; as-eben-eingefuegt: T, wenn der Anwender die AS-Frage ("AS-Element
;; setzen?") explizit mit Ja beantwortet hat (as-vorhanden in
;; vf-linienzug-modus) - das AS-Element braucht danach zuerst ein GERADES
;; Segment (Linie-GF/Linie-VF/Horizontal-VF), eine horizontale Kurve direkt
;; im Anschluss (GF-Bogen/Vario-Kurve) ergibt keinen Sinn und wird ebenfalls
;; ausgegraut. Greift nur, wenn familie nicht schon "VF" ist (dort ist
;; wahl_gfbogen bereits deaktiviert); nil, wenn der Startpunkt automatisch
;; auf einer bestehenden Kette erkannt wurde (as-vorhanden dann ohnehin nil).
;; "Neue Linie BIS Kettenende" ist kein Radio mehr, sondern der eigene Button
;; "abschliessen" (done_dialog 3) - er setzt slot direkt auf 6 und ignoriert
;; die aktuelle Radio-Auswahl (hat ihre eigene GF/VF-Erkennung, bleibt daher
;; immer waehlbar, auch wenn GF-Bogen/Neue Linie: GF ausgegraut sind).
(defun vflw-gruppe-naechstes-element-impl (kettenanfang familie as-eben-eingefuegt / dat ergebnis slot gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_naechstes_element" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
@@ -1546,20 +1568,31 @@
(mode_tile "wahl_gfbogen" 1)
(mode_tile "wahl_liniegf" 1)
(set_tile "wahl_variokurve" "1")))
;; Unmittelbar nach einem explizit eingefuegten AS-Element ergibt eine
;; horizontale Kurve (GF-Bogen/Vario-Kurve) als DIREKTE Fortsetzung
;; keinen Sinn - das AS-Element braucht zuerst ein gerades Segment
;; (Linie-GF/Linie-VF/Horizontal-VF). Nur relevant am Kettenanfang und
;; nur, wenn nicht schon durch familie="VF" abgedeckt (dort ist
;; wahl_gfbogen bereits deaktiviert).
(if (and kettenanfang as-eben-eingefuegt (not (equal familie "VF")))
(progn
(mode_tile "wahl_gfbogen" 1)
(mode_tile "wahl_variokurve" 1)
(set_tile "wahl_liniegf" "1")))
(action_tile "accept"
"(setq slot (cond ((= (get_tile \"wahl_gfbogen\") \"1\") 1)
((= (get_tile \"wahl_variokurve\") \"1\") 2)
((= (get_tile \"wahl_linievf\") \"1\") 4)
((= (get_tile \"wahl_horizontalvf\") \"1\") 5)
((= (get_tile \"wahl_linieende\") \"1\") 6)
(t 3)))
(done_dialog 1)")
(action_tile "abschliessen" "(setq slot 6) (done_dialog 3)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "back" "(done_dialog 2)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((= ergebnis 1)
((or (= ergebnis 1) (= ergebnis 3))
(setq gwahl (if (or kettenanfang (<= slot 2)) slot (1- slot)))
(vflw-pending-push-all (list (itoa gwahl))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
@@ -6594,7 +6627,8 @@
(progn
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-naechstes-element-impl
(list (null frame) (if (null frame) startpunkt-familie nil))))
(list (null frame) (if (null frame) startpunkt-familie nil)
(if (null frame) as-vorhanden nil))))
(if frame
(progn
(princ (ssg-text "vfl-menu-gf-bogen-1"))
@@ -7008,7 +7042,7 @@
(setq hz-neu (car (frame->hz-winkel frame)))
)
(setq rad3 (* gf-max-winkel (/ pi 180.0)))
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-sep-gf-impl nil))
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-sep-gf-impl (list (= gf-kettenende-antwort "1"))))
(princ (ssg-text "vfl-sep-vor-gf-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
@@ -7050,9 +7084,16 @@
(if (> sep-anzahl 0)
(setq deltaH (max 0.0 (- deltaH (* sep-anzahl *vfk-separator-laenge* (sin rad3))))))
;; ES-Fussabdruck VORAB reservieren, siehe Kommentar bei
;; gf-kettenende-antwort oben.
;; gf-kettenende-antwort oben. ES bringt IMMER seinen eigenen
;; Separator mit (vfl-insert-es-element, siehe Kommentar oben
;; "bringt seinen eigenen Separator VOR dem ES-Block schon
;; mit") - dessen Hoehenanteil fehlte hier bisher komplett
;; (realer Bug, Nutzer-Meldung 2026-10-08: Kette baute zu lang/
;; zu tief, weil der automatische Kettenende-Separator anders
;; als die optionalen vor/nach-Separatoren oben NICHT reserviert
;; wurde).
(if (= gf-kettenende-antwort "1")
(setq deltaH (max 0.0 (- deltaH (abs ein-dz)))))
(setq deltaH (max 0.0 (- deltaH (* *vfk-separator-laenge* (sin rad3)) (abs ein-dz)))))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-gefaelle-impl
(list (vfl-gf-hoehe-vorschlag (caddr p-aktuell)) t nil)))
@@ -7116,7 +7157,7 @@
;; gepickten deltaL abgezogen, damit die Kette exakt am
;; gepickten Punkt endet statt danach ueberzustehen.
(setq rad3 (* gf-max-winkel (/ pi 180.0)))
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-sep-gf-impl nil))
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-sep-gf-impl (list (= gf-kettenende-antwort "1"))))
(princ (ssg-text "vfl-sep-vor-gf-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
@@ -7139,9 +7180,15 @@
(if (> sep-anzahl 0)
(setq deltaL (- deltaL (* sep-anzahl *vfk-separator-laenge* (cos rad3)))))
;; ES-Fussabdruck VORAB reservieren, siehe Kommentar bei
;; gf-kettenende-antwort oben.
;; gf-kettenende-antwort oben. ES bringt IMMER seinen
;; eigenen Separator mit (vfl-insert-es-element) - dessen
;; Laenge fehlte hier bisher komplett (realer Bug,
;; Nutzer-Meldung 2026-10-08: Kette baute ca. 300mm*cos(w)
;; zu lang, weil der automatische Kettenende-Separator
;; anders als die optionalen vor/nach-Separatoren oben
;; NICHT reserviert wurde).
(if (= gf-kettenende-antwort "1")
(setq deltaL (- deltaL (abs ein-dx))))
(setq deltaL (- deltaL (* *vfk-separator-laenge* (cos rad3)) (abs ein-dx))))
(if (< deltaL 1.0)
(progn (princ (ssg-text "vfl-fehler-linie-zu-kurz")) (setq gf-ok nil)))
(if gf-ok
@@ -8985,6 +9032,12 @@
(princ (ssg-text "vfl-vwnb-titel"))
(princ "\n=========================================")
;; "Zurueck"/"Abbrechen"-Flag ganz am Anfang zuruecksetzen - identischer Fix
;; wie in vf-linienzug-modus/-modus2 (siehe dortiger Kommentar): sonst
;; wuerde ein von einem VORHERIGEN Lauf noch gesetztes Flag den allerersten
;; vfl-in-*-Aufruf dieses NEUEN Laufs sofort wieder abbrechen.
(setq *vfl-wizard-abbruch-grund* nil)
;; --- Debug-Session (Schalter "vfl-modus3", DEFAULT AN) -------------------
;; Bei Bedarf abschaltbar: (dbg-schalter-off "vfl-modus3") in der Konsole.
;; Alle interaktiven Eingaben (Punkte, Hoehen, Seiten, Winkel, Menue-
@@ -9503,6 +9556,7 @@
nonclimber-cnt nkurve kurve-chords run-span
hor-koerper-len hor-pairs flat-p flat-zone-erste fill-len wahl3
rad3v feste-vf dH-adj dir-x dir-y fill-D end-hz
laengs-wert quer-wert soll-korrigiert
es-vek-fix es-along-fix
gf-total br-gf-mode br-gf2-exp filler-A-len filler-a-done
as-vorhanden es-vorhanden dbg-an dbg-old-error
@@ -9512,6 +9566,16 @@
(princ (ssg-text "vfl-m3-titel"))
(princ "\n=========================================")
;; "Zurueck"/"Abbrechen"-Flag ganz am Anfang zuruecksetzen (auch schon vor
;; der ersten Praeambel-Frage) - sonst wuerde ein von einem VORHERIGEN Lauf
;; (egal ob Modus 1/2/3) noch gesetztes Flag (z.B. nach "Abbrechen") den
;; allerersten vfl-in-*-Aufruf DIESES NEUEN Laufs sofort wieder abbrechen
;; (siehe zentraler Check in vfl-in-value/-value-p) - identischer Fix wie in
;; vf-linienzug-modus (Modus 1). Realer Bug: ein zweiter Modus-2-Aufruf in
;; derselben Zeichnung/Session brach sofort mit "ABBRUCH-TRIGGER:
;; *vfl-wizard-abbruch-grund*=abbrechen" ab, ohne ueberhaupt die
;; Pfad-Auswahl anzuzeigen (Livetest 2026-09-21).
(setq *vfl-wizard-abbruch-grund* nil)
;; *vfl-journal* VOR dem allerersten vfl-in-*-Aufruf zuruecksetzen (nicht
;; *vfl-replay-queue*, siehe Kommentar bei vfl-journal-reset-lauf und die
;; analoge Korrektur in vf-linienzug-modus). Frueher stand dieser Reset erst
@@ -10304,12 +10368,30 @@
;; ~0 sein (Endpunkt liegt auf der KS_AUS-Achse), Laengs = ES-Ausladung.
(setq end-hz (car (frame->hz-winkel frame))) ; KS_AUS-Achsrichtung
(setq dir-x (cos (* end-hz (/ pi 180.0))) dir-y (sin (* end-hz (/ pi 180.0))))
(princ (ssg-textf "vfl-m3-laengs-quer"
(list (rtos (+ (* (- (car ist-ende) (car soll-ende)) dir-x)
(* (- (cadr ist-ende) (cadr soll-ende)) dir-y)) 2 1)
(rtos (+ (* (- (car ist-ende) (car soll-ende)) (- dir-y))
(* (- (cadr ist-ende) (cadr soll-ende)) dir-x)) 2 1))))
(setq laengs-wert (+ (* (- (car ist-ende) (car soll-ende)) dir-x)
(* (- (cadr ist-ende) (cadr soll-ende)) dir-y)))
(setq quer-wert (+ (* (- (car ist-ende) (car soll-ende)) (- dir-y))
(* (- (cadr ist-ende) (cadr soll-ende)) dir-x)))
(princ (ssg-textf "vfl-m3-laengs-quer" (list (rtos laengs-wert 2 1) (rtos quer-wert 2 1))))
(princ (ssg-text "vfl-m3-achse-hinweis"))
;; Soll (ES-korrigiert): der gepickte Zielpunkt, verschoben um den bereits
;; oben gemessenen Laengs-Wert entlang der KS_AUS-Achse - zeigt, dass die
;; Abweichung oben keine Unsicherheit ist, sondern GENAU der ES-eigene
;; Fussabdruck (90/30-Grad-Schwenk, siehe doc/VarioFoerderer_Linienzug_
;; Prinzipien.md Abschnitt 6/14.11: "seitliche ES-Ausladung, kein Fehler").
;; Bewusst aus dem bereits gemessenen Laengs-Wert abgeleitet statt ueber
;; eine zweite, eigenstaendige vf-element-ks-info-Neuberechnung - das waere
;; ein zweiter Rechenweg fuer dieselbe Information mit eigenem Bug-Risiko,
;; hier reicht die Umkehrung der bereits validierten Laengs/Quer-Zerlegung.
(setq soll-korrigiert (list (+ (car soll-ende) (* laengs-wert dir-x))
(+ (cadr soll-ende) (* laengs-wert dir-y))
(caddr soll-ende)))
(princ (ssg-textf "vfl-m3-ziel-soll-es-korrigiert"
(list (rtos (car soll-korrigiert) 2 1) (rtos (cadr soll-korrigiert) 2 1) (rtos (caddr soll-korrigiert) 2 1))))
(princ (ssg-textf "vfl-m3-abweichung-es-korrigiert"
(list (rtos (- (car ist-ende) (car soll-korrigiert)) 2 1)
(rtos (- (cadr ist-ende) (cadr soll-korrigiert)) 2 1)
(rtos (- (caddr ist-ende) (caddr soll-korrigiert)) 2 1))))
(princ "\n=========================================")
(if dbg-an
Lisp/vf_spec.lsp
+22 -9
View File
@@ -1,7 +1,7 @@
;; ============================================================
;; vf_spec.lsp - VF-Linienzug aus Eingabedaten bauen (ohne GUI/Konsole)
;; ============================================================
;; Stufe 1 des Fahrplans in doc/TODO-plan-vf-interactive.md.
;; Stufe 1 des Fahrplans in doc/todo/plan-vf-interactive.md.
;;
;; Eine SPEC beschreibt eine Kette in Domaenenwerten ("links", "winkel",
;; "aussen", ja/nein) statt in Menue-Codes: lesbar, schreibbar, versionierbar.
@@ -903,15 +903,28 @@
;; abgebrochene Kette bleibt also als lose Geometrie liegen und ist per
;; c:VF_SEKTION_RESTORE rettbar (vfl-segment-xdata-sichern hat pro Iteration
;; schon SSG_VF_EDIT_SEG/_PRE geschrieben).
(defun vsp-bau-aus-spec (spec / kopf sid journal rec vor-ent alt-error err
offen hl meld ist-glieder soll-glieder diff
ist-journal jdiff ent ed dim)
(defun vsp-bau-aus-spec (spec / kopf journal)
(setq kopf (vsp-kopf spec))
(setq sid (vsp-spec-id kopf))
;; vsp-journal sammelt seine Fehler in *vsp-fehler* - darum erst danach lesen.
(setq journal (vsp-journal spec))
(vsp-bau-journal (vsp-spec-id kopf) journal (ssg-val kopf "dim") *vsp-fehler*))
;; Eine Kette aus einem fertigen Eingabe-Journal bauen (Liste (art . wert) in
;; Bau-Reihenfolge, wie vfl-journal-replay-start sie erwartet). Gemeinsamer
;; Kern fuer Specs (vsp-bau-aus-spec, Journal per vsp-journal uebersetzt) und
;; fuer UNVERAENDERT uebernommene Aufzeichnungen - z.B. die SSG_VF_EDIT-XDATA
;; eines von Hand gebauten VF_n (tests/test_dematic_arvato.lsp, Journal per
;; vfl-string->entry gelesen). Letztere brauchen keinen Uebersetzer und
;; laufen darum auch dann, wenn der Dialog neuer ist als die Spec-Grammatik.
;; sid = Kennung im Record, dim = "2D"/"3D" oder nil (Sitzung),
;; fehler = Liste der Spec-Fehler (bei nil-Journal die Begruendung).
;; Erwartet den Headless-Rahmen (vsp-headless-an) beim Aufrufer.
(defun vsp-bau-journal (sid journal dim fehler / rec vor-ent alt-error err
offen hl meld ist-glieder soll-glieder diff
ist-journal jdiff ent ed)
(setq soll-glieder (if journal (vfl-journal-glieder journal) nil))
(setq rec (vsp-rec-neu sid))
(setq rec (vsp-set rec "spec_fehler" *vsp-fehler*))
(setq rec (vsp-set rec "spec_fehler" fehler))
(setq rec (vsp-set rec "glieder_soll" soll-glieder))
(setq rec (vsp-set rec "eingaben_gesamt" (if journal (length journal) 0)))
(princ (strcat "\n [SPEC] " sid))
@@ -919,9 +932,9 @@
(cond
;; --- Spec fehlerhaft: nichts bauen ---
((null journal)
(princ (strcat "\n " (itoa (length *vsp-fehler*))
(princ (strcat "\n " (itoa (length fehler))
" Spec-Fehler, nichts gebaut:"))
(foreach f *vsp-fehler* (princ (strcat "\n - " f)))
(foreach f fehler (princ (strcat "\n - " f)))
(setq rec (vsp-set rec "status" "spec-fehler"))
(setq rec (vsp-set rec "dimension" (vsp-dim-text)))
rec)
@@ -934,7 +947,7 @@
;; Feld in der Spec. Ist keines gesetzt, gilt die Sitzung.
(setq dim (if (and (boundp '*vsp-dim-override*) *vsp-dim-override*)
*vsp-dim-override*
(ssg-val kopf "dim")))
dim))
(if dim (setq *ssg-ils-dim* dim))
(setq rec (vsp-set rec "dimension" (vsp-dim-text)))
(princ (strcat " -> " (itoa (length journal)) " Journal-Eintraege, "
Lisp/vf_standard.lsp
+310 -29
View File
@@ -803,11 +803,26 @@
;; ============================================================
;; DCL-DIALOG (Standardfall) - dcl/variofoerderer.dcl
;; Ersetzt die interaktive Werteingabe aus vf-eingabe-abfragen
;; (Konsolen-Modus "Werteingabe") fuer anlage-typ "standard" durch
;; zwei DCL-Dialoge: Basis-Eingabe und Winkel/Verteilung. Die
;; 3D-Linie-Eingabe sowie die Typen "etage"/"linienzug" bleiben
;; unveraendert interaktiv (siehe Verzweigung in c:VarioFoerderer).
;; Ersetzt die frueher komplett interaktive Werteingabe fuer anlage-typ
;; "standard" durch zwei DCL-Dialoge: Basis-Eingabe und Winkel/Verteilung.
;; Beide Eingabemodi (3D-Linie UND Werteingabe, siehe vf-dialog-ablauf in
;; vf_core.lsp) laufen seitdem ueber denselben Basis-Dialog - bei 3D-Linie
;; nur mit deltaL/deltaH/Richtung/Einfuegehoehe vorbelegt. Nur der Typ
;; "linienzug" bleibt unveraendert interaktiv (siehe Verzweigung in
;; c:VarioFoerderer).
;;
;; Beide Dialoge existieren je in zwei Varianten:
;; -popup (Dropdowns, urspruengliche Implementierung, unveraendert) und
;; -radio (Radio-Buttons statt Dropdown). Radio-Button-Labels lassen sich
;; nach new_dialog nicht per set_tile aendern (DCL-Limitierung) - die
;; -radio-Varianten loesen das, indem sie ihre DCL-Datei bei JEDEM Aufruf
;; frisch per ssg-dcl-temp-schreiben (ssg_core.lsp) schreiben und die
;; Labels dabei direkt mit dem schon von ssg-text/ssg-textf aufgeloesten
;; String befuellen - funktioniert dadurch in jeder Sprache, keine
;; Sprachweiche noetig (anders als vfc-dialog-typ-waehlen). Die
;; namenlosen Dispatcher-Funktionen (ohne Suffix) bevorzugen -radio und
;; fallen nur bei einem technischen Fehler (Temp-Datei nicht schreibbar/
;; ladbar, Sentinel 'FEHLER) auf -popup zurueck.
;; ============================================================
;; Bau-Parameter eines bestehenden VF_n-Blocks aus XDATA + Attributen lesen -
@@ -846,14 +861,76 @@
(cons "hz" hz)
(cons "z-start" z-start)))
;; Basis-Eingabe (Dialog 1): deltaL, deltaH, Richtung, Einfuegehoehe,
;; Fahrtrichtung, Seite, Geruest fuer Einzelmodul, Geruestoption.
;; Baut die DCL-Zeilen einer boxed_radio_column mit einem radio_button pro
;; Eintrag in "labels" (Tile-Keys "<prefix>_0".."<prefix>_(n-1)"). labels
;; sind bereits fertige, uebersetzte Strings (ssg-text/ssg-textf) - werden
;; hier nur noch fuer die DCL-Syntax escaped (ssg-dcl-label-escape).
;; Genutzt von vfs-dialog-eingabe-basis-radio fuer die drei verbleibenden
;; Radio-Gruppen (Seite, Motorseite, Geruestoption).
(defun vfs-dcl-radio-gruppe-zeilen (prefix box-label labels / zeilen i)
(setq zeilen (list
": boxed_radio_column {"
(strcat " label = \"" (ssg-dcl-label-escape box-label) "\";")
(strcat " key = \"" prefix "\";")))
(setq i 0)
(foreach lbl labels
(setq zeilen (append zeilen (list
(strcat " : radio_button { key = \"" prefix "_" (itoa i) "\"; label = \""
(ssg-dcl-label-escape lbl) "\"; }"))))
(setq i (1+ i))
)
(append zeilen (list "}"))
)
;; Baut das (cond ...)-Fragment (als String), das innerhalb eines
;; action_tile-Callbacks den gewaehlten Index 0..(n-1) einer per
;; vfs-dcl-radio-gruppe-zeilen erzeugten Gruppe ermittelt. n ist die
;; tatsaechliche Options-Anzahl zum Generierungszeitpunkt - dadurch bleibt
;; z.B. die Geruesttyp- oder Winkel-Gruppe korrekt, auch wenn deren Anzahl
;; sich einmal aendert (kein hartkodiertes "_1"/"_2"/"_3" im Aufrufer).
(defun vfs-dcl-radio-idx-cond (prefix n / s i)
(setq s "(cond " i 1)
(while (< i n)
(setq s (strcat s "((= (get_tile \"" prefix "_" (itoa i) "\") \"1\") " (itoa i) ")"))
(setq i (1+ i))
)
(strcat s "(t 0))")
)
;; L_GF1/L_GF2 aus dem gewaehlten Verteilungsmodus ("0".."3") berechnen -
;; gemeinsam genutzt von der Popup- UND der Radio-Variante von
;; vfs-dialog-winkel-verteilung (frueher inline in beiden dupliziert).
;; Rueckgabe: (L_GF1 L_GF2).
(defun vfs-verteilung-berechnen (verteilung-modus L_GF staustrecke-basis lgf1-manuell-str /
L_GF1 L_GF2)
(cond
((= verteilung-modus "0")
(setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
((= verteilung-modus "1")
(setq L_GF1 (float staustrecke-basis))
(setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "2")
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "3")
(setq L_GF1 (atof lgf1-manuell-str))
(if (or (null L_GF1) (< L_GF1 0)) (setq L_GF1 (/ L_GF 2.0)))
(if (> L_GF1 L_GF) (setq L_GF1 L_GF))
(setq L_GF2 (max 0.0 (- L_GF L_GF1))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(list L_GF1 L_GF2)
)
;; Basis-Eingabe (Dialog 1, Popup-Variante): deltaL, deltaH, Richtung,
;; Einfuegehoehe, Fahrtrichtung, Seite, Geruest fuer Einzelmodul,
;; Geruestoption.
;; prefill: Assoziationsliste zur Vorbelegung (fuer VARIOFOERDERER_EDIT) mit
;; Schluesseln "deltaL" "deltaH" "richtung" "einfuegehoehe" "hz" "seite"
;; "geruest-einzelmodul" "geruest-typ" - oder nil fuer Neuanlage mit Defaults.
;; Rueckgabe: (deltaL deltaH richtung einfuegehoehe hz seite
;; geruest-einzelmodul geruest-typ) oder nil bei Abbruch.
(defun vfs-dialog-eingabe-basis (prefill / dcl-pfad dat ergebnis
(defun vfs-dialog-eingabe-basis-popup (prefill / dcl-pfad dat ergebnis
dlg-deltal dlg-deltah dlg-richtung dlg-hoehe
dlg-fahrtrichtung dlg-seite dlg-motorseite dlg-dimension
dlg-geruest-einzelmodul dlg-geruest-typ
@@ -973,17 +1050,189 @@
)
)
;; Winkel/Verteilung-Eingabe (Dialog 2): Winkel-Popup aus den vorher
;; Basis-Eingabe (Dialog 1, dynamische Variante) - siehe Kopfkommentar
;; des DCL-DIALOG-Abschnitts. Nur "Seite", "Motorseite" und "Geruestoption"
;; bleiben als Radio-Button-Gruppen (alle Optionen sofort sichtbar); alle
;; anderen Felder (Foerderrichtung, Fahrtrichtung, Darstellung 2D/3D) sind
;; wieder Comboboxen (popup_list), wie der uebrige Dialog. Gleiche
;; prefill-Struktur/Rueckgabe wie -popup; 'FEHLER bei technischem Fehler
;; (Dispatcher faellt dann zurueck).
(defun vfs-dialog-eingabe-basis-radio (prefill / zeilen dcl-pfad dat ergebnis
dlg-deltal dlg-deltah dlg-hoehe
dlg-richtung-idx dlg-fahrt-idx dlg-seite-idx
dlg-motorseite-idx dlg-dim-idx
dlg-geruest-einzelmodul dlg-geruest-typ-idx
deltaL deltaH richtung hz seite z-start dim
motorseite geruest-einzelmodul geruest-typ
sel-richtung sel-fahrt sel-seite sel-motorseite
sel-dim sel-geruest-typ n-geruest-typ)
;; Vorbelegte Auswahl-Indizes aus prefill ableiten - gleiche Logik wie
;; -popup, nur als Index statt als Popup-Tile-Wert.
(setq sel-richtung
(if (and prefill (equal (cdr (assoc "richtung" prefill)) "Ab")) 1 0))
(setq sel-fahrt
(if prefill
(cond ((equal (cdr (assoc "hz" prefill)) 90.0 0.1) 1)
((equal (cdr (assoc "hz" prefill)) 180.0 0.1) 2)
((equal (cdr (assoc "hz" prefill)) 270.0 0.1) 3)
(t 0))
0))
(setq sel-seite
(if (and prefill (equal (cdr (assoc "seite" prefill)) "links")) 1 0))
(setq sel-motorseite
(if (and prefill (equal (cdr (assoc "motorseite" prefill)) "links")) 1 0))
(setq sel-dim
(if (equal (cond ((cdr (assoc "dim" prefill))) ((ssg-ils-dim-aktuell))) "2D") 1 0))
(setq n-geruest-typ (length *ssg-geruest-optionen*))
(setq sel-geruest-typ
(ssg-geruest-typ-to-idx (if prefill (cdr (assoc "geruest-typ" prefill)) nil)))
(setq zeilen (list
"vfs_basis_dyn : dialog {"
" label = \"VarioFoerderer (Standard) - Eingabe\";"
" : column {"
" : boxed_column {"
" label = \"Geometrie\";"
" : row {"
" : edit_box { key = \"deltal\"; label = \"Horizontale Distanz deltaL (mm):\"; edit_width = 10; }"
" : popup_list { key = \"richtung\"; label = \"Foerderrichtung:\"; width = 16; }"
" }"
" : row {"
" : edit_box { key = \"einfuegehoehe\"; label = \"Einfuegehoehe (mm):\"; edit_width = 10; }"
" : edit_box { key = \"deltah\"; label = \"Hoehenunterschied deltaH (mm):\"; edit_width = 10; }"
" }"
" }"
" : boxed_column {"
" label = \"Ausrichtung\";"
" : popup_list { key = \"fahrtrichtung\"; label = \"Fahrtrichtung:\"; width = 30; }"
" : row {"))
(setq zeilen (append zeilen
(vfs-dcl-radio-gruppe-zeilen "seite" "Seite:"
(list (ssg-text "gf-dlg-rechts") (ssg-text "gf-dlg-links")))))
(setq zeilen (append zeilen
(vfs-dcl-radio-gruppe-zeilen "motorseite" "Motorseite:"
(list (ssg-text "gf-dlg-rechts") (ssg-text "gf-dlg-links")))))
(setq zeilen (append zeilen (list
" }"
" : popup_list { key = \"dimension\"; label = \"Darstellung (2D/3D):\"; width = 20; }"
" }"
" : boxed_column {"
" label = \"Geruest\";"
" : toggle { key = \"geruest_einzelmodul\"; label = \"Geruest fuer Einzelmodul\"; }")))
(setq zeilen (append zeilen
(vfs-dcl-radio-gruppe-zeilen "geruest_typ" "Geruestoption:" *ssg-geruest-optionen*)))
(setq zeilen (append zeilen (list
" }"
" }"
" ok_cancel;"
"}")))
(setq dcl-pfad (ssg-dcl-temp-schreiben "vfsbasis" zeilen))
(if (null dcl-pfad)
'FEHLER
(progn
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vfs_basis_dyn" dat))
(progn
(if (and dat (>= dat 0)) (unload_dialog dat))
(vl-file-delete dcl-pfad)
'FEHLER
)
(progn
(set_tile "deltal" (if prefill (rtos (cdr (assoc "deltaL" prefill)) 2 0) "15000"))
(set_tile "deltah" (if prefill (rtos (cdr (assoc "deltaH" prefill)) 2 0) "3000"))
(set_tile "einfuegehoehe" (if prefill (rtos (cdr (assoc "einfuegehoehe" prefill)) 2 1) "0"))
(start_list "richtung")
(add_list (ssg-text "vfs-dlg-richtung-auf"))
(add_list (ssg-text "vfs-dlg-richtung-ab"))
(end_list)
(set_tile "richtung" (itoa sel-richtung))
(start_list "fahrtrichtung")
(add_list (ssg-textf "gf-dlg-richtung-0" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-90" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-180" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-270" (list grad-zeichen)))
(end_list)
(set_tile "fahrtrichtung" (itoa sel-fahrt))
(set_tile (strcat "seite_" (itoa sel-seite)) "1")
(set_tile (strcat "motorseite_" (itoa sel-motorseite)) "1")
(start_list "dimension")
(add_list "3D")
(add_list "2D")
(end_list)
(set_tile "dimension" (itoa sel-dim))
(set_tile "geruest_einzelmodul"
(if (or (null prefill) (equal (cdr (assoc "geruest-einzelmodul" prefill)) "1")) "1" "0"))
(set_tile (strcat "geruest_typ_" (itoa sel-geruest-typ)) "1")
(action_tile "accept"
(strcat
"(setq dlg-deltal (get_tile \"deltal\"))"
"(setq dlg-deltah (get_tile \"deltah\"))"
"(setq dlg-hoehe (get_tile \"einfuegehoehe\"))"
"(setq dlg-richtung-idx (atoi (get_tile \"richtung\")))"
"(setq dlg-fahrt-idx (atoi (get_tile \"fahrtrichtung\")))"
"(setq dlg-seite-idx " (vfs-dcl-radio-idx-cond "seite" 2) ")"
"(setq dlg-motorseite-idx " (vfs-dcl-radio-idx-cond "motorseite" 2) ")"
"(setq dlg-dim-idx (atoi (get_tile \"dimension\")))"
"(setq dlg-geruest-einzelmodul (get_tile \"geruest_einzelmodul\"))"
"(setq dlg-geruest-typ-idx " (vfs-dcl-radio-idx-cond "geruest_typ" n-geruest-typ) ")"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(vl-file-delete dcl-pfad)
(if (= ergebnis 1)
(progn
(setq deltaL (atof dlg-deltal))
(setq deltaH (atof dlg-deltah))
(setq richtung (nth dlg-richtung-idx '("Auf" "Ab")))
(setq z-start (atof dlg-hoehe))
(setq hz (nth dlg-fahrt-idx '(0.0 90.0 180.0 270.0)))
(setq seite (nth dlg-seite-idx '("rechts" "links")))
(setq motorseite (nth dlg-motorseite-idx '("rechts" "links")))
(setq dim (nth dlg-dim-idx '("3D" "2D")))
(setq geruest-einzelmodul dlg-geruest-einzelmodul)
(setq geruest-typ (ssg-geruest-idx-to-typ dlg-geruest-typ-idx))
(list deltaL deltaH richtung z-start hz seite dim geruest-einzelmodul geruest-typ motorseite)
)
nil
)
)
)
)
)
)
;; Dispatcher: bevorzugt die dynamisch generierte Variante (Seite/
;; Motorseite/Geruestoption als Radio, Rest als Combobox - siehe
;; Kopfkommentar des DCL-DIALOG-Abschnitts), Rueckfall auf die reine
;; Popup-Variante nur bei technischem Fehler.
(defun vfs-dialog-eingabe-basis (prefill / ergebnis)
(setq ergebnis (vfs-dialog-eingabe-basis-radio prefill))
(if (eq ergebnis 'FEHLER) (vfs-dialog-eingabe-basis-popup prefill) ergebnis)
)
;; Winkel/Verteilung-Eingabe (Dialog 2, Popup-Variante): Winkel-Popup aus den vorher
;; berechneten gueltigen Varianten (gueltige-winkel/ergebnis-liste, siehe
;; berechne-alle-winkel), plus L_GF-Verteilung vorne/hinten (analog Schritt
;; 8+9 in c:VarioFoerderer).
;; prefill: Assoziationsliste ("winkel" . best-winkel) ("verteilung-idx" . "0".."3")
;; ("lgf1" . mm) - oder nil fuer Vorbelegung mit dem kleinsten gueltigen Winkel.
;; Rueckgabe: (best-winkel L_GF L_VF L_GF1 L_GF2 verteilung-modus) oder nil bei Abbruch.
(defun vfs-dialog-winkel-verteilung (gueltige-winkel ergebnis-liste staustrecke-basis prefill /
(defun vfs-dialog-winkel-verteilung-popup (gueltige-winkel ergebnis-liste staustrecke-basis prefill /
dcl-pfad dat ergebnis w eintrag idx sel-idx init-verteilung
dlg-winkel dlg-verteilung dlg-lgf1
best-winkel L_GF L_VF verteilung-modus L_GF1 L_GF2)
best-winkel L_GF L_VF verteilung-modus L_GF1 L_GF2 lgf-paar)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "variofoerderer_winkel" dat))
@@ -1052,22 +1301,8 @@
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(setq verteilung-modus dlg-verteilung)
(cond
((= verteilung-modus "0")
(setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
((= verteilung-modus "1")
(setq L_GF1 (float staustrecke-basis))
(setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "2")
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "3")
(setq L_GF1 (atof dlg-lgf1))
(if (or (null L_GF1) (< L_GF1 0)) (setq L_GF1 (/ L_GF 2.0)))
(if (> L_GF1 L_GF) (setq L_GF1 L_GF))
(setq L_GF2 (max 0.0 (- L_GF L_GF1))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(setq lgf-paar (vfs-verteilung-berechnen verteilung-modus L_GF staustrecke-basis dlg-lgf1))
(setq L_GF1 (car lgf-paar) L_GF2 (cadr lgf-paar))
(list best-winkel L_GF L_VF L_GF1 L_GF2 verteilung-modus)
)
nil
@@ -1076,6 +1311,14 @@
)
)
;; Winkel/Verteilung-Eingabe: Dialog nutzt durchgaengig Comboboxen
;; (variofoerderer_winkel in dcl/variofoerderer.dcl) - keine Radio-Variante
;; mehr noetig, da weder "winkel" noch "verteilung" als Radio bleiben
;; (siehe Kopfkommentar des DCL-DIALOG-Abschnitts).
(defun vfs-dialog-winkel-verteilung (gueltige-winkel ergebnis-liste staustrecke-basis prefill)
(vfs-dialog-winkel-verteilung-popup gueltige-winkel ergebnis-liste staustrecke-basis prefill)
)
;; ============================================================
;; XDATA-Metadaten fuer den Edit-Nachbau (App "SSG_VF_EDIT").
;; Markiert ein VF_n-INSERT als "mit dem Standard-Dialog erstellt" und
@@ -1310,6 +1553,38 @@
;; Neuanlage 0). Wer hz nicht kennt: der Wert steht in der urspruenglichen
;; Bau-Eingabe (z.B. mubea.json "hz") bzw. ergibt sich aus der Ausrichtung.
;; Bereits markierte Bloecke und Nicht-VF-Bloecke werden uebersprungen.
;; Baurichtung (hz) fuer EINEN Fund per Dialog abfragen - ersetzt den
;; frueheren getreal-Prompt in c:VARIOFOERDERER_NACHRUESTEN. "kopf" per
;; set_tile aus ssg-text befuellt (Blockname + erkannter Typ), deshalb
;; sprachunabhaengig. Rueckgabe: hz (Real) bei OK, 'ABBRUCH wenn der Nutzer
;; bewusst abbricht (Aufrufer uebernimmt dann default-hz, OHNE nochmal auf
;; der Konsole zu fragen), nil wenn der Dialog gar nicht gezeigt werden
;; konnte/durfte (GUI aus) - NUR dann faellt der Aufrufer auf den alten
;; getreal-Prompt zurueck.
(defun vfs-dialog-nachruesten-hz (bname typ default-hz / dcl-pfad dat ergebnis hz)
(if (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
(progn
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vfs_nachruesten_hz" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil)
(progn
(set_tile "kopf" (ssg-textf "vfs-nachruesten-erkannt" (list bname typ)))
(set_tile "hz" (rtos default-hz 2 1))
(action_tile "accept"
"(setq hz (distof (get_tile \"hz\") 2)) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond ((and (= ergebnis 1) hz) hz) (t 'ABBRUCH))
)
)
)
nil
)
)
(defun c:VARIOFOERDERER_NACHRUESTEN ( / ss i ent ed bname attribs xd typ hz
n-neu n-skip default-hz)
(ssg-start "VARIOFOERDERER_NACHRUESTEN" nil)
@@ -1337,8 +1612,14 @@
(if (or (assoc "GF_Bogen_R_60" attribs) (assoc "GF_Bogen_L_60" attribs))
"etage" "standard"))
(princ (ssg-textf "vfs-nachruesten-erkannt" (list bname typ)))
(setq hz (getreal (ssg-textf "vfs-nachruesten-prompt-hz" (list (rtos default-hz 2 1)))))
(if (null hz) (setq hz default-hz))
(setq hz (vfs-dialog-nachruesten-hz bname typ default-hz))
(cond
((eq hz 'ABBRUCH) (setq hz default-hz))
((null hz)
(setq hz (getreal (ssg-textf "vfs-nachruesten-prompt-hz" (list (rtos default-hz 2 1)))))
(if (null hz) (setq hz default-hz))
)
)
(setq default-hz hz)
(vf-edit-xdata-schreiben ent typ hz)
(princ (ssg-textf "vfs-nachruesten-markiert" (list (rtos hz 2 1))))