mistangl/dxfmakros
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
8be256fb5a90f2cbdfebbc8ce7c7d759ac54ecc3
dxfmakros/Lisp/vf_linienzug.lsp
T
Michael StanglandClaude Opus 4.8 8be256fb5a VF: gemeinsamen Wrapper-Rumpf vf-wrapper-bauen (Standard/Etage + Linienzug) 
vf-block-erstellen (vf_core, Standard/Etage) und vfl-block-erstellen
(vf_linienzug) hatten denselben ~25-Zeilen-Rumpf wortgleich: ATTDEFs am
Startpunkt, Entity-Sweep seit lastEnt, Sepliste sichern, ssg-block-wrap-welt,
Layer setzen, Sepliste-XDATA, Attribute setzen, ID + Dim-XDATA. Jetzt in
vf-wrapper-bauen (vf_core) zusammengefasst; beide Aufrufer bauen nur noch ihre
FERTIGE Attributliste (Standard/Etage: feste Werte; Linienzug: *vfl-acc-*-
Komma-Listen) und uebergeben sie - der Rumpf kennt die Attribut-Semantik nicht.

ATTDEF-FORMAT VEREINHEITLICHT auf den kanonischen Stil: 3 von 4 Wrapper-Bauern
(vfl-block-erstellen, Gefaellestrecke, Vario_Kette_Merge) nutzten bereits
identisch (10/11=startpunkt, 40, 70/72/74, alle am selben Punkt). vf-block-
erstellen war der Ausreisser mit Layer-0/Model-Space-Zwang, y-Dekrementierung
je Zeile und fehlenden Ausrichtungscodes - historischer Drift OHNE Effekt bei
unsichtbaren ATTDEFs (Flag 70=1, reine Attribut-Container). Standard/Etage
bauen die ATTDEFs damit jetzt im kanonischen Format.

Toter Code entfernt: *vfk-attdef-zeilenabstand* (einzige Nutzung war die
entfernte y-Dekrementierung). *vfk-attdef-texthoehe* jetzt in vf-wrapper-bauen
zentral genutzt.

Die ATTRIBUTWERTE sind unveraendert (Diff-Review: Bezeichnung wertgleich,
Etage-Bogen-Extra nur von zweitem ssg-attrib-set-on in die Hauptliste gezogen).
Verhaltensneutral fuer den Linienzug (hatte schon das kanonische Format);
fuer Standard/Etage aendert sich nur das (unsichtbare) ATTDEF-Format.

243/243 LISP-Unit-Tests gruen; Python-Suite unveraendert (11 Baseline);
Klammerbalance geprueft. Der Attribut-/Geometrie-Gleichstand von Standard/Etage
ist interaktiv in BricsCAD bzw. per SSG_RUN_ALL_TESTS gegenzupruefen.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-09-18 21:08:54 +02:00

10974 lines
590 KiB
Common Lisp
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;; ============================================================
;; VF_LINIENZUG - Gemischte Gefaellestrecke/VarioFoerderer-Kette
;; Typ "linienzug" fuer VarioFoerderer (3. Typ neben "standard"/"etage")
;; ============================================================
;; Kette: immer genau EIN AS_Element am Anfang, genau EIN ES_Element am Ende,
;; dazwischen beliebig viele Segmente. Jedes gerade Segment wird automatisch
;; klassifiziert:
;; - Endpunkt hoeher als Startpunkt -> immer VF (Gefaelle kann nicht steigen,
;; reine Schwerkraftstrecke)
;; - Endpunkt tiefer, Neigung >= 3 Grad -> reine Gefaellestrecke (GF), da 3
;; Grad im ganzen Projekt die kleinste
;; Neigung ist (Vario_Bogen_auf/ab_3)
;; - Endpunkt tiefer, Neigung < 3 Grad -> VF (zu flach fuer reine GF):
;; erst Horizontale Mitte pruefen
;; (berechne-horizontale-mitte), sonst
;; diskreten Winkel 3-51 Grad suchen
;; (berechne-alle-winkel)
;; Nach einem GF-Segment: naechstes Element nur GF-Bogen oder neue Linie.
;; Nach einem VF-Segment: naechstes Element nur Vario-Kurve oder neue Linie.
;;
;; Architektur-Entscheidung (mit Nutzer abgestimmt): eigener Befehlsablauf,
;; NICHT ueber die berechne-fn/einfuege-fn-Registry (die ist fuer ein einzelnes
;; durchgehendes Segment gedacht, nicht fuer eine interaktive Mehrsegment-Kette).
;; c:VarioFoerderer erkennt den Typ "linienzug" und dispatcht direkt hierher.
;;
;; BEKANNTE EINSCHRAENKUNGEN dieser ersten Version (bitte in BricsCAD pruefen):
;; - Vario_Kurve_*-Bloecke (data/ils/3D/) wurden bislang nirgends im Projekt
;; verwendet. Ob sie KS_EIN/KS_AUS enthalten (Voraussetzung fuer
;; insert-block-ks-to-ks) ist ungeklaert und muss beim ersten Testlauf
;; verifiziert werden.
;; - Am Uebergang GF-Segment -> VF-Segment (ueber "neue Linie", die
;; automatisch als VF eingestuft wird) kann ein sichtbarer Knick entstehen:
;; vfs-mitte-teil beginnt sein erstes Element (GF1) immer fest bei 3 Grad,
;; unabhaengig vom Neigungswinkel des vorangehenden GF-Segments.
;; - Die Fusspunkte von AS-/ES-Element (aus-dx/dz bzw. ein-dx/dz) werden vom
;; Erst- bzw. Letzt-Segment abgezogen (vfl-as-deltaL/H-korrigiert bzw. die
;; Separator+ES-Reservierung im Kettenende-Modus), damit der gepickte
;; Endpunkt vom gebauten GF/VF-Koerper exakt getroffen wird.
;; ============================================================
;; Attribut-Definitionen fuer den Linienzug-Block kommen aus dem gemeinsamen
;; Strecken-Schema in ssg_core.lsp (ssg-strecke-attrib-defs). Der TYP wird zur
;; Laufzeit bestimmt: einsegmentige GF ohne Bogen -> "Gefaellestrecke"
;; (reduziert), sonst -> "Streckengruppe" (voll, segmentweise Werte).
;; Toleranzband (Grad) um die feste 3-Grad-Neigung: liegt der natuerliche
;; Winkel eines fallenden Segments innerhalb 3+/-Toleranz, wird es als reine
;; 3-Grad-Gefaellestrecke gebaut. Steiler -> VF-ab, flacher -> VF (flach).
;; Grund: eine reine Gefaellestrecke ist nie steiler als 3 Grad.
;; Bei Bedarf empirisch anpassen.
(if (null *vfl-gf-winkel-toleranz*) (setq *vfl-gf-winkel-toleranz* 0.5))
;; Mindestlaenge (mm) fuer die 3-Grad-Gefaellestrecke GF1 am Einlauf (zwischen
;; AS und Umlenkstation). Im Linienzug sitzt die gesamte Staustrecke am Einlauf
;; (GF1 = komplettes L_GF), GF2 am Ausgang entfaellt. Faellt das berechnete
;; L_GF darunter, wird GF1 auf diesen Wert angehoben - damit der 3-Grad-
;; Anschluss immer physisch vorhanden ist.
(if (null *vfl-gf-min-laenge*) (setq *vfl-gf-min-laenge* 400.0))
;; Horizontales Budget der festen Elemente im Linienzug-VF:
;; Umlenkstation (500) + Motorstation (500) + EIN Separator am Einlauf (300)
;; = 1300 mm. Der Ausgangs-Separator entfaellt (anders als Standard-VF=1600).
(if (null *vfl-feste-horizontal*) (setq *vfl-feste-horizontal* 1300.0))
;; ============================================================
;; TEIL 0: ATTRIBUT-AKKUMULATOREN (werden waehrend des Baus gefuellt)
;; ============================================================
;; Segment-Listen werden in Bau-Reihenfolge angehaengt und spaeter
;; kommagetrennt in die Attribute geschrieben. Bogen-/Kurven-Zaehler als Alist.
(defun vfl-acc-reset ()
(setq *vfl-acc-lvf* '() ; L_VF je VF-Sub-Segment (m, String)
*vfl-acc-lgf* '() ; L_GF je GF-Segment (m, String) - inkl. GF1/GF2
*vfl-acc-gfwinkel* '() ; Neigungswinkel je GF-Segment (String, parallel zu lgf)
*vfl-acc-richtung* '() ; "Auf"/"Ab"/"horizontal" je VF-Sub-Segment
*vfl-acc-winkel* '() ; Winkel je VF-Sub-Segment (String, 0=horizontal)
*vfl-acc-motorseite* '() ; Seite ("rechts"/"links") je Motorstation
*vfl-acc-gfbogen* '() ; Alist ("L_90".n ...) GF-Boegen
*vfl-acc-variokurve* '() ; Alist ("A_90".n ...) Vario-Kurven
*vfl-ziel-punkt* nil ; Soll-ES-Punkt fuer Option-3-Ist-Ziel-Report
*vfl-acc-separator* 0 ; Anzahl eingefuegter Separatoren (300 mm)
;; "Zurueck"/"Abbrechen"-Button (siehe vfl-in-value/vfl-modus-abbruch-
;; sichern): nil (normal) / "zurueck" (letztes Glied verwerfen und neu
;; fragen) / "abbrechen" (Bau hier stoppen, Baustand bleibt stehen).
*vfl-wizard-abbruch-grund* nil
*vfl-abbruch-letztes-ent* nil))
;; Alist-Zaehler erhoehen / lesen
(defun vfl-inc-count (al key / e)
(setq e (assoc key al))
(if e (subst (cons key (1+ (cdr e))) e al) (cons (cons key 1) al)))
(defun vfl-get-count (al key / e)
(if (setq e (assoc key al)) (cdr e) 0))
;; Ein VF-Sub-Segment (Koerper) erfassen. Winkel 0 => horizontal.
(defun vfl-acc-vf-seg (richtung winkel L_VF)
(setq *vfl-acc-lvf* (append *vfl-acc-lvf* (list (rtos (/ L_VF 1000.0) 2 3))))
(setq *vfl-acc-winkel* (append *vfl-acc-winkel* (list (itoa (fix winkel)))))
(setq *vfl-acc-richtung* (append *vfl-acc-richtung*
(list (if (= (fix winkel) 0) "horizontal" richtung)))))
;; Ein GF-Segment erfassen (Laenge = Schraeglaenge in m, winkel = Neigung).
;; Gilt fuer reine GF-Chain-Segmente UND die VF-internen GF1/GF2-Anschluesse.
(defun vfl-acc-gf-seg (L_GF winkel)
(setq *vfl-acc-lgf* (append *vfl-acc-lgf* (list (rtos (/ L_GF 1000.0) 2 3))))
(setq *vfl-acc-gfwinkel* (append *vfl-acc-gfwinkel* (list (rtos (float winkel) 2 1)))))
;; Liste kommagetrennt verketten ("" bei leer).
(defun vfl-join-komma (lst / s first)
(setq s "" first t)
(foreach x lst
(if first (progn (setq s x) (setq first nil)) (setq s (strcat s "," x))))
s)
;; Gewaehlte AS-/ES-Winkelvariante ("30"/"90"). Vorgabe "90", solange der Modus
;; nichts anderes gesetzt hat (Blocknamen AS_Element_<winkel>_<seite>).
(defun vfl-as-winkel () (if (boundp '*vfl-as-winkel*) *vfl-as-winkel* "90"))
(defun vfl-es-winkel () (if (boundp '*vfl-es-winkel*) *vfl-es-winkel* "90"))
;; ============================================================
;; TEIL 0a-2: MELDUNGEN (statt alert im Bau-Pfad)
;; ============================================================
;; Ein (alert ...) im Bau-Pfad blockiert jeden nicht-interaktiven Lauf
;; (Batch-Konvertierung vfl-konvertiere-ent, Testtreiber, Spec-Bau) mit einem
;; modalen Fenster - und der Text ist zugleich die EINZIGE Auskunft darueber,
;; welche Sektion warum abgewiesen wurde. vfl-meldung sammelt ihn deshalb
;; immer ein (*vfl-meldungen*, aelteste zuerst -> Auswertung im Ergebnis-
;; Record), schreibt ihn ins Debug-Log und zeigt ihn nur dann modal, wenn die
;; GUI erlaubt ist (ssg-gui-p, ssg_core.lsp); sonst geht er auf die Konsole.
;; Interaktiv ist das Verhalten damit unveraendert.
;; NUR fuer Meldungen aus dem Bau-Pfad. Die reinen Interaktiv-Alerts (fehlende
;; DCL-Datei, "Glied nicht editierbar", "kein Journal") bleiben alert - sie
;; koennen nur bei echter Benutzerbedienung auftreten.
(if (not (boundp '*vfl-meldungen*)) (setq *vfl-meldungen* nil))
(defun vfl-meldung (txt)
;; Ein fehlender i18n-Schluessel liefert nil - dann wuerde strcat
;; hier abbrechen, und zwar in dem Moment, in dem ohnehin schon
;; etwas schiefgelaufen ist. Also abfangen statt nachtraeglich
;; suchen.
(if (null txt) (setq txt "(Meldung ohne Text)"))
(setq *vfl-meldungen* (append *vfl-meldungen* (list txt)))
(dbgmsg (strcat "MELDUNG: " txt))
(dbgflush)
(if (ssg-gui-p)
(alert txt)
(princ (strcat "\n" txt)))
txt)
;; ============================================================
;; TEIL 0a-3: HEADLESS-NOTAUSGANG
;; ============================================================
;; Bei aktivem *vfl-headless* darf keine Live-Eingabe mehr stattfinden. Eine
;; erschoepfte Replay-Queue heisst dann: die Datenquelle (aufgezeichnetes
;; Journal bzw. Spec) passt nicht zum tatsaechlichen Bau-Ablauf (Desync) - ein
;; getpoint/getreal/ssget an dieser Stelle wuerde den Batch-Lauf still
;; blockieren statt den Fehler zu zeigen. Bisher fielen die Wrapper
;; STILLSCHWEIGEND auf Live-Eingabe zurueck; genau das wird hier zum harten,
;; lokalisierten Abbruch.
;;
;; *vfl-headless-fehler* traegt danach die Fundstelle (welche Art Eingabe,
;; welches Glied, welche Eingabe-Nummer) und wird vom Aufrufer in den
;; Ergebnis-Record uebernommen. Die Texte sind reine Diagnose (kein
;; ssg-text-Key noetig), sie erscheinen im normalen Betrieb nie.
;;
;; *vfl-headless-antwort-fn*: optionaler Hook, der eine nicht vorhersagbare
;; Rueckfrage doch noch beantworten darf (Beispiel: vfl-waehle-winkel fragt
;; nur dann, wenn mehrere Winkel-Kandidaten geometrisch gueltig sind - das
;; laesst sich vorab nicht immer wissen). Der gelieferte Wert wird normal
;; journalisiert; die Ersetzung wird zusaetzlich als Meldung protokolliert,
;; damit ein solcher Lauf nie als "sauber" durchgeht.
;; Aufruf: (fn was ort) -> Wert.
(if (not (boundp '*vfl-headless*)) (setq *vfl-headless* nil))
(if (not (boundp '*vfl-headless-fehler*)) (setq *vfl-headless-fehler* nil))
(if (not (boundp '*vfl-headless-antwort-fn*)) (setq *vfl-headless-antwort-fn* nil))
(defun vfl-headless-p () (and (boundp '*vfl-headless*) *vfl-headless*))
;; Fundstelle als Text: Glied-Nummer (STEP-Marker im bisherigen Journal) und
;; Nummer der Eingabe, die JETZT faellig gewesen waere (STEP-Marker zaehlen
;; nicht mit, die entstehen beim Replay neu).
(defun vfl-headless-ort ( / steps)
(setq steps (vfl-steps-zaehlen *vfl-journal*))
(strcat "Glied " (itoa steps)
", Eingabe " (itoa (1+ (- (length *vfl-journal*) steps)))))
;; Harter Abbruch ohne Rueckfrage (kehrt NICHT zurueck, (exit) wird vom
;; vl-catch-all-apply des Aufrufers gefangen). Fuer Eingaben, bei denen ein
;; nachgelieferter Wert nicht sinnvoll waere - z.B. eine Objektauswahl: eine
;; Teilauswahl wuerde die Fragenzahl des ganzen Modus-2-Ablaufs still
;; verschieben.
(defun vfl-headless-abbruch (was / ort steps)
(setq steps (vfl-steps-zaehlen *vfl-journal*))
(setq ort (vfl-headless-ort))
(setq *vfl-headless-fehler*
(list (cons "was" was)
(cons "glied" steps)
(cons "eingabe" (1+ (- (length *vfl-journal*) steps)))
(cons "ort" ort)))
(vfl-meldung (strcat "HEADLESS-ABBRUCH: keine Eingabedaten mehr fuer ["
was "] - " ort))
(exit))
;; Wie vfl-headless-abbruch, aber der Antwort-Hook darf zuerst uebernehmen.
;; Rueckgabe dann (wert) als 1-elementige Liste - dieselbe Form wie
;; vfl-replay-pop, damit die Aufrufstelle sie unveraendert weiterverwendet.
(defun vfl-headless-notausgang (was / ort v)
(if *vfl-headless-antwort-fn*
(progn
(setq ort (vfl-headless-ort))
(setq v (vl-catch-all-apply *vfl-headless-antwort-fn* (list was ort)))
(if (vl-catch-all-error-p v) (setq v nil))
(vfl-meldung (strcat "HEADLESS: Ersatzantwort fuer [" was "] - " ort))
(list v))
(vfl-headless-abbruch was)))
;; Gemeinsame Vorbedingung aller drei Linienzug-Modi: die GF-Segmente/-Boegen
;; nutzen Funktionen aus Gefaellestrecke.lsp (gf-insert-hz-incl-scaled,
;; gf-bogen-blockname, ...). Bei reiner VarioFoerderer-Ladung ohne
;; Gefaellestrecke wuerde der GF-Zweig fehlschlagen - deshalb hier pruefen und
;; danach die AS/ES-/Bogen-Bibliothek initialisieren (init-bibliothek), falls
;; noch nicht geschehen. alert-key: modusspezifischer i18n-Text (Modus 1 ist
;; ausfuehrlicher als 2/3, daher als Parameter statt vereinheitlicht).
(defun vfl-gf-abhaengigkeit-sicherstellen (alert-key)
(if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED"))))
(progn (vfl-meldung (ssg-text alert-key)) (exit)))
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)))
;; ============================================================
;; TEIL 0b: EINGABE-JOURNAL (RECORD & REPLAY)
;; ============================================================
;; Jede interaktive Eingabe im Modus-1-Aufrufbaum laeuft ueber die Wrapper
;; vfl-in-point/-string/-real/-int. Diese arbeiten in zwei Modi:
;; Record (*vfl-replay-queue* = nil): normal fragen + in *vfl-journal* anhaengen.
;; Replay (*vfl-replay-queue* gesetzt): naechsten gespeicherten Wert liefern
;; (nicht fragen) und ebenfalls in *vfl-journal* anhaengen. Laeuft die
;; Queue leer, wird ab hier wieder live gefragt (nahtloser Uebergang).
;; Weil der Builder deterministisch bzgl. seiner Eingaben ist, reproduziert das
;; Abspielen desselben Journals exakt dieselbe Kette. *vfl-journal* wird beim
;; Replay komplett neu aufgebaut (durch die erneute Ausfuehrung), die Queue ist
;; nur Lesequelle.
;;
;; Journal-Eintrag: (kind . value) mit kind aus
;; "PT" Punkt (Liste x y z) "STR" String (auch "")
;; "REAL" Realzahl "INT" Ganzzahl
;; "NIL" Abbruch/Default (value nil) "STEP" Glied-Checkpoint (value = Label)
;; *vfl-journal* wird in UMGEKEHRTER Reihenfolge gehalten (neuestes zuerst, cons).
;; *vfl-seg-glied-letzte* = Glied-Stand nach der vorherigen Iteration der
;; Bau-Hauptschleife (fuer die Segment-XDATA, siehe vfl-segment-xdata-sichern).
;; MUSS bei jedem Journal-Start auf 0 stehen, sonst bekaeme das erste Glied
;; eines neuen Baus einen zu hohen Index und die Praeambel wuerde nicht
;; geschrieben.
(if (not (boundp '*vfl-seg-glied-letzte*)) (setq *vfl-seg-glied-letzte* 0))
;; Journal und Replay-Queue muessen auch VOR dem ersten
;; vfl-journal-reset lesbar sein: die vfl-in-*-Wrapper und die
;; Headless-Diagnose lesen sie ungeschuetzt.
(if (not (boundp '*vfl-journal*)) (setq *vfl-journal* nil))
(if (not (boundp '*vfl-replay-queue*)) (setq *vfl-replay-queue* nil))
(defun vfl-journal-reset ()
;; Sammel-Meldungen und Headless-Diagnose gehoeren zum LAUF, nicht zur
;; Sitzung - sonst tragen sie in einen neuen Bau die Befunde des alten.
(setq *vfl-meldungen* nil *vfl-headless-fehler* nil)
(setq *vfl-journal* '() *vfl-replay-queue* nil *vfl-seg-glied-letzte* 0)
(if (boundp '*vflw-pending*) (setq *vflw-pending* nil)))
;; Wie vfl-journal-reset, aber OHNE *vfl-replay-queue*/*vflw-pending*/die
;; Meldungs-Sammler zu loeschen. Fuer den Aufruf INNERHALB von
;; vf-linienzug-modus/-modus2 selbst (siehe dortige Kommentare): die
;; REPLAY-getriebenen Aufrufer (vsp-bau-aus-spec) haben *vfl-replay-queue*
;; per vfl-journal-replay-start VOR dem Aufruf absichtlich befuellt - ein
;; voller Reset hier wirft die noch unverbrauchte Queue mitten im Bau weg
;; (realer Bug: HEADLESS-ABBRUCH direkt nach der AS-Element-Praeambel,
;; obwohl die Queue laut Debug-Log noch Eintraege hatte). Der eigentliche
;; Zweck - *vfl-journal* nicht ueber mehrere Ketten derselben Sitzung
;; hinweg wachsen zu lassen - bleibt erhalten.
(defun vfl-journal-reset-lauf ()
(setq *vfl-journal* '() *vfl-seg-glied-letzte* 0))
;; Eintrag anhaengen (vorn, da Reverse-Reihenfolge).
;; Zusaetzlich (falls ein Debug-Schalter fuer die aktuelle Sitzung eine .dbg-
;; Datei geoeffnet hat, siehe ssg_dbg.lsp/dbg-schalter-open) wird jeder
;; Eintrag als FRAGE/ANTWORT-Paar mitgeloggt - da ALLE interaktiven Eingaben
;; von Modus 1 UND Modus 2 durch diesen einen Punkt laufen (vfl-in-point/
;; -string/-real/-int/-value/-selection), deckt das beide Modi komplett ab,
;; ohne jede einzelne Aufrufstelle im Bau-Ablauf separat instrumentieren zu
;; muessen. Modus 3 nutzt bewusst rohe getstring/getreal/getint (reine
;; Konsole, kein Journal) und wird stattdessen direkt in vf-linienzug-modus3
;; mit eigenen dbgmsg-Aufrufen geloggt. dbgmsg/dbg sind von sich aus No-Ops,
;; solange keine .dbg-Datei offen ist (*dbg-path* nil) - daher hier bewusst
;; UNBEDINGT aufgerufen, kein eigener An/Aus-Check noetig.
(defun vfl-journal-record (kind val)
(setq *vfl-journal* (cons (cons kind val) *vfl-journal*))
(if (= kind "STEP")
(dbgmsg (strcat "--- GLIED: " (if val (vl-princ-to-string val) "?") " ---"))
(progn
(dbgmsg (strcat "EINGABE [" kind "]:"))
(dbg val)
(dbgflush))))
;; Glied-Checkpoint setzen (Label spaeter via vfl-journal-steplabel setzbar).
(defun vfl-journal-mark (label)
(vfl-journal-record "STEP" label))
;; Label des JUENGSTEN STEP-Eintrags nachtraeglich setzen (der Segmenttyp steht
;; erst nach der Menue-Auswahl fest, der Marker sitzt aber am Iterationskopf).
(defun vfl-journal-steplabel (label / found)
(setq found nil)
(setq *vfl-journal*
(mapcar
(function (lambda (e)
(if (and (not found) (= (car e) "STEP"))
(progn (setq found t) (cons "STEP" label))
e)))
*vfl-journal*))
(dbgmsg (strcat "--- GLIED-LABEL: " (if label label "?") " ---"))
(dbgflush)
label)
;; Naechsten Eingabe-Eintrag aus der Replay-Queue poppen (STEP-Marker dabei
;; ueberspringen - die werden bei der erneuten Ausfuehrung neu erzeugt).
;; Rueckgabe: (value) als 1-elementige Liste, falls ein Eintrag da war
;; (unterscheidet einen echten nil-Wert von einer leeren Queue); nil, wenn die
;; Queue erschoepft ist (danach faellt der Wrapper auf Live-Eingabe zurueck).
(defun vfl-replay-pop ( / e)
(while (and *vfl-replay-queue* (= (car (car *vfl-replay-queue*)) "STEP"))
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*)))
(if *vfl-replay-queue*
(progn
(setq e (car *vfl-replay-queue*))
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*))
(list (cdr e)))
nil))
;; ============================================================
;; TEIL 0b-1b: GLIED-SCHEMA (single source of truth)
;; ============================================================
;; Das Journal ist und bleibt eine flache (kind . value)-Liste - das Format auf
;; der XDATA aendert sich NICHT (keine Migration noetig, Replay unveraendert).
;; Neu ist nur eine zentrale, DEKLARATIVE Beschreibung, welche Felder in welcher
;; Reihenfolge und mit welchem Typ ein Glied ausmachen. Damit gibt es genau EINE
;; Stelle, die die Struktur eines Glieds kennt - Bauen, Lesen, Validieren und
;; das Debug-Log leiten sich alle daraus ab (kein Auseinanderlaufen von je-Typ-
;; slice-bauen/slice-werte mehr, aus dem der Winkel-Bug entstand).
;;
;; Ein Feld ist: (name kind werte). name = Feldname (fuers Log), kind = Journal-
;; kind ("STR"/"INT"/"REAL"/"PT"), werte = Liste erlaubter Werte oder nil (frei).
;; Das fuehrende STEP (Glied-Checkpoint) ist NICHT Teil der Feldliste - es wird
;; von den Slice-Helfern separat vorangestellt bzw. beim Lesen uebersprungen.
;;
;; Nur die FESTEN, kurzen Glieder sind hier erfasst (AS, ES, GF-Bogen, Vario-
;; Kurve). Die VF-Einheit/Horizontal-VF ist ein variabler Dialog-Fluss mit
;; optionsabhaengiger Feldzahl - sie ist bewusst KEIN Feld-Record und wird
;; weiter direkt behandelt (nicht einzeln editierbar, siehe vfl-edit-glied).
;;
;; Feldkonventionen (wie vom bestehenden Code erzeugt):
;; seite "1"=links / "2"=rechts
;; menue fuehrende "Naechstes Element waehlen"-Antwort (nur GF-Bogen: "1")
;; winkel GF-Bogen/Vario-Kurve als INT (30/60/90), AS/ES als STR ("30"/"90")
;; GF-Bogen/Vario-Kurve-Winkel kommen zentral aus *vfk-gf-bogen-winkel*, AS/ES-
;; Winkel aus *vfk-as-es-winkel* (beide vf_konstanten.lsp) - hier nicht mehr
;; hartcodiert. Daher (list ...) statt Quote fuer die betroffenen Winkel-Slots.
;; Fallback, falls vf_konstanten (aus irgendeinem Grund) nicht geladen wurde.
(if (null *vfk-gf-bogen-winkel*) (setq *vfk-gf-bogen-winkel* '(30 60 90)))
(if (null *vfk-as-es-winkel*) (setq *vfk-as-es-winkel* '("30" "90")))
(setq *vfl-glied-schema*
(list
(cons "AS"
(list (list "winkel" "STR" *vfk-as-es-winkel*)
'("seite" "STR" ("1" "2"))))
(cons "ES"
(list (list "winkel" "STR" *vfk-as-es-winkel*)
'("seite" "STR" ("1" "2"))))
(cons "GF-Bogen"
(list '("menue" "STR" ("1"))
(list "winkel" "INT" *vfk-gf-bogen-winkel*)
'("seite" "STR" ("1" "2"))))
(cons "Vario-Kurve"
(list (list "winkel" "INT" *vfk-gf-bogen-winkel*)
'("seite" "STR" ("1" "2"))
'("variante" "STR" ("1" "2"))))))
;; --- VF-Einheit: Sub-Step-Referenz (variable Laenge) ---------------------
;; Die VF-Einheit (Linie-VF / Horizontal-VF) ist KEIN Glied mit fester Feldzahl,
;; sondern eine SCHLEIFE, die beliebig viele Sub-Segmente aneinanderhaengt, bis
;; der Nutzer "Ende" waehlt. Sie kann ausserdem Vario-Kurven ENTHALTEN. Ein
;; starres Feld-Schema wie oben passt daher nicht.
;;
;; Diese Referenz beschreibt die EINZELNEN Teilfragen, die im VF-Fluss auftreten
;; koennen - jede fuer sich ein kleiner benannter Record. Anders als bei den
;; festen Gliedern ist die REIHENFOLGE hier verzweigungsabhaengig; die Benennung
;; im Log erfolgt deshalb ueber das Wert-Muster (nicht ueber eine feste
;; Position). Zweck: lesbares Log ("VF.sep-vor = ja") + Wert-Validierung, OHNE
;; den fragilen Bau-Fluss nachzubauen. min/max = wie oft die Teilfrage je
;; VF-Einheit auftreten kann (Doku-Wert; die Schleife macht max offen = nil).
;;
;; Teilfrage kind werte min max Bedeutung
;; menue STR "3"/"4" 1 1 Hauptmenue-Wahl Linie-VF/Horizontal-VF
;; laenge DL - 1 n Reststrecke (Punktwahl -> dL)
;; zielhoehe REAL - 0 n Zielhoehe (nur Auf/Ab bzw. Linie-VF)
;; sep-vor STR "1"/"2" 0 n Separator vor (horizontaler Koerper)
;; sep-nach STR "1"/"2" 0 n Separator nach (horizontaler Koerper)
;; ist-ende STR "1"/"2"/"3" 1 n "Ist Endpunkt der Foerderer?" (Schleife)
;; naechstes-vf STR "1"/"2"/"3" 0 n Fortsetzung Horiz./Vario-Kurve/Auf-Ab
;; es-gewuenscht STR "1"/"2" 0 1 ES setzen? (nur Kettenende-Option 3)
;; variokurve.* siehe Glied "Vario-Kurve" (eingebettet moeglich)
;;
;; Fuer die Log-Benennung (vfl-schema-log-vf) reicht die Unterscheidung nach
;; Wert-Muster: eine STR mit Wert "3" ist ein 1-3-Menue-Schritt, "1"/"2" eine
;; Ja/Nein-Frage; REAL/DL sind Laenge bzw. Hoehe.
(setq *vfl-vf-substeps*
(list
'("STR-menue" "STR" ("3" "4")) ; fuehrende Menue-Wahl
'("STR-janein" "STR" ("1" "2")) ; sep-vor/-nach, es-gewuenscht
'("STR-menue3" "STR" ("1" "2" "3")))) ; ist-ende, naechstes-vf
;; Feldliste eines Glied-Typs (nil, wenn nicht im Schema - z.B. VF-Einheit).
(defun vfl-schema-felder (label) (cdr (assoc label *vfl-glied-schema*)))
(defun vfl-schema-feld-name (feld) (car feld))
(defun vfl-schema-feld-kind (feld) (cadr feld))
(defun vfl-schema-feld-werte (feld) (caddr feld))
;; Prueft EINEN Wert gegen eine Felddefinition. Rueckgabe: nil = ok, sonst ein
;; Fehlertext (fuer Log/Alert). Prueft (a) den Typ passend zum kind und (b) die
;; erlaubten Werte, falls im Feld angegeben.
(defun vfl-schema-feld-pruefen (feld val / kind werte typ-ok)
(setq kind (vfl-schema-feld-kind feld) werte (vfl-schema-feld-werte feld))
(setq typ-ok
(cond ((= kind "STR") (= (type val) 'STR))
((= kind "INT") (= (type val) 'INT))
((= kind "REAL") (or (= (type val) 'REAL) (= (type val) 'INT)))
((= kind "PT") (and (listp val) (= (length val) 3)))
(t t)))
(cond
((not typ-ok)
(strcat (vfl-schema-feld-name feld) ": erwartet " kind ", ist "
(vl-princ-to-string (type val))))
((and werte (not (member val werte)))
(strcat (vfl-schema-feld-name feld) "=" (vl-princ-to-string val)
" nicht in erlaubten Werten " (vl-princ-to-string werte)))
(t nil)))
;; Baut eine Journal-Slice aus einem Glied-Label und einer Werteliste (in
;; Feldreihenfolge). Stellt das STEP voran. AS ist ein Sonderfall (kein STEP -
;; Praeambel), daher hier NICHT erlaubt (nil-Rueckgabe). Validiert jeden Wert
;; vor dem Bauen; bei einem Fehler wird er als dbgmsg protokolliert, der Wert
;; aber trotzdem geschrieben (Sicherung geht vor - lieber ein warnendes Log als
;; ein verworfener Bau). Rueckgabe: forward-order Slice (Liste (kind . value)).
(defun vfl-schema-slice-bauen (label werte / felder out feld val fehler)
(setq felder (vfl-schema-felder label))
(if (or (null felder) (= label "AS"))
nil
(progn
(setq out (list (cons "STEP" label)))
(while felder
(setq feld (car felder) val (car werte))
(setq fehler (vfl-schema-feld-pruefen feld val))
(if fehler (dbgmsg (strcat ">> SCHEMA-WARN " label "." fehler)))
(setq out (append out (list (cons (vfl-schema-feld-kind feld) val))))
(setq felder (cdr felder) werte (cdr werte)))
out)))
;; Liest die Feldwerte aus einer Glied-Slice (STEP + Felder) in Feldreihenfolge.
;; Nimmt der Reihe nach den naechsten Eintrag, dessen kind zum jeweiligen Feld
;; passt (ueberspringt das fuehrende STEP automatisch). Fehlt ein Wert oder
;; stimmt der Typ nicht, wird der (optionale) Default aus defaults an dieser
;; Position eingesetzt. Rueckgabe: Werteliste in Feldreihenfolge.
(defun vfl-schema-slice-werte (label slice defaults / felder rest out feld val gefunden)
(setq felder (vfl-schema-felder label) rest slice out '())
(while felder
(setq feld (car felder) gefunden nil)
;; naechsten passenden Eintrag suchen (STEP und Fremdtypen ueberspringen)
(while (and rest (not gefunden))
(if (= (car (car rest)) (vfl-schema-feld-kind feld))
(setq val (cdr (car rest)) gefunden t))
(setq rest (cdr rest)))
(setq out (append out (list (if gefunden val (car defaults)))))
(setq felder (cdr felder) defaults (cdr defaults)))
out)
;; Benanntes Debug-Log fuer eine ganze Glied-Slice: statt roher [INT] value=90-
;; Zeilen die Felder als "GF-Bogen.winkel = 90". No-Op ohne offene .dbg-Datei.
;; Wird beim Sichern (vfl-segment-xdata-sichern) genutzt.
(defun vfl-schema-log-slice (label slice / felder werte feld fehler)
(setq felder (vfl-schema-felder label))
(if felder
(progn
(setq werte (vfl-schema-slice-werte label slice
(mapcar '(lambda (f) nil) felder)))
(dbgmsg (strcat ">> GLIED " label ":"))
(while felder
(setq feld (car felder))
(setq fehler (vfl-schema-feld-pruefen feld (car werte)))
(dbgmsg (strcat " " (vfl-schema-feld-name feld) " = "
(vl-princ-to-string (car werte))
(if fehler (strcat " <!! " fehler) "")))
(setq felder (cdr felder) werte (cdr werte)))
(dbgflush))))
;; Benennt einen EINZELNEN VF-Slice-Eintrag (kind . value) nach Wert-Muster
;; (siehe *vfl-vf-substeps*). Rueckgabe: (name . fehlertext-oder-nil). laufend =
;; wie oft schon eine STR gesehen wurde (die 1. STR einer VF-Einheit ist die
;; menue-Wahl "3"/"4", spaetere STR sind Ja/Nein- bzw. 1-3-Menue-Schritte).
(defun vfl-vf-substep-benennen (eintrag pos-str / kind val name fehler)
(setq kind (car eintrag) val (cdr eintrag))
(cond
((= kind "STEP") (cons "STEP" nil))
((= kind "DL") (cons "laenge" nil)) ; Punktwahl -> Reststrecke
((= kind "REAL") (cons "hoehe" nil)) ; Zielhoehe (Auf/Ab bzw. Linie-VF)
((= kind "PT") (cons "punkt" nil))
((= kind "INT") ; eingebettete Vario-Kurve
(setq fehler (vfl-schema-feld-pruefen (list "vk-winkel" "INT" *vfk-gf-bogen-winkel*) val))
(cons "variokurve.winkel" fehler))
((= kind "STR")
(cond
((= pos-str 0) ; 1. STR = fuehrende Menue-Wahl
(setq fehler (vfl-schema-feld-pruefen '("menue" "STR" ("3" "4")) val))
(cons "menue" fehler))
((member val '("3")) ; nur 1-3-Menue kann "3" sein
(cons "ist-ende/naechstes-vf" nil))
((member val '("1" "2")) ; ja/nein ODER 1-3 (1/2)
(cons "wahl(1/2)" nil))
(t (cons "str" (strcat "unerwarteter STR-Wert " (vl-princ-to-string val))))))
(t (cons kind nil))))
;; Benanntes Debug-Log fuer eine ganze VF-Einheit-Slice (variable Laenge). Statt
;; roher [STR]/[REAL]-Zeilen jede Teilfrage benannt ("VF.menue = 4",
;; "VF.laenge = 4566.7", "VF.wahl(1/2) = 2"). Validiert dabei, was validierbar
;; ist (menue-Wert, eingebettete Vario-Kurven-Winkel). No-Op ohne offene .dbg.
(defun vfl-schema-log-vf (label slice / rest e paar name fehler pos-str)
(dbgmsg (strcat ">> GLIED " label " (VF-Einheit, variable Laenge):"))
(setq rest slice pos-str 0)
(foreach e rest
(if (/= (car e) "STEP")
(progn
(setq paar (vfl-vf-substep-benennen e pos-str))
(setq name (car paar) fehler (cdr paar))
(dbgmsg (strcat " " name " = " (vl-princ-to-string (cdr e))
(if fehler (strcat " <!! " fehler) "")))
(if (= (car e) "STR") (setq pos-str (1+ pos-str))))))
(dbgflush))
;; ============================================================
;; TEIL 0b-2: WIZARD-EINGABE (DCL statt Konsole)
;; ============================================================
;; Ersetzt NUR die LIVE-Eingabe (frischer Bau) durch DCL-Dialoge
;; (dcl/vf_linienzug_wizard.dcl). Journal-Replay (Editieren bestehender
;; Ketten, vfl-edit-ent) ist UNVERAENDERT: er liefert seinen Wert ueber
;; "popped" und erreicht den Wizard-Zweig unten gar nicht erst.
;; Die ORIGINALEN Konsolen-Fragen (princ + getstring/getreal/getint an jeder
;; Aufrufstelle) bleiben vollstaendig im Code stehen (weiterhin de/en ueber
;; ssg-text/lang/*.json) - sie laufen bei *vfl-wizard-mode* = nil unveraendert
;; wie bisher. Schnell zurueckschalten: Befehl VF_WIZARD_AUS bzw.
;; (setq *vfl-wizard-mode* nil).
;; Sicherheitsnetz: jeder Wizard-Aufruf ist per vl-catch-all-apply
;; abgesichert - jeder Fehler (fehlendes DCL, kaputtes Tile etc.) faellt
;; automatisch und lautlos auf die alte Konsolen-Eingabe zurueck, es gibt
;; also keinen Abbruch-Pfad, der NUR durch den Wizard entsteht.
(if (not (boundp '*vfl-wizard-mode*)) (setq *vfl-wizard-mode* T))
(if (not (boundp '*vflw-menu-optionen*)) (setq *vflw-menu-optionen* nil))
(if (not (boundp '*vflw-menu-default*)) (setq *vflw-menu-default* 1))
(if (not (boundp '*vflw-menu-frage*)) (setq *vflw-menu-frage* nil))
;; Effektiver Wizard-Zustand: Wizard-DCL-Dialoge nur, wenn *vfl-wizard-mode*
;; gesetzt UND die GUI global nicht abgeschaltet ist (Tests: (ssg-gui-aus)).
;; Bei abgeschalteter GUI fallen alle Eingaben auf den Konsolen-/getXXX-Pfad
;; zurueck, den die Testrunner per Mock/Replay bedienen.
(defun vfl-wizard-mode-p ()
(and *vfl-wizard-mode*
(or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))))
;; Wizard-GRUPPEN-Dialoge (vflw-gruppe-*-impl) duerfen NUR bei echter Live-
;; Eingabe aufgehen - waehrend eines Journal-Replays (Editieren/Fortsetzen
;; einer bestehenden Kette, *vfl-replay-queue* gesetzt) liefern vfl-in-point/
;; -string/-real/-int/-value ihre Werte bereits stumm aus der Replay-Queue;
;; ein trotzdem geoeffneter Gruppen-Dialog wuerde einerseits unnoetig
;; blockieren und andererseits seine Antworten in *vflw-pending* ablegen, wo
;; sie NICHT konsumiert werden (die Wrapper pruefen die Replay-Queue zuerst)
;; und liegen bleiben - sobald die Replay-Queue erschoepft ist und auf Live-
;; Eingabe umgeschaltet wird, liest der naechste Wrapper diese laengst
;; veralteten, falsch typisierten Werte statt neu zu fragen (siehe
;; vfl-neue-linie-messen: fuehrte zu einem String-statt-Punkt-Absturz).
(defun vfl-wizard-aktiv () (and (vfl-wizard-mode-p) (null *vfl-replay-queue*)))
(defun c:VF_WIZARD_AN ()
(setq *vfl-wizard-mode* T)
(princ "\nVF-Linienzug-Assistent: EIN (DCL-Dialoge)")
(princ))
(defun c:VF_WIZARD_AUS ()
(setq *vfl-wizard-mode* nil)
(princ "\nVF-Linienzug-Assistent: AUS (Konsolen-Fragen)")
(princ))
(defun vflw-dcl-pfad ()
(strcat (vl-string-translate "\\" "/" (getenv "DXFM_DCL")) "/vf_linienzug_wizard.dcl"))
;; Text fuer Dialog-Anzeige (Kopfzeile ODER Popup-Listen-Option) saeubern:
;; fuehrende Newlines/Leerzeichen entfernen, DANACH ein fuehrendes
;; Konsolen-Ziffernpraefix wie "1 - " (aus "1 - 90 Grad", "2 - Links" usw.)
;; abschneiden - im Dialog klickt der Nutzer die Option, die Ziffer braucht
;; er nur an der Kommandozeile. Die Ziffer/der Index selbst wird davon nicht
;; beruehrt: Popup-Auswahl und Pending-Queue arbeiten weiterhin ueber die
;; Listenposition (get_tile "..." liefert einen 0-basierten Index), nicht
;; ueber diesen Anzeigetext. Kopfzeilen-Texte beginnen nie mit einer Ziffer
;; und sind von diesem zweiten Schritt daher unberuehrt.
(defun vflw-clean (s / i n)
(while (and (> (strlen s) 0) (member (substr s 1 1) (list "\n" " ")))
(setq s (substr s 2)))
(setq n (strlen s) i 1)
(while (and (<= i n) (wcmatch (substr s i 1) "#")) (setq i (1+ i)))
(if (> i 1)
(progn
(while (and (<= i n) (= (substr s i 1) " ")) (setq i (1+ i)))
(if (and (<= i n) (= (substr s i 1) "-"))
(progn
(setq i (1+ i))
(while (and (<= i n) (= (substr s i 1) " ")) (setq i (1+ i)))
(setq s (substr s i))))))
s)
;; Generischer Zahlen-Dialog (ersetzt getreal). Rueckgabe: reale Zahl oder
;; nil (Abbruch/leer - wie getreal bei blossem Enter, von den Aufrufern
;; bereits ueberall mit einem Default abgefangen).
(defun vflw-zahl-impl (prompt / dat dcl-pfad dlg-wert ergebnis)
(setq dcl-pfad (vflw-dcl-pfad))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vflw_zahl" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil)
(progn
(set_tile "kopf" (vflw-clean prompt))
(action_tile "accept" "(setq dlg-wert (get_tile \"wert\")) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "back" "(done_dialog 2)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((and (= ergebnis 1) dlg-wert (> (strlen dlg-wert) 0)) (atof dlg-wert))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck") nil)
((= ergebnis 0) (setq *vfl-wizard-abbruch-grund* "abbrechen") nil)
(t nil)))))
(defun vflw-zahl (prompt / r)
(setq r (vl-catch-all-apply 'vflw-zahl-impl (list prompt)))
(if (vl-catch-all-error-p r) (getreal prompt) r))
;; Generischer Auswahl-Dialog (ersetzt eine princ-Menue-Liste + getstring/
;; getint). optionen = Liste bereits lokalisierter Options-Texte,
;; default-idx = 1-basiert vorselektiert. Rueckgabe: "1".."N" (String, wie
;; getstring) oder "" (Abbruch/leer - faellt bei den Aufrufern ueberall auf
;; den bestehenden Default-Zweig zurueck, genau wie ein leeres Enter heute).
(defun vflw-wahl-impl (prompt optionen default-idx / dat dcl-pfad dlg-opt ergebnis opt)
(setq dcl-pfad (vflw-dcl-pfad))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vflw_wahl" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) "")
(progn
(set_tile "kopf" (vflw-clean prompt))
(start_list "opts")
(foreach opt optionen (add_list (vflw-clean opt)))
(end_list)
(set_tile "opts" (itoa (max 0 (1- (if default-idx default-idx 1)))))
(action_tile "accept" "(setq dlg-opt (get_tile \"opts\")) (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) (itoa (1+ (atoi dlg-opt))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck") "")
(t (setq *vfl-wizard-abbruch-grund* "abbrechen") "")))))
(defun vflw-wahl (prompt optionen default-idx / r)
(setq r (vl-catch-all-apply 'vflw-wahl-impl (list prompt optionen default-idx)))
(if (vl-catch-all-error-p r) "" r))
;; ============================================================
;; TEIL 0b-4: GRUPPEN-DIALOGE - GEMEINSAME PUNKTWAHL-BAUSTEINE
;; ============================================================
;; Punktwahl aus einem offenen Dialog heraus: (getpoint) direkt aus einem
;; action_tile-Callback funktioniert in BricsCAD NICHT zuverlaessig (der
;; Dialog behaelt den Fokus, die Zeichnung reagiert nicht auf Klicks - per
;; Test bestaetigt). Stattdessen das robuste "Schliessen-Picken-Neu-Zeigen"-
;; Muster: der Pick-Button beendet den Dialog ueber einen eigenen
;; done_dialog-Code (2), NACH dem unload_dialog laeuft (getpoint) ganz
;; normal auf der Kommandozeile, danach wird der Dialog mit dem Ergebnis neu
;; aufgebaut (new_dialog erneut) - eine (while ...)-Schleife um new_dialog/
;; start_dialog statt eines einmaligen Aufrufs.
(defun vflw-g-punkt-str (pt)
(strcat "X=" (rtos (car pt) 2 1) " Y=" (rtos (cadr pt) 2 1) " Z=" (rtos (caddr pt) 2 1)))
;; ------------------------------------------------------------
;; Gruppe "Punkt+Hoehe": ein Punkt gefolgt von einer davon abhaengigen
;; Hoehen-Zahl (Default = Z des gepickten Punkts, wie im Original-Prompt).
;; Wiederverwendet fuer Modus 1 "Kettenstart" (Startpunkt+Starthoehe) UND
;; Modus 2 "Startpunkt/Endpunkt" (jeweils +Hoehe) - kopf-key/wlabel-text pro
;; Aufruf. Original-Reihenfolge/-Journal an jeder Aufrufstelle: vfl-in-point,
;; dann vfl-in-real - bleibt unveraendert, nur die Werte kommen aus der
;; Pending-Queue.
(defun vflw-gruppe-punkt-hoehe-impl (kopf-key wlabel-text /
dat dcl-pfad ergebnis gpunkt gwert wert-akt fertig)
(setq wert-akt "0" fertig nil)
(while (not fertig)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_punkt_zahl" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) (setq fertig t))
(progn
(set_tile "kopf" (vflw-clean (ssg-text kopf-key)))
(set_tile "wlabel" wlabel-text)
(set_tile "wert" wert-akt)
(if gpunkt (set_tile "pt_anzeige" (vflw-g-punkt-str gpunkt)))
(action_tile "pick" "(done_dialog 2)")
(action_tile "accept" "(setq gwert (get_tile \"wert\")) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
;; Code 3 statt 2 - 2 ist hier schon durch "Punkt waehlen..." belegt.
(action_tile "back" "(done_dialog 3)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((= ergebnis 2)
;; Dialog ist jetzt zu - Zeichnung hat den Fokus, getpoint geht normal.
(setq gpunkt (vfl-getpoint nil "\nPunkt waehlen: "))
(if gpunkt (setq wert-akt (rtos (caddr gpunkt) 2 1)))
;; fertig bleibt nil -> Schleife zeigt den Dialog mit dem Ergebnis erneut.
)
((= ergebnis 1)
(setq fertig t)
(if (and gpunkt gwert (> (strlen gwert) 0))
(vflw-pending-push-all (list gpunkt (atof gwert)))))
((= ergebnis 3) (setq fertig t) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq fertig t) (setq *vfl-wizard-abbruch-grund* "abbrechen")))
)
)
)
(princ))
;; ------------------------------------------------------------
;; Gruppe "AS-/ES-Element": Ja/Nein + [wenn Ja] Winkel(30/90) + Seite.
;; Wiederverwendet fuer Modus 1 UND Modus 2, jeweils fuer AS (Kettenanfang)
;; UND ES (Kettenende) - kopf-key pro Aufruf traegt die konkrete Frage; die
;; Winkel/Seite-Optionen sind in allen vier Faellen identisch (90/30 bzw.
;; links/rechts), "Nein" ist journalseitig immer "2" (identischer Vergleich
;; im Aufrufer-Code) - beides braucht daher keinen eigenen Parameter.
;; Original-Reihenfolge/-Journal: vfl-in-string (Ja/Nein), dann bei Ja
;; vfl-in-value (Winkel) + vfl-in-string (Seite) - bleibt unveraendert.
(defun vflw-gruppe-as-impl (kopf-key / dat dcl-pfad ergebnis gsetzen gwinkel gseite)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_as" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text kopf-key)))
(set_tile "setzen" "1")
(set_tile "winkel_90" "1")
(set_tile "seite_links" "1")
(action_tile "setzen"
"(mode_tile \"winkel_90\" (if (= (get_tile \"setzen\") \"1\") 0 1))
(mode_tile \"winkel_30\" (if (= (get_tile \"setzen\") \"1\") 0 1))
(mode_tile \"seite_links\" (if (= (get_tile \"setzen\") \"1\") 0 1))
(mode_tile \"seite_rechts\" (if (= (get_tile \"setzen\") \"1\") 0 1))")
(action_tile "accept"
"(setq gsetzen (get_tile \"setzen\"))
(setq gwinkel (if (= (get_tile \"winkel_30\") \"1\") \"30\" \"90\"))
(setq gseite (if (= (get_tile \"seite_rechts\") \"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)
(if (= gsetzen "1")
;; Winkel-Slot wird von vfl-in-value (AS-Winkel, ueber
;; vf-frage-element-winkel) konsumiert - der erwartet direkt
;; "30"/"90", NICHT den Auswahl-Index wie beim Seite-Slot.
(vflw-pending-push-all (list "1" gwinkel gseite))
(vflw-pending-push-all (list "2"))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; ------------------------------------------------------------
;; Gruppe "Winkel+Seite": GF-Bogen (3 Winkel-Optionen) ODER ES-Element am
;; Kettenende (2 Winkel-Optionen). Original-Reihenfolge/-Journal:
;; vfl-menu-winkel/vfl-in-value (Winkel), dann vfl-in-string (Seite).
;; winkel-werte: Liste der zu den Optionen gehoerenden WINKELWERTE, in der
;; Reihenfolge der Labels - GF-Bogen (30 60 90), ES ("90" "30"). Der Winkel
;; wird IMMER als echter Wert in die Pending-Queue geschrieben (nie als Index),
;; damit Journal/Log selbsterklaerend sind. GF-Bogen legt Zahlen ab (vom
;; vfl-menu-winkel/vfl-in-value als "INT" journalisiert), ES Strings "90"/"30".
(defun vflw-gruppe-winkel-seite-impl (kopf-key winkel-optionen winkel-werte /
dat dcl-pfad ergebnis gwinkel-grad gseite
mit-60 dlg-name)
;; 60 Grad ist NUR beim GF-Bogen/Vario-Kurve eine gueltige Option - bei
;; AS/ES (winkel-werte immer nur ("90" "30")) waere ein staendig
;; ausgegrautes "60 Grad" verwirrend, daher ein eigener 2-Optionen-Dialog
;; OHNE die Kachel statt mode_tile-Deaktivierung (siehe DCL-Kommentar).
(setq mit-60 (vfl-winkel-in-liste-p 60 winkel-werte))
(setq dlg-name (if mit-60 "vflw_winkel_seite" "vflw_winkel_seite_30_90"))
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog dlg-name dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text kopf-key)))
(if mit-60
(progn
(if (not (vfl-winkel-in-liste-p 30 winkel-werte)) (mode_tile "winkel_30" 1))
(if (not (vfl-winkel-in-liste-p 90 winkel-werte)) (mode_tile "winkel_90" 1))
)
)
(set_tile (strcat "winkel_" (itoa (vfl-winkel-als-zahl (car winkel-werte)))) "1")
(set_tile "seite_links" "1")
(action_tile "accept"
(if mit-60
"(setq gwinkel-grad (cond ((= (get_tile \"winkel_30\") \"1\") 30)
((= (get_tile \"winkel_60\") \"1\") 60)
(t 90)))
(setq gseite (if (= (get_tile \"seite_rechts\") \"1\") \"2\" \"1\"))
(done_dialog 1)"
"(setq gwinkel-grad (if (= (get_tile \"winkel_30\") \"1\") 30 90))
(setq gseite (if (= (get_tile \"seite_rechts\") \"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)
;; Original-Eintrag aus winkel-werte uebernehmen (nicht den nackten
;; Grad-Wert) - erhaelt den Typ (INT fuer GF-Bogen, STR fuer ES).
(vflw-pending-push-all
(list (car (vl-remove-if-not
(function (lambda (w) (= (vfl-winkel-als-zahl w) gwinkel-grad)))
winkel-werte))
gseite)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; Nur Winkel (30/90), OHNE Seite - fuer "QC Linie mit GF" (vfl-qc-linie-
;; mit-gf): deren ES-Seite = AS-Seite ist bereits erzwungen, eine Seiten-
;; Frage im selben Dialog waere irrefuehrend. Schiebt "90"/"30" (den
;; AUFGELOESTEN Wert, kein Index - vf-frage-element-winkel wird beim
;; Pending-Konsum NICHT mehr durchlaufen) in die Pending-Queue.
(defun vflw-gruppe-qc-winkel-impl (kopf-key / dat ergebnis gwinkel)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_qc_winkel" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text kopf-key)))
(action_tile "accept"
"(setq gwinkel (if (= (get_tile \"winkel_30\") \"1\") \"30\" \"90\"))
(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) (vflw-pending-push-all (list gwinkel)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; ------------------------------------------------------------
;; Gruppe "Vario-Kurve": Winkel(90/60/30) + Seite + Variante(aussen/innen).
;; Reihenfolge/Journal: vfl-menu-winkel (Winkel als ECHTER Wert 90/60/30, als
;; INT journalisiert - kein Index mehr), vfl-in-string (Seite), vfl-in-string
;; (Variante).
(defun vflw-gruppe-variokurve-impl ( / dat dcl-pfad ergebnis gwinkel gseite gvariante)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_variokurve" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-variokurve-winkel-header")))
(set_tile "winkel_90" "1")
(set_tile "seite_links" "1")
(set_tile "variante_innen" "1")
(action_tile "accept"
"(setq gwinkel (cond ((= (get_tile \"winkel_30\") \"1\") 30)
((= (get_tile \"winkel_60\") \"1\") 60)
(t 90)))
(setq gseite (if (= (get_tile \"seite_rechts\") \"1\") \"2\" \"1\"))
(setq gvariante (if (= (get_tile \"variante_innen\") \"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) (vflw-pending-push-all (list gwinkel gseite gvariante)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; ------------------------------------------------------------
;; Gruppe "Gefaelle festlegen" (Linie GF): Modus(Hoehe/Winkel) + EIN
;; Wertfeld (Beschriftung wechselt mit dem Modus). KEIN Punkt-Feld: die
;; Laenge/Fahrtrichtung ist an der Aufrufstelle bereits VOR dieser Gruppe
;; ueber vfl-neue-linie-messen/vfl-in-abstand als deltaL/hz ermittelt (nur
;; noch ein Skalarpaar, kein Punkt mehr - siehe Kommentar bei
;; vfl-in-abstand) - dessen Z-Konzept existiert nicht mehr, "Hoehe" hier ist
;; ein eigener, unabhaengiger Zahlenwert. Original-Reihenfolge/-Journal ab hier:
;; vfl-in-string (Modus), danach vfl-in-real (Winkel ODER Hoehe).
;; nur-winkel: T fuer den "Zielhoehe zuerst festlegen"-Zweig von "Neue Linie:
;; GF" (Zielhoehe ist dort BEREITS fix, deltaL wird erst aus Winkel+Hoehe
;; berechnet) - "Gegebene Hoehe" ergibt dann keinen Sinn mehr und wird per
;; mode_tile gesperrt, der Hinweistext zeigt stattdessen, dass deltaL
;; berechnet wird. Konventionswahl dieses Projekts (siehe vf-linienzug-modus,
;; wahl="Linie-GF"): Option "1" = Hoehe, Option "2" = Winkel - Hoehe ist
;; daher hier Default, nicht der DCL-eigene value="1" bei modus_winkel.
;; winkel-als-default: T, wenn (bei nicht gesperrter Hoehe-Option) trotzdem
;; der Neigungswinkel statt der Zielhoehe vorausgewaehlt sein soll - genutzt
;; von der Aufrufstelle "Zielhoehe zuerst" (die dortige Nachfrage ist zwar
;; textlich "Hoehe zuerst", die pragmatische Standard-Antwort ist aber meist
;; der direkt vorgegebene Neigungswinkel).
(defun vflw-gruppe-gefaelle-impl (hoehe-default nur-winkel winkel-als-default /
dat dcl-pfad ergebnis gmodus gwert winkel-default)
(setq winkel-default (ssg-cfg-or "vario" "gefaelle_winkel" 3))
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_gefaelle" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-gefaelle-festlegen-header")))
(cond
(nur-winkel
(set_tile "modus_winkel" "1")
(set_tile "wlabel" "Neigungswinkel (Grad):")
(set_tile "wert" (rtos (float winkel-default) 2 1))
(mode_tile "modus_hoehe" 1)
(set_tile "hinweis" (ssg-text "vfl-gf-hinweis-laenge-berechnet")))
(winkel-als-default
(set_tile "modus_winkel" "1")
(set_tile "wlabel" "Neigungswinkel (Grad):")
(set_tile "wert" (rtos (float winkel-default) 2 1)))
(t
(set_tile "modus_hoehe" "1")
(set_tile "wlabel" "Zielhoehe (Z, mm):")
(set_tile "wert" (rtos hoehe-default 2 1))))
;; Wertfeld MUSS beim Moduswechsel mit umschalten - sonst steht dort
;; nach dem Wechsel noch der Wert des vorherigen Modus (Hoehe/Winkel
;; sind nicht dieselbe Groesse, ein stehengebliebener Hoehenwert waere
;; als Neigungswinkel unsinnig).
(action_tile "modus_hoehe"
"(set_tile \"wlabel\" \"Zielhoehe (Z, mm):\")
(set_tile \"wert\" (rtos hoehe-default 2 1))")
(action_tile "modus_winkel"
"(set_tile \"wlabel\" \"Neigungswinkel (Grad):\")
(set_tile \"wert\" (rtos (float winkel-default) 2 1))")
(action_tile "accept"
"(setq gmodus (if (= (get_tile \"modus_winkel\") \"1\") \"2\" \"1\"))
(setq gwert (get_tile \"wert\")) (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)
(if nur-winkel
(vflw-pending-push-all (list (atof gwert)))
(vflw-pending-push-all (list gmodus (atof gwert)))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; "Neue Linie: GF" - Vorfrage "Wie soll die Laenge bestimmt werden?"
;; (Endpunkt/Zielhoehe/Steigende GF). Die verschachtelte Unterfrage bei
;; Zweig C (Endpunkt vs. Zielhoehe, nur 2 Optionen) hat einen EIGENEN,
;; separaten Dialog (vflw-gruppe-gf-steigend-untermodus-impl, weiter unten) -
;; der 3-Optionen-Dialog hier waere dort irrefuehrend (dritte Kachel
;; "Steigend" existiert in diesem Kontext gar nicht mehr).
(defun vflw-gruppe-gf-laenge-modus-impl ( / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_gf_laenge_modus" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-gf-laenge-modus-header")))
(action_tile "accept"
"(setq gwahl (cond ((= (get_tile \"modus_hoehe\") \"1\") \"2\")
((= (get_tile \"modus_steigend\") \"1\") \"3\")
((= (get_tile \"modus_qc\") \"1\") \"4\")
(t \"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) (vflw-pending-push-all (list gwahl)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; Zweig C ("Steigende GF") Unterfrage Endpunkt/Zielhoehe - dieselben 2
;; Optionen wie vflw-gruppe-gf-laenge-modus-impl, aber ohne die 3. Kachel
;; "Steigend" (siehe dcl/vf_linienzug_wizard.dcl, vflw_gf_steigend_untermodus).
;; Lief bisher mangels eigenem Dialog auf den generischen Dropdown-Fallback
;; (vflw-wahl) hinaus.
(defun vflw-gruppe-gf-steigend-untermodus-impl ( / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_gf_steigend_untermodus" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-gf-laenge-modus-header")))
(action_tile "accept"
"(setq gwahl (if (= (get_tile \"modus_hoehe\") \"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) (vflw-pending-push-all (list gwahl)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; "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)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_sep_gf" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-sep-gf-header")))
(set_tile "sepvor" "0")
(set_tile "sepnach" "0")
(action_tile "accept"
"(setq gsepvor (get_tile \"sepvor\")) (setq gsepnach (get_tile \"sepnach\")) (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)
(vflw-pending-push-all
(list (if (= gsepvor "1") "1" "2") (if (= gsepnach "1") "1" "2"))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; ------------------------------------------------------------
;; Gruppe "Ziel-Hoehe": NUR die Hoehen-Zahl (kein Punkt-Feld). Wiederverwendet
;; an mehreren Stellen (Linie-VF, VF-Einheit-Fortsetzung "Auf/Ab",
;; vfl-body-abschluss). Die Segmentlaenge ist an der Aufrufstelle bereits
;; separat ueber vfl-neue-linie-messen/vfl-in-abstand als deltaL (Skalar,
;; kein Punkt mehr) ermittelt - die Hoehe hier ist eine davon unabhaengige
;; Zahl (Default = aktuelle Kettenhoehe, wie im Original-Prompt). Nutzt
;; bewusst den generischen Einzel-Dialog vflw_zahl (kein Punkt-Button, der
;; faelschlich eine hier moegliche Punktwahl suggerieren wuerde).
;; hoehe-default: entweder eine Zahl (aktuelle Kettenhoehe, alte Vorbelegung -
;; die bei direkter Uebernahme immer als deltaH=0 abgelehnt wird), ODER eine
;; Liste (hoehe-ab hoehe-auf hoehe-kette [hoehe-pick]) mit zwei baubaren
;; Vorschlaegen (siehe vfl-vf-hoehe-vorschlaege/vfl-segment-hoehe-vorschlaege)
;; - dann zeigt der Kopftext beide Richtungen. Vorbelegt wird, in dieser
;; Reihenfolge: hoehe-pick (die tatsaechliche Z-Hoehe des zuvor per Objektfang
;; gepickten Endpunkts, siehe *vfl-letzter-pick-z*/vfl-hoehe-endpunkt-abfragen
;; - der Nutzer hat damit meist schon die gewuenschte Zielhoehe angeklickt),
;; sonst die Ab-Variante (haeufigerer Fall, siehe vfl-segment-entscheidung).
;; Ist weder hoehe-pick noch hoehe-ab vorhanden, faellt die Vorbelegung auf
;; die unveraenderte Kettenhoehe zurueck (altes Verhalten) plus Warnhinweis.
(defun vflw-gruppe-ziel-hoehe-impl (hoehe-default / dat dcl-pfad ergebnis dlg-wert
zwei-werte hoehe-ab hoehe-auf hoehe-kette
hoehe-pick vorbelegt)
(setq zwei-werte (listp hoehe-default))
(if zwei-werte
(progn
(setq hoehe-ab (nth 0 hoehe-default) hoehe-auf (nth 1 hoehe-default))
(setq hoehe-kette (nth 2 hoehe-default) hoehe-pick (nth 3 hoehe-default))
(setq vorbelegt (cond (hoehe-pick hoehe-pick) (hoehe-ab hoehe-ab) (t hoehe-kette))))
(setq vorbelegt hoehe-default))
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_zahl" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf"
(vflw-clean
(cond
((and zwei-werte hoehe-ab hoehe-auf hoehe-pick)
(ssg-textf "vfl-prompt-hoehe-endpunkt-3"
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1) (rtos hoehe-pick 2 1))))
((and zwei-werte hoehe-ab hoehe-auf)
(ssg-textf "vfl-prompt-hoehe-endpunkt-2"
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1))))
(t (ssg-textf "vfl-prompt-hoehe-endpunkt" (list (rtos vorbelegt 2 1)))))))
(set_tile "wert" (rtos vorbelegt 2 1))
(action_tile "accept" "(setq dlg-wert (get_tile \"wert\")) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "back" "(done_dialog 2)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((and (= ergebnis 1) dlg-wert (> (strlen dlg-wert) 0))
(vflw-pending-push-all (list (atof dlg-wert))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
((= ergebnis 0) (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; ============================================================
;; TEIL 0b-4a: WEITERE GRUPPEN-DIALOGE (Modus 1, Radio-Buttons statt Dropdown)
;; ============================================================
;; Text in maximal max-zeilen Zeilen von je hoechstens max-len Zeichen
;; umbrechen (an Wortgrenzen; bereits vorhandene "\n" bleiben als Zeilenumbruch
;; erhalten) - fuer DCL-text-Tiles, die selbst NICHT automatisch umbrechen
;; (einzeiliges Tile, laengerer Text wird sonst stillschweigend abgeschnitten -
;; siehe vflw-gruppe-ja-nein-impl). Ueberzaehlige Zeilen werden auf eine "..."-
;; Zeile gekuerzt statt verworfen, damit sichtbar bleibt, dass Text fehlt.
(defun vflw-umbruch-zeilen (text max-len max-zeilen / roh-zeilen zeilen woerter aktuelle i gekuerzt)
(setq roh-zeilen (vfl-kette-split text "\n"))
(setq zeilen '())
(foreach roh roh-zeilen
(setq woerter (vfl-kette-split roh " ") aktuelle nil)
(foreach wort woerter
(cond
((= wort ""))
((null aktuelle) (setq aktuelle wort))
((<= (+ (strlen aktuelle) 1 (strlen wort)) max-len)
(setq aktuelle (strcat aktuelle " " wort)))
(t (setq zeilen (append zeilen (list aktuelle)))
(setq aktuelle wort))))
(setq zeilen (append zeilen (list (if aktuelle aktuelle "")))))
(if (> (length zeilen) max-zeilen)
(progn
(setq gekuerzt '() i 0)
(repeat (1- max-zeilen)
(setq gekuerzt (append gekuerzt (list (nth i zeilen))) i (1+ i)))
(setq zeilen (append gekuerzt (list "...")))))
zeilen)
;; ------------------------------------------------------------
;; Generische Ja/Nein-Rueckfrage (2 Radio-Buttons, dynamischer Kopftext ueber
;; MEHRERE Zeilen - siehe vflw-umbruch-zeilen, ein einzelnes text-Tile schneidet
;; laengere Hinweise sonst ab) - wiederverwendet ueberall dort, wo bisher eine
;; einzelne Ja/Nein-Frage auf den generischen Dropdown (vflw_wahl)
;; zurueckgefallen waere, z.B. "trotzdem mit Mindestlaenge bauen?"
;; (Zu-kurz-Nachfrage in vfl-baue-horizontal-koerper).
(defun vflw-gruppe-ja-nein-impl (kopf-txt / dat ergebnis gwahl zeilen zeile i dlg-name max-zeilen)
;; Zeilenzahl VOR new_dialog ermitteln - waehlt eine von drei Groessen-
;; varianten (1/3/6 Kopf-Zeilen), damit kurze Hinweise nicht mit leeren
;; Zeilen aufgeblaeht werden (siehe Kommentar bei den vflw_ja_nein_*-
;; Dialogen im DCL).
(setq zeilen (vflw-umbruch-zeilen (vflw-clean kopf-txt) 70 6))
(cond
((<= (length zeilen) 1) (setq dlg-name "vflw_ja_nein_1" max-zeilen 1))
((<= (length zeilen) 3) (setq dlg-name "vflw_ja_nein_3" max-zeilen 3))
(t (setq dlg-name "vflw_ja_nein_6" max-zeilen 6)))
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog dlg-name dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(setq i 1)
(foreach zeile zeilen
(set_tile (strcat "kopf" (itoa i)) zeile)
(setq i (1+ i)))
(while (<= i max-zeilen) (set_tile (strcat "kopf" (itoa i)) "") (setq i (1+ i)))
;; Default "Nein" (nicht der DCL-eigene "Ja"-Default): alle bisherigen
;; Aufrufstellen (Separator-Zusatzfragen) haben auch im Konsolen-Pfad
;; "Nein" als Vorgabe (vfl-menu default-idx=2).
(set_tile "wahl_nein" "1")
(action_tile "accept" "(setq gwahl (get_tile \"wahl_nein\")) (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)
;; Konsolen-Echo: im Wizard-Modus kommt die Antwort aus dem Dialog,
;; nicht aus einer getippten Konsolen-Eingabe - ohne dieses Echo
;; steht im (Debug-)Log/Konsolen-Log nirgends, was hier gewaehlt
;; wurde.
(princ (ssg-textf "vfl-wizard-antwort-echo"
(list (ssg-text (if (= gwahl "1") "vfl-antwort-nein" "vfl-antwort-ja")))))
(vflw-pending-push-all (list (if (= gwahl "1") "2" "1"))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; Generische Auf/Ab-Richtungsfrage (2 Radio-Buttons, dynamischer Kopftext) -
;; wiederverwendet fuer die Kletter-Teilstrecke ohne Zielhoehe, sowohl
;; "Naechstes im VF" als auch "Neue Linie: Ab/Auf VF" mit reduziertem
;; Eingang.
(defun vflw-gruppe-richtung-impl (kopf-txt / dat ergebnis grichtung)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_richtung" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean kopf-txt))
(set_tile "richtung_auf" "1")
(action_tile "accept" "(setq grichtung (get_tile \"richtung_ab\")) (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) (vflw-pending-push-all (list (if (= grichtung "1") "2" "1"))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; Startpunkt-Typ (kein eindeutiger GF-/VF-Baustein per KS_AUS-Scan erkannt,
;; siehe vfl-eingang-modus-bestimmen): EINE flache 3-Optionen-Frage (direkt
;; Umlenkstation / GF-Stueck+Umlenkstation / ohne Umlenkstation) statt
;; verschachtelter Zwei-Schritt-Abfrage.
(defun vflw-gruppe-startpunkt-typ-impl ( / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_startpunkt_typ" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-textf "vfl-frage-startpunkt-typ" (list (rtos *vfl-gf-min-laenge* 2 0)))))
(set_tile "eingang_direkt" "1")
(action_tile "accept"
"(setq gwahl (cond ((= (get_tile \"eingang_stumpf\") \"1\") \"2\")
((= (get_tile \"eingang_ohne\") \"1\") \"3\")
(t \"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) (vflw-pending-push-all (list gwahl)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; "Ist das Kettenende?" (2-Optionen-Variante: Ja-Separator+ES / Nein-
;; weiterbauen) - vfl-vf-einheit-abschluss.
(defun vflw-gruppe-ist-kettenende-2opt-impl ( / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_ist_kettenende_2opt" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-ist-kettenende-frage")))
(action_tile "accept" "(setq gwahl (get_tile \"wahl_ja\")) (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) (vflw-pending-push-all (list (if (= gwahl "1") "1" "2"))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; --- Modus 2: Lauf-Abschluss (NUR wenn der VF-Lauf das Pfadende ist) ---
;; "1"=ohne Motorstation (offenes Ende) / "2"=Motorstation setzen (kein ES) /
;; "3"=Motorstation + ES-Element (Kettenende). Plain ok_cancel wie alle
;; anderen Modus-2-Segment-Dialoge - kein Zurueck/Abbrechen-Mechanismus.
;; es-frueh-abgelehnt: die Upfront-Frage ("ES-Element setzen?") wurde bereits
;; mit "Nein" beantwortet - Option 3 dann deaktivieren, sonst widerspricht sie
;; der schon getroffenen Entscheidung (Nutzer-Feedback).
(defun vflw-m2-lauf-abschluss-impl (kopf-txt es-frueh-abgelehnt / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_m2_lauf_abschluss" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean kopf-txt))
(set_tile "abschluss_motor" "1")
(if es-frueh-abgelehnt (mode_tile "abschluss_motor_es" 1))
(action_tile "accept"
"(setq gwahl (cond ((= (get_tile \"abschluss_offen\") \"1\") \"1\")
((= (get_tile \"abschluss_motor_es\") \"1\") \"3\")
(t \"2\")))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1) (vflw-pending-push-all (list gwahl)))))
(princ))
;; --- Modus 2: Lauf-Anfang (NUR wenn der VF-Lauf der Pfadanfang ist) ---
;; "1"=ohne Umlenkstation (offener Anfang) / "2"=Umlenkstation direkt (kein
;; GF1/Separator) / "3"=Umlenkstation mit GF1+Separator (heutiges Standard-
;; verhalten). Plain ok_cancel, analog vflw-m2-lauf-abschluss-impl.
(defun vflw-m2-lauf-anfang-impl (kopf-txt / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_m2_lauf_anfang" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean kopf-txt))
(set_tile "anfang_umlenk_gf1" "1")
(action_tile "accept"
"(setq gwahl (cond ((= (get_tile \"anfang_offen\") \"1\") \"1\")
((= (get_tile \"anfang_umlenk\") \"1\") \"2\")
(t \"3\")))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1) (vflw-pending-push-all (list gwahl)))))
(princ))
;; GF-Verteilung (Haelfte Einlauf+Ausgang / alles Einlauf) - kopf-txt dynamisch,
;; wiederverwendet fuer Modus 1 (vfl-vf-einheit-abschluss) UND Modus 3
;; (Segment-Loop br-gf-mode). Die beiden Aufrufer kodieren die Antwort
;; UNTERSCHIEDLICH (Modus 1: "1"=Haelfte/"2"=Einlauf; Modus 3: "2"=Haelfte/
;; "1"=Einlauf) - haelfte-code/einlauf-code legen das je Aufrufer fest.
(defun vflw-gruppe-gf-verteilung-impl (kopf-txt haelfte-code einlauf-code / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_gf_verteilung" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean kopf-txt))
(action_tile "accept" "(setq gwahl (get_tile \"wahl_haelfte\")) (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) (vflw-pending-push-all (list (if (= gwahl "1") haelfte-code einlauf-code))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; "Naechstes im VF" (innerhalb einer laufenden VF-Einheit weiterbauen):
;; Horizontaler Foerderer / Vario-Kurve / Auf-Ab-Foerderer.
(defun vflw-gruppe-naechstes-im-vf-impl ( / dat ergebnis gwahl)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_naechstes_im_vf" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-naechstes-element-vf")))
(action_tile "accept"
"(setq gwahl (cond ((= (get_tile \"wahl_horizontal\") \"1\") \"1\")
((= (get_tile \"wahl_variokurve\") \"1\") \"2\")
(t \"3\")))
(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) (vflw-pending-push-all (list gwahl)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; Feste Zuordnung Standard-Winkel -> Radio-Tile-Key, gemeinsam genutzt von
;; vflw-gruppe-winkel-hoehen-impl und vflw-gruppe-winkel-wahl-impl (beide
;; Dialoge nutzen dieselben 12 Slots w_3..w_51).
(setq *vflw-winkel-tile-keys*
'((3 . "w_3") (6 . "w_6") (9 . "w_9") (12 . "w_12") (15 . "w_15") (18 . "w_18")
(21 . "w_21") (27 . "w_27") (33 . "w_33") (39 . "w_39") (45 . "w_45") (51 . "w_51")))
;; Winkel/Hoehen-Tabelle (vfl-waehle-winkel-hoehen-tabelle): optionen
;; = ALLE konfigurierten Winkel (winkel dH-oder-nil L_VF-oder-nil gueltig),
;; gueltige = die daraus gefilterten baubaren. Fuer JEDEN der 12 Radio-Slots
;; wird das Text-Tile daneben befuellt: baubar -> Endhoehe, nicht baubar ->
;; Grund (wie die Konsolen-Zeile) - und NUR die baubaren werden per mode_tile
;; freigeschaltet. Pusht die POSITION (1-basiert) des gewaehlten Winkels
;; INNERHALB von gueltige, identisch zu dem, was vfl-menu-int an dieser
;; Aufrufstelle sonst liefern wuerde.
(defun vflw-gruppe-winkel-hoehen-impl (optionen gueltige start-z / dat ergebnis e gwinkel
tk htk zeile idx gefunden)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_winkel_hoehen" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-winkel-hoehen-header")))
(foreach e optionen
(setq tk (cdr (assoc (car e) *vflw-winkel-tile-keys*)))
(if tk
(progn
(setq htk (strcat "h_" (substr tk 3)))
(if (nth 3 e)
(progn
(set_tile htk (ssg-textf "vfl-winkel-hoehen-zeile-tile" (list (rtos (+ start-z (nth 1 e)) 2 0))))
(mode_tile tk 0)
)
(progn
(set_tile htk (ssg-text "vfl-winkel-zeile-tile-ungueltig"))
(mode_tile tk 1)
)
)
)
)
)
(setq gefunden nil)
(foreach e gueltige
(setq tk (cdr (assoc (car e) *vflw-winkel-tile-keys*)))
(if (and tk (not gefunden)) (progn (set_tile tk "1") (setq gefunden t)))
)
(action_tile "accept"
"(setq gwinkel (cond
((= (get_tile \"w_3\") \"1\") 3) ((= (get_tile \"w_6\") \"1\") 6)
((= (get_tile \"w_9\") \"1\") 9) ((= (get_tile \"w_12\") \"1\") 12)
((= (get_tile \"w_15\") \"1\") 15) ((= (get_tile \"w_18\") \"1\") 18)
((= (get_tile \"w_21\") \"1\") 21) ((= (get_tile \"w_27\") \"1\") 27)
((= (get_tile \"w_33\") \"1\") 33) ((= (get_tile \"w_39\") \"1\") 39)
((= (get_tile \"w_45\") \"1\") 45) (t 51)))
(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)
(setq idx 1 zeile nil)
(foreach e gueltige
(if (= (car e) gwinkel) (setq zeile idx))
(setq idx (1+ idx)))
(if zeile (vflw-pending-push-all (list zeile))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; Winkel-Wahl aus berechne-alle-winkel (Zielhoehe-basierter Solve):
;; ergebnis-liste = ALLE konfigurierten Winkel (winkel L_GF L_VF gueltig),
;; gueltige = die daraus gefilterten baubaren (Filter komplexer als nur der
;; gueltig-Flag - siehe vfl-waehle-winkel: zusaetzlich L_GF/L_VF > 0 -
;; deshalb hier NICHT (nth 3 e) pruefen, sondern per gueltige-winkel-Liste
;; abgleichen). Fuer JEDEN der 12 Radio-Slots wird das Text-Tile daneben
;; befuellt: baubar -> L_GF+L_VF, nicht baubar -> "nicht baubar" - und NUR
;; die baubaren werden per mode_tile freigeschaltet. Pusht die POSITION
;; (1-basiert) des gewaehlten Winkels INNERHALB von gueltige.
(defun vflw-gruppe-winkel-wahl-impl (ergebnis-liste gueltige / dat ergebnis e gwinkel idx
tk htk zeile gefunden gueltige-winkel)
(setq gueltige-winkel (mapcar 'car gueltige))
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_winkel_wahl" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-mehrere-winkel-header")))
(foreach e ergebnis-liste
(setq tk (cdr (assoc (car e) *vflw-winkel-tile-keys*)))
(if tk
(progn
(setq htk (strcat "h_" (substr tk 3)))
(if (member (car e) gueltige-winkel)
(progn
(set_tile htk (ssg-textf "vfl-winkel-wahl-zeile-tile" (list (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))
(mode_tile tk 0)
)
(progn
(set_tile htk (ssg-text "vfl-winkel-zeile-tile-ungueltig"))
(mode_tile tk 1)
)
)
)
)
)
(setq gefunden nil)
(foreach e gueltige
(setq tk (cdr (assoc (car e) *vflw-winkel-tile-keys*)))
(if (and tk (not gefunden)) (progn (set_tile tk "1") (setq gefunden t)))
)
(action_tile "accept"
"(setq gwinkel (cond
((= (get_tile \"w_3\") \"1\") 3) ((= (get_tile \"w_6\") \"1\") 6)
((= (get_tile \"w_9\") \"1\") 9) ((= (get_tile \"w_12\") \"1\") 12)
((= (get_tile \"w_15\") \"1\") 15) ((= (get_tile \"w_18\") \"1\") 18)
((= (get_tile \"w_21\") \"1\") 21) ((= (get_tile \"w_27\") \"1\") 27)
((= (get_tile \"w_33\") \"1\") 33) ((= (get_tile \"w_39\") \"1\") 39)
((= (get_tile \"w_45\") \"1\") 45) (t 51)))
(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)
(setq idx 1 zeile nil)
(foreach e gueltige
(if (= (car e) gwinkel) (setq zeile idx))
(setq idx (1+ idx)))
(if zeile (vflw-pending-push-all (list zeile))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(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
;; 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
;; (wahl_gfbogen usw.), waehrend die Umrechnung auf die richtige Positions-
;; Nummer hier im Callback passiert (kettenanfang: 1:1: 1-6; sonst: Slot 2
;; entfaellt, alles ab Slot 3 ruecktr um 1 nach vorn).
;; familie: bei Kettenanfang das Ergebnis der KS_AUS-Erkennung ("GF"/"VF"/nil)
;; - 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)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_naechstes_element" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-naechstes-element-header")))
(set_tile "wahl_liniegf" "1")
(if (not kettenanfang) (mode_tile "wahl_variokurve" 1))
(if (and kettenanfang (equal familie "VF"))
(progn
(mode_tile "wahl_gfbogen" 1)
(mode_tile "wahl_liniegf" 1)
(set_tile "wahl_variokurve" "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 "cancel" "(done_dialog 0)")
(action_tile "back" "(done_dialog 2)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((= ergebnis 1)
(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"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
(princ))
;; ============================================================
;; TEIL 0b-4b: SEGMENT-GRUPPEN-DIALOGE (Modus 2 + Modus 3)
;; ============================================================
;; Modus 2 und Modus 3 gehen die Kette Segment fuer Segment durch und stellen
;; je Segment mehrere unmittelbar aufeinanderfolgende Fragen (Typ + ggf.
;; Neigung/Vario-Winkel/Variante). Diese werden - wie die uebrigen Gruppen -
;; im Wizard in EINEM Dialog erfasst und die Antworten in *vflw-pending*
;; abgelegt; die unveraenderten vfl-in-*/vfl-menu-Aufrufe im Segment-Loop
;; konsumieren sie danach der Reihe nach. Der Dialog-Kopf zeigt immer
;; "Segment i/n ..." (wie die Konsolen-Frage). Das jeweils abgefragte Segment
;; wird VOR dem Dialog per vfl-seg-highlight in der Zeichnung hervorgehoben.
;;
;; Highlight: Segment-Entity (LINE/ARC) hervorheben (redraw-Modus 3) bzw.
;; zuruecksetzen (0). ent darf nil sein (dann No-op) - der Aufrufer uebergibt
;; (car (nth i kette)) als VLA-Objekt; wir wandeln in einen Ename fuer redraw.
(defun vfl-seg-highlight (ent an / en)
(if ent
(progn
(setq en (vl-catch-all-apply 'vlax-vla-object->ename (list ent)))
(if (and en (not (vl-catch-all-error-p en)))
(redraw en (if an 3 0)))))
(princ))
;; Kopfzeile "Segment i/n: <Text>" fuer die Segment-Dialoge (i 1-basiert).
(defun vfl-seg-kopf (i n txt)
(strcat "Segment " (itoa i) "/" (itoa n) ": " txt))
;; --- Modus 2, Segment "Gerade": Typ (GF/VF) + [bei GF] Neigung ---
;; Original-Reihenfolge/-Journal im Loop: vfl-menu (Typ), dann bei GF
;; vfl-in-real (Neigung). Bei VF wird KEIN Neigungswert gefragt -> nur "2"
;; in die Pending-Queue. neigung-default: Vorbelegung Neigungsfeld (Grad).
(defun vflw-seg-linie-m2-impl (kopf-txt neigung-default / dat ergebnis gtyp gwert gsepvor gsepnach)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_seg_linie_m2" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean kopf-txt))
(set_tile "typ_gf" "1")
(set_tile "wert" (rtos (float neigung-default) 2 1))
;; Neigungsfeld + Separator-Toggles nur bei GF aktiv.
(action_tile "typ_gf"
"(mode_tile \"wert\" 0) (mode_tile \"sep_vor\" 0) (mode_tile \"sep_nach\" 0)")
(action_tile "typ_vf"
"(mode_tile \"wert\" 1) (mode_tile \"sep_vor\" 1) (mode_tile \"sep_nach\" 1)")
(action_tile "accept"
"(setq gtyp (if (= (get_tile \"typ_gf\") \"1\") \"0\" \"1\"))
(setq gwert (get_tile \"wert\"))
(setq gsepvor (get_tile \"sep_vor\"))
(setq gsepnach (get_tile \"sep_nach\"))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(if (= gtyp "0")
;; GF + Neigung + Separator VOR/NACH (Ja/Nein je "1"/"0")
(vflw-pending-push-all
(list "1" (atof gwert) (if (= gsepvor "1") "1" "2") (if (= gsepnach "1") "1" "2")))
(vflw-pending-push-all (list "2")))))) ; VF (keine Neigung/Separator)
(princ))
;; --- Modus 3, Segment "Gerade": Typ (GF/VF-Ab/VF-Auf/VF-Hor) + Wert ---
;; Original-Reihenfolge/-Journal im Loop: vfl-in-string (Typ "1".."4"), dann
;; bei GF vfl-in-real (Neigung), bei VF-Ab/Auf vfl-in-int (Vario-Winkel), bei
;; VF-Hor KEINE weitere Frage. neigung-default/vario-default: Vorbelegungen.
(defun vflw-seg-linie-m3-impl (kopf-txt neigung-default vario-default /
dat ergebnis gtyp gwert)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_seg_linie_m3" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean kopf-txt))
(set_tile "typ_gf" "1")
(set_tile "wlabel" "GF-Neigung (Grad):")
(set_tile "wert" (rtos (float neigung-default) 2 1))
;; Feld/Beschriftung schaltet mit dem Typ um: GF->Neigung, VF-Ab/Auf->
;; Vario-Winkel, VF-Hor->deaktiviert. Werte-Defaults liegen als lokale
;; Variablen vor und werden im Callback (dynamic scope) gelesen.
(action_tile "typ_gf"
"(set_tile \"wlabel\" \"GF-Neigung (Grad):\")
(set_tile \"wert\" (rtos (float neigung-default) 2 1))
(mode_tile \"wert\" 0)")
(action_tile "typ_vfab"
"(set_tile \"wlabel\" \"Vario-Winkel (Grad):\")
(set_tile \"wert\" (rtos (float vario-default) 2 1))
(mode_tile \"wert\" 0)")
(action_tile "typ_vfauf"
"(set_tile \"wlabel\" \"Vario-Winkel (Grad):\")
(set_tile \"wert\" (rtos (float vario-default) 2 1))
(mode_tile \"wert\" 0)")
(action_tile "typ_vfhor"
"(set_tile \"wlabel\" \"(kein Wert)\")
(mode_tile \"wert\" 1)")
(action_tile "accept"
"(setq gtyp (cond ((= (get_tile \"typ_gf\") \"1\") \"0\")
((= (get_tile \"typ_vfab\") \"1\") \"1\")
((= (get_tile \"typ_vfauf\") \"1\") \"2\")
(t \"3\")))
(setq gwert (get_tile \"wert\")) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(cond
;; typ 0 = GF -> "1" + Neigung(real)
((= gtyp "0") (vflw-pending-push-all (list "1" (atof gwert))))
;; typ 1 = VF-Ab -> "2" + Vario-Winkel(int)
((= gtyp "1") (vflw-pending-push-all (list "2" (fix (atof gwert)))))
;; typ 2 = VF-Auf -> "3" + Vario-Winkel(int)
((= gtyp "2") (vflw-pending-push-all (list "3" (fix (atof gwert)))))
;; typ 3 = VF-Hor -> "4" (kein Wert)
(t (vflw-pending-push-all (list "4")))))))
(princ))
;; --- Segment "Eck/Bogen" (Modus 2 + Modus 3): Typ + [bei Vario] Variante ---
;; Original-Reihenfolge/-Journal: vfl-in-string/vfl-menu (Typ "1"/"2"), dann
;; bei Vario-Kurve vfl-in-string/vfl-menu (Variante "1"/"2"). Bei GF-Bogen
;; wird KEINE Variante gefragt -> nur "1" in die Pending-Queue.
;; vario-erlaubt: T, wenn Vario-Kurve hier zulaessig ist (Modus 2 immer T;
;; Modus 3 nur im offenen VF-Lauf - sonst konsumiert der Aufrufer die
;; Variante-Antwort nicht und sie wuerde ins naechste Segment lecken). Bei
;; nil wird die Vario-Kurve-Option deaktiviert und bei versehentlicher Wahl
;; als GF-Bogen ("1") behandelt (der Aufrufer weist Vario dort ohnehin ab).
(defun vflw-seg-bogen-impl (kopf-txt vario-erlaubt / dat ergebnis gtyp gvariante)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_seg_bogen" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean kopf-txt))
(if (eq vario-erlaubt 'ERZWUNGEN)
(progn
(set_tile "typ_vario" "1")
(mode_tile "typ_gfbogen" 1) ; GF-Bogen gesperrt - Vario ist Pflicht
(mode_tile "variante_aussen" 0) ; Variante sofort aktiv
(mode_tile "variante_innen" 0))
(progn
(set_tile "typ_gfbogen" "1")
(set_tile "variante_aussen" "1")
(mode_tile "variante_aussen" 1) ; Variante erst bei Vario-Kurve aktiv
(mode_tile "variante_innen" 1)
;; Vario-Kurve-Option selbst nur anklickbar, wenn erlaubt (Modus 3
;; ausserhalb eines offenen VF-Laufs: deaktiviert - ihr Label kann
;; hier NICHT auf "(nur im VF-Lauf)" umbeschriftet werden, radio_button-
;; Labels sind fest, siehe DCL-Kommentar).
(if (not vario-erlaubt) (mode_tile "typ_vario" 1))
;; Variante-Feld nur aktivieren, wenn Vario gewaehlt UND erlaubt.
(if vario-erlaubt
(progn
(action_tile "typ_gfbogen"
"(mode_tile \"variante_aussen\" 1) (mode_tile \"variante_innen\" 1)")
(action_tile "typ_vario"
"(mode_tile \"variante_aussen\" 0) (mode_tile \"variante_innen\" 0)")))))
(action_tile "accept"
"(setq gtyp (if (= (get_tile \"typ_vario\") \"1\") \"1\" \"0\"))
(setq gvariante (if (= (get_tile \"variante_innen\") \"1\") \"1\" \"0\"))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(if (and (= gtyp "1") vario-erlaubt)
;; Vario-Kurve: "2" + Variante ("1"=aussen / "2"=innen; Index+1)
(vflw-pending-push-all (list "2" (itoa (1+ (atoi gvariante)))))
;; GF-Bogen (oder Vario unzulaessig): "1" (keine Variante)
(vflw-pending-push-all (list "1"))))))
(princ))
;; ============================================================
;; TEIL 0b-3: GRUPPEN-DIALOGE (PENDING-QUEUE)
;; ============================================================
;; Mehrere Fragen, die im Ablauf IMMER unmittelbar hintereinander kommen
;; (kein Zwischenschritt, keine Verzweigung dazwischen), werden im Wizard in
;; EINEM Dialog gemeinsam erfasst (siehe vflw-gruppe-* unten). Die
;; darunterliegende Aufruf-Reihenfolge in vf-linienzug-modus/vfl-* bleibt
;; dabei WOERTLICH UNVERAENDERT (weiterhin ein vfl-in-point/-string/-real/
;; -int/-value-Aufruf pro Wert, in derselben Reihenfolge) - nur die HERKUNFT
;; des Werts aendert sich: statt live zu fragen (oder einen Einzel-Dialog zu
;; zeigen) wird der naechste Wert aus *vflw-pending* entnommen, den der
;; Gruppen-Dialog vorher dort abgelegt hat. Journal-Aufzeichnung passiert
;; weiterhin in JEDEM einzelnen vfl-in-*-Aufruf selbst - Editieren/Replay
;; bestehender Ketten ist dadurch unveraendert (siehe TEIL 0b-2).
;; Bricht der Nutzer den Gruppen-Dialog ab, bleibt *vflw-pending* leer -
;; die nachfolgenden vfl-in-*-Aufrufe fallen dann automatisch auf ihre
;; EINZEL-Dialoge zurueck (kein Sonderfall noetig).
(if (not (boundp '*vflw-pending*)) (setq *vflw-pending* nil))
(defun vflw-pending-pop ( / v)
(if *vflw-pending*
(progn (setq v (car *vflw-pending*)) (setq *vflw-pending* (cdr *vflw-pending*)) (list v))
nil))
(defun vflw-pending-push-all (vals) (setq *vflw-pending* (append *vflw-pending* vals)) nil)
;; --- Eingabe-Wrapper ---
;; kind steuert nur, wie ein FRISCH live erfasster Wert typisiert wird; beim
;; Replay wird der gespeicherte Wert unveraendert durchgereicht.
;;
;; Alle Basis-Wrapper teilen dasselbe 3-Zweig-Muster (Replay-Queue ->
;; Pending-Queue -> Live-Eingabe) plus Journal-Aufzeichnung. Dieses Skelett
;; ist EINMAL in vfl-in-value (weiter unten) implementiert; die folgenden
;; Wrapper liefern nur ihre Live-Eingabe-Funktion (livefn) und ihr kind-Tag.
;; Journal-Format und Signaturen bleiben damit unveraendert (63 Aufrufstellen).
;; Ausnahme: vfl-in-selection (OBJS/Handles) hat abweichende Replay-/Journal-
;; Logik und bleibt eigenstaendig.
(defun vfl-in-point (base prompt)
(vfl-in-value "PT" (function (lambda () (vfl-getpoint base prompt)))))
;; Objektauswahl (Modus 2: Pfad-Objekte). Wie die anderen Wrapper repliziert
;; bzw. journalisiert - aber KEIN Wizard-Dialog (Objektwahl braucht wie
;; Punktwahl die Zeichnung, kein DCL-Fenster wuerde hier helfen). Beim Replay
;; werden die gespeicherten Handles zurueck in Enames aufgeloest; Handles
;; sind - anders als Enames - ueber Sitzungen hinweg stabil und damit fuer
;; die XDATA-Persistenz geeignet. Loest sich ein Handle nicht mehr auf (z.B.
;; weil der Nutzer die urspruengliche Pfad-Geometrie zwischenzeitlich
;; geloescht hat), wird das klar gemeldet statt eine unvollstaendige Auswahl
;; stillschweigend weiterzureichen.
(defun vfl-in-selection (filter / popped v handles h en k ss fehlt)
;; Zentraler Abbruch-Trigger (siehe Kommentar in vfl-in-value): auch
;; vfl-in-selection hat eine eigenstaendige Replay-/Journal-Logik und laeuft
;; NICHT ueber vfl-in-value - ohne diesen Check bliebe ein von einem
;; VORHERGEHENDEN Gruppen-Dialog gesetztes *vfl-wizard-abbruch-grund*
;; unbemerkt liegen, statt hier zuverlaessig zu terminieren.
(if *vfl-wizard-abbruch-grund*
(progn
(dbgmsg (strcat "ABBRUCH-TRIGGER: *vfl-wizard-abbruch-grund*=" *vfl-wizard-abbruch-grund* " -> (exit)"))
(exit)))
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped
(progn
(setq handles (car popped) v nil fehlt 0)
(foreach h handles
(setq en (vl-catch-all-apply 'handent (list h)))
(if (or (vl-catch-all-error-p en) (null en))
(setq fehlt (1+ fehlt))
(setq v (cons en v))))
(setq v (reverse v))
(if (> fehlt 0)
(progn
(vfl-meldung (ssg-textf "vfl-m3-alert-objekte-fehlen" (list (itoa fehlt))))
;; Headless NICHT mit einer Teilauswahl weiterbauen: die Segmentzahl
;; bestimmt die gesamte Fragenfolge des Modus-2-Ablaufs, ein
;; fehlendes Pfad-Objekt verschiebt sie still. Ein nachgelieferter
;; Wert waere hier sinnlos, darum -abbruch statt -notausgang.
(if (vfl-headless-p) (vfl-headless-abbruch "OBJS-unvollstaendig")))))
(progn
;; Ohne Replay-Daten gibt es headless keine Objektauswahl.
(if (vfl-headless-p) (vfl-headless-abbruch "OBJS"))
(setq ss (ssget filter))
(setq v nil)
(if ss
(progn
(setq k 0)
(while (< k (sslength ss))
(setq v (cons (ssname ss k) v))
(setq k (1+ k)))
(setq v (reverse v))))))
(setq handles (mapcar (function (lambda (e) (cdr (assoc 5 (entget e))))) v))
(vfl-journal-record (if v "OBJS" "NIL") handles)
v)
;; String: "" (Enter) ist ein GUELTIGER String (kein Abbruch) -> "STR". Daher
;; das strikte STR-Praedikat statt der Default-non-nil-Pruefung.
(defun vfl-in-string (prompt)
(vfl-in-value-p "STR"
(function (lambda (v) (eq (type v) 'STR)))
(function (lambda ()
(if (and (vfl-wizard-mode-p) *vflw-menu-optionen*)
(vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt)
*vflw-menu-optionen* *vflw-menu-default*)
(getstring prompt))))))
(defun vfl-in-real (prompt)
(vfl-in-value "REAL"
(function (lambda ()
(if (vfl-wizard-mode-p) (vflw-zahl prompt) (getreal prompt))))))
(defun vfl-in-int (prompt)
(vfl-in-value "INT"
(function (lambda ( / vs)
(if (and (vfl-wizard-mode-p) *vflw-menu-optionen*)
(progn
(setq vs (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt)
*vflw-menu-optionen* *vflw-menu-default*))
(if (and vs (> (strlen vs) 0)) (atoi vs) nil))
(getint prompt))))))
;; Menue-Wrapper: princ-Ausgabe der Optionen bleibt beim Aufrufer unveraendert
;; stehen (Konsolen-Fallback, de/en via ssg-text) - hier wird nur die
;; ABSCHLIESSENDE Eingabe-Zeile ersetzt. frage-key: ssg-text-Schluessel der
;; eigentlichen Frage (die Kopfzeile, die vorher separat per princ ausgegeben
;; wurde, z.B. "vfl-ist-endpunkt-frage") - OHNE das wuerde der Wizard-Dialog
;; nur die generische "Ihre Wahl (1/2/3)..."-Zeile zeigen und die eigentliche
;; Frage bliebe unsichtbar (nur auf der Konsole hinter dem Dialog). Die
;; Lokalvariablen sind ueber die '/'-Deklaration dynamisch nur waehrend
;; dieses Aufrufs sichtbar (AutoLISP dynamic scoping) und wirken daher
;; ausschliesslich auf den EINEN vfl-in-string/-int-Aufruf im Rumpf.
(defun vfl-menu (prompt option-labels default-idx frage-key /
*vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*)
(setq *vflw-menu-optionen* option-labels)
(setq *vflw-menu-default* default-idx)
(setq *vflw-menu-frage* frage-key)
(vfl-in-string prompt))
(defun vfl-menu-int (prompt option-labels default-idx frage-key /
*vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*)
(setq *vflw-menu-optionen* option-labels)
(setq *vflw-menu-default* default-idx)
(setq *vflw-menu-frage* frage-key)
(vfl-in-int prompt))
;; Winkel-Menue: fragt einen WINKELWERT (30/60/90) ab und journalisiert ihn
;; als echten Winkel (INT-Eintrag = 30/60/90), NICHT als Auswahl-Index 1/2/3.
;; Damit ist jedes Journal/Log selbsterklaerend und alle GF-Bogen-/Vario-Kurve-
;; Stellen (Live-Bau, Slice, Edit) teilen denselben Wert. winkel-werte ist die
;; Liste der zur Optionsreihenfolge gehoerenden Winkel (einheitlich (30 60 90)
;; fuer GF-Bogen UND Vario-Kurve); default-winkel der vorbelegte Winkelwert. Bei Konsolen-Eingabe
;; tippt der Nutzer den Winkel direkt (30/60/90); ungueltige Eingaben fallen auf
;; den naechstliegenden gueltigen Wert bzw. den Default. Rueckgabe: Winkel (Int).
(defun vfl-menu-winkel (prompt option-labels winkel-werte default-winkel frage-key /
*vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage* v)
(setq *vflw-menu-optionen* option-labels)
(setq *vflw-menu-frage* frage-key)
;; Default-Index = Position des Default-Winkels in winkel-werte (1-basiert).
(setq *vflw-menu-default*
(+ 1 (- (length winkel-werte) (length (member default-winkel winkel-werte)))))
(setq v (vfl-in-value "INT"
(function (lambda () (vfl-winkel-live prompt winkel-werte default-winkel)))))
;; Absicherung: nur gueltige Winkel zulassen (auch bei Alt-Journals mit Index).
(vfl-winkel-normieren v winkel-werte default-winkel))
;; Live-Abfrage eines Winkelwerts. Wizard: Auswahl aus den Labels, Position ->
;; winkel-werte. Konsole: direkte Zahleneingabe (ENTER = Default).
(defun vfl-winkel-live (prompt winkel-werte default-winkel / vs idx r)
(if (and (vfl-wizard-mode-p) *vflw-menu-optionen*)
(progn
(setq vs (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt)
*vflw-menu-optionen* *vflw-menu-default*))
(setq idx (if (and vs (> (strlen vs) 0)) (atoi vs) 0))
(if (and (>= idx 1) (<= idx (length winkel-werte)))
(nth (1- idx) winkel-werte)
default-winkel))
(progn
(setq r (getint prompt))
(if r r default-winkel))))
;; Normiert einen (moeglicherweise aus Alt-Journals stammenden Index oder einen
;; frei getippten Wert) auf einen gueltigen Winkel aus winkel-werte. Ein Wert,
;; der bereits gueltig ist, bleibt unveraendert. Ansonsten Default.
(defun vfl-winkel-normieren (v winkel-werte default-winkel / n)
(setq n (cond ((null v) default-winkel)
((= (type v) 'STR) (atoi v))
(T v)))
(if (member n winkel-werte) n default-winkel))
;; Generisches Eingabe-Skelett: der gemeinsame 3-Zweig-Ablauf (Replay-Queue ->
;; Pending-Queue -> Live-Eingabe) plus Journal-Aufzeichnung, den alle Basis-
;; Wrapper (vfl-in-point/-string/-real/-int) teilen. livefn ist ein aufrufbares
;; Objekt ohne Argumente (die eigentliche Live-Eingabe, z.B. getpoint/getreal
;; oder eine fragende Hilfsfunktion wie vf-frage-element-winkel); es wird NUR
;; aufgerufen, wenn weder Replay- noch Pending-Wert vorliegt.
;; kind: Journal-Typ eines frisch/gueltig erfassten Werts. Ein non-nil v gilt
;; als gueltig (-> kind), nil als Abbruch (-> "NIL"). Fuer Faelle, in denen die
;; Gueltigkeit strenger geprueft werden muss (z.B. vfl-in-string: "" ist ein
;; gueltiger String), siehe vfl-in-value-p.
;; Generisches Echo der Antwort auf JEDE vfl-in-*-Frage (Nutzerwunsch: nach
;; jeder Konsolen-/Wizard-Frage soll sichtbar sein, was gewaehlt wurde) -
;; zentral in vfl-in-value/-value-p verankert (statt an jeder Aufrufstelle
;; einzeln), deckt dadurch ALLE Fragen ab, auch kuenftige. Bei einer Menue-
;; Frage (vfl-menu/-menu-int, *vflw-menu-optionen* gesetzt - dynamisch aus
;; deren eigener '/'-Deklaration sichtbar) wird die Antwort, falls sie als
;; 1-basierter Index in die Options-Liste passt, zum Options-Text aufgeloest
;; (vflw-clean entfernt das "\n N - "-Praefix); sonst (z.B. vfl-menu-winkel
;; mit einem echten Winkelwert statt Index, oder eine freie Texteingabe wie
;; der AS-/ES-Winkel "90"/"30") wird der Rohwert gezeigt. Nur STR/INT
;; (echte Auswahl-Antworten) - REAL (Hoehen/Laengen/Winkel-Zahlen) und
;; PT/DL (Punktwahl) werden NICHT echot, das Ergebnis zeigt sich ohnehin
;; ueber die nachfolgende Bau-/KS_AUS-Ausgabe.
(defun vfl-echo-antwort (kind v / idx label)
(if (and v (member kind '("STR" "INT")))
(progn
(setq label nil)
(if (and *vflw-menu-optionen*
(setq idx (if (= kind "INT") v (atoi v)))
(>= idx 1) (<= idx (length *vflw-menu-optionen*)))
(setq label (vflw-clean (nth (1- idx) *vflw-menu-optionen*))))
(vfl-echo-wahl (if label label (if (= kind "STR") v (vl-princ-to-string v))))
)
)
)
(defun vfl-in-value (kind livefn / popped v)
;; Zentraler Abbruch-Trigger fuer den "Zurueck"/"Abbrechen"-Button (siehe
;; vfl-modus-abbruch-sichern): EIN Check hier deckt vfl-in-point/-string/
;; -real/-int/vfl-menu/-menu-int komplett ab, statt jede Aufrufstelle im
;; Bau-Ablauf einzeln pruefen zu muessen. Laeuft AUSSERHALB von vl-catch-
;; all-apply (das umschliesst nur den vorgelagerten Gruppen-Dialog-Aufruf),
;; (exit) erreicht also zuverlaessig den scharf geschalteten *error*-Handler.
(if *vfl-wizard-abbruch-grund*
(progn
(dbgmsg (strcat "ABBRUCH-TRIGGER: *vfl-wizard-abbruch-grund*=" *vfl-wizard-abbruch-grund* " -> (exit)"))
(exit)))
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped
(setq v (car popped))
(progn
(setq popped (vflw-pending-pop))
;; Headless: statt still live zu fragen (Batch-Haenger, und der Grund
;; des Desyncs waere verloren) abbrechen bzw. den Antwort-Hook fragen.
(if (and (null popped) (vfl-headless-p))
(setq popped (vfl-headless-notausgang kind)))
(if popped (setq v (car popped)) (setq v (apply livefn nil)))))
(vfl-journal-record (if v kind "NIL") v)
(vfl-echo-antwort kind v)
v)
;; Variante mit explizitem Gueltig-Praedikat (fuer vfl-in-string: "" ist gueltig).
(defun vfl-in-value-p (kind gueltig-p livefn / popped v)
;; Siehe Kommentar in vfl-in-value - derselbe zentrale Abbruch-Trigger.
(if *vfl-wizard-abbruch-grund*
(progn
(dbgmsg (strcat "ABBRUCH-TRIGGER: *vfl-wizard-abbruch-grund*=" *vfl-wizard-abbruch-grund* " -> (exit)"))
(exit)))
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped
(setq v (car popped))
(progn
(setq popped (vflw-pending-pop))
(if (and (null popped) (vfl-headless-p)) ; siehe vfl-in-value
(setq popped (vfl-headless-notausgang kind)))
(if popped (setq v (car popped)) (setq v (apply livefn nil)))))
(vfl-journal-record (if (apply gueltig-p (list v)) kind "NIL") v)
(vfl-echo-antwort kind v)
v)
;; --- String-Hilfen (generisch, Trenner beliebig) ---
(defun vfl-strjoin (lst sep / s first)
(setq s "" first t)
(foreach x lst
(if first (progn (setq s x) (setq first nil)) (setq s (strcat s sep x))))
s)
(defun vfl-strsplit (s sep / pos out)
(setq out '())
(while (setq pos (vl-string-search sep s))
(setq out (cons (substr s 1 pos) out))
(setq s (substr s (+ pos 1 (strlen sep)))))
(reverse (cons s out)))
;; --- SEGS: Segment-Essenz einer Modus-3-Kette (selbst-enthalten) ---
;; Ein SEGS-Wert ist die AUS DEN PFAD-OBJEKTEN ABGELEITETE Zahlenliste, die der
;; Modus-3-Bau ohnehin allein verwendet (gf-analysiere-kette + Start/Endpunkte
;; aus gf-sortiere-objekte). Sie ersetzt im Journal die frueheren OBJS-Handles:
;; dadurch ist die Kette im XDATA vollstaendig beschrieben und beim Doppelklick-
;; Replay unabhaengig davon, ob die urspruenglichen LINE/ARC noch existieren
;; (robuster als der OBJS-Weg von Modus 2). Siehe doc/variofoerderer.md.
;;
;; Ein Segment ist eine 9er-Liste, die die "Bau-Essenz" und die fuer die
;; AS-Trimmung/das Soll-Ende noetigen absoluten Punkte zusammenfuehrt:
;; (typ hz laenge bwinkel bseite spx spy epx epy)
;; typ "Linie"/"Bogen" (delimiter-frei, daher unquotiert serialisiert)
;; hz Eintritts-Horizontalwinkel (Grad)
;; laenge 2D-Laenge / Sehnenmass (mm)
;; bwinkel Bogenwinkel (0 bei Linie)
;; bseite "links"/"rechts"
;; spx spy Startpunkt (XY, mm) des Segments \ aus gf-sortiere-objekte,
;; epx epy Endpunkt (XY, mm) des Segments / fuer Trimmung + Soll-Ende
;;
;; Serialisierung: Segmente per ";" getrennt, Felder je Segment per "|". Beide
;; Trenner sind kollisionsfrei - die einzigen String-Felder (typ/bseite) sind
;; feste Schluesselwoerter ohne ";" oder "|", alle uebrigen Felder sind Zahlen
;; (rtos-Mode-2, wie PT/REAL). Ein leeres SEGS ("") ist eine leere Liste.
(defun vfl-seg->string (seg)
(vfl-strjoin
(list (nth 0 seg) ; typ (String)
(rtos (float (nth 1 seg)) 2 6) ; hz
(rtos (float (nth 2 seg)) 2 6) ; laenge
(rtos (float (nth 3 seg)) 2 6) ; bwinkel
(nth 4 seg) ; bseite (String)
(rtos (float (nth 5 seg)) 2 6) ; spx
(rtos (float (nth 6 seg)) 2 6) ; spy
(rtos (float (nth 7 seg)) 2 6) ; epx
(rtos (float (nth 8 seg)) 2 6)) ; epy
"|"))
(defun vfl-string->seg (s / f)
(setq f (vfl-strsplit s "|"))
(list (nth 0 f) ; typ
(atof (nth 1 f)) ; hz
(atof (nth 2 f)) ; laenge
(fix (atof (nth 3 f))) ; bwinkel (Ganzzahl, wie gf-analysiere-kette)
(nth 4 f) ; bseite
(atof (nth 5 f)) ; spx
(atof (nth 6 f)) ; spy
(atof (nth 7 f)) ; epx
(atof (nth 8 f)))) ; epy
(defun vfl-segs->string (segs)
(vfl-strjoin (mapcar 'vfl-seg->string segs) ";"))
(defun vfl-string->segs (s)
(if (= (strlen s) 0)
'()
(mapcar 'vfl-string->seg (vfl-strsplit s ";"))))
;; --- Serialisierung (tagged, selbstbeschreibend) ---
;; Zeilenformat "kind:payload", Eintraege per "\n" verkettet. getstring/getreal
;; liefern nie ein Newline, daher ist "\n" ein sicherer Record-Trenner.
;; "OBJS" (Objektauswahl, Modus 2): Payload = kommagetrennte Liste von
;; Entity-Handles (Hex-Strings, kollidieren nie mit dem Komma-Trenner).
;; Handles bleiben - anders als Enames - ueber Sitzungen/Undo hinweg stabil
;; und sind damit die richtige Persistenzform fuer ssget-Ergebnisse.
;; "SEGS" (Segment-Essenz, Modus 3): Payload = ";"-getrennte Segmente, Felder
;; per "|" (siehe vfl-segs->string oben).
(defun vfl-entry->string (e / k v)
(setq k (car e) v (cdr e))
(cond
((= k "PT") (strcat "PT:" (rtos (car v) 2 6) "," (rtos (cadr v) 2 6) ","
(rtos (caddr v) 2 6)))
((= k "REAL") (strcat "REAL:" (rtos v 2 6)))
((= k "DL") (strcat "DL:" (rtos v 2 6)))
((= k "INT") (strcat "INT:" (itoa v)))
((= k "STR") (strcat "STR:" v))
((= k "STEP") (strcat "STEP:" v))
((= k "OBJS") (strcat "OBJS:" (vfl-strjoin v ",")))
((= k "SEGS") (strcat "SEGS:" (vfl-segs->string v)))
(t "NIL:")))
(defun vfl-string->entry (ln / p kind pay c)
(setq p (vl-string-search ":" ln))
(if (null p)
(cons "NIL" nil)
(progn
(setq kind (substr ln 1 p) pay (substr ln (+ p 2)))
(cond
((= kind "PT")
(setq c (vfl-strsplit pay ","))
(cons "PT" (list (atof (nth 0 c)) (atof (nth 1 c)) (atof (nth 2 c)))))
((= kind "REAL") (cons "REAL" (atof pay)))
((= kind "DL") (cons "DL" (atof pay)))
((= kind "INT") (cons "INT" (atoi pay)))
((= kind "STR") (cons "STR" pay))
((= kind "STEP") (cons "STEP" pay))
((= kind "OBJS") (cons "OBJS" (if (> (strlen pay) 0) (vfl-strsplit pay ",") nil)))
((= kind "SEGS") (cons "SEGS" (vfl-string->segs pay)))
(t (cons "NIL" nil))))))
;; forward-journal ist bereits in Bau-Reihenfolge (nicht die umgekehrte
;; *vfl-journal*-Rohform) - gemeinsame Serialisierung fuer Ketten- UND
;; Segment-XDATA (vfl-journal-xdata-schreiben / vfl-journal-xdata-schreiben-seg).
(defun vfl-journal-list->string (forward-journal)
(vfl-strjoin (mapcar 'vfl-entry->string forward-journal) "\n"))
(defun vfl-journal->string ()
(vfl-journal-list->string (reverse *vfl-journal*)))
;; --- JSON-Dump des Journals fuer die Debug-Datei (nur Diagnose) ---
;; Wandelt EINEN Journal-Eintrag (kind . value) in ein JSON-Objekt
;; {"kind":"PT","value":[x,y,z]} um. String-Werte werden gequotet (mit
;; einfachem Escaping fuer " und \), Zahlen unquotiert, PT als Zahlen-Array,
;; OBJS als String-Array, NIL als null. Rein additive Diagnose - beruehrt die
;; XDATA-Serialisierung (vfl-entry->string) NICHT.
(defun vfl-json-escape (s / out c i n)
(setq out "" i 1 n (strlen s))
(while (<= i n)
(setq c (substr s i 1))
(setq out (strcat out (cond ((= c "\"") "\\\"") ((= c "\\") "\\\\") (t c))))
(setq i (1+ i)))
out)
(defun vfl-json-num (x) (rtos x 2 6)) ; einheitliches Zahlformat (wie vfl-entry->string)
(defun vfl-entry->json (e / k v)
(setq k (car e) v (cdr e))
(strcat "{\"kind\":\"" k "\",\"value\":"
(cond
((null v) "null")
((= k "PT") (strcat "[" (vfl-json-num (car v)) "," (vfl-json-num (cadr v)) ","
(vfl-json-num (caddr v)) "]"))
((= k "REAL") (vfl-json-num v))
((= k "DL") (vfl-json-num v))
((= k "INT") (itoa v))
((= k "STR") (strcat "\"" (vfl-json-escape v) "\""))
((= k "STEP") (strcat "\"" (vfl-json-escape v) "\""))
((= k "OBJS") (strcat "[" (vfl-strjoin
(mapcar (function (lambda (h) (strcat "\"" (vfl-json-escape h) "\"")))
v) ",") "]"))
((= k "SEGS") (strcat "["
(vfl-strjoin
(mapcar
(function (lambda (seg)
(strcat "[\"" (vfl-json-escape (nth 0 seg)) "\","
(vfl-json-num (float (nth 1 seg))) ","
(vfl-json-num (float (nth 2 seg))) ","
(vfl-json-num (float (nth 3 seg))) ",\""
(vfl-json-escape (nth 4 seg)) "\","
(vfl-json-num (float (nth 5 seg))) ","
(vfl-json-num (float (nth 6 seg))) ","
(vfl-json-num (float (nth 7 seg))) ","
(vfl-json-num (float (nth 8 seg))) "]")))
v) ",")
"]"))
(t "null"))
"}"))
;; forward-journal (Bau-Reihenfolge) als kompakter JSON-Array-String.
(defun vfl-journal->json (forward-journal)
(strcat "[" (vfl-strjoin (mapcar 'vfl-entry->json forward-journal) ",") "]"))
(defun vfl-string->journal (s / out)
(setq out '())
(foreach ln (vfl-strsplit s "\n")
(if (> (strlen ln) 0) (setq out (cons (vfl-string->entry ln) out))))
(reverse out))
;; --- Persistenz am VF_n-Block ueber die SSG_VF_EDIT-XDATA-App ---
;; Layout der 1000-Gruppen: [0]="linienzug" (Marker), [1..]=Journal-String in
;; 250-Byte-Chunks (DXF-Limit 255). Rueckwaertskompatibel zum Standard/Etage-
;; Reader vfs-xdata-lesen, der alle 1000-Werte als Liste liefert.
(defun vfl-chunk-string (s n / out len)
(setq out '())
(while (> (setq len (strlen s)) n)
(setq out (cons (substr s 1 n) out))
(setq s (substr s (1+ n))))
(if (> (strlen s) 0) (setq out (cons s out)))
(reverse out))
;; marker: "linienzug" (Modus 1, Sektions-Editieren via vfl-edit-ent) oder
;; "linienzug2" (Modus 2, vfl-edit-ent2 - voller Reset ohne Sektionswahl,
;; siehe dortiger Kommentar). Der Marker steht in der ersten 1000-Gruppe und
;; entscheidet beim Lesen (vfl-journal-xdata-lesen), welcher Editier-Pfad
;; greift.
(defun vfl-journal-xdata-schreiben (ent marker / chunks appentry)
(if (null *vf-xdata-app*) (setq *vf-xdata-app* "SSG_VF_EDIT"))
(regapp *vf-xdata-app*)
;; Diagnose: komplettes Journal beim Erzeugen der Geometrie als JSON in die
;; Debug-Datei (No-Op ohne offene .dbg-Datei, siehe dbgmsg). marker + JSON-
;; Array der Eintraege in Bau-Reihenfolge.
(dbgmsg (strcat "XDATA-GESCHRIEBEN marker=" marker))
(dbgmsg (strcat "XDATA-JOURNAL-JSON " (vfl-journal->json (reverse *vfl-journal*))))
(dbgflush)
(setq chunks (vfl-chunk-string (vfl-journal->string) 250))
(setq appentry
(cons *vf-xdata-app*
(cons (cons 1000 marker)
(mapcar (function (lambda (c) (cons 1000 c))) chunks))))
(entmod (append (entget ent) (list (list -3 appentry))))
ent)
;; Rueckgabe: (marker . journal) oder nil (kein/unbekanntes Journal).
(defun vfl-journal-xdata-lesen (ent / xd)
(setq xd (vfs-xdata-lesen ent))
(if (and xd (member (car xd) '("linienzug" "linienzug2" "linienzug3")))
(cons (car xd) (vfl-string->journal (apply 'strcat (cdr xd))))
nil))
;; --- Segment-XDATA (pro einzelnem Glied-Entity, eigener App-Name) ---
;; Eigene App "SSG_VF_EDIT_SEG" statt SSG_VF_EDIT: sauber getrennt vom
;; Ketten-Journal, keine Kollisionsgefahr mit dessen Marker-Schema
;; ("linienzug"/"linienzug2"/"standard"/"etage"). Wird auf JEDES seit
;; Glied-Start neu erzeugte Entity geschrieben, WAEHREND es noch frei in der
;; Zeichnung liegt (vor dem finalen -BLOCK-Sweep in vfl-block-erstellen) -
;; siehe vfl-segment-xdata-sichern. Rein additive Zusatzinformation: das
;; bestehende Ketten-Journal (SSG_VF_EDIT) bleibt unabhaengig davon die
;; primaere/vollstaendige Quelle, Segment-XDATA ist kein Ersatz dafuer.
;; Layout: [0]="linienzug-seg" (Marker), [1]=Glied-Index (1-basiert, String),
;; [2..]=Segment-Journal-String in 250-Byte-Chunks.
(defun vfl-journal-xdata-schreiben-seg (ent seg-idx seg-journal / chunks appentry)
(regapp "SSG_VF_EDIT_SEG")
(setq chunks (vfl-chunk-string (vfl-journal-list->string seg-journal) 250))
(setq appentry
(cons "SSG_VF_EDIT_SEG"
(cons (cons 1000 "linienzug-seg")
(cons (cons 1000 (itoa seg-idx))
(mapcar (function (lambda (c) (cons 1000 c))) chunks)))))
(entmod (append (entget ent) (list (list -3 appentry))))
ent)
;; Rueckgabe: (seg-idx . segment-journal) oder nil (kein/unbekanntes Segment-XDATA).
(defun vfl-journal-xdata-lesen-seg (ent / xd app-data werte)
(setq xd (entget ent '("SSG_VF_EDIT_SEG")))
(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-seg") (cadr werte))
(cons (atoi (cadr werte)) (vfl-string->journal (apply 'strcat (cddr werte))))
nil))
nil))
;; --- Praeambel-XDATA (eigene App "SSG_VF_EDIT_PRE") -----------------------
;; Die Segment-XDATA (SSG_VF_EDIT_SEG) deckt nur die GLIEDER ab - alles vor
;; dem ersten STEP (Startpunkt, Starthoehe, AS ja/nein + AS-Winkel/-Seite)
;; steht in keiner Slice. Fuer eine vollstaendige Wiederherstellung aus der
;; Zeichnung allein (c:VF_SEKTION_RESTORE) fehlt damit genau der Kopf des
;; Journals. Deshalb wird die Praeambel zusaetzlich als eigene XDATA-App auf
;; die Entities des ERSTEN Gliedes geschrieben - eigene App, weil pro Entity
;; nur ein SSG_VF_EDIT_SEG-Record Platz hat (der gehoert dem Glied).
;; Layout: [0]="linienzug-pre" (Marker), [1..]=Journal-String in 250-Byte-Chunks.
;;
;; Praeambel = alle Journal-Eintraege VOR dem ersten STEP.
(defun vfl-journal-praeambel (forward-journal / out fertig)
(setq out '() fertig nil)
(foreach e forward-journal
(if (and (not fertig) (= (car e) "STEP")) (setq fertig t))
(if (not fertig) (setq out (cons e out))))
(reverse out))
(defun vfl-journal-xdata-schreiben-pre (ent pre-journal / chunks appentry)
(regapp "SSG_VF_EDIT_PRE")
(setq chunks (vfl-chunk-string (vfl-journal-list->string pre-journal) 250))
(setq appentry
(cons "SSG_VF_EDIT_PRE"
(cons (cons 1000 "linienzug-pre")
(mapcar (function (lambda (c) (cons 1000 c))) chunks))))
(entmod (append (entget ent) (list (list -3 appentry))))
ent)
;; Rueckgabe: Praeambel-Journal oder nil (keine/unbekannte Praeambel-XDATA).
(defun vfl-journal-xdata-lesen-pre (ent / xd app-data werte)
(setq xd (entget ent '("SSG_VF_EDIT_PRE")))
(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-pre"))
(vfl-string->journal (apply 'strcat (cdr werte)))
nil))
nil))
;; Wird direkt nach dem Segment-Dispatch-cond in vf-linienzug-modus aufgerufen
;; (per vl-catch-all-apply abgesichert - ein Fehler hier darf den Hauptbau nie
;; abbrechen, rein additive Zusatz-XDATA). seg-lastEnt = Schnappschuss VOR
;; diesem Glied (vf-lastent-ohne-attribute, siehe Aufruf). wahl wird hier
;; nicht mehr gebraucht (das Label steckt schon im STEP-Eintrag des Journals
;; via vfl-journal-steplabel) - Parameter bleibt fuer eine spaetere dbgmsg-
;; Diagnose nuetzlich, daher weiterhin uebergeben.
;; Ermittelt Glied-Index + Journal-Teilsequenz selbst aus dem aktuellen
;; *vfl-journal* (zu diesem Zeitpunkt bereits um dieses Glied vollstaendig
;; ergaenzt) und schreibt sie auf JEDES seit seg-lastEnt neu erzeugte Entity
;; (entnext-Wanderung, gleiches Muster wie vfl-block-erstellen/
;; vfl-modus-abbruch-sichern).
(defun vfl-segment-xdata-sichern (seg-lastEnt wahl / forward-journal seg-idx seg-von
seg-journal log-slice e cnt slice-label pre-journal)
(setq forward-journal (reverse *vfl-journal*))
(setq seg-idx (length (vfl-journal-glieder forward-journal)))
;; Erstes Glied DIESER Iteration: eine Iteration kann mehrere Glieder
;; erzeugen (VF-Einheit + eingebettete Vario-Kurven). *vfl-seg-glied-letzte*
;; haelt den Glied-Stand der vorherigen Iteration.
(if (null *vfl-seg-glied-letzte*) (setq *vfl-seg-glied-letzte* 0))
(setq seg-von (1+ *vfl-seg-glied-letzte*))
(setq cnt 0)
(if (and (> seg-idx 0) (>= seg-idx seg-von))
(progn
;; XDATA: der KOMPLETTE in dieser Iteration entstandene Journal-Abschnitt
;; (Glieder seg-von .. seg-idx), indiziert mit dem ERSTEN Glied-Index.
;; Nur so ist die Kette spaeter luecken- und desync-frei aus der
;; Zeichnung rekonstruierbar (c:VF_SEKTION_RESTORE).
(setq seg-journal (vfl-journal-ab-glied forward-journal seg-von))
;; Fuers Log/die Schema-Validierung weiterhin die Slice des LETZTEN
;; Glieds (unveraendertes Verhalten, siehe Kommentar unten).
(setq log-slice (vfl-journal-slice forward-journal seg-idx))
;; Praeambel (Startpunkt/Starthoehe/AS) bei der ERSTEN Iteration
;; mitschreiben - ohne sie waere die Kette aus der Zeichnung nicht
;; vollstaendig rekonstruierbar (vfl-journal-xdata-schreiben-pre).
;; Danach aendert sich die Praeambel nicht mehr.
(setq pre-journal (if (= seg-von 1) (vfl-journal-praeambel forward-journal) nil))
;; Tatsaechliches Label der geschnittenen Slice (der STEP-Wert am Anfang).
;; Kann von wahl (dem Hauptschleifen-Label) ABWEICHEN: enthaelt die
;; VF-Einheit eine Vario-Kurve, ist DEREN STEP das letzte Glied, seg-idx
;; zeigt darauf, und die Slice ist die Vario-Kurve-Slice - waehrend wahl
;; noch "Horizontal-VF"/"Linie-VF" ist. Fuers Log/die Validierung zaehlt
;; das echte Slice-Label, nicht wahl (sonst falsch etikettiert).
(setq slice-label
(if (and log-slice (= (car (car log-slice)) "STEP"))
(cdr (car log-slice)) wahl))
(setq e (if seg-lastEnt (entnext seg-lastEnt) (entnext)))
(while e
(vfl-journal-xdata-schreiben-seg e seg-von seg-journal)
(if pre-journal (vfl-journal-xdata-schreiben-pre e pre-journal))
(setq cnt (1+ cnt))
(setq e (entnext e))
)
;; Glied-Stand NUR fortschreiben, wenn wirklich Entities beschrieben
;; wurden. Ein Glied ohne Geometrie (z.B. "VF-Einheit nicht baubar" -
;; Menue-Antwort und Laenge sind journalisiert, gebaut wurde nichts) hat
;; keinen Traeger fuer seine XDATA. Bliebe der Stand trotzdem stehen,
;; waere sein Journal-Abschnitt unauffindbar und die Kette waere ab dort
;; nur noch mit Luecke wiederherstellbar. So wandert der Abschnitt
;; stattdessen in den naechsten Record, der Entities bekommt.
(if (> cnt 0) (setq *vfl-seg-glied-letzte* seg-idx))
;; Diagnose: den tatsaechlichen Segment-Journal-Inhalt als JSON loggen
;; (analog zum Ketten-XDATA-JOURNAL-JSON in vfl-journal-xdata-schreiben)
;; plus die Anzahl der beschriebenen Entities. No-Op ohne offene .dbg.
(dbgmsg (strcat "SEGMENT-XDATA-JSON Glied " (itoa seg-von)
(if (> seg-idx seg-von) (strcat ".." (itoa seg-idx)) "")
" (" (if slice-label slice-label "?") ") auf " (itoa cnt)
" Entity(s): " (vfl-journal->json seg-journal)))
;; Zusaetzlich benannt loggen (statt roher [INT]/[STR]-Zeilen). Feste
;; Glieder (AS/ES/GF-Bogen/Vario-Kurve) ueber ihr Feld-Schema
;; (GF-Bogen.winkel = 90), die VF-Einheit (Linie-VF/Horizontal-VF, variable
;; Laenge) ueber den Sub-Step-Logger (VF.menue = 4, VF.laenge = ...). Beide
;; validieren, was validierbar ist, und markieren Abweichungen (<!! ...>).
;; Ueber slice-label (echtes Glied), nicht wahl.
;; Bewusst log-slice (genau EIN Glied) - die Schema-Logger erwarten die
;; Slice eines einzelnen Glieds, nicht den Iterations-Abschnitt.
(if (vfl-schema-felder slice-label)
(vfl-schema-log-slice slice-label log-slice)
(if (member slice-label '("Linie-VF" "Horizontal-VF"))
(vfl-schema-log-vf slice-label log-slice)))
)
(dbgmsg (strcat "SEGMENT-XDATA: kein Glied vorhanden (" (if wahl wahl "?") ")"))
)
(dbgflush)
(princ))
;; --- Abbruch-Sicherung ---
;; Alle nach lastEnt erzeugten Entities werden NICHT geloescht, sondern
;; GENAUSO wie beim erfolgreichen Abschluss (vfl-block-erstellen) zu einem
;; neuen VF_n-Block gewickelt, mit dem VOLLEN aktuellen Eingabe-Journal
;; (inkl. des angefangenen, noch unfertigen letzten Gliedes) als XDATA. Die
;; Geometrie bleibt in der Zeichnung stehen und ist sofort per Doppelklick
;; weiter editierbar/fortsetzbar (vfl-edit-ent) - unabhaengig davon, ob es
;; sich um einen frischen Bau oder einen Editier-Neuaufbau handelte (kein
;; Sonderfall mehr noetig). Aufgerufen aus dem *error*-Handler von
;; vf-linienzug-modus.
;; Debug-Session eines Modus starten - gemeinsam fuer alle drei Linienzug-Modi
;; (frueher 3x fast wortgleich, nur Schalter-/Datei-/Funktions-/Sessiontext
;; unterschieden sich). Oeffnet die dbg-Datei und schreibt Kopf + Session-Start.
;; Rueckgabe: dbg-an (T, wenn geloggt wird). Der Modus-1-Zusatz (Replay-Queue-
;; JSON-Diagnose) bleibt an M1s Aufrufstelle - er ist M1-spezifisch.
(defun vfl-dbg-session-start (schalter datei funcname sessiontext / dbg-an)
(setq dbg-an (dbg-schalter-open schalter datei "DXFM_LOG"))
(if dbg-an
(progn
(dbgf funcname)
(dbgmsg sessiontext)
(dbgflush)))
dbg-an)
;; Fruehen, DUENNEN dbg-*error*-Hook installieren (Modus 2/3): schliesst bei
;; einem Abbruch waehrend der Pfad-/Praeambel-Phase (noch keine Geometrie) nur
;; die dbg-Datei sauber und faellt auf dbg-old-error zurueck. Wird spaeter vom
;; scharfen Wickel-Handler (vfl-abbruch-handler-installieren) abgeloest, sobald
;; vfl-nummer/lastEnt feststehen. Frueher in M2 und M3 wortgleich ausgeschrieben.
;; VERTRAG (dynamic scoping, wie vfl-abbruch-handler-installieren): der Aufrufer
;; MUSS dbg-old-error und dbg-an als Locals gebunden haben; der Hook-Lambda loest
;; sie zur Abbruchzeit gegen den Modus-Frame auf. dbg-old-error hier setzen
;; (Save von *error*) und zurueckgeben.
(defun vfl-dbg-hook-installieren ()
(setq dbg-old-error *error*)
(setq *error*
(function (lambda (msg)
(setq *error* dbg-old-error)
(if dbg-an
(progn
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
(dbgreturn nil)
(dbgclose)))
(if dbg-old-error (dbg-old-error msg) (princ)))))
dbg-old-error)
;; Den scharfen Abbruch-Wickel-Handler als *error* installieren - gemeinsam
;; fuer alle drei Linienzug-Modi (frueher 3x wortgleich ausgeschrieben, nur der
;; Marker-String "linienzug"/"linienzug2"/"linienzug3" unterschied sich).
;;
;; Der Handler faengt jeden Abbruch (ESC / (exit) / Laufzeitfehler) ab, wickelt
;; die bis dahin gebaute Teil-Geometrie per vfl-modus-abbruch-sichern zu einem
;; VF_n-Block mit dem vollen Journal (Marker als XDATA) und stellt *error*
;; wieder her. Details/Begruendung (dynamic scoping, *ssg-ils-dim*-Reset,
;; ssg-end) siehe die ausfuehrlichen Kommentare an der frueheren Aufrufstelle
;; in vf-linienzug-modus.
;;
;; VERTRAG (dynamic scoping): Der Aufrufer MUSS als Locals gebunden haben und
;; VOR diesem Aufruf gesetzt haben: old-error (Ruecksprung-*error*), lastEnt,
;; vfl-nummer, anzahl-gf, anzahl-vf, startpunkt, frame, as-seite, es-seite,
;; dbg-an. Sie werden vom Handler-Lambda zur ABBRUCHZEIT dynamisch aufgeloest -
;; also gegen den dann noch aktiven Modus-Frame, nicht gegen diesen Konstruktor
;; (der ist beim Abbruch laengst zurueckgekehrt). marker wird dagegen ZUR
;; INSTALL-ZEIT als String-Literal in den Lambda eingebacken (list-Konstruktion),
;; damit der Handler ihn ohne globalen Zwischenzustand selbst traegt.
(defun vfl-abbruch-handler-installieren (marker)
;; *error* auf eine LAMBDA-LISTE setzen, in die der marker als String-Literal
;; eingebaut ist (list-Konstruktion). AutoLISP ruft *error* als Funktion auf,
;; egal ob (lambda ...) oder (function (lambda ...)) - die reine Lambda-Liste
;; genuegt und vermeidet eval/function-Feinheiten. Alle uebrigen Symbole
;; (old-error, lastEnt, ...) bleiben ungequotet-frei und werden zur Aufrufzeit
;; dynamisch aufgeloest.
(setq *error*
(list 'lambda '(msg)
'(setq *error* old-error)
'(setq *ssg-ils-dim* nil)
(list 'vfl-modus-abbruch-sichern 'lastEnt 'vfl-nummer 'anzahl-gf 'anzahl-vf
'startpunkt 'frame 'as-seite 'es-seite marker)
'(if dbg-an
(progn
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
(dbgreturn nil)
(dbgclose)))
'(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
'(princ)))
*error*)
(defun vfl-modus-abbruch-sichern (lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite marker /
e cnt vfl-ins wickel-erg grund fwd n trunc)
;; Abbruch-Grund VOR dem Wickeln merken (das Flag wird unten evtl. schon
;; fuer den "Zurueck"-Neuaufruf zurueckgesetzt) UND immer konsumieren, damit
;; kein "Zurueck"/"Abbrechen" aus diesem Lauf in einen etwaigen naechsten
;; durchsickert (siehe auch Reset am Kopf von vf-linienzug-modus).
(setq grund *vfl-wizard-abbruch-grund*)
(setq *vfl-wizard-abbruch-grund* nil)
(dbgmsg (strcat "ABBRUCH-SICHERN erreicht: grund=" (if grund grund "nil(ESC/Fehler)")))
(setq cnt 0 e (if lastEnt (entnext lastEnt) (entnext)))
(while e (setq cnt (1+ cnt)) (setq e (entnext e)))
(cond
((or (= cnt 0) (null frame))
(princ (ssg-text "vfl-abbruch-nichts-gebaut"))
;; "Zurueck" ohne jede gebaute Geometrie (z.B. ganz am Anfang) - nichts
;; zu verwerfen, einfach denselben Lauf frisch neu starten.
(if (= grund "zurueck") (vl-catch-all-apply 'vf-linienzug-modus)))
(t
;; vfl-block-erstellen nutzt intern (command "_.UCS" ...) fuer den
;; BKS-Wechsel (ssg-block-wrap-welt) - im *error*-Handler-Kontext
;; riskanter als eine einfache Loesch-Schleife, daher abgesichert.
(setq wickel-erg
(vl-catch-all-apply
(function (lambda ()
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf
(caddr startpunkt) (caddr (car frame))
(vfl-planar-dist startpunkt (car frame))
as-seite es-seite startpunkt lastEnt))
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins marker))))
nil))
(if (vl-catch-all-error-p wickel-erg)
(princ (ssg-textf "vfl-abbruch-wickeln-fehler"
(list (vl-catch-all-error-message wickel-erg))))
(progn
(princ (ssg-textf "vfl-abbruch-gesichert" (list (itoa cnt))))
(setq *vfl-abbruch-letztes-ent* vfl-ins)
;; "Zurueck": letztes (angefangenes) Glied verwerfen und automatisch
;; genau das tun, was der Sektions-Reset-Zweig von vfl-edit-ent sonst
;; ueber den Auswahl-Dialog macht - nur ohne den Dialog, Ziel-Sektion
;; ist immer "ein Glied weniger als jetzt vorhanden".
(if (and (= grund "zurueck") vfl-ins)
(progn
(setq fwd (reverse *vfl-journal*))
(setq n (length (vfl-journal-glieder fwd)))
(setq trunc (vfl-journal-truncate fwd (max 0 (1- n))))
(princ (ssg-text "vfl-zurueck-glied-verworfen"))
(entdel vfl-ins)
(vfl-journal-replay-start trunc)
(vl-catch-all-apply 'vf-linienzug-modus)))
)
)
)
)
(princ))
;; Replay-Modus scharf schalten: die uebergebene (Vorwaerts-)Journalliste wird
;; zur Lesequelle, *vfl-journal* startet leer und wird bei der erneuten
;; Ausfuehrung neu aufgebaut. Genutzt von vfl-edit-ent und der Wiederaufnahme.
(defun vfl-journal-replay-start (forward-journal)
(setq *vfl-replay-queue* forward-journal *vfl-journal* '()
*vfl-seg-glied-letzte* 0)
(if (boundp '*vflw-pending*) (setq *vflw-pending* nil)))
;; --- Glied-Zerlegung fuer den Editier-Dialog ---
;; Labels der Glieder (STEP-Marker) in Bau-Reihenfolge.
(defun vfl-journal-glieder (forward-journal / out)
(setq out '())
(foreach e forward-journal
(if (= (car e) "STEP") (setq out (cons (cdr e) out))))
(reverse out))
;; Journal auf die ersten (keep) Glieder kuerzen: Praeambel (vor dem 1. STEP)
;; bleibt immer erhalten; ab dem (keep+1)-ten STEP wird alles verworfen.
(defun vfl-journal-truncate (forward-journal keep / seen out done)
(setq seen 0 out '() done nil)
(foreach e forward-journal
(if (not done)
(if (= (car e) "STEP")
(if (< seen keep)
(progn (setq seen (1+ seen)) (setq out (cons e out)))
(setq done t))
(setq out (cons e out)))))
(reverse out))
;; Journal-Eintraege GENAU eines Glieds liefern: der (from-step-idx)-te STEP
;; (1-basiert, in Bau-Reihenfolge) bis ausschliesslich dem naechsten STEP.
;; Praeambel-Eintraege vor dem 1. STEP gehoeren zu keinem Glied und werden
;; hier nie zurueckgegeben (anders als vfl-journal-truncate, das sie immer
;; mitnimmt). Genutzt fuer die Segment-XDATA (vfl-segment-xdata-sichern) und
;; das Ersetzen eines einzelnen Glieds (vfl-journal-splice).
(defun vfl-journal-slice (forward-journal from-step-idx / seen out started done)
(setq seen 0 out '() started nil done nil)
(foreach e forward-journal
(if (not done)
(cond
((and (= (car e) "STEP") started) (setq done t))
((= (car e) "STEP")
(setq seen (1+ seen))
(if (= seen from-step-idx) (progn (setq started t) (setq out (cons e out)))))
(started (setq out (cons e out))))))
(reverse out))
;; Journal-Eintraege AB dem (from-step-idx)-ten Glied bis zum ENDE des
;; Journals (alle folgenden STEPs inklusive). Gegenstueck zu
;; vfl-journal-slice, das bei genau einem Glied stoppt.
;; Gebraucht fuer die Segment-XDATA: eine Iteration der Bau-Hauptschleife kann
;; MEHRERE Glieder erzeugen (eine VF-Einheit mit eingebetteten Vario-Kurven
;; legt Horizontal-VF/Linie-VF + je Kurve ein eigenes STEP ab). Auf die
;; Entities dieser Iteration muss deshalb der GESAMTE in ihr entstandene
;; Journal-Abschnitt, nicht nur die Slice des letzten Glieds - sonst fehlen
;; die Eingaben der Einheit selbst und die Kette ist aus der Zeichnung nicht
;; mehr vollstaendig rekonstruierbar (c:VF_SEKTION_RESTORE).
(defun vfl-journal-ab-glied (forward-journal from-step-idx / seen out started)
(setq seen 0 out '() started nil)
(foreach e forward-journal
(if started
(setq out (cons e out))
(if (= (car e) "STEP")
(progn
(setq seen (1+ seen))
(if (= seen from-step-idx)
(progn (setq started t) (setq out (cons e out))))))))
(reverse out))
;; Anzahl der Glieder (STEP-Eintraege) in einem Journal-Abschnitt.
(defun vfl-steps-zaehlen (journal / n)
(setq n 0)
(foreach e journal (if (= (car e) "STEP") (setq n (1+ n))))
n)
;; Journal-Eintraege des Glieds (seg-idx) durch (new-seg-journal) ersetzen -
;; alle anderen Glieder (davor UND danach) sowie die Praeambel bleiben
;; unveraendert. Gegenstueck zu vfl-journal-slice (welches genau dieses Glied
;; ISOLIERT liefert). Genutzt von der Einzelsegment-Bearbeitung (vfl-edit-glied).
(defun vfl-journal-splice (forward-journal seg-idx new-seg-journal / seen out)
(setq seen 0 out '())
(foreach e forward-journal
(progn
(if (= (car e) "STEP") (setq seen (1+ seen)))
(cond
((< seen seg-idx) (setq out (cons e out))) ; vor dem Ziel-Glied: unveraendert
((> seen seg-idx) (setq out (cons e out))) ; nach dem Ziel-Glied: unveraendert
((and (= seen seg-idx) (= (car e) "STEP")) ; Ziel-Glied: einmalig durch
(setq out (append (reverse new-seg-journal) out)))))) ; new-seg-journal ersetzen,
(reverse out)) ; alle uebrigen Eintraege verwerfen
;; Internes (sprachneutrales) Glied-Token in lesbaren Text der AKTUELLEN Sprache
;; uebersetzen. Da im Journal nur das Token steht, folgt die Anzeige immer der
;; aktiven Sprache - ein in Deutsch aufgezeichnetes Journal zeigt in englischer
;; UI englische Labels (und umgekehrt).
(defun vfl-glied-label-text (w)
(cond ((= w "GF-Bogen") (ssg-text "vfl-glied-gf-bogen"))
((= w "Linie-GF") (ssg-text "vfl-glied-gf"))
((= w "Linie-VF") (ssg-text "vfl-glied-vf"))
((= w "Horizontal-VF") (ssg-text "vfl-glied-horizontal-vf"))
((= w "Linie") (ssg-text "vfl-glied-linie"))
((= w "AS") (ssg-text "vfl-glied-as"))
((= w "ES") (ssg-text "vfl-glied-es"))
((= w "Vario-Kurve") (ssg-text "vfl-glied-vario"))
((= w "?") (ssg-text "vfl-glied-offen"))
(t w)))
;; ============================================================
;; TEIL 1: SEGMENT-ENTSCHEIDUNG (GF oder VF)
;; ============================================================
;; Aus der Ergebnisliste von berechne-alle-winkel die GUELTIGEN Winkel filtern
;; und - bei mehreren - den Nutzer waehlen lassen. Rueckgabe: (winkel L_GF L_VF)
;; oder nil, wenn kein gueltiger Winkel existiert.
;; --- Winkelwahl: reine Teile + Frage-Schale ---
;; Die gueltigen Kandidaten aus einer berechne-alle-winkel-Ergebnisliste
;; filtern. Gueltig heisst: baubar (cadddr) UND beide Laengen positiv.
;; Reine Funktion, keine Frage, keine Globals.
(defun vfl-winkel-gueltige (ergebnis-liste / gueltige)
(setq gueltige '())
(foreach e ergebnis-liste
(if (and (cadddr e) (numberp (cadr e)) (numberp (caddr e))
(> (cadr e) 0) (> (caddr e) 0))
(setq gueltige (append gueltige (list e)))))
gueltige)
;; Kandidat Nummer idx (1-basiert) als (winkel L_GF L_VF). Ein Index
;; ausserhalb der Liste faellt auf den ersten Kandidaten zurueck - so
;; verhielt sich die Frage-Schale schon immer bei ungueltiger Eingabe.
(defun vfl-winkel-nach-index (gueltige idx / e)
(if (or (null idx) (< idx 1) (> idx (length gueltige))) (setq idx 1))
(setq e (nth (1- idx) gueltige))
(if e (list (nth 0 e) (nth 1 e) (nth 2 e)) nil))
;; Vorgabe-Kanal: ist *vfl-winkel-idx-vorgabe* gesetzt, wird NICHT gefragt,
;; sondern dieser Kandidat genommen. Derselbe Mechanismus, den die Datei
;; schon fuer die Wizard-Menues nutzt (dynamisch gebundene *vflw-menu-*).
;; Warum ein Kanal und kein Parameter: vfl-waehle-winkel wird aus vier
;; Solvern gerufen (vfl-vf-winkel, vfl-vf-entscheidung, vfl-body-zerlegung,
;; vfl-segment-entscheidung) - ein zusaetzlicher Parameter wuerde vier
;; Signaturen und alle deren Aufrufer aendern.
;; ACHTUNG: die Vorgabe gilt fuer JEDE folgende Winkelfrage, bis sie
;; zurueckgesetzt wird. Setzer muessen sie darum wieder auf nil stellen.
(if (not (boundp '*vfl-winkel-idx-vorgabe*))
(setq *vfl-winkel-idx-vorgabe* nil))
;; Hilfsfunktionen fuer winkel-werte-Listen, die je nach Aufrufer Zahlen
;; (GF-Bogen) oder Strings (ES) enthalten koennen.
(defun vfl-winkel-als-zahl (w) (if (numberp w) w (atoi w)))
(defun vfl-winkel-in-liste-p (grad liste)
(vl-some (function (lambda (w) (= (vfl-winkel-als-zahl w) grad))) liste))
;; Punkt 7: fuer eine VF-Einheit mit reduziertem Eingang (eingang-modus <>
;; nil, siehe vfl-eingang-modus-bestimmen) gibt es KEINE frei waehlbare
;; GF-Laenge mehr, mit der eine beliebige Zielhoehe exakt getroffen werden
;; koennte (L_GF ist dort immer 0.0) - stattdessen wird der Kletter-Winkel
;; aus der Bogen-Bibliothek (*vfk-bogen-winkel* ueber ssg-cfg-or) probiert
;; und die sich daraus ERGEBENDE Endhoehe je Winkel tabellarisch angezeigt.
;; Rueckgabe je Zeile: (winkel dH L_VF gueltig).
(defun vfl-winkel-hoehen-optionen (deltaL richtung / winkel-list rad3 w
mass1 mass2 r2 winkel-eff radEff
bx1 bz1 bx2 bz2 L_VF dH gueltig ergebnisse)
(setq winkel-list (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq rad3 (* *vfk-gefaelle-winkel* (/ pi 180.0)))
(setq ergebnisse '())
(foreach w winkel-list
(if (= richtung "Auf")
(setq mass1 (get-bogen-mass bogen-auf w) mass2 (get-bogen-mass bogen-ab w)
r2 (* (float (- *vfk-gefaelle-winkel* w)) (/ pi 180.0))
winkel-eff (- w *vfk-gefaelle-winkel*))
(setq mass1 (get-bogen-mass bogen-ab w) mass2 (get-bogen-mass bogen-auf w)
r2 (* (float (+ w *vfk-gefaelle-winkel*)) (/ pi 180.0))
winkel-eff (+ w *vfk-gefaelle-winkel*)))
(setq dH nil L_VF nil gueltig nil)
(if (and mass1 mass2)
(progn
(setq bx1 (+ (* (car mass1) (cos rad3)) (* (caddr mass1) (sin rad3))))
(setq bz1 (+ (* (- (car mass1)) (sin rad3)) (* (caddr mass1) (cos rad3))))
(setq bx2 (+ (* (car mass2) (cos r2)) (* (caddr mass2) (sin r2))))
(setq bz2 (+ (* (- (car mass2)) (sin r2)) (* (caddr mass2) (cos r2))))
(setq radEff (* (float winkel-eff) (/ pi 180.0)))
(setq L_VF (/ (- deltaL bx1 bx2) (cos radEff)))
(if (> L_VF *vfk-restlaenge-min-clamp*)
(progn
(setq dH (+ bz1 bz2 (* L_VF (sin radEff))))
(setq gueltig t)
)
)
)
)
(setq ergebnisse (append ergebnisse (list (list w dH L_VF gueltig))))
)
ergebnisse)
;; UI zu vfl-winkel-hoehen-optionen: ALLE konfigurierten Winkel als Tabelle
;; zeigen (gueltige mit resultierender Endhoehe, ungueltige mit Hinweis
;; "Bogen passt nicht in die gewaehlte Strecke"), dann aus den GUELTIGEN
;; waehlen lassen. start-z = aktuelle Z-Koordinate (fuer die Anzeige der
;; absoluten Ende-Hoehe). Rueckgabe: (winkel dH L_VF gueltig) oder nil, wenn
;; kein einziger Winkel bei dieser Streckenlaenge baubar ist.
(defun vfl-waehle-winkel-hoehen-tabelle (deltaL richtung start-z /
optionen gueltige idx labels e antwort)
(setq optionen (vfl-winkel-hoehen-optionen deltaL richtung))
(princ (ssg-text "vfl-winkel-hoehen-header"))
(foreach e optionen
(if (nth 3 e)
(princ (ssg-textf "vfl-winkel-hoehen-zeile" (list (car e) (rtos (+ start-z (nth 1 e)) 2 0))))
(princ (ssg-textf "vfl-winkel-hoehen-zeile-ungueltig" (list (car e))))
)
)
(setq gueltige (vl-remove-if-not (function (lambda (e) (nth 3 e))) optionen))
(cond
((null gueltige) nil)
((= (length gueltige) 1) (car gueltige))
(t
(setq idx 1 labels '())
(foreach e gueltige
(setq labels (append labels
(list (ssg-textf "vfl-winkel-hoehen-option"
(list idx (car e) (rtos (+ start-z (nth 1 e)) 2 0))))))
(setq idx (1+ idx)))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-winkel-hoehen-impl (list optionen gueltige start-z)))
(setq antwort (vfl-menu-int (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige)))
labels 1 "vfl-winkel-hoehen-header"))
(if (or (null antwort) (< antwort 1) (> antwort (length gueltige))) (setq antwort 1))
(nth (1- antwort) gueltige))))
;; Frage-Schale (Name unveraendert, alle Aufrufstellen bleiben): gueltige
;; Kandidaten bestimmen, bei genau einem ohne Frage nehmen, sonst fragen -
;; bzw. die Vorgabe verwenden.
(defun vfl-waehle-winkel (ergebnis-liste / gueltige idx antwort e labels)
(setq gueltige (vfl-winkel-gueltige ergebnis-liste))
(cond
((null gueltige) nil)
((= (length gueltige) 1) (vfl-winkel-nach-index gueltige 1))
(*vfl-winkel-idx-vorgabe*
(vfl-winkel-nach-index gueltige *vfl-winkel-idx-vorgabe*))
(t
(princ (ssg-text "vfl-mehrere-winkel-header"))
(setq idx 1 labels '())
(foreach e gueltige
(princ (ssg-textf "vfl-winkel-option"
(list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))
(setq labels (append labels
(list (ssg-textf "vfl-winkel-option" (list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))))
(setq idx (1+ idx)))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-winkel-wahl-impl (list ergebnis-liste gueltige)))
(setq antwort (vfl-menu-int (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige)))
labels 1 "vfl-mehrere-winkel-header"))
(vfl-winkel-nach-index gueltige antwort))))
;; berechne-alle-winkel ausfuehren (mit Linienzug-FESTE_HORIZONTAL = 1300) und
;; den Winkel waehlen lassen. Rueckgabe: (winkel L_GF L_VF) oder nil.
;; aus-dx/aus-dz temporaer nullen: an jeder Aufrufstelle (ueber vfl-vf-
;; entscheidung) ist ein evtl. vorhandenes AS-Element bereits real eingefuegt
;; und deltaL bereits aus dessen echtem KS_AUS neu berechnet (vfl-projiziere-
;; distanz) - der Platzbedarf ist also schon "verbraucht" und darf nicht
;; nochmal in berechne-alle-winkel abgezogen werden (sonst fehlt am Ende
;; systematisch genau dieser Betrag, aus-dx typischerweise mehrere hundert mm).
;; ein-dx/ein-dz bleiben unangetastet: das ES-Element ist an dieser Stelle noch
;; nicht gebaut (folgt erst nach der "Kettenende?"-Frage) - konsistent mit
;; vfl-body-zerlegung, die ebenfalls nur aus-dx/aus-dz nullt.
(defun vfl-vf-winkel (deltaL deltaH richtung / save-ausdx save-ausdz res)
(setq save-ausdx aus-dx save-ausdz aus-dz)
(setq aus-dx 0.0 aus-dz 0.0)
(setq res
(vfl-waehle-winkel
(nth 3 (berechne-alle-winkel deltaL deltaH richtung *vfl-feste-horizontal* nil))))
(setq aus-dx save-ausdx aus-dz save-ausdz)
res)
;; Rueckgabe: (typ winkel L_GF L_VF) - erzwingt IMMER eine VF-Einheit (nie GF),
;; genutzt sowohl von vfl-segment-entscheidung (automatische Zweig-Auswahl) als
;; auch direkt vom expliziten "Ab/Auf VF"-Menuepunkt in Modus 1 (vf-linienzug-modus).
;; typ="VF": winkel = best-winkel (0 = Horizontale Mitte), L_GF/L_VF wie
;; berechne-alle-winkel bzw. berechne-horizontale-mitte
;; typ=nil : keine VF-Einheit fuer dieses deltaL/deltaH geometrisch moeglich
;; Duenner Wrapper: eigene Mindestlaenge (Umlenkstation+Motorstation), sonst
;; delegiert an vfl-winkel-stufe-entscheidung mit dem Eingangs-Budget einer
;; frischen VF-Einheit. schon-flach immer nil - der Frame kommt hier immer
;; frisch von der Umlenkstation bei 3 Grad, nie flach.
(defun vfl-vf-entscheidung (deltaL deltaH richtung)
(if (< deltaL *vfk-vf-mindestlaenge*)
(list nil nil nil nil)
(vfl-winkel-stufe-entscheidung deltaL deltaH richtung nil *vfl-feste-horizontal*)))
;; Stumme Variante von berechne-alle-winkel: NUR die Machbarkeits-Pruefung
;; (mind. ein Winkel mit L_GF>=0 und L_VF>=0), OHNE die Diagnosetabelle auf
;; die Kommandozeile zu schreiben. Rechenweg 1:1 aus berechne-alle-winkel
;; (vf_standard.lsp) uebernommen - bei Aenderungen dort auch hier nachziehen.
;; Gebraucht von vfl-vf-machbar-p fuer die Sondierung in vfl-vf-min-deltah,
;; die viele Testwerte durchprobiert (dort wuerde die Tabellenausgabe von
;; berechne-alle-winkel die Konsole zuspammen).
(defun vfl-winkel-machbar-p (deltaL deltaH richtung feste-hz schon-flach /
winkel-list cos3 sin3 mass1 mass2 rad5 rad7
bogen-x1 bogen-z1 bogen-x2 bogen-z2 cosa sina
A B winkel-eff cosEff sinEff L_GF L_VF
abs-dz-AUS abs-dz-EIN gefunden entry-mass entry-dx entry-dz)
(if (null feste-hz) (setq feste-hz FESTE_HORIZONTAL))
(setq entry-dx 0.0 entry-dz 0.0)
(if schon-flach
(progn
(setq entry-mass (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(setq entry-dx (car entry-mass) entry-dz (caddr entry-mass))))
(setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz))
(setq winkel-list (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq cos3 (cos (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0)))
sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))))
(setq gefunden nil)
(foreach winkel winkel-list
(if (not gefunden)
(progn
(if (= richtung "Auf")
(setq mass1 (get-bogen-mass bogen-auf winkel)
mass2 (get-bogen-mass bogen-ab winkel))
(setq mass1 (get-bogen-mass bogen-ab winkel)
mass2 (get-bogen-mass bogen-auf winkel)))
(if (and mass1 mass2)
(progn
(setq rad5 (* *vfk-gefaelle-winkel* (/ pi 180.0)))
(setq rad7 (* (float (if (= richtung "Auf") (- *vfk-gefaelle-winkel* winkel) (+ winkel *vfk-gefaelle-winkel*)))
(/ pi 180.0)))
(setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5))))
(setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5))))
(setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7))))
(setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7))))
(setq cosa (cos (* winkel (/ pi 180.0)))
sina (sin (* winkel (/ pi 180.0))))
(setq A (- deltaL aus-dx ein-dx bogen-x1 bogen-x2 (* feste-hz cos3) entry-dx))
(setq winkel-eff (if (= richtung "Auf") (- winkel *vfk-gefaelle-winkel*) (+ winkel *vfk-gefaelle-winkel*)))
(setq cosEff (cos (* winkel-eff (/ pi 180.0)))
sinEff (sin (* winkel-eff (/ pi 180.0))))
(if (= richtung "Auf")
(setq B (+ deltaH abs-dz-AUS abs-dz-EIN (abs entry-dz) (- bogen-z1) (- bogen-z2)
(* feste-hz sin3)))
(setq B (+ (- deltaH abs-dz-AUS abs-dz-EIN (abs entry-dz) (* feste-hz sin3))
bogen-z1 bogen-z2)))
(if (> (abs sina) 0.0001)
(progn
(setq L_GF (/ (- (* A sinEff) (* B cosEff)) sina))
(if (= richtung "Auf")
(setq L_VF (/ (+ (* A sin3) (* B cos3)) sina))
(setq L_VF (/ (- (* B cos3) (* A sin3)) sina)))
(if (and (numberp L_GF) (numberp L_VF) (>= L_GF 0) (>= L_VF 0))
(setq gefunden t))
)
)
)
)
)
)
)
gefunden
)
;; Nur-Machbarkeits-Check (kein interaktives Waehlen wie vfl-waehle-winkel):
;; T, wenn fuer deltaL/deltaH/richtung MINDESTENS ein gueltiger Winkel bzw.
;; die horizontale Mitte existiert - sonst nil. Nutzt dieselbe Fallunter-
;; scheidung wie vfl-vf-entscheidung, aber ohne Nutzer-Interaktion (fuer die
;; Sondierung in vfl-vf-min-deltah). aus-dx/aus-dz werden wie in vfl-vf-winkel
;; temporaer genullt (AS-Footprint an dieser Stelle bereits verbraucht) -
;; sonst wuerde die Sondierung ein zu kleines Budget sehen und einen
;; eigentlich baubaren Wert faelschlich als "nicht baubar" verwerfen.
(defun vfl-vf-machbar-p (deltaL deltaH richtung / horizontal-info save-ausdx save-ausdz ergebnis)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(cond
((< deltaL *vfk-vf-mindestlaenge*) nil)
((< deltaH 1.0) nil)
((= richtung "Auf")
(setq save-ausdx aus-dx save-ausdz aus-dz)
(setq aus-dx 0.0 aus-dz 0.0)
(setq ergebnis (vfl-winkel-machbar-p deltaL deltaH "Auf" *vfl-feste-horizontal* nil))
(setq aus-dx save-ausdx aus-dz save-ausdz)
ergebnis)
(t
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" nil))
(if (and horizontal-info (caddr horizontal-info))
t
(progn
(setq save-ausdx aus-dx save-ausdz aus-dz)
(setq aus-dx 0.0 aus-dz 0.0)
(setq ergebnis (vfl-winkel-machbar-p deltaL deltaH "Ab" *vfl-feste-horizontal* nil))
(setq aus-dx save-ausdx aus-dz save-ausdz)
ergebnis)))
)
)
;; Kleinste baubare Hoehendifferenz (mm, > 0) fuer deltaL/richtung sondieren -
;; linearer Anstieg in 10-mm-Schritten (grob genug fuer einen Vorschlagswert,
;; fein genug um keine schmale gueltige Zone zu ueberspringen) bis 1/3 von
;; deltaL (grosszuegige Obergrenze; steilere Faelle braucht kein Vorschlag).
;; Rueckgabe: deltaH (mm) oder nil, wenn in diesem Bereich nichts baubar ist.
(defun vfl-vf-min-deltah (deltaL richtung / schritt grenze h gefunden)
(setq schritt 10.0)
(setq grenze (/ deltaL *vfk-gefaelle-winkel*))
(setq h schritt gefunden nil)
(while (and (not gefunden) (<= h grenze))
(if (vfl-vf-machbar-p deltaL h richtung)
(setq gefunden h)
(setq h (+ h schritt)))
)
gefunden
)
;; Liefert zwei baubare Ziel-Hoehen-Vorschlaege (Ab zuerst, Auf danach) fuer
;; die aktuelle Kettenhoehe p-aktuell-z bei gegebenem deltaL - Ersatz fuer den
;; blossen "unveraenderte Ist-Hoehe"-Default, der bei direkter Uebernahme
;; immer als deltaH=0 ("kein sinnvolles VF") abgelehnt wird (siehe
;; vfl-vf-entscheidung). NUR-VF-Variante: fuer den expliziten "Linie-VF"-
;; Menuepunkt, wo GF keine Option ist (der Nutzer hat VF bereits gewaehlt).
;; Rueckgabe: (hoehe-ab hoehe-auf) - je nil, wenn in der sondierten Zone kein
;; baubarer Wert existiert.
(defun vfl-vf-hoehe-vorschlaege (p-aktuell-z deltaL / min-ab min-auf)
(setq min-ab (vfl-vf-min-deltah deltaL "Ab"))
(setq min-auf (vfl-vf-min-deltah deltaL "Auf"))
(list
(if min-ab (- p-aktuell-z min-ab) nil)
(if min-auf (+ p-aktuell-z min-auf) nil))
)
;; Wie vfl-vf-hoehe-vorschlaege, aber fuer den automatischen "Linie"-Menue-
;; punkt (vfl-segment-entscheidung: GF ODER VF). Der Ab-Vorschlag nutzt dort
;; NICHT die VF-Sondierung, sondern direkt die feste 3-Grad-GF-Neigung
;; (deltaH = deltaL*tan(3 Grad), wie im bestehenden Kurzsegment-Zweig,
;; vfl-baue-mehrsegment-linie oben) - bei exakt 3 Grad natuerlichem Winkel
;; greift IMMER der GF-Zweig von vfl-segment-entscheidung (Toleranzband um
;; 3 Grad), eine reine Gefaellestrecke hat keine deltaL-Mindestlaenge und ist
;; damit garantiert baubar, ohne die (teurere) VF-Sondierung zu brauchen. Der
;; Auf-Vorschlag bleibt VF-only (GF kann nicht steigen).
(defun vfl-segment-hoehe-vorschlaege (p-aktuell-z deltaL / min-ab min-auf rad3)
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
(setq min-ab (* deltaL (/ (sin rad3) (cos rad3))))
(setq min-auf (vfl-vf-min-deltah deltaL "Auf"))
(list
(- p-aktuell-z min-ab)
(if min-auf (+ p-aktuell-z min-auf) nil))
)
;; Hinweis auf die Konsole, wenn NUR EINE der beiden Richtungen einen
;; baubaren Vorschlag hat (die andere Richtung ist bei dieser Segmentlaenge
;; also aussichtslos) - macht sichtbar, warum der Dialog/Prompt dann nur
;; einen Wert zeigt, statt es wie einen Fehler wirken zu lassen.
(defun vfl-hoehe-hinweis-falls-noetig (hoehe-ab hoehe-auf)
(if (or (and hoehe-ab (not hoehe-auf)) (and hoehe-auf (not hoehe-ab)))
(princ (ssg-text "vfl-hinweis-hoehe-vorschlag-fehlt")))
(princ)
)
;; Gemeinsame Frage-Schale "Zielhoehe nach Endpunkt-Pick" - buendelt das an
;; mehreren Stellen (vfl-body-abschluss/Kettenende, VF-Fortsetzung Auf/Ab,
;; Horizontal-VF-Eingang, "Linie" GF-Familie) fast identisch wiederholte
;; Muster (Wizard-Dialog + Konsolen-Fallback + leere Eingabe -> Vorschlag).
;; *vfl-letzter-pick-z* (von vfl-in-abstand gesetzt, siehe dort) hat Vorrang
;; vor dem rein rechnerischen Ab-Vorschlag: wurde der Endpunkt per Objektfang
;; auf einem echten 3D-Punkt (z.B. einem vorhandenen Block) gepickt, ist genau
;; diese Hoehe die vom Nutzer gemeinte Zielhoehe - nicht der naechstgelegene
;; nur rechnerisch baubare Wert. Der Vorschlag bleibt im Eingabefeld/Dialog
;; jederzeit ueberschreibbar; der final gewaehlte Wert (hn) fliesst dabei
;; UNVERAENDERT in den Bau ein (siehe Aufrufer) - eine manuelle Korrektur wird
;; also korrekt weiterverrechnet, nicht verworfen.
;; schluessel-basis waehlt die passenden lang-Keys ("endpunkt"/"kettenende"/
;; "linienendpunkt", siehe lang/de_DE.json) - vor dem Anlegen weiterer
;; Varianten immer erst pruefen, ob eine der drei bestehenden passt.
;; Rueckgabe: die gewaehlte Zielhoehe, NIE nil (leere Eingabe -> Vorschlag).
(defun vfl-hoehe-endpunkt-abfragen (hoehe-ab hoehe-auf ist-hoehe schluessel-basis / hoehe-fallback hn)
(setq hoehe-fallback
(cond (*vfl-letzter-pick-z* *vfl-letzter-pick-z*) (hoehe-ab hoehe-ab) (t ist-hoehe)))
(vfl-hoehe-hinweis-falls-noetig hoehe-ab hoehe-auf)
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl
(list (list hoehe-ab hoehe-auf ist-hoehe *vfl-letzter-pick-z*))))
(setq hn
(vfl-in-real
(cond
((and hoehe-ab hoehe-auf *vfl-letzter-pick-z*)
(ssg-textf (strcat "vfl-prompt-hoehe-" schluessel-basis "-3")
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1) (rtos *vfl-letzter-pick-z* 2 1))))
((and hoehe-ab hoehe-auf)
(ssg-textf (strcat "vfl-prompt-hoehe-" schluessel-basis "-2")
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1))))
(t
(ssg-textf (strcat "vfl-prompt-hoehe-" schluessel-basis)
(list (rtos hoehe-fallback 2 1)))))))
(if (null hn) (setq hn hoehe-fallback))
hn
)
;; Konsolen-Echo nach Endpunkt-Pick + Zielhoehe-Eingabe: zeigt den absoluten
;; Endpunkt (X/Y, aus p-aktuell + deltaL entlang hz-neu zurueckgerechnet - nur
;; deltaL/hz werden journalisiert, siehe vfl-in-abstand) sowie die eingegebene
;; Zielhoehe UND das daraus resultierende deltaH VOR jeder spaeteren
;; Footprint-Reduktion (Separator/ES bei linie-ende-modus) - damit am
;; Bildschirm nachvollziehbar bleibt, welcher Rohwert in eine spaeter
;; angezeigte, ggf. reduzierte Zahl eingeht (sonst wirkt ein reduzierter Wert
;; wie ein Rechenfehler statt wie eine bewusste Reservierung).
(defun vfl-echo-endpunkt-hoehe (p-aktuell deltaL hz-neu hoehe-neu deltaH richtung / rad ex ey)
(setq rad (* (float hz-neu) (/ pi 180.0)))
(setq ex (+ (car p-aktuell) (* deltaL (cos rad))))
(setq ey (+ (cadr p-aktuell) (* deltaL (sin rad))))
(princ (ssg-textf "vfl-echo-endpunkt-hoehe"
(list (rtos ex 2 1) (rtos ey 2 1) (rtos deltaL 2 0) (rtos hz-neu 2 1)
(rtos hoehe-neu 2 1) (rtos (caddr p-aktuell) 2 1)
(rtos deltaH 2 1) richtung)))
(princ)
)
;; Konsolen-Echo der aktuellen Kettenposition (X/Y/Z) - nach jedem gebauten
;; Kettenglied aufgerufen, damit der Nutzer ohne Attribut-Blick sofort sieht,
;; wo die Kette gerade steht (Wunsch nach durchgaengigem Fortschritts-Echo,
;; analog zu vfl-echo-endpunkt-hoehe).
(defun vfl-echo-position (pt)
(princ (ssg-textf "vfl-echo-position"
(list (rtos (car pt) 2 2) (rtos (cadr pt) 2 2) (rtos (caddr pt) 2 2))))
(princ)
)
;; Konsolen-Echo der getroffenen Menue-Auswahl (Label-Text statt nur "1"/"2"),
;; damit ein Log/Protokoll nachvollziehbar bleibt, was gewaehlt wurde.
(defun vfl-echo-wahl (label)
(princ (ssg-textf "vfl-echo-wahl" (list label)))
(princ)
)
;; Wie vfl-vf-machbar-p, aber fuer das Budget von vfl-body-zerlegung
;; (Kettenende-Modus, "Ja - Motorstation setzen, Kettenende festlegen"):
;; feste-hz=800 (nur Motor+Separator, KEIN Umlenk-/AS-Anteil) statt
;; *vfl-feste-horizontal*, Mindestlaenge 800mm statt 1000mm, und bei
;; praktisch flachem Rest (deltaH<1) NUR die horizontale Mitte (kein
;; direkter GF-Fallback wie bei vfl-vf-machbar-p - vfl-body-zerlegung prueft
;; GF nur beim natuerlichen ~3-Grad-Fall weiter unten). aus-dx/aus-dz werden
;; wie im Original immer genullt (nicht nur bedingt wie bei vfl-vf-machbar-p),
;; da der Abschluss-Koerper nie einen AS-Fussabdruck traegt.
;; Reserviertes Fest-Budget am Kettenende: Motor+Separator (800), AUSSER kein
;; ES gewuenscht - dann baut vfl-insert-es-element (das den Separator
;; MITBRINGT) gar nicht erst, also darf auch kein Separator reserviert werden
;; (sonst bleibt die Kette um dessen Laenge hinter dem Zielpunkt zurueck -
;; realer Bug, siehe vfl-body-zerlegung).
(defun vfl-body-budget (es-gewuenscht)
(if es-gewuenscht
*vfk-feste-horizontal-kettenende*
(- *vfk-feste-horizontal-kettenende* *vfk-separator-laenge*)))
(defun vfl-body-machbar-p (deltaL deltaH richtung es-gewuenscht schon-flach /
horizontal-info save-ausdx save-ausdz ergebnis budget)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(setq budget (vfl-body-budget es-gewuenscht))
(setq save-ausdx aus-dx save-ausdz aus-dz)
(setq aus-dx 0.0 aus-dz 0.0)
(setq ergebnis
(cond
((< deltaL budget) nil)
((< deltaH 1.0)
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" schon-flach))
(and horizontal-info (caddr horizontal-info) t))
((= richtung "Auf")
(vfl-winkel-machbar-p deltaL deltaH "Auf" budget schon-flach))
(t
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" schon-flach))
(if (and horizontal-info (caddr horizontal-info))
t
(vfl-winkel-machbar-p deltaL deltaH "Ab" budget schon-flach)))
)
)
(setq aus-dx save-ausdx aus-dz save-ausdz)
ergebnis
)
;; Wie vfl-vf-min-deltah, aber mit vfl-body-machbar-p (Budget von
;; vfl-body-zerlegung statt vfl-vf-entscheidung).
(defun vfl-body-min-deltah (deltaL richtung es-gewuenscht schon-flach / schritt grenze h gefunden)
(setq schritt 10.0)
(setq grenze (/ deltaL *vfk-gefaelle-winkel*))
(setq h schritt gefunden nil)
(while (and (not gefunden) (<= h grenze))
(if (vfl-body-machbar-p deltaL h richtung es-gewuenscht schon-flach)
(setq gefunden h)
(setq h (+ h schritt)))
)
gefunden
)
;; Wie vfl-vf-hoehe-vorschlaege, aber fuer vfl-body-abschluss (Kettenende-
;; Modus): nutzt vfl-body-min-deltah (800mm-Budget, 500mm ohne ES) statt
;; vfl-vf-min-deltah (1300mm-Budget) - sonst wuerde ein Vorschlag als baubar
;; erscheinen, der es am Kettenende (kleineres Budget: nur Motor+Separator,
;; kein Umlenk-Anteil) tatsaechlich nicht ist.
(defun vfl-body-hoehe-vorschlaege (p-aktuell-z deltaL es-gewuenscht schon-flach / min-ab min-auf)
(setq min-ab (vfl-body-min-deltah deltaL "Ab" es-gewuenscht schon-flach))
(setq min-auf (vfl-body-min-deltah deltaL "Auf" es-gewuenscht schon-flach))
(list
(if min-ab (- p-aktuell-z min-ab) nil)
(if min-auf (+ p-aktuell-z min-auf) nil))
)
;; Rueckgabe: (typ winkel L_GF L_VF)
;; typ="GF": winkel = kontinuierlicher Neigungswinkel, L_GF/L_VF ungenutzt (nil)
;; typ="VF": winkel = best-winkel (0 = Horizontale Mitte), L_GF/L_VF wie
;; berechne-alle-winkel bzw. berechne-horizontale-mitte
;; typ=nil : weder GF noch VF fuer dieses deltaL/deltaH geometrisch moeglich
(defun vfl-segment-entscheidung (deltaL deltaH richtung / winkel-natuerlich)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(cond
;; Zu kurz fuer eine VF-Einheit: Umlenkstation (500 mm) + Motorstation
;; (500 mm) belegen zusammen 1000 mm deltaL - darunter ist kein VF baubar.
;; Also nur GF moeglich, und GF ist mindestens 3 Grad geneigt -> fest 3 Grad.
;; Steigend geht mit einer Gefaellestrecke nicht -> nicht baubar.
((< deltaL *vfk-vf-mindestlaenge*)
(if (= richtung "Auf")
(list nil nil nil nil)
(list "GF" *vfk-gefaelle-winkel* nil nil)))
;; Steigend: Gefaelle kann nicht steigen -> nur VF moeglich. deltaH<1.0
;; (kein messbarer Hoehenunterschied) faellt jetzt NICHT mehr sofort raus -
;; vfl-vf-entscheidung (ueber vfl-winkel-stufe-entscheidung) behandelt das
;; selbst als "praktisch flach" (horizontales VF + GF2, Stufe 2).
((= richtung "Auf") (vfl-vf-entscheidung deltaL deltaH richtung))
;; Fallend: natuerlichen Neigungswinkel bestimmen (atan der Schraege).
;; Eine reine Gefaellestrecke ist nie steiler als 3 Grad, daher:
;; ~3 Grad (Toleranzband) -> reine GF, am NATUERLICHEN Winkel gebaut
;; sonst -> VF (vfl-vf-entscheidung)
;; WICHTIG: winkel-natuerlich (nicht der feste *vfk-gefaelle-winkel*) wird
;; zurueckgegeben - vfl-insert-gf-segment (der tatsaechliche Bauaufruf,
;; siehe Aufrufer) baut GENAU bei diesem Winkel ueber die volle deltaL,
;; trifft deltaH damit per Definition exakt. Der feste 3-Grad-Wert wuerde
;; hier - anders als beim Kettenende-Abschluss (vfl-winkel-stufe-
;; entscheidung/vfl-body-abschluss, wo GF2 ohnehin IMMER fest bei 3 Grad
;; gebaut wird und ein abweichender Rueckgabewinkel wirkungslos waere) -
;; einen echten Hoehenfehler erzeugen, sobald der natuerliche Winkel nur
;; NAHE (Toleranz *vfl-gf-winkel-toleranz*=0.5 Grad), aber nicht EXAKT 3
;; Grad ist.
(t
(setq winkel-natuerlich (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
(if (<= (abs (- winkel-natuerlich *vfk-gefaelle-winkel*)) *vfl-gf-winkel-toleranz*)
(list "GF" winkel-natuerlich nil nil)
(vfl-vf-entscheidung deltaL deltaH richtung))
)
)
)
;; ============================================================
;; TEIL 2: SEGMENT-EINFUEGUNG (ohne AS/ES - reine Kettenmitte)
;; ============================================================
;; Reine, kontinuierlich skalierte Gefaelleschraege (kein AS/ES, kein Bogen).
;; punkt: Startpunkt (3D), hz: Horizontalrichtung, deltaL: horizontaler
;; Fussabdruck, winkel: Neigungswinkel (aus vfl-segment-entscheidung).
;; Die Schraeglaenge wird aus deltaL/cos(winkel) abgeleitet, damit der
;; horizontale Fussabdruck exakt deltaL entspricht (deltaH = deltaL*tan(winkel)
;; ergibt sich damit konsistent). Rueckgabe: neuer Frame am Segmentende.
(defun vfl-insert-gf-segment (punkt hz deltaL winkel / l-schraeg endpunkt)
(setq l-schraeg (/ deltaL (cos (* (float winkel) (/ pi 180.0)))))
(setq endpunkt
(gf-insert-hz-incl-scaled "Staustrecke_SP_1000_mm" punkt l-schraeg hz winkel))
(make-frame-from-dir endpunkt (hz-winkel->xu hz winkel))
)
;; Ansicht auf Grundriss (Draufsicht, Welt-UCS) zoomen: nach jedem
;; Kettenglied mit Geometrieerzeugung wird die neu entstandene Strecke sonst
;; leicht aus dem sichtbaren Bereich oder in eine schraege 3D-Ansicht
;; hinauslaufen - der naechste Punkt (vfl-neue-linie-messen, siehe unten)
;; waere dann schwer/ungenau anzuwaehlen. _PLAN "_World" aendert nur die
;; ANSICHT, nicht das aktuell aktive BKS. Rein kosmetisch (per
;; vl-catch-all-apply abgesichert) - ein Fehler hier darf den eigentlichen
;; Kettenbau nie unterbrechen.
(defun vfl-view-refresh ( / )
;; Headless nur Kosten: die Ansicht sieht niemand, _PLAN/_ZOOM laufen aber
;; vor JEDER Laengeneingabe (vfl-neue-linie-messen) - im Batch reine Zeit.
(if (not (vfl-headless-p))
(vl-catch-all-apply
(function (lambda ()
(command "_.PLAN" "_World")
(command "_.ZOOM" "_Extents")))
nil))
(princ))
;; --- Hilfsfunktionen fuer die VF-Einheit ---
;; Planare (XY-)Distanz und Richtung zwischen zwei Punkten.
(defun vfl-planar-dist (p1 p2)
(sqrt (+ (expt (- (car p2) (car p1)) 2) (expt (- (cadr p2) (cadr p1)) 2))))
(defun vfl-planar-hz (p1 p2)
(* (atan (- (cadr p2) (cadr p1)) (- (car p2) (car p1))) (/ 180.0 pi)))
;; Neue Linie ausmessen: Laenge (deltaL) und Fahrtrichtung (hz) bestimmen.
;; Ist hz-vorgabe gesetzt (Fahrtrichtung durch das vorherige Element - z.B.
;; einen GF-Bogen oder eine Vario-Kurve - bereits festgelegt), wird der
;; gewaehlte Punkt auf diese Richtung PROJIZIERT: die Linie folgt exakt der
;; Fahrtrichtung, der Nutzer gibt praktisch nur die Laenge vor (eine gerade
;; Foerderstrecke kann die Richtung nicht aendern). Nur beim allerersten
;; Segment (hz-vorgabe=nil) definiert der gewaehlte Punkt die Richtung frei.
;; Punkt-Abfrage mit FESTER 2-Arity (Basispunkt + Prompt). Verhaltensneutraler
;; Wrapper um das variadische Built-in getpoint: mit Basispunkt (base) wird die
;; 2-Argument-Form genutzt (Gummiband), ohne (base=nil) die reine Prompt-Form.
;; Zweck: ein Testmock kann diese feste Signatur ersetzen (getpoint selbst kann
;; als defun nicht 1- UND 2-argumentig gemockt werden).
;; DYNMODE waehrend des Picks auf 3 (Pointer- + Dimensions-Input) setzen, damit
;; BricsCAD Distanz/Winkel dynamisch am Cursor anzeigt (Laengen-Feedback beim
;; Picken) - danach den Nutzer-Wert wiederherstellen.
(defun vfl-getpoint (base prompt / old-dynmode pt)
(setq old-dynmode (vl-catch-all-apply 'getvar (list "DYNMODE")))
(if (vl-catch-all-error-p old-dynmode) (setq old-dynmode nil))
(if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" 3)))
(setq pt (if base (getpoint base prompt) (getpoint prompt)))
(if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" old-dynmode)))
pt
)
;; Vorschlagswert fuer die GF-Zielhoehe: die aktuelle Kettenhoehe (ist-hoehe)
;; UNVERAENDERT als Default anzubieten fuehrt in eine Falle - ein GF-Segment
;; MUSS fallen (0 Grad Gefaelle gibt es nicht), ein direkt uebernommener
;; Vorschlag mit deltaH=0 wird also immer als "kann nicht steigen" abgelehnt.
;; Deshalb hier auf volle mm ABGERUNDET (truncate, nicht rtos-Rundung - die
;; koennte sonst aufrunden und ueber die Ist-Hoehe hinausgehen) und bei
;; bereits ganzzahligen Werten zusaetzlich 1mm abgezogen, damit der Vorschlag
;; immer echt unterhalb der Ist-Hoehe liegt und direkt uebernehmbar ist.
(defun vfl-gf-hoehe-vorschlag (ist-hoehe / gekappt)
(setq gekappt (float (fix ist-hoehe)))
(if (>= gekappt ist-hoehe) (- gekappt 1.0) gekappt))
;; Punkt+Prompt-Eingabe fuer eine neue Linie journalfrei in (deltaL . hz)
;; uebersetzen: LIVE wird ganz normal ein Punkt gepickt (Gummiband), aber
;; NICHT der Punkt selbst journalisiert, sondern nur die daraus berechnete
;; Distanz (immer) und - NUR wenn hz-vorgabe nil war (freie Richtung, gilt
;; ausschliesslich fuer das allererste Segment der Kette) - zusaetzlich die
;; gesnappte Richtung. Ist hz-vorgabe bereits gesetzt (jedes Nicht-Start-
;; Segment), journalisiert diese Funktion NUR deltaL - die Richtung ist ja
;; ohnehin immer die des Vorgaengers, ein Journal-Eintrag dafuer waere
;; redundant. Rueckgabe: (deltaL . hz) oder nil bei Abbruch/leerer Eingabe.
(defun vfl-in-abstand (p-akt hz-vorgabe prompt / p2 rad ux uy deltaL hz-aktuell popped)
;; *vfl-letzter-pick-z* IMMER zuerst zuruecksetzen (auch im Replay-Zweig,
;; siehe unten) - ein Wert aus einem fruehreren Live-Pick derselben Sitzung
;; darf niemals in einen Replay-/Headless-Nachbau durchsickern.
(setq *vfl-letzter-pick-z* nil)
;; Zentraler Abbruch-Trigger (siehe Kommentar in vfl-in-value): vfl-in-abstand
;; hat eine EIGENE Pending-/Replay-Logik und laeuft NICHT ueber vfl-in-value/
;; -value-p - ohne diesen Check wuerde ein per Wizard-Dialog gesetztes
;; *vfl-wizard-abbruch-grund* hier NICHT erkannt: die Pending-Queue ist nach
;; einem Dialog-Abbruch leer, der Code faellt dann auf einen rohen
;; (vfl-getpoint ...)-Aufruf zurueck statt zu terminieren - genau das
;; Fehlerbild "Abbrechen springt zurueck in die Abfrage" statt zu beenden.
(if *vfl-wizard-abbruch-grund*
(progn
(dbgmsg (strcat "ABBRUCH-TRIGGER: *vfl-wizard-abbruch-grund*=" *vfl-wizard-abbruch-grund* " -> (exit)"))
(exit)))
;; Eigene Replay-Logik (zwei Eintraege pro Aufruf), darum ein eigener
;; Headless-Riegel: leere Queue = Desync, nicht "Nutzer soll picken".
(if (and (null *vfl-replay-queue*) (vfl-headless-p))
(vfl-headless-abbruch "DL"))
(if *vfl-replay-queue*
(progn
;; Replay: IMMER nur deltaL aus der Queue lesen (nie einen Punkt). Bei
;; freier Richtung (hz-vorgabe nil) steht direkt DANACH noch die
;; gesnappte Richtung als zweiter Eintrag im Journal (siehe
;; Live-Zweig unten) - Reihenfolge: deltaL, dann optional hz.
(setq popped (vfl-replay-pop))
(if (null popped)
(setq deltaL nil)
(setq deltaL (car popped)))
(if (and deltaL (null hz-vorgabe))
(progn
(setq popped (vfl-replay-pop))
;; Queue endet zwischen DL und Richtung: headless ein Desync, nicht
;; stillschweigend 0 Grad (das wuerde die ganze Kette verdrehen).
(if (and (null popped) (vfl-headless-p))
(vfl-headless-abbruch "REAL-hz"))
(setq hz-aktuell (if popped (car popped) 0.0)))
(setq hz-aktuell hz-vorgabe)))
(progn
;; Live/Wizard: Pending-Queue zuerst pruefen (Konsistenz mit den
;; anderen vfl-in-*-Wrappern/Sicherheitsnetz, siehe vfl-wizard-aktiv-
;; Kommentar oben) - aktuell legt kein Gruppen-Dialog hier einen Punkt
;; ab, dieser Zweig bleibt also praktisch immer leer. Sonst normal
;; picken (Gummiband). Der Punkt lebt nur hier lokal, er wird nie
;; journalisiert.
(setq popped (vflw-pending-pop))
(setq p2 (if popped (car popped) (vfl-getpoint p-akt prompt)))
;; *vfl-letzter-pick-z*: die Z-Hoehe DIESES Picks, fuer eine unmittelbar
;; nachfolgende Zielhoehe-Frage (siehe vfl-hoehe-endpunkt-abfragen) als
;; Vorschlag verfuegbar machen - vorher bei JEDEM Endpunkt-Pick
;; ersatzlos verworfen (nur X/Y gingen in deltaL ein), obwohl gerade ein
;; Snap auf einen vorhandenen 3D-Block (Objektfang) die vom Nutzer
;; gemeinte Zielhoehe meist schon exakt liefert. Nur uebernehmen, wenn
;; die Z-Koordinate spuerbar von der aktuellen Konstruktionsebene
;; (ELEVATION) abweicht - sonst ist es nur ein flacher Freihand-Klick
;; ohne echte 3D-Information, kein echter Objektfang. Analog zu
;; *vfl-stufe2-minl-vorschlag* ein transientes globales Vorschlags-Feld,
;; nicht Teil des Rueckgabewerts (der bleibt unveraendert deltaL/hz);
;; oben bereits auf nil zurueckgesetzt.
(if (and p2 (> (abs (- (caddr p2) (getvar "ELEVATION"))) 0.01))
(setq *vfl-letzter-pick-z* (caddr p2)))
(if (null p2)
(setq deltaL nil)
(progn
(setq hz-aktuell (if hz-vorgabe hz-vorgabe (vfl-hz-snappen-absolut (vfl-planar-hz p-akt p2))))
(setq rad (* (float hz-aktuell) (/ pi 180.0)) ux (cos rad) uy (sin rad))
(setq deltaL (+ (* (- (car p2) (car p-akt)) ux) (* (- (cadr p2) (cadr p-akt)) uy)))))))
;; Journalisieren fuer BEIDE Zweige (Replay UND Live) - wie alle anderen
;; vfl-in-*-Wrapper (siehe vfl-in-point/-real/-int): ein beim Replay aus der
;; alten Queue gelesener Wert MUSS ins neue *vfl-journal* uebernommen werden,
;; sonst fehlt er beim erneuten Speichern (vfl-journal-xdata-schreiben nach
;; einem Edit) - genau das fuehrte beim ZWEITEN Edit einer Kette zum
;; deltaL-Desync (die replizierten DL/Richtungs-Eintraege waren im nach dem
;; ersten Edit gespeicherten Journal verschwunden). Reihenfolge identisch zur
;; Lese-Reihenfolge oben: erst DL, dann - nur beim ersten Segment
;; (hz-vorgabe nil) - die gesnappte Richtung als REAL.
(vfl-journal-record (if deltaL "DL" "NIL") deltaL)
(if (and deltaL (null hz-vorgabe))
(vfl-journal-record "REAL" hz-aktuell))
(if deltaL (cons deltaL hz-aktuell) nil))
;; Rueckgabe: (deltaL hz) oder nil bei Abbruch. Foerderer-Maximallaenge 25 m:
;; bei Ueberschreitung wird die Eingabe abgelehnt und der Endpunkt erneut
;; abgefragt.
;;
;; WICHTIG (siehe vfl-in-abstand): journalisiert wird NUR deltaL (+ ggf. die
;; gesnappte Richtung beim allerersten Segment), niemals ein absoluter Punkt.
;; deltaL ist eine reine Distanz relativ zum AKTUELLEN Frame (p-akt) entlang
;; der (ggf. vom Vorgaenger geerbten) Fahrtrichtung - eine absolute
;; Weltkoordinate wuerde dagegen nur zur URSPRUENGLICHEN Frame-Position
;; passen. Wird nach einem Einzelsegment-Edit (vfl-edit-glied, z.B. GF-Bogen
;; Seite/Winkel aendern) die Kette AB einem anderen Frame neu verkettet, ist
;; eine gespeicherte Distanz+Richtung sofort und ohne jede Umrechnung wieder
;; korrekt - ein gespeicherter absoluter Punkt waere es nicht (siehe Bug:
;; Neuprojektion des alten Punkts gegen den neuen Frame ergab eine falsche,
;; teils negative Laenge und in der Folge einen Queue-Desync-Absturz).
;; Einzige Ausnahme im ganzen Modus 1: der Kettenstartpunkt (vf-linienzug-
;; modus, vfl-in-point auf den allerersten Klick) - er bleibt ein echter
;; absoluter Punkt, weil er den einzigen Anker der ganzen Kette markiert und
;; von keiner Bogen-Aenderung betroffen sein kann.
;; Reine Richtungswahl OHNE Laenge (journalisiert nur REAL, kein DL-Token) -
;; fuer Faelle, in denen am Kettenanfang eine Richtung noetig ist, aber (noch)
;; keine echte Segmentlaenge (z.B. Zielhoehe-zuerst-Zweige "Linie-GF", wo die
;; Laenge erst spaeter aus Hoehe/Winkel berechnet wird).
(defun vfl-in-richtung (p-akt prompt)
(vfl-in-value "REAL"
(function (lambda ( / p2)
(setq p2 (vfl-getpoint p-akt prompt))
(if p2 (vfl-hz-snappen-absolut (vfl-planar-hz p-akt p2)) nil)))))
(defun vfl-neue-linie-messen (p-akt hz-vorgabe / erg deltaL hz-aktuell ergebnis fertig)
(vfl-view-refresh)
(setq fertig nil)
(while (not fertig)
(setq erg (vfl-in-abstand p-akt hz-vorgabe
(if hz-vorgabe
(ssg-text "vfl-prompt-endpunkt-fahrtrichtung")
(ssg-text "vfl-prompt-endpunkt-frei"))))
(if (null erg)
(setq ergebnis nil fertig t)
(progn
(setq deltaL (car erg) hz-aktuell (cdr erg))
(if (> deltaL *vfk-segment-maximallaenge*)
(princ (ssg-textf "vfl-fehler-laenge-max" (list (rtos (/ deltaL 1000.0) 2 2))))
(progn
(setq ergebnis (list deltaL hz-aktuell))
(setq fertig t)
)
)
)
)
)
ergebnis
)
;; Planare Projektionsdistanz von neu-basis zu ziel-punkt entlang der
;; Fahrtrichtung hz (Grad) - wird genutzt, um nach dem AS-Element-Insert die
;; tatsaechlich noetige Restlaenge (vom echten KS_AUS zum urspruenglich
;; gepickten Punkt) direkt zu berechnen. Bewusst KEINE Fussabdruck-Schaetzung
;; (weder aus KS_EIN->KS_AUS noch aus Block-Ursprung->KS_AUS): beide ignorieren
;; die Dreh­teller-Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
;; anwendet, und liefern empirisch bestaetigt einen falschen Wert (~210mm
;; Schaetzung vs. ~420mm tatsaechlich noetiger Versatz bei AS_Element_30).
(defun vfl-projiziere-distanz (neu-basis ziel-punkt hz / rad)
(setq rad (* (float hz) (/ pi 180.0)))
(+ (* (- (car ziel-punkt) (car neu-basis)) (cos rad))
(* (- (cadr ziel-punkt) (cadr neu-basis)) (sin rad))))
;; Fahrtrichtung + Vorlauflaenge FUER EIN DREHENDES AS-/ES-ELEMENT so
;; korrigieren, dass dessen KS_AUS exakt den absoluten Zielpunkt trifft - real
;; gemessener Bug: die bisherige Reservierung zog nur den Laengsanteil
;; (ein-dx/aus-dx, hz-unabhaengig IMMER exakt der Laengsanteil des rohen
;; Block-Fussabdrucks) vom Budget ab, nie den Queranteil (ein-dy/aus-dy), der
;; bei jedem Winkel <>0 Grad entsteht (0 bei 0 Grad, maximal bei 90 Grad) -
;; die Kette landete dadurch seitlich exakt um raw-dy versetzt neben dem Ziel
;; (BricsCAD-bestaetigt: Modus 1 UND Modus 2, ES_Element_90, ca. 638mm Versatz,
;; Hoehe und Laengsrichtung dabei beide exakt getroffen).
;; Herleitung: Sei D = ziel - start (2D), raw-dx/raw-dy der ROHE, ungedrehte
;; Fussabdruck (vf-element-masse, KS_AUS-KS_EIN bei Rotation 0). Bei
;; Einfuegewinkel hz gilt IMMER (Rotationsinvariante: die Projektion eines
;; gedrehten Vektors auf seine eigene Drehachse aendert sich durch die Drehung
;; nicht): Laengsanteil (entlang hz) = raw-dx, Queranteil (quer zu hz) =
;; raw-dy - unabhaengig vom konkreten hz. Mit L = Vorlauflaenge + raw-dx
;; (effektive Gesamt-Laengsstrecke inkl. Element-Vorschub) folgt daraus ein
;; rechtwinkliges Dreieck: |D|^2 = L^2 + raw-dy^2 (D, L-Anteil und raw-dy-
;; Anteil bilden ein orthonormales Paar), also L = sqrt(|D|^2 - raw-dy^2), und
;; die gesuchte Richtung hz' = Winkel von D MINUS dem Winkel, den raw-dy quer
;; dazu beitraegt (atan2(raw-dy, L)).
;; Rueckgabe: (hz-korrigiert L) - L ist die korrigierte RAW-Distanz zum
;; Zielpunkt entlang hz-korrigiert (Laengsanteil von D), NICHT bereits um
;; raw-dx reduziert - genau wie das bisherige deltaL (vfl-neue-linie-messen/
;; vfl-projiziere-distanz) wird sie unveraendert an die bestehenden Solver
;; (vfl-body-zerlegung/vfl-vf-entscheidung -> berechne-alle-winkel) weiter-
;; gereicht, die raw-dx (ein-dx/aus-dx) SELBST intern abziehen (siehe deren
;; A-Formel) - hier zusaetzlich abzuziehen waere eine Doppel-Reservierung.
;; nil, wenn |D| < |raw-dy| (Ziel liegt naeher als der reine Seitenversatz -
;; geometrisch unerreichbar, unabhaengig von jeder Winkelwahl).
(defun vfl-richtung-mit-drehendem-fussabdruck (start ziel raw-dx raw-dy /
dx dy dsq l hz-ziel hz-korr)
(setq dx (- (car ziel) (car start)) dy (- (cadr ziel) (cadr start)))
(setq dsq (- (+ (* dx dx) (* dy dy)) (* raw-dy raw-dy)))
(if (< dsq 0.0)
nil
(progn
(setq l (sqrt dsq))
(setq hz-ziel (* (atan dy dx) (/ 180.0 pi)))
(setq hz-korr (- hz-ziel (* (atan raw-dy l) (/ 180.0 pi))))
(list hz-korr l)
)
)
)
;; Rahmen am Ende eines vfs-*-Bausteins: die Bausteine (Entry/Koerper/Exit)
;; enden IMMER auf der 3-Grad-Basisneigung (siehe Prinzipien-Dok Abschnitt 6).
(defun vfl-frame-3grad (punkt hz)
(make-frame-from-dir punkt (hz-winkel->xu hz (ssg-cfg-or "vario" "gefaelle_winkel" 3))))
;; 20-Meter-Regel: warnt, wenn die VF-Segmente seit der Umlenkstation 20 m
;; ueberschreiten (Prinzipien-Dok Abschnitt 7). v1: nur Hinweis, kein
;; automatisches Einfuegen einer Zwischen-Motorstation.
(defun vfl-20m-check (p-umlenk p-akt / laenge)
(setq laenge (vfl-planar-dist p-umlenk p-akt))
(if (> laenge *vfk-motorabstand-warnung*)
(princ (ssg-textf "vfl-20m-hinweis" (list (rtos (/ laenge 1000.0) 2 2))))
)
)
;; Baut EINE reine VarioFoerderer-Einheit als interaktive Sub-Kette:
;; genau EINE Umlenkstation (Eingang) ... beliebig viele Koerper-Sub-Segmente
;; und Vario-Kurven ... genau EINE Motorstation (Ausgang). Siehe Prinzipien-Dok
;; Abschnitt 2+4. Jedes Koerper-Sub-Segment beginnt/endet auf 3-Grad-Neigung.
;; frame: Eingangsrahmen (KS_AUS des Vorgaenger-Elements, i.d.R. AS-Element).
;; hz1/richtung1/winkel1/L_GF1/L_VF1: Daten des ersten (bereits klassifizierten)
;; VF-Linien-Sub-Segments aus vfl-segment-entscheidung.
;; gf-am-ausgang: T => halbe Staustrecke als GF2 am Ausgang (ohne Separator),
;; nil => gesamte Staustrecke am Einlauf (GF1), kein GF2.
;; Neigung des Frames aus der xu-Richtung ablesen: T => (nahezu) flach (0 Grad),
;; nil => auf 3-Grad-Basis. Damit wird der Uebergang auf_3/ab_3 nur dann gesetzt,
;; wenn wirklich ein Neigungswechsel noetig ist.
(defun vfl-frame-flach-p (frame)
(< (abs (cadr (frame->hz-winkel frame))) *vfk-frame-flach-toleranz*))
;; Separator (300 mm) HORIZONTAL (0 Grad) an einen Punkt anfuegen - fuer das
;; horizontale Stueck, wo der Separator in der 0-Grad-Ebene liegt (NICHT auf der
;; 3-Grad-Basis wie vfl-insert-separator). Rueckgabe: Endpunkt.
(defun vfl-sep-hz (pt hz / ep)
(princ (ssg-text "vfl-sep-horizontal-info"))
(setq ep (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" pt hz 0 *vfk-separator-laenge* 0))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
ep)
;; Uebergang zurueck auf die 3-Grad-Basis, FALLS der Frame gerade flach (0 Grad)
;; ist: fuegt einen Vario_Bogen_ab_3 ein. Wird vor jedem 3-Grad-Element
;; (gewinkeltes VF, Motorstation, ES) aufgerufen, damit der ab_3-Uebergang erst
;; DANN kommt, wenn er wirklich gebraucht wird (die flache Zone bleibt sonst
;; flach). Ist der Frame schon auf 3-Grad-Basis, bleibt er unveraendert.
(defun vfl-nach-3grad (frame / hz m pt)
(if (vfl-frame-flach-p frame)
(progn
(setq hz (car (frame->hz-winkel frame)))
(setq m (get-bogen-mass bogen-ab 3))
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" (car frame)
0 (car m) (caddr m) hz))
(vfl-frame-3grad pt hz))
frame))
;; Genereller Uebergang zwischen zwei Basis-Neigungen (0/+3/-3 Grad,
;; Vorzeichenkonvention wie frame->hz-winkel: positiv=fallend, negativ=
;; steigend) MIT DER VF-BIBLIOTHEK (Vario_Bogen_*_TEF_rechts, init-
;; bibliothek) - fuer Uebergaenge VOR/IN einer VF-Baugruppe (vfs-vf-koerper/
;; Motorstation), wo der Bogen ohnehin als VF-Familie zaehlt. Reine GF-
;; Kontexte (Linie-GF) nutzen stattdessen vfl-gf-bogen-uebergang (GF-eigene
;; Bloecke, siehe dort) - aktuell KEIN Aufrufer mehr hier im Code, aber als
;; Baustein fuer die dokumentierte Luecke in vfl-body-abschluss-bauen
;; (steigender Frame-Eintritt vor einem VF-Koerper) bewusst nicht entfernt.
;; Die VF-Bibliothek kennt nur einen 3-Grad-Bogen gegenueber FLACH (0 Grad) -
;; ein Wechsel zwischen der fallenden (+3) und der steigenden (-3) Basis
;; braucht daher IMMER zwei Boegen ueber 0 als Zwischenhalt. "auf"-Boegen
;; senken die Neigung numerisch (Richtung steigend), "ab"-Boegen erhoehen sie
;; (Richtung fallend) - siehe vfl-nach-3grad/vfl-hor-koerper-bauen, deren
;; Uebergaenge hier verallgemeinert werden. Ist kein Uebergang noetig (Start-
;; /Zielbasis identisch), no-op.
;; Rueckgabe: (neuer-frame fussabdruck-summe) - fussabdruck-summe (mm, auf hz
;; projiziert) muss der Aufrufer von der geplanten Restlaenge/Zielstrecke
;; abziehen.
(defun vfl-bogen-uebergang (frame ziel-winkel / t0 basis-ziel hz pt m summe vor-pt)
(setq hz (car (frame->hz-winkel frame)))
(setq t0 (cadr (frame->hz-winkel frame)))
(setq t0 (cond ((< (abs t0) *vfk-frame-flach-toleranz*) 0)
((< t0 0) (- (fix *vfk-gefaelle-winkel*)))
(t (fix *vfk-gefaelle-winkel*))))
(setq basis-ziel (cond ((< (abs ziel-winkel) *vfl-gf-winkel-toleranz*) 0)
((< ziel-winkel 0) (- (fix *vfk-gefaelle-winkel*)))
(t (fix *vfk-gefaelle-winkel*))))
(setq summe 0.0)
(if (/= t0 basis-ziel)
(progn
;; Schritt 1: t0 -> 0 (falls t0 noch nicht flach ist).
(if (/= t0 0)
(progn
(setq vor-pt (car frame))
(if (> t0 0)
(progn
(setq m (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*)))
(princ (ssg-text "vfl-bogen-auf3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" vor-pt
(fix *vfk-gefaelle-winkel*) (car m) (caddr m) hz)))
(progn
(setq m (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" vor-pt
(- (fix *vfk-gefaelle-winkel*)) (car m) (caddr m) hz)))
)
(setq summe (+ summe (vfl-projiziere-distanz vor-pt pt hz)))
(setq frame (make-frame-from-dir pt (hz-winkel->xu hz 0)))
)
)
;; Schritt 2: 0 -> basis-ziel (falls das Ziel nicht flach ist).
(if (/= basis-ziel 0)
(progn
(setq vor-pt (car frame))
(if (> basis-ziel 0)
(progn
(setq m (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" vor-pt
0 (car m) (caddr m) hz)))
(progn
(setq m (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*)))
(princ (ssg-text "vfl-bogen-auf3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" vor-pt
0 (car m) (caddr m) hz)))
)
(setq summe (+ summe (vfl-projiziere-distanz vor-pt pt hz)))
(setq frame (make-frame-from-dir pt (hz-winkel->xu hz basis-ziel)))
)
)
)
)
(list frame summe)
)
;; ------------------------------------------------------------------
;; GF-eigene Vertikalboegen (Nutzer-Vorgabe): 8 dedizierte Bloecke in
;; data/ils - Vario_Bogen_ab/auf_3/6_rechts (OHNE "_TEF_", das Suffix der
;; VF-Bibliothek). Zweck: reine GF-Uebergaenge (Linie-GF: Einstieg aus der
;; aktuellen Kettenneigung, Ausstieg vor ES/AS) sollen NICHT laenger die
;; VF-Bogen-Bibliothek (bogen-ab/bogen-auf, init-bibliothek) mitbenutzen -
;; die Bloecke tragen dadurch ihre eigene GF-Familie in vfl-kette-typ statt
;; als VF ("BOGENAUF"/"BOGENAB") erkannt zu werden, und ein KS_AUS-Scan am
;; Kettenanfang klassifiziert eine Kette, die mit einem dieser Boegen endet,
;; weiterhin korrekt als GF. Eigener Satz Globals/Init, damit KEINE
;; Abhaengigkeit zu vf_standard.lsp/init-bibliothek entsteht (ensure-block-
;; loaded/vf-element-masse sind bereits generische ssg_ks_insert.lsp/
;; vf_core.lsp-Helfer, keine VF-spezifischen).
(setq *gf-bogen-auf* nil *gf-bogen-ab* nil *gf-bogen-lib-initialized* nil)
(defun vfl-gf-bogen-init ( / bname m)
(if (not *gf-bogen-lib-initialized*)
(progn
(setq *gf-bogen-auf* nil *gf-bogen-ab* nil)
(foreach w '(3 6)
(setq bname (strcat "Vario_Bogen_auf_" (itoa w) "_rechts"))
(if (tblsearch "BLOCK" (ensure-block-loaded bname))
(progn
(setq m (vf-element-masse bname))
(if m (setq *gf-bogen-auf* (cons (cons w m) *gf-bogen-auf*))
(princ (ssg-textf "vfl-gf-bogen-ks-fehlt" (list bname)))))
(princ (ssg-textf "vfl-gf-bogen-block-fehlt" (list bname))))
(setq bname (strcat "Vario_Bogen_ab_" (itoa w) "_rechts"))
(if (tblsearch "BLOCK" (ensure-block-loaded bname))
(progn
(setq m (vf-element-masse bname))
(if m (setq *gf-bogen-ab* (cons (cons w m) *gf-bogen-ab*))
(princ (ssg-textf "vfl-gf-bogen-ks-fehlt" (list bname)))))
(princ (ssg-textf "vfl-gf-bogen-block-fehlt" (list bname))))
)
(setq *gf-bogen-auf* (reverse *gf-bogen-auf*) *gf-bogen-ab* (reverse *gf-bogen-ab*))
(setq *gf-bogen-lib-initialized* t)
)
)
)
;; Wie vfl-bogen-uebergang, aber fuer reine GF-Kontexte (Linie-GF: Einstieg
;; aus der aktuellen Kettenneigung VOR dem GF-Segment, Ausstieg VOR ES/AS) -
;; nutzt die GF-eigenen Vertikalboegen (siehe oben) statt der VF-Bibliothek.
;; WICHTIG: der 6-Grad-Sprung (steigend<->fallend) braucht dadurch NUR EINEN
;; dedizierten 6-Grad-Bogen statt zwei 3-Grad-Boegen ueber 0 als Zwischenhalt
;; (vfl-bogen-uebergang) - kuerzer und geometrisch sauberer, sobald die
;; passenden 6-Grad-Bloecke vorhanden sind (Nutzer-Vorgabe 2026-09-12).
;; Rueckgabe: (neuer-frame fussabdruck-summe), wie vfl-bogen-uebergang.
(defun vfl-gf-bogen-uebergang (frame ziel-winkel / t0 basis-ziel hz pt m summe)
(vfl-gf-bogen-init)
(setq hz (car (frame->hz-winkel frame)))
(setq t0 (cadr (frame->hz-winkel frame)))
(setq t0 (cond ((< (abs t0) *vfk-frame-flach-toleranz*) 0)
((< t0 0) (- (fix *vfk-gefaelle-winkel*)))
(t (fix *vfk-gefaelle-winkel*))))
(setq basis-ziel (cond ((< (abs ziel-winkel) *vfl-gf-winkel-toleranz*) 0)
((< ziel-winkel 0) (- (fix *vfk-gefaelle-winkel*)))
(t (fix *vfk-gefaelle-winkel*))))
(setq summe 0.0)
(cond
((= t0 basis-ziel) (list frame summe))
;; 6 Grad in einem Zug: steigend<->fallend, EIN dedizierter Bogen.
((and (/= t0 0) (/= basis-ziel 0))
(if (> t0 0)
(progn
(setq m (get-bogen-mass *gf-bogen-auf* 6))
(princ (ssg-text "vfl-gf-bogen-auf6-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_6_rechts" (car frame)
(fix *vfk-gefaelle-winkel*) (car m) (caddr m) hz)))
(progn
(setq m (get-bogen-mass *gf-bogen-ab* 6))
(princ (ssg-text "vfl-gf-bogen-ab6-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_6_rechts" (car frame)
(- (fix *vfk-gefaelle-winkel*)) (car m) (caddr m) hz)))
)
(setq summe (vfl-projiziere-distanz (car frame) pt hz))
(list (make-frame-from-dir pt (hz-winkel->xu hz basis-ziel)) summe))
;; 3 Grad: flach -> geneigt oder geneigt -> flach, EIN 3-Grad-Bogen.
(t
(if (= t0 0)
(if (> basis-ziel 0)
(progn
(setq m (get-bogen-mass *gf-bogen-ab* 3))
(princ (ssg-text "vfl-gf-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_rechts" (car frame)
0 (car m) (caddr m) hz)))
(progn
(setq m (get-bogen-mass *gf-bogen-auf* 3))
(princ (ssg-text "vfl-gf-bogen-auf3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_rechts" (car frame)
0 (car m) (caddr m) hz))))
(if (> t0 0)
(progn
(setq m (get-bogen-mass *gf-bogen-auf* 3))
(princ (ssg-text "vfl-gf-bogen-auf3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_rechts" (car frame)
(fix *vfk-gefaelle-winkel*) (car m) (caddr m) hz)))
(progn
(setq m (get-bogen-mass *gf-bogen-ab* 3))
(princ (ssg-text "vfl-gf-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_rechts" (car frame)
(- (fix *vfk-gefaelle-winkel*)) (car m) (caddr m) hz))))
)
(setq summe (vfl-projiziere-distanz (car frame) pt hz))
(list (make-frame-from-dir pt (hz-winkel->xu hz basis-ziel)) summe))
)
)
;; ECHTE Neigungs-Fortsetzung UEBER die von vfl-gf-bogen-uebergang
;; unterstuetzten Zustaende (flach/+3/-3) hinaus - z.B. steigend-3 ->
;; steigend-6 (oder mit grad=6 weiter -> steigend-9) und zurueck.
;; vfl-gf-bogen-uebergang selbst kennt NUR Uebergaenge zu/von flach (der
;; 3-Grad-Fall) bzw. zwischen +3/-3 (der kombinierte 6-Grad-Fall) - fuer eine
;; WEITERE Neigungs-Aenderung AUSGEHEND von einem bereits geneigten Zustand
;; (z.B. Option 5's S bei 6 oder 9 statt 3 Grad, Nutzer-Vorgabe 2026-09-13:
;; ECHTE Bausteine statt rein rechnerischem Ruecksprung) wird derselbe rohe
;; insert-rotated-block-with-ks-Aufruf wie dort direkt genutzt, nur mit einer
;; von 0/+3/-3 abweichenden "eingehende-neigung" als Rotationsparameter -
;; "Vario_Bogen_auf_3/6_rechts"/"_ab_3/6_rechts" sind generische Bloecke mit
;; einem FIXEN eigenen Bogen (grad=3 oder 6), ihre Projektion funktioniert
;; fuer JEDEN eingehenden Rotationswinkel, nicht nur die drei von
;; vfl-gf-bogen-uebergang klassifizierten Zustaende.
;; richtung="auf": eingehende-neigung -> eingehende-neigung-grad (steiler
;; steigend bzw. weniger fallend). richtung="ab": eingehende-neigung ->
;; eingehende-neigung+grad (steiler fallend bzw. weniger steigend).
(defun vfl-gf-bogen-weiter (frame richtung eingehende-neigung grad / m blockname pt hz exit-neigung)
(vfl-gf-bogen-init)
(setq hz (car (frame->hz-winkel frame)))
(if (= richtung "auf")
(progn
(setq m (get-bogen-mass *gf-bogen-auf* grad))
(setq blockname (strcat "Vario_Bogen_auf_" (itoa grad) "_rechts"))
(setq exit-neigung (- eingehende-neigung grad)))
(progn
(setq m (get-bogen-mass *gf-bogen-ab* grad))
(setq blockname (strcat "Vario_Bogen_ab_" (itoa grad) "_rechts"))
(setq exit-neigung (+ eingehende-neigung grad)))
)
(setq pt (insert-rotated-block-with-ks blockname (car frame) eingehende-neigung (car m) (caddr m) hz))
(make-frame-from-dir pt (hz-winkel->xu hz exit-neigung))
)
;; Verkettet mehrere vfl-gf-bogen-weiter-Schritte, um eine BELIEBIGE
;; Neigungs-Erweiterung (Vielfaches von 3 Grad) mit MOEGLICHST WENIGEN
;; Bausteinen zu erreichen (moeglichst viele 6-Grad-Bloecke, ein 3-Grad-Block
;; fuer den Rest) - Option 5's dynamische Winkelwahl (Nutzer-Vorgabe
;; 2026-09-13: "gegebene Laenge -> passenden Winkel waehlen" statt einem
;; einzigen fest verdrahteten Winkel). extra-grad=0 (S bei nur 3 Grad, der
;; symmetrische Grundfall) baut nichts und gibt frame unveraendert zurueck.
;; richtung wie vfl-gf-bogen-weiter ("auf"/"ab"); eingehende-neigung ist der
;; Startwert VOR der Erweiterung (z.B. -3 fuer "auf").
(defun vfl-gf-bogen-erweitern (frame richtung eingehende-neigung extra-grad / rest neigung-jetzt)
(setq rest extra-grad)
(setq neigung-jetzt eingehende-neigung)
(while (>= rest 6)
(setq frame (vfl-gf-bogen-weiter frame richtung neigung-jetzt 6))
(setq neigung-jetzt (if (= richtung "auf") (- neigung-jetzt 6) (+ neigung-jetzt 6)))
(setq rest (- rest 6))
)
(if (= rest 3)
(setq frame (vfl-gf-bogen-weiter frame richtung neigung-jetzt 3))
)
frame
)
;; Projiziert eine rohe (dx,dz)-Bogenmasse (bei Rotation 0 gemessen, siehe
;; get-bogen-mass) in die Welt, wenn der Bogen bei einer gegebenen Neigung
;; (Grad, gefaelle-winkel-Konvention: positiv=fallend) eingebaut wird -
;; dieselbe Rz(hz)*Ry(rot)-Projektion wie insert-rotated-block-with-ks, hier
;; OHNE Insert (reine Vorausberechnung fuer vfl-gf-auf-ab-solve). Rueckgabe:
;; (welt-dx welt-dz).
(defun vfl-projiziere-neigung (dx dz rot-grad / rad)
(setq rad (* (float rot-grad) (/ pi 180.0)))
(list (+ (* dx (cos rad)) (* dz (sin rad)))
(+ (- (* dx (sin rad))) (* dz (cos rad))))
)
;; Rein rechnerisches (KEIN Bau) Pendant zu vfl-gf-bogen-erweitern - fuer
;; Option 4's Formel-basierten Solver (vfl-gf-auf-ab-solve), der die
;; Neigungs-Erweiterung VORAB in die Fixterme einrechnen muss, BEVOR
;; ueberhaupt etwas gebaut wird (Nutzer-Vorgabe 2026-09-14: dieselbe
;; dynamische Winkelwahl wie Option 5, jetzt auch fuer Option 4). Summiert
;; die WELT-(dx,dz) einer Kette aus moeglichst wenigen Bausteinen
;; (moeglichst viele 6-Grad-, ein 3-Grad-Rest-Baustein), exakt in derselben
;; Reihenfolge/Neigungs-Abfolge wie vfl-gf-bogen-erweitern es spaeter ECHT
;; baut - extra-grad=0 liefert (0.0 0.0). Rueckgabe: (welt-dx welt-dz).
(defun vfl-gf-bogen-summe (richtung eingehende-neigung extra-grad /
rest neigung-jetzt m proj sum-dx sum-dz)
(setq sum-dx 0.0 sum-dz 0.0 rest extra-grad neigung-jetzt eingehende-neigung)
(while (>= rest 6)
(setq m (get-bogen-mass (if (= richtung "auf") *gf-bogen-auf* *gf-bogen-ab*) 6))
(setq proj (vfl-projiziere-neigung (car m) (caddr m) neigung-jetzt))
(setq sum-dx (+ sum-dx (car proj)) sum-dz (+ sum-dz (cadr proj)))
(setq neigung-jetzt (if (= richtung "auf") (- neigung-jetzt 6) (+ neigung-jetzt 6)))
(setq rest (- rest 6))
)
(if (= rest 3)
(progn
(setq m (get-bogen-mass (if (= richtung "auf") *gf-bogen-auf* *gf-bogen-ab*) 3))
(setq proj (vfl-projiziere-neigung (car m) (caddr m) neigung-jetzt))
(setq sum-dx (+ sum-dx (car proj)))
(setq sum-dz (+ sum-dz (cadr proj)))
)
)
(list sum-dx sum-dz)
)
;; 2D-Rotation eines LOKALEN (dx,dy)-Versatzes (KS_EIN->KS_AUS eines Blocks
;; bei Rotation 0, siehe vf-element-masse) um einen WELT-Richtungswinkel
;; (Grad) - dieselbe Rz(hz)-Rotationsformel wie in insert-block-ks-to-ks/
;; insert-rotated-block-with-ks, hier eigenstaendig fuer eine Vorab-
;; Berechnung OHNE Insert. Rueckgabe: (welt-dx welt-dy).
(defun vfl-rot2d (dx dy hz-grad / rad)
(setq rad (* (float hz-grad) (/ pi 180.0)))
(list (- (* dx (cos rad)) (* dy (sin rad)))
(+ (* dx (sin rad)) (* dy (cos rad)))))
;; 2D-Kreuzprodukt (ax,ay) x (bx,by) = ax*by - ay*bx. Fuer eine Gerade durch
;; P0 mit Richtungsvektor d_ref gilt fuer einen Punkt P: (P-P0) x d_ref = 0
;; genau dann, wenn P auf der Geraden liegt.
(defun vfl-kreuz2d (ax ay bx by) (- (* ax by) (* ay bx)))
;; Weltposition eines benannten KS-Markers ("KS_EIN"/"KS_AUS") eines BEREITS
;; in der Zeichnung platzierten Blocks - wie vfl-kette-ks-aus-richtung, aber
;; fuer einen beliebigen KS-Namen und ohne die Richtung (nur der Punkt wird
;; gebraucht). Ueber eine skalierungsneutrale KOPIE gemessen (das Original
;; bleibt unangetastet in der Zeichnung stehen). Rueckgabe: Weltpunkt oder
;; nil, falls der Marker nicht gefunden wurde.
;; Hintergrund (Nutzer-Befund 2026-09-12): bei AS_Element/ES_Element liegt
;; KS_EIN/KS_AUS aus mechanischen Gruenden (Drehteller-Anschluss) seitlich
;; versetzt vom Block-URSPRUNG - insert-block-mixed-to-ks fluchtet bewusst
;; den Ursprung (nicht KS_EIN) auf den Kettenpunkt (siehe dortiger
;; Kommentar). Der geklickte Startpunkt ist darum NICHT identisch mit
;; KS_EIN - fuer die Kolinearitaets-Referenzgerade in vfl-qc-linie-mit-gf
;; wird das ECHTE, gemessene KS_EIN gebraucht, nicht der rohe Klickpunkt.
(defun vfl-block-ks-punkt (block-obj ks-name / copyobj ksdata p)
(setq copyobj (vla-Copy block-obj))
(vla-put-XScaleFactor copyobj 1.0)
(vla-put-YScaleFactor copyobj 1.0)
(vla-put-ZScaleFactor copyobj 1.0)
(setq ksdata (extract-ks-from-block-raw copyobj))
(if (not (vlax-erased-p copyobj)) (vl-catch-all-apply 'vla-Delete (list copyobj)))
(setq p (if (assoc ks-name ksdata) (car (cadr (assoc ks-name ksdata))) nil))
p
)
;; ------------------------------------------------------------------
;; "QC Linie mit GF" (Option 4 der gf-laenge-modus-Frage, Nutzer-Vorgabe
;; 2026-09-12, Geometrie danach nach BricsCAD-Test komplett ueberarbeitet):
;; automatisch berechnete Auf-Ab-GF-Kette, die auf derselben
;; Hoehe endet, auf der sie beginnt - AS -> fallend-GF -> 30-Grad-Bogen ->
;; [fallend-GF -> Bogen auf (6 Grad, ggf. steiler) -> steigend-GF -> Bogen ab
;; (6 Grad, ggf. steiler) -> fallend-GF] -> 30-Grad-Bogen (Gegenseite) ->
;; fallend-GF -> ES. Die beiden fallenden Mittelstuecke (vor/nach dem
;; Steig-Stueck) werden als EIN gemeinsamer Unbekannter F_total behandelt
;; (Nutzer-Vorgabe, aufgeteilt nach einem waehlbaren Anteil) -
;; vfl-gf-auf-ab-solve loest F_total und das steigende Mittelstueck S aus
;; der vorgegebenen Mittelteil-Gesamtlaenge und der geforderten Netto-
;; Hoehenaenderung (hier immer 0, da AS/ES auf derselben Hoehe liegen
;; sollen). S's Neigung wird dabei DYNAMISCH gewaehlt (Nutzer-Vorgabe
;; 2026-09-14, dieselbe Idee wie Option 5): 3 Grad (symmetrischer
;; Grundfall) zuerst, dann 6/9/12/...Grad, bis F_total UND S beide baubar
;; (>=0) sind - der FLACHSTE passende Winkel gewinnt, damit auch kuerzere
;; Mittelteil-Gesamtlaengen noch baubar sind, statt nur bei einem einzigen
;; fest verdrahteten Winkel zu funktionieren.
;;
;; Weltmass-Formel wie insert-rotated-block-with-ks (ssg_ks_insert.lsp):
;; world_dx = dx*cos(rot) + dz*sin(rot) (horizontal, entlang hz)
;; world_dz = -dx*sin(rot) + dz*cos(rot) (Hoehenaenderung)
;; rot=+gefaelle-winkel fuer den "auf"-Bogen (Einstieg fallend), rot=
;; -gefaelle-winkel fuer den "ab"-Bogen (Einstieg steigend) - siehe
;; vfl-gf-bogen-uebergang, das dieselben Tabellen beim tatsaechlichen Bau
;; verwendet.
;; s-winkel (Nutzer-Vorgabe 2026-09-14: dieselbe dynamische Winkelwahl wie
;; Option 5 - "gegebene Laenge -> passenden Winkel waehlen"): die Neigung
;; des steigenden Mittelstuecks S (Grad, STEIGEND-Betrag - F_total bleibt
;; IMMER bei *vfk-gefaelle-winkel*, nur S wird bei Bedarf steiler). Der
;; Aufrufer probiert typischerweise s-winkel=3 (symmetrischer Grundfall),
;; dann 6, 9, ... bis gueltig=T (siehe vfl-qc-linie-mit-gf).
;; Rueckgabe: (f-total s gueltig ziel-laenge-min) - f-total/s als horizontale
;; Laengen (wie deltaL bei vfl-insert-gf-segment), gueltig=nil bei negativem
;; Ergebnis (Mittelteil-Vorgabe geometrisch nicht baubar). ziel-laenge-min ist
;; in diesem Fall die kleinste Gesamtlaenge, mit der f-total UND s BEIDE >= 0
;; wuerden (Nutzer-Vorgabe 2026-09-13: als Vorschlag in der Fehlermeldung
;; ausgeben) - aus F_total+S=a, -F_total*tan3+S*tan(s-winkel)=b (a,b wie
;; unten): S>=0 braucht a>=-b/tan3, F_total>=0 braucht a>=b/tan(s-winkel) -
;; das striktere (groessere) der beiden Minima entscheidet.
(defun vfl-gf-auf-ab-solve (ziel-laenge-horiz ziel-hoehe-delta s-winkel /
rad3 tan3 rad-s tan-s m-auf m-ab proj-auf proj-ab
extra-grad extra-auf extra-ab
fix-dx fix-dz a b f-total s gueltig
a-min-s a-min-ftotal a-min ziel-laenge-min)
(vfl-gf-bogen-init)
(setq rad3 (* (float (fix *vfk-gefaelle-winkel*)) (/ pi 180.0)))
(setq tan3 (/ (sin rad3) (cos rad3)))
(setq rad-s (* (float s-winkel) (/ pi 180.0)))
(setq tan-s (/ (sin rad-s) (cos rad-s)))
(setq m-auf (get-bogen-mass *gf-bogen-auf* 6))
(setq m-ab (get-bogen-mass *gf-bogen-ab* 6))
;; Basis-Uebergaenge (IMMER vorhanden, wie bisher): auf_6 bei Einstieg
;; fallend(+3), ab_6 bei Einstieg steigend(-3).
(setq proj-auf (vfl-projiziere-neigung (car m-auf) (caddr m-auf) (fix *vfk-gefaelle-winkel*)))
(setq proj-ab (vfl-projiziere-neigung (car m-ab) (caddr m-ab) (- (fix *vfk-gefaelle-winkel*))))
;; Zusaetzliche Erweiterung (nur falls s-winkel > *vfk-gefaelle-winkel*):
;; "auf"-Kette von -3 weiter auf -s-winkel, "ab"-Kette von -s-winkel
;; zurueck auf -3 (rein rechnerisch - vfl-gf-bogen-summe, echter Bau folgt
;; per vfl-gf-bogen-erweitern erst NACH dem Solve).
(setq extra-grad (- s-winkel (fix *vfk-gefaelle-winkel*)))
(setq extra-auf (vfl-gf-bogen-summe "auf" (- (fix *vfk-gefaelle-winkel*)) extra-grad))
(setq extra-ab (vfl-gf-bogen-summe "ab" (- s-winkel) extra-grad))
;; Fixterme: zwei Separatoren (300mm, fallend) + alle Bogen-Beitraege.
(setq fix-dx (+ (* 2.0 *vfk-separator-laenge* (cos rad3))
(car proj-auf) (car proj-ab)
(car extra-auf) (car extra-ab)))
(setq fix-dz (+ (* -2.0 *vfk-separator-laenge* (sin rad3))
(cadr proj-auf) (cadr proj-ab)
(cadr extra-auf) (cadr extra-ab)))
(setq a (- ziel-laenge-horiz fix-dx))
(setq b (- ziel-hoehe-delta fix-dz))
;; F_total+S=a, -F_total*tan3+S*tan-s=b => S=(b+a*tan3)/(tan3+tan-s)
(setq s (/ (+ b (* a tan3)) (+ tan3 tan-s)))
(setq f-total (- a s))
(setq gueltig (and (>= f-total -0.01) (>= s -0.01)))
(setq a-min-s (- (/ b tan3)))
(setq a-min-ftotal (/ b tan-s))
(setq a-min (if (> a-min-ftotal a-min-s) a-min-ftotal a-min-s))
(setq ziel-laenge-min (+ fix-dx a-min))
(list f-total s gueltig ziel-laenge-min)
)
;; Ablauf/Bau von Option 4. Nutzt die dynamisch (AutoLISP-typisch) sichtbaren
;; Lokalvariablen des Aufrufers vf-linienzug-modus (frame, p-aktuell,
;; as-vorhanden, as-seite, kettenanfang, fertig, es-seite, anzahl-gf, ...) -
;; wie alle anderen wahl-Zweige dort auch. Setzt am Ende frame/p-aktuell auf
;; den ES-Ausgang und fertig=t; der gemeinsame Rest des Hauptloops (Segment-
;; XDATA, Echo, Block-Erstellung) laeuft danach unveraendert weiter.
(defun vfl-qc-linie-mit-gf ( / as-w as-s theta-ref as-turn es-turn
bogen-turn-30-r bogen-turn-30-l bogen-turn-90-r bogen-turn-90-l
bogen-seite bogen-winkel bogen-turn-echt
b-noetig tol hz0 hz1 hz2 e1 e1-brutto e2 anteil ziel-laenge
loesung f-total s gueltig fa fb hz-jetzt
erg-bogen soll-hoehe ist-hoehe antwort
s-winkel extra-grad rad-s versuche
rad3 tan3
p0x p0y px py vx vy esx esy dref-x dref-y
hz1-rad hz2-rad zaehler nenner abweichung
checkpoint p0-real h-aussen-rest theta-ref-rad
probe-checkpoint probe-frame probe-frame2
bg2x bg2y bg2z esz acc-gfbogen-save acc-sep-save)
(if (not kettenanfang)
(princ (ssg-text "vfl-qc-nur-kettenanfang"))
(progn
;; --- AS-Winkel/-Seite: wiederverwenden, falls am Kettenanfang schon
;; entschieden (Regelfall) - sonst (Nutzer hatte "Kein AS-Element"
;; gewaehlt) hier eine eigene, minimale Nachfrage, da diese Option
;; konzeptionell IMMER mit einem AS beginnt.
(if as-vorhanden
(progn (setq as-w (vfl-as-winkel)) (setq as-s as-seite))
(progn
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-qc-winkel-impl (list "vf-winkel-aus-header")))
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq as-w (vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header")))))
(setq *vfl-as-winkel* as-w)
(princ (ssg-text "vfl-aus-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"vfl-aus-seite-header"))
(setq as-s (if (= antwort "2") "rechts" "links"))
(setq as-seite as-s)
(vf-set-as-masse as-w as-s)
(setq as-vorhanden t)
)
)
;; --- Richtung waehlen (Nutzer-Vorgabe 2026-09-12): die Gerade, auf
;; der KS_EIN des AS-Elements UND (nach dem ganzen Umweg) KS_AUS des
;; ES-Elements liegen sollen - per Mausklick wie ueberall sonst im
;; Linienzug (vfl-in-richtung, auf das 30-Grad-Weltraster gesnappt).
;; p0x/p0y (das REFERENZ-KS_EIN fuer die Kolinearitaets-Pruefung) sind
;; hier einfach der gepickte Punkt selbst - fuer DIESE Option wird
;; AS_Element unten bewusst MIT KS_EIN (nicht mit dem Block-Ursprung)
;; auf den Klickpunkt gefluchtet (Nutzer-Vorgabe 2026-09-12: der
;; Klickpunkt soll die reale Anlagenplanung, z.B. Kreisel-Anschluss,
;; exakt treffen).
(setq theta-ref (vfl-in-richtung p-aktuell (ssg-text "vfl-qc-prompt-richtung")))
(if (null theta-ref) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
;; Echter Grundriss-Schwenk des AS-Elements (KEINE Annahme "30 bzw. 90
;; Grad genau" - die reale Blockgeometrie entscheidet, siehe
;; vf-element-plan-turn) - die gewaehlte Richtung ist die EINTRITTS-
;; Achse (KS_EIN), die tatsaechliche Fahrtrichtung danach (hz0, KS_AUS)
;; liegt um diesen Schwenk verdreht.
(setq as-turn (vf-element-plan-turn (strcat "AS_Element_" as-w "_" as-s)))
(setq hz0 (+ theta-ref as-turn))
;; --- Mengengeruest abfragen ---
;; E1 ist die GESAMTE Strecke vom AS-Austritt bis zum ersten 30-Grad-
;; Bogen INKLUSIVE des dazwischenliegenden 300mm-Separators (Nutzer-
;; Korrektur 2026-09-12: vorher kam der Separator ZUSAETZLICH oben
;; drauf, die Kette wurde dadurch laenger als eingegeben) - die reine
;; GF-Geradenstrecke ist E1 MINUS des Separator-Horizontalanteils.
(setq rad3 (* (float (fix *vfk-gefaelle-winkel*)) (/ pi 180.0)))
(setq e1-brutto (vfl-in-real (ssg-textf "vfl-qc-prompt-e1" (list (rtos *vfk-qc-einlauf-laenge* 2 0)))))
(if (null e1-brutto) (setq e1-brutto *vfk-qc-einlauf-laenge*))
(setq e1 (- e1-brutto (* *vfk-separator-laenge* (cos rad3))))
(setq ziel-laenge (vfl-in-real (ssg-text "vfl-qc-prompt-gesamtlaenge-mittelteil")))
(setq anteil (vfl-in-real (ssg-textf "vfl-qc-prompt-anteil" (list (rtos *vfk-qc-fallend-anteil-default* 2 2)))))
(if (null anteil) (setq anteil *vfk-qc-fallend-anteil-default*))
;; E2 (Laenge 2. Bogen -> ES) wird NICHT gefragt (Nutzer-Vorgabe
;; 2026-09-12): sobald Winkel und alle anderen Laengen feststehen, ist
;; sie die einzige verbleibende Freiheit, um die Kette exakt auf
;; theta-ref zurueckzufuehren - siehe die Geraden-Gleichung weiter
;; unten (nach dem 2. Bogen, ueber vfl-kreuz2d).
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-qc-winkel-impl (list "vf-winkel-ein-header")))
(princ (ssg-text "vf-winkel-ein-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-es-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header")))))
(setq es-seite as-s) ; Nutzer-Vorgabe: ES-Seite = AS-Seite, keine Frage
(vf-set-es-masse *vfl-es-winkel* es-seite)
;; --- Bogen-Seite UND -Winkel HERLEITEN (keine Frage, Nutzer-Vorgabe
;; 2026-09-12): beide Boegen benutzen DIESELBE Seite UND denselben
;; Winkel. Damit die Kette am Ende wieder auf theta-ref liegt, muss der
;; Boegen-Schwenk b die Gleichung as-turn + 2*b + es-turn = 0
;; erfuellen - b wird daraus hergeleitet und gegen die vier real
;; vorhandenen Bogen-Varianten (30/90 Grad x links/rechts - AS/ES
;; koennen laut Nutzer-Vorgabe nur 30 oder 90 Grad sein, mehr braucht
;; es daher nicht) geprueft (kein Raten); passt keine, ist die
;; Winkel-Kombination nicht schliessbar.
(setq es-turn (vf-element-plan-turn (strcat "ES_Element_" *vfl-es-winkel* "_" es-seite)))
(setq bogen-turn-30-r (vf-element-plan-turn "Gefaellebogen_rechts_30_R500"))
(setq bogen-turn-30-l (vf-element-plan-turn "Gefaellebogen_links_30_R500"))
(setq bogen-turn-90-r (vf-element-plan-turn "Gefaellebogen_rechts_90_R500"))
(setq bogen-turn-90-l (vf-element-plan-turn "Gefaellebogen_links_90_R500"))
(setq b-noetig (/ (- (+ as-turn es-turn)) 2.0))
(setq tol 2.0)
(setq bogen-seite nil bogen-winkel nil)
(cond
((< (abs (- bogen-turn-30-r b-noetig)) tol) (setq bogen-seite "rechts" bogen-winkel 30))
((< (abs (- bogen-turn-30-l b-noetig)) tol) (setq bogen-seite "links" bogen-winkel 30))
((< (abs (- bogen-turn-90-r b-noetig)) tol) (setq bogen-seite "rechts" bogen-winkel 90))
((< (abs (- bogen-turn-90-l b-noetig)) tol) (setq bogen-seite "links" bogen-winkel 90))
)
(if (null bogen-seite)
(princ (ssg-textf "vfl-qc-bogen-nicht-schliessbar"
(list (rtos as-turn 2 1) (rtos es-turn 2 1) (rtos b-noetig 2 1))))
(progn
(setq bogen-turn-echt
(cond
((and (= bogen-seite "rechts") (= bogen-winkel 30)) bogen-turn-30-r)
((and (= bogen-seite "links") (= bogen-winkel 30)) bogen-turn-30-l)
((and (= bogen-seite "rechts") (= bogen-winkel 90)) bogen-turn-90-r)
(T bogen-turn-90-l)))
(setq rad3 (* (float (fix *vfk-gefaelle-winkel*)) (/ pi 180.0)))
(setq tan3 (/ (sin rad3) (cos rad3)))
(setq dref-x (cos (* (float theta-ref) (/ pi 180.0))))
(setq dref-y (sin (* (float theta-ref) (/ pi 180.0))))
;; --- AS + E1 + Sep + 1. Bogen JETZT SCHON WIRKLICH BAUEN (nicht erst
;; nach der Hoehenbilanz) - Grund (Nutzer-Befund 2026-09-12):
;; Gefaellebogen-Bloecke haengen an einem BEREITS 3-Grad-geneigten
;; Rahmen - ihre reale Positions-/Hoehenwirkung liess sich per Formel
;; nicht zuverlaessig vorhersagen (siehe vfl-gf-auf-ab-solve-Historie);
;; MESSEN nach echtem Bau ist robuster als eine weitere Rotationsformel
;; zu vertrauen. Faellt die Kette hinterher als "nicht baubar" durch,
;; wird diese Teil-Geometrie ueber checkpoint/vfl-loesche-seit wieder
;; entfernt.
;; AS-Einfuegung fuer diese Option BEWUSST NICHT ueber
;; vfl-insert-as-element (das fluchtet den Block-URSPRUNG auf den
;; Kettenpunkt, siehe dortiger Kommentar - Mittelachsen-Konvention der
;; UEBRIGEN Linie-GF-Zweige) - Nutzer-Vorgabe 2026-09-12 fuer DIESE
;; Option: der Klickpunkt soll die reale Anlagenplanung exakt treffen
;; (z.B. Anschluss an einen Kreisel), darum wird hier KS_EIN direkt
;; (xy-ref/z-ref="KS_EIN") auf den Klickpunkt gefluchtet - p0-real ist
;; dadurch einfach der Klickpunkt selbst, keine Nachmessung mehr noetig.
(setq checkpoint (vf-lastent-ohne-attribute))
(setq p0-real p-aktuell)
(setq p0x (car p0-real) p0y (cadr p0-real))
(setq theta-ref-rad (* (float theta-ref) (/ pi 180.0)))
(setq frame (insert-block-mixed-to-ks
(strcat "AS_Element_" as-w "_" as-s)
(make-frame-from-dir p-aktuell (list (cos theta-ref-rad) (sin theta-ref-rad) 0.0))
(caddr p-aktuell) "KS_EIN" "KS_EIN"))
(setq p-aktuell (car frame))
(setq soll-hoehe (caddr p-aktuell))
(princ (ssg-textf "vfl-qc-ks-ein-gemessen"
(list (rtos p0x 2 2) (rtos p0y 2 2) (rtos (caddr p0-real) 2 2))))
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt e1 (fix *vfk-gefaelle-winkel*)))
(vfl-acc-gf-seg (/ e1 (cos rad3)) (fix *vfk-gefaelle-winkel*))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-insert-separator frame))
(setq frame (vfl-insert-gf-bogen-block frame bogen-winkel bogen-seite))
(setq hz1 (car (frame->hz-winkel frame)))
(setq hz2 (+ hz1 bogen-turn-echt))
;; --- 2. Bogen UND Separator+ES werden HIER PROBEWEISE an der
;; AKTUELLEN Stelle (nach dem 1. Bogen) eingefuegt, ihre reale
;; Wirkung gemessen, dann wieder geloescht (Nutzer-Log 2026-09-12:
;; trotz mehrerer Korrekturrunden an der Formel-Schaetzung blieb eine
;; Rest-Abweichung - die Division im E2-Solve kann jeden
;; verbleibenden Schaetzfehler stark verstaerken, wenn hz2 nah an
;; theta-ref liegt. ECHT MESSEN statt einer vierten Formel-Korrektur).
;; Gueltig, weil sowohl der 2. Bogen als auch Separator+ES NUR von der
;; ANKUNFTS-ORIENTIERUNG abhaengen (hz1 bzw. die daraus resultierende
;; hz2), nicht von der Position - die Probe an dieser Stelle liefert
;; also exakt dieselbe relative Wirkung wie der spaetere echte Bau
;; nach Fa/S/Fb (dieselbe Orientierung, nur eine andere Position). Das
;; Mittelteil (Fa+Sep+Bogen6auf+S+Bogen6ab+Fb+Sep) hat als GANZES per
;; Definition die horizontale Laenge ziel-laenge (Nutzer-Eingabe) -
;; IMMER, unabhaengig von der spaeteren F_total/S-Aufteilung (beide
;; Teile liegen auf derselben Fahrtrichtung hz1) - daher genuegt fuer
;; die Position vor der Probe ein einfacher ziel-laenge-Vorschub.
(setq hz1-rad (* (float hz1) (/ pi 180.0)))
;; vfl-insert-gf-bogen-block/vfl-insert-es-element zaehlen intern in
;; *vfl-acc-gfbogen*/*vfl-acc-separator* mit (fuer die spaeteren
;; GF_Bogen_L/R_xx- bzw. Separator-Attribute) - die Probe darf diese
;; Zaehler NICHT dauerhaft verfaelschen, darum sichern/zuruecksetzen.
(setq acc-gfbogen-save *vfl-acc-gfbogen* acc-sep-save *vfl-acc-separator*)
(setq probe-checkpoint (vf-lastent-ohne-attribute))
(setq probe-frame (vfl-insert-gf-bogen-block frame bogen-winkel bogen-seite))
(setq hz2 (car (frame->hz-winkel probe-frame)))
(setq bg2x (- (car (car probe-frame)) (car (car frame))))
(setq bg2y (- (cadr (car probe-frame)) (cadr (car frame))))
(setq bg2z (- (caddr (car probe-frame)) (caddr (car frame))))
(setq probe-frame2 (vfl-insert-es-element "GF" probe-frame hz2 (fix *vfk-gefaelle-winkel*)
(caddr (car probe-frame)) es-seite))
(setq esx (- (car (car probe-frame2)) (car (car probe-frame))))
(setq esy (- (cadr (car probe-frame2)) (cadr (car probe-frame))))
(setq esz (- (caddr (car probe-frame2)) (caddr (car probe-frame))))
(vfl-loesche-seit probe-checkpoint)
(setq *vfl-acc-gfbogen* acc-gfbogen-save *vfl-acc-separator* acc-sep-save)
(setq hz2-rad (* (float hz2) (/ pi 180.0)))
(setq px (+ (car (car frame)) (* ziel-laenge (cos hz1-rad)) bg2x))
(setq py (+ (cadr (car frame)) (* ziel-laenge (sin hz1-rad)) bg2y))
(setq vx (- px p0x) vy (- py p0y))
(setq zaehler (- (+ (vfl-kreuz2d vx vy dref-x dref-y)
(vfl-kreuz2d esx esy dref-x dref-y))))
(setq nenner (vfl-kreuz2d (cos hz2-rad) (sin hz2-rad) dref-x dref-y))
(setq e2 (/ zaehler nenner))
(if (< e2 1.0)
(progn
(princ (ssg-textf "vfl-qc-e2-negativ" (list (rtos e2 2 0))))
(vfl-loesche-seit checkpoint))
(progn
;; --- Ziel-Hoehenaenderung des Mittelteils: AS+E1+Sep+1.Bogen sind
;; bereits ECHT gebaut (frame traegt die reale Hoehe nach dem 1.
;; Bogen) - kein Formel-Risiko mehr fuer diesen Teil. WICHTIG: die
;; Referenz fuer "gleiche Hoehe" ist KS_EIN des AS-Elements (Z des
;; Klickpunkts, siehe insert-block-mixed-to-ks z-ref="KS_EIN"), NICHT
;; soll-hoehe (= AS's KS_AUS-Hoehe, direkt nach dem Bau gemessen) -
;; genau wie bei der X/Y-Referenzgerade weiter oben. AS hat einen
;; ECHTEN, von Null verschiedenen KS_EIN->KS_AUS-Hoehenanteil (aus-dz,
;; Nutzer-Korrektur vom Sitzungsbeginn) - der muss hier separat wieder
;; hinzugerechnet werden (die reale Frame-Messung ab soll-hoehe
;; deckt nur "AS-KS_AUS bis nach 1.Bogen" ab, nicht "AS-KS_EIN bis
;; AS-KS_AUS"). bg2z/esz sind die oben ECHT GEMESSENEN Hoehenanteile
;; des 2. Bogens bzw. von Separator+ES (Probe-Bau) - kein
;; Formel-Risiko mehr. Es fehlt nur noch E2 selbst (reine Gerade,
;; E2*tan3 exakt).
(setq h-aussen-rest
(+ aus-dz
(- (caddr (car frame)) soll-hoehe)
bg2z
(- (* e2 tan3))
esz))
;; --- Solver: F_total/S aus vorgegebener Mittelteil-Gesamtlaenge und
;; der noch fehlenden Hoehenaenderung (Rest bis Gesamtbilanz=0) - S
;; beginnt beim symmetrischen Grundfall (3 Grad) und wird in 3-Grad-
;; Schritten steiler (6, 9, 12, ...) probiert, bis F_total/S beide
;; baubar sind (>=0) - der FLACHSTE passende Winkel wird automatisch
;; gewaehlt (Nutzer-Vorgabe 2026-09-14: dieselbe dynamische Winkelwahl
;; wie Option 5, "gegebene Laenge -> passenden Winkel waehlen"). ---
(setq s-winkel (fix *vfk-gefaelle-winkel*))
(setq versuche 0 gueltig nil)
(while (and (not gueltig) (< versuche 10))
(setq loesung (vfl-gf-auf-ab-solve ziel-laenge (- h-aussen-rest) s-winkel))
(setq f-total (nth 0 loesung) s (nth 1 loesung) gueltig (nth 2 loesung))
(if (not gueltig) (setq s-winkel (+ s-winkel (fix *vfk-gefaelle-winkel*))))
(setq versuche (1+ versuche))
)
(princ (ssg-textf "vfl-qc-s-winkel-echo" (list (itoa s-winkel))))
(if (not gueltig)
(progn
(princ (ssg-textf "vfl-qc-nicht-baubar" (list (rtos f-total 2 0) (rtos s 2 0) (rtos (nth 3 loesung) 2 0))))
(vfl-loesche-seit checkpoint))
(progn
(setq extra-grad (- s-winkel (fix *vfk-gefaelle-winkel*)))
(setq rad-s (* (float s-winkel) (/ pi 180.0)))
(setq fa (* f-total anteil))
(setq fb (- f-total fa))
;; --- Rest WIRKLICH bauen (physische Reihenfolge; AS/E1/Sep/1.
;; Bogen sind bereits gebaut, frame steht auf dessen Ausgang) ---
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt fa (fix *vfk-gefaelle-winkel*)))
(vfl-acc-gf-seg (/ fa (cos rad3)) (fix *vfk-gefaelle-winkel*))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-insert-separator frame))
(setq erg-bogen (vfl-gf-bogen-uebergang frame (- (fix *vfk-gefaelle-winkel*))))
(setq frame (car erg-bogen))
;; --- S bei s-winkel Grad (dynamisch gewaehlt): die zusaetzliche
;; Neigung wird mit ECHTEN Bausteinen erreicht (vfl-gf-bogen-
;; erweitern, wie bei Option 5). ---
(setq frame (vfl-gf-bogen-erweitern frame "auf" (- (fix *vfk-gefaelle-winkel*)) extra-grad))
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt s (- s-winkel)))
(vfl-acc-gf-seg (/ s (cos rad-s)) (- s-winkel))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-gf-bogen-erweitern frame "ab" (- s-winkel) extra-grad))
(setq erg-bogen (vfl-gf-bogen-uebergang frame (fix *vfk-gefaelle-winkel*)))
(setq frame (car erg-bogen))
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt fb (fix *vfk-gefaelle-winkel*)))
(vfl-acc-gf-seg (/ fb (cos rad3)) (fix *vfk-gefaelle-winkel*))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-insert-separator frame))
(setq frame (vfl-insert-gf-bogen-block frame bogen-winkel bogen-seite))
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt e2 (fix *vfk-gefaelle-winkel*)))
(vfl-acc-gf-seg (/ e2 (cos rad3)) (fix *vfk-gefaelle-winkel*))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-insert-es-element "GF" frame hz-jetzt (fix *vfk-gefaelle-winkel*)
(caddr (car frame)) es-seite))
(setq p-aktuell (car frame))
(setq letzter-typ "GF")
(setq ist-hoehe (caddr p-aktuell))
(setq abweichung (vfl-kreuz2d (- (car p-aktuell) p0x) (- (cadr p-aktuell) p0y) dref-x dref-y))
(princ (ssg-textf "vfl-qc-erfolg"
(list (rtos soll-hoehe 2 1) (rtos ist-hoehe 2 1) (rtos abweichung 2 1))))
(setq fertig t)
)
)
)
)
)
)
)
)
)
;; ------------------------------------------------------------------
;; "QC Linie mit GF und U-Form" (Option 5 der gf-laenge-modus-Frage,
;; Nutzer-Vorgabe 2026-09-13, nach mehreren Praezisierungsrunden - inkl. echter
;; BricsCAD-Tests): wie vfl-qc-linie-mit-gf (Option 4), aber statt EINES
;; 30/90-Grad-Bogens ein kompletter U-Turn ueber ZWEI 90-Grad-GF-
;; Horizontalboegen (dieselbe Seite = GEGENSEITE der AS-Seite, zusammen ~180
;; Grad Wende) mit einer festen Zwischenstrecke dazwischen. E1, die feste
;; Zwischenstrecke, beide 90-Grad-Bogen behalten dabei durchgehend die
;; aktuelle 3-Grad-Neigung bei (wie ueberall sonst in Linie-GF) - eine
;; probeweise horizontale (0 Grad) Variante wurde getestet und wieder
;; verworfen (Nutzer-Korrektur 2026-09-13).
;; AS/ES-Winkel sind fest 90 Grad, nur die Seite ist waehlbar. E1 UND die
;; Referenzrichtung werden in EINEM Klick bestimmt (vfl-in-abstand) - der
;; Klickpunkt markiert den Start des 1. Bogens, Separator-Laenge wird intern
;; abgezogen (wie Option 4: Klickpunkt = exakter Bogen-Start). AS wird mit
;; xy-ref/z-ref="KS_EIN" eingefuegt (Klickpunkt = KS_EIN exakt). theta-ref
;; (die Klick-Richtung) ist E1's Fahrtrichtung, NICHT AS's Eintrittsachse -
;; AS's KS_EIN-Achse (eintritt-hz = theta-ref - as-turn) steht bei einem
;; echten 90-Grad-Element senkrecht dazu und ist die Baseline, auf die ES am
;; Ende EXAKT zurueckkehren muss (Nutzer-Vorgabe, 3. Praezisierungsrunde:
;; erzwungen, nicht mehr nur informativ wie urspruenglich).
;; Mittelteil (Nutzer-Vorgabe 2026-09-13, finale Struktur nach mehreren
;; Praezisierungsrunden): nach dem 2. (horizontalen) Bogen direkt Fa
;; (fallend, STANDARD 3 Grad, UNBEKANNT) + Sep -> Uebergang fallend->
;; steigend (auf_6, STANDARD - Fa/Sep garantieren sauber 3 Grad davor) ->
;; ECHTE Zusatz-Neigung auf -9 Grad (zweiter Vario_Bogen_auf_6-Baustein,
;; vfl-gf-bogen-weiter) -> S (steigend, 9 Grad - STEILER als Fa, UNBEKANNT,
;; Nutzer-Vorgabe: je steiler S, desto kleiner kann E1 gewaehlt werden) ->
;; ECHTE Rueckkehr auf -3 Grad (zweiter Vario_Bogen_ab_6-Baustein) ->
;; Uebergang steigend->fallend (ab_6, STANDARD) -> ES (mit automatisch
;; gebuendeltem Separator). Fa UND S sind BEIDE Unbekannte, geloest aus
;; einem 2x2-System: Hoehenbilanz (S*tan9-Fa*tan3=D) UND Lage-Bilanz/
;; Kolinearitaet zur Baseline (Fa+S=T, Kreuzprodukt-Gleichung wie Option 4's
;; E2-Loesung, inkl. dem Fixterm des Separators zwischen Fa und dem
;; auf_6-Uebergang). Der komplette Rest (Uebergang auf_6+Zusatz-auf_6+
;; Zusatz-ab_6+ab_6+Sep+ES) haengt nur von der Ankunfts-Orientierung ab
;; (nicht von Fa/S selbst) - sein GESAMTER Hoehen- UND Lage-Beitrag (mit
;; Fa=S=0) wird darum per Probe-Bau+Messen VORAB ermittelt (dasselbe Prinzip
;; wie bei Option 4), danach Fa/S direkt geloest und alles ECHT gebaut. Die
;; asymmetrische Neigung (Fa bei 3, S bei 9 statt beide bei 3) macht Fa/S
;; erst ueber E1 steuerbar - bei identischen Winkeln waeren D und T
;; rechnerisch gleich empfindlich auf alle Laengen-Eingaben, das
;; Gleichungssystem also nicht ueber Nutzereingaben beeinflussbar (Fa+S=T
;; haengt NIE von den Neigungswinkeln ab, nur die Hoehenbilanz tut es -
;; erst der Winkel-Unterschied entkoppelt beide Gleichungen genug, um
;; ueberhaupt eine Loesung ueber E1/Zwischenstrecke anzusteuern).
(defun vfl-qc-linie-mit-gf-uform ( / as-w as-s bogen-seite theta-ref as-turn eintritt-hz
hz-jetzt e1 e1-brutto erg-abstand fest-laenge
e1-neigung e1-neigung-rad
s fa d-hoehe t-lage gueltig sep-dx-planar sep-dz
s-winkel extra-grad rad-s tan-s versuche
tan-e1neigung d-fa-de1 e1-vorschlag
soll-hoehe ist-hoehe rad3 tan3
p0x p0y dref-x dref-y theta-ref-rad
checkpoint p0-real h-aussen-rest hoehe-vor-fa
p2x p2y hz2 hz2-rad fixedx fixedy dx-fix dy-fix
probe-checkpoint probe-frame-a probe-frame-b probe-frame-c dz-fix
acc-gfbogen-save acc-sep-save
abweichung antwort erg-bogen)
(if (not kettenanfang)
(princ (ssg-text "vfl-qc-uform-nur-kettenanfang"))
(progn
;; --- AS-Seite: wiederverwenden, falls am Kettenanfang schon
;; entschieden - Winkel wird IMMER auf 90 erzwungen (Nutzer-Vorgabe),
;; unabhaengig davon, was bei der allgemeinen AS-Frage evtl. schon
;; gewaehlt wurde (vf-set-as-masse wird darum hier IMMER erneut mit "90"
;; aufgerufen, auch wenn as-vorhanden schon t war).
(princ (ssg-text "vfl-qc-uform-winkel-fix"))
(if as-vorhanden
(setq as-s as-seite)
(progn
(princ (ssg-text "vfl-aus-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"vfl-aus-seite-header"))
(setq as-s (if (= antwort "2") "rechts" "links"))
(setq as-seite as-s)
(setq as-vorhanden t)
)
)
(setq as-w "90")
(vf-set-as-masse as-w as-s)
;; Bogen-Seite = GEGENSEITE der AS-Seite (Nutzer-Korrektur 2026-09-13,
;; nach BricsCAD-Test: mit bogen-seite=as-s lief der U-Turn in die
;; falsche Richtung zurueck - die AS-Drehteller-Seite und die
;; GF-Bogen-Seite sind entgegengesetzt konventioniert).
(setq bogen-seite (if (= as-s "links") "rechts" "links"))
(setq rad3 (* (float (fix *vfk-gefaelle-winkel*)) (/ pi 180.0)))
(setq tan3 (/ (sin rad3) (cos rad3)))
;; rad-s/tan-s (S's Neigung) werden weiter unten PRO WINKEL-KANDIDAT neu
;; berechnet (dynamische Winkelwahl, Nutzer-Vorgabe 2026-09-13) - Fa
;; faellt immer bei 3 Grad, VOR S (asymmetrische Neigung fuer Fa/S, je
;; steiler S desto kleiner kann E1 werden).
;; --- Richtung UND E1-Laenge in EINEM Klick (Nutzer-Vorgabe
;; 2026-09-13): der Klickpunkt markiert den Start des 1. 90-Grad-Bogens;
;; Separator-Laenge wird intern abgezogen, damit der Bogen exakt dort
;; beginnt (wie Option 4's Klickpunkt=KS_EIN-Prinzip). ---
(setq erg-abstand (vfl-in-abstand p-aktuell nil (ssg-text "vfl-qc-uform-prompt-richtung-e1")))
(if (null erg-abstand) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq e1-brutto (car erg-abstand) theta-ref (cdr erg-abstand))
;; Konsolen-Echo (Nutzer-Vorgabe 2026-09-13): anders als bei einem
;; Zahl-Dialog zeigt ein reiner Klick den erfassten Wert nicht von
;; selbst an - wie bei vfl-echo-endpunkt-hoehe/vfl-echo-position wird
;; das Ergebnis darum explizit ausgegeben.
(princ (ssg-textf "vfl-qc-uform-e1-echo" (list (rtos e1-brutto 2 0) (rtos theta-ref 2 1))))
(setq as-turn (vf-element-plan-turn (strcat "AS_Element_" as-w "_" as-s)))
;; --- E1-Neigung: NICHT die angenommene *vfk-gefaelle-winkel* (3 Grad),
;; sondern die REALE, am AS-Block gemessene Neigungsaenderung KS_EIN->
;; KS_AUS (Nutzer-Vorgabe 2026-09-13, NUR fuer diese Option - siehe
;; vf-element-plan-neigung-Kommentar). E1 schliesst damit exakt an AS's
;; echten KS_AUS an, ohne kuenstlichen Neigungssprung. Als Nebeneffekt
;; (Nutzer-Befund) wird dadurch Fa/S ueber E1 steuerbar - bei E1-Neigung
;; = 3 Grad waeren D (Hoehenbilanz) und T (Lagebilanz) rechnerisch exakt
;; gleich empfindlich auf E1, Fa haette also NICHT ueber E1 korrigiert
;; werden koennen.
(setq e1-neigung (vf-element-plan-neigung (strcat "AS_Element_" as-w "_" as-s)))
(setq e1-neigung-rad (* (float e1-neigung) (/ pi 180.0)))
(princ (ssg-textf "vfl-qc-uform-e1-neigung-echo" (list (rtos e1-neigung 2 2))))
;; Separator-Abzug mit e1-neigung (nicht rad3) - der Separator erbt die
;; Neigung des vorangehenden Segments (E1), nicht die feste 3 Grad.
(setq e1 (- e1-brutto (* *vfk-separator-laenge* (cos e1-neigung-rad))))
;; --- Restliches Mengengeruest ---
(setq fest-laenge (vfl-in-real (ssg-textf "vfl-qc-prompt-u-fest-laenge" (list (rtos *vfk-qc-u-fest-laenge* 2 0)))))
(if (null fest-laenge) (setq fest-laenge *vfk-qc-u-fest-laenge*))
(setq es-seite as-s) ; Nutzer-Vorgabe: ES-Seite = AS-Seite, keine Frage
(vf-set-es-masse "90" es-seite) ; ES-Winkel ebenfalls fest 90, keine Frage
;; --- AS wirklich bauen (Klickpunkt = KS_EIN, wie Option 4) ---
;; WICHTIG (Nutzer-Korrektur 2026-09-13): theta-ref ist die gewuenschte
;; FAHRTRICHTUNG von E1 (der Klick misst e1-brutto entlang theta-ref,
;; siehe vfl-in-abstand) - das ist AS's AUSTRITTS-Richtung (KS_AUS),
;; NICHT die Eintritts-Achse (KS_EIN)! AS_Element_90 dreht intern um
;; as-turn (gemessen, nicht angenommen) - die KS_EIN-Achse muss darum
;; um as-turn ZURUECKgedreht werden (eintritt-hz = theta-ref - as-turn),
;; damit KS_AUS nach dem Bau exakt auf theta-ref zeigt. Bei einem
;; echten 90-Grad-Bogen bedeutet das: die KS_EIN-Achse steht senkrecht
;; zur gewaehlten Richtung.
(setq eintritt-hz (- theta-ref as-turn))
;; Referenzgerade (Baseline), zu der ES am Ende EXAKT zurueckkehren soll
;; (Nutzer-Vorgabe 2026-09-13, 3. Runde: erzwungen, nicht mehr nur
;; informativ), ist AS's EINTRITTS-Achse (eintritt-hz, senkrecht zu
;; theta-ref) - NICHT theta-ref selbst (das ist E1's Fahrtrichtung).
(setq dref-x (cos (* (float eintritt-hz) (/ pi 180.0))))
(setq dref-y (sin (* (float eintritt-hz) (/ pi 180.0))))
(setq checkpoint (vf-lastent-ohne-attribute))
(setq p0-real p-aktuell)
(setq p0x (car p0-real) p0y (cadr p0-real))
(setq theta-ref-rad (* (float eintritt-hz) (/ pi 180.0)))
(setq frame (insert-block-mixed-to-ks
(strcat "AS_Element_" as-w "_" as-s)
(make-frame-from-dir p-aktuell (list (cos theta-ref-rad) (sin theta-ref-rad) 0.0))
(caddr p-aktuell) "KS_EIN" "KS_EIN"))
(setq p-aktuell (car frame))
(setq soll-hoehe (caddr p-aktuell))
(princ (ssg-textf "vfl-qc-ks-ein-gemessen"
(list (rtos p0x 2 2) (rtos p0y 2 2) (rtos (caddr p0-real) 2 2))))
;; --- E1 + Sep bei e1-neigung (REAL gemessen, NICHT der festen 3-Grad-
;; Annahme - siehe Kommentar oben), danach 1. Bogen, feste
;; Zwischenstrecke, 2. Bogen bei der jetzt aktuellen Neigung (Bogen/
;; Zwischenstrecke sind neigungs-agnostisch, "erhalten die aktuelle
;; Neigung") - ALLES strikt sequenziell ECHT gebaut. ---
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt e1 e1-neigung))
(vfl-acc-gf-seg (/ e1 (cos e1-neigung-rad)) e1-neigung)
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-insert-separator frame))
;; --- Rein rechnerischer Ruecksprung auf EXAKT 3 Grad (Nutzer-Vorgabe
;; 2026-09-13): e1-neigung ist die REALE AS-Neigung, oft ein "krummer"
;; Wert, keiner der beiden Zustaende (flach/3 Grad), die die
;; Uebergangs-Bogen-Bibliothek kennt - ein spaeterer Uebergang auf
;; steigend (fuer Bogen-auf-6) wuerde sonst falsch klassifiziert
;; (Nutzer-Befund: "auf_3" statt "auf_6" im Log). Position/Fahrtrichtung
;; bleiben unveraendert, nur die Neigung wird auf *vfk-gefaelle-winkel*
;; gesetzt - wie jeder GF-Geraden-Uebergang (vfl-insert-gf-segment endet
;; ja ebenfalls immer mit genau der uebergebenen winkel, kein
;; Uebergangs-Baustein noetig) ---
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (make-frame-from-dir (car frame) (hz-winkel->xu hz-jetzt (fix *vfk-gefaelle-winkel*))))
(setq frame (vfl-insert-gf-bogen-block frame 90 bogen-seite))
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt fest-laenge (fix *vfk-gefaelle-winkel*)))
(vfl-acc-gf-seg (/ fest-laenge (cos rad3)) (fix *vfk-gefaelle-winkel*))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-insert-gf-bogen-block frame 90 bogen-seite))
;; --- Nochmaliger rein rechnerischer Ruecksprung auf EXAKT 3 Grad NACH
;; Bogen2 (Nutzer-Befund 2026-09-13: die Gefaellebogen_..._90_R500-
;; Bloecke geben ihre eigene, REAL gemessene KS_AUS-Neigung zurueck -
;; die weicht leicht von der eingehenden Neigung ab und fiel dann in
;; die "flach"-Toleranz von vfl-gf-bogen-uebergang, was die PROBE
;; direkt betrifft: die Probe ruft vfl-gf-bogen-uebergang naemlich MIT
;; dem rohen frame direkt nach Bogen2 auf, NOCH BEVOR Fa gebaut wird -
;; Fa's eigene Neigungs-Korrektur (explizites winkel=3) kommt fuer die
;; Probe also zu spaet. Position (car frame) bleibt unveraendert, nur
;; die Neigung wird hart auf *vfk-gefaelle-winkel* gesetzt - dasselbe
;; Prinzip wie beim E1-Fix weiter oben. ---
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (make-frame-from-dir (car frame) (hz-winkel->xu hz-jetzt (fix *vfk-gefaelle-winkel*))))
(setq hoehe-vor-fa (caddr (car frame)))
(setq p2x (car (car frame)) p2y (cadr (car frame)))
(setq hz2 (car (frame->hz-winkel frame)))
(setq hz2-rad (* (float hz2) (/ pi 180.0)))
;; --- Dynamische Winkelwahl (Nutzer-Vorgabe 2026-09-13: "gegebene
;; Laenge -> passenden Winkel waehlen" statt einem einzigen fest
;; verdrahteten Winkel): S beginnt beim symmetrischen Grundfall (3
;; Grad, extra-grad=0) und wird in 3-Grad-Schritten steiler (6, 9,
;; 12, ...), bis Fa/S beide baubar sind (>=0) - der FLACHSTE passende
;; Winkel wird automatisch gewaehlt. Jede Erweiterung nutzt ECHTE
;; Bausteine (vfl-gf-bogen-erweitern: moeglichst viele 6-Grad-, ein
;; 3-Grad-Rest-Baustein). Je Kandidat: Probe-Bau+Messen (wie Option 4)
;; von Bogen-auf-6 + Erweiterung + Rueckkehr + Bogen-ab-6 + Sep+ES
;; (Fa=S=0) - ihr GESAMTER Hoehen- UND Lage-Beitrag haengt nur von der
;; Ankunfts-Orientierung ab (hz2), nicht von Fa/S. Fa (fallend, VOR S,
;; 3 Grad) und S (steigend, NACH Fa, s-winkel) sind die beiden
;; Unbekannten in einem 2x2-System: Hoehenbilanz (S*tan(s-winkel)-
;; Fa*tan3=D) UND Lage-Bilanz (Fa+S=T, Kolinearitaet zur Baseline
;; eintritt-hz/dref). ---
;; --- Separator ZWISCHEN Fa und dem auf_6-Uebergang: die Probe beginnt
;; DIREKT bei p2 (ohne Fa/Sep) - Fa selbst steckt schon in der Gleichung
;; (S-Fa), aber der Separator NACH Fa hat eine EIGENE, FESTE (vom
;; Nutzer nicht beeinflussbare) Horizontal-/Hoehenwirkung, die sonst
;; NIRGENDS mitgezaehlt wuerde (Bug-Fund 2026-09-13: realer Test lief
;; durch, aber deltaX/deltaZ zur Baseline waren NICHT null). Analog zu
;; Option 4's fix-dx/fix-dz (vfl-gf-auf-ab-solve) wird sein Fussabdruck
;; hier explizit ergaenzt. ---
(setq sep-dx-planar (* *vfk-separator-laenge* (cos rad3)))
(setq sep-dz (* *vfk-separator-laenge* (sin rad3)))
(setq s-winkel (fix *vfk-gefaelle-winkel*))
(setq versuche 0 gueltig nil)
(while (and (not gueltig) (< versuche 10))
(setq extra-grad (- s-winkel (fix *vfk-gefaelle-winkel*)))
(setq rad-s (* (float s-winkel) (/ pi 180.0)))
(setq tan-s (/ (sin rad-s) (cos rad-s)))
(setq acc-gfbogen-save *vfl-acc-gfbogen* acc-sep-save *vfl-acc-separator*)
(setq probe-checkpoint (vf-lastent-ohne-attribute))
(setq probe-frame-a (car (vfl-gf-bogen-uebergang frame (- (fix *vfk-gefaelle-winkel*)))))
(setq probe-frame-a (vfl-gf-bogen-erweitern probe-frame-a "auf" (- (fix *vfk-gefaelle-winkel*)) extra-grad))
(setq probe-frame-a (vfl-gf-bogen-erweitern probe-frame-a "ab" (- s-winkel) extra-grad))
(setq probe-frame-b (car (vfl-gf-bogen-uebergang probe-frame-a (fix *vfk-gefaelle-winkel*))))
(setq probe-frame-c (vfl-insert-es-element "GF" probe-frame-b (car (frame->hz-winkel probe-frame-b))
(fix *vfk-gefaelle-winkel*) (caddr (car probe-frame-b)) es-seite))
(setq dz-fix (- (caddr (car probe-frame-c)) hoehe-vor-fa))
(setq dx-fix (- (car (car probe-frame-c)) p2x))
(setq dy-fix (- (cadr (car probe-frame-c)) p2y))
(vfl-loesche-seit probe-checkpoint)
(setq *vfl-acc-gfbogen* acc-gfbogen-save *vfl-acc-separator* acc-sep-save)
(setq h-aussen-rest (+ aus-dz (- hoehe-vor-fa soll-hoehe) dz-fix (- sep-dz)))
(setq d-hoehe (- h-aussen-rest))
(setq fixedx (+ p2x dx-fix) fixedy (+ p2y dy-fix))
(setq t-lage (- (/ (- (vfl-kreuz2d (- fixedx p0x) (- fixedy p0y) dref-x dref-y))
(vfl-kreuz2d (cos hz2-rad) (sin hz2-rad) dref-x dref-y))
sep-dx-planar))
(setq s (/ (+ d-hoehe (* t-lage tan3)) (+ tan3 tan-s)))
(setq fa (- t-lage s))
(setq gueltig (and (>= s -0.01) (>= fa -0.01)))
(if (not gueltig) (setq s-winkel (+ s-winkel (fix *vfk-gefaelle-winkel*))))
(setq versuche (1+ versuche))
)
(princ (ssg-textf "vfl-qc-uform-fa-s-echo" (list (rtos fa 2 0) (rtos s 2 0) (itoa s-winkel))))
(if (not gueltig)
(progn
;; --- Mindest-E1-Vorschlag (Nutzer-Vorgabe 2026-09-13, analog zu
;; Option 4's Mindest-Gesamtlaenge): d(Fa)/d(E1) ist EXAKT konstant
;; (haengt nur von s-winkel/e1-neigung ab, nicht von E1 selbst) -
;; die Korrektur ist damit kein Schaetzwert, sondern eine exakte
;; algebraische Aufloesung nach E1, bei der Fa (mit dem STEILSTEN
;; probierten S-Winkel, hier also der beste erreichbare Fall) genau
;; 0 wird. ---
(setq tan-e1neigung (/ (sin e1-neigung-rad) (cos e1-neigung-rad)))
(setq d-fa-de1 (/ (- tan-s tan-e1neigung) (+ tan3 tan-s)))
(setq e1-vorschlag (if (> d-fa-de1 0.0001) (+ e1-brutto (/ (- fa) d-fa-de1)) nil))
(if e1-vorschlag
(princ (ssg-textf "vfl-qc-uform-fa-s-negativ-e1" (list (rtos fa 2 0) (rtos s 2 0) (rtos e1-vorschlag 2 0))))
(princ (ssg-textf "vfl-qc-uform-fa-s-negativ" (list (rtos fa 2 0) (rtos s 2 0))))
)
(vfl-loesche-seit checkpoint))
(progn
(setq extra-grad (- s-winkel (fix *vfk-gefaelle-winkel*)))
;; --- Fa ECHT bauen (fallend, STANDARD 3 Grad, VOR S) + Sep ---
(setq frame (vfl-insert-gf-segment (car frame) hz2 fa (fix *vfk-gefaelle-winkel*)))
(vfl-acc-gf-seg (/ fa (cos rad3)) (fix *vfk-gefaelle-winkel*))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-insert-separator frame))
;; --- Uebergang fallend->steigend (auf_6, STANDARD - Fa/Sep
;; garantieren sauber 3 Grad davor) ---
(setq erg-bogen (vfl-gf-bogen-uebergang frame (- (fix *vfk-gefaelle-winkel*))))
(setq frame (car erg-bogen))
;; --- S bei s-winkel Grad (dynamisch gewaehlt): die zusaetzliche
;; Neigung wird mit ECHTEN Bausteinen erreicht (vfl-gf-bogen-
;; erweitern, siehe dort). ---
(setq frame (vfl-gf-bogen-erweitern frame "auf" (- (fix *vfk-gefaelle-winkel*)) extra-grad))
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-gf-segment (car frame) hz-jetzt s (- s-winkel)))
(vfl-acc-gf-seg (/ s (cos rad-s)) (- s-winkel))
(setq anzahl-gf (1+ anzahl-gf))
(setq frame (vfl-gf-bogen-erweitern frame "ab" (- s-winkel) extra-grad))
(setq erg-bogen (vfl-gf-bogen-uebergang frame (fix *vfk-gefaelle-winkel*)))
(setq frame (car erg-bogen))
(setq hz-jetzt (car (frame->hz-winkel frame)))
(setq frame (vfl-insert-es-element "GF" frame hz-jetzt (fix *vfk-gefaelle-winkel*)
(caddr (car frame)) es-seite))
(setq p-aktuell (car frame))
(setq letzter-typ "GF")
(setq ist-hoehe (caddr p-aktuell))
(setq abweichung (vfl-kreuz2d (- (car p-aktuell) p0x) (- (cadr p-aktuell) p0y) dref-x dref-y))
(princ (ssg-textf "vfl-qc-erfolg"
(list (rtos soll-hoehe 2 1) (rtos ist-hoehe 2 1) (rtos abweichung 2 1))))
(setq fertig t)
)
)
)
)
)
;; Horizontales Sub-Segment bauen. Die flache Zone (0 Grad) wird NICHT mehr
;; automatisch mit ab_3 auf die 3-Grad-Basis zurueckgefuehrt - das Stueck ENDET
;; FLACH. Der ab_3-Uebergang kommt erst, wenn ein 3-Grad-Element folgt
;; (vfl-nach-3grad). Der auf_3-Eintritt wird nur gesetzt, wenn der Frame noch
;; NICHT flach ist (sonst bleibt die laufende flache Zone erhalten). Separatoren
;; VOR/NACH liegen in der 0-Grad-Ebene. Rueckgabe: neuer Frame (flach, 0 Grad).
;; ziel-modus=T: dL ist die GESAMT-Zielstrecke ab pt (der Nutzer hat einen
;; Endpunkt gepickt, den die Kette exakt treffen soll). In diesem Fall werden
;; ALLE Fragen, die die spaeter tatsaechlich gebaute Laenge beeinflussen
;; (Separator VOR/NACH, UND "Ist der Endpunkt der Foerderer?"), VOR der
;; Laengenberechnung gestellt - erst wenn wirklich alle Informationen da sind,
;; wird dL final berechnet und die horizontale Strecke gebaut. Das verhindert,
;; dass die Kette am Ende ueber den gepickten Punkt hinausragt, nur weil
;; nachtraeglich noch ein Separator oder eine Motorstation dazukommt.
;; gf2-laenge: die (schon feststehende) GF2-Laenge aus der GF-Verteilungs-
;; Frage (L_GF2-bau in vfl-vf-einheit) - wird bei Antwort "1" (nur Motor-
;; station) MIT reserviert, da vfs-vf-exit sie direkt danach anbaut. Bei
;; Antwort "3" (Kettenende definieren) NICHT reservieren: dort berechnet
;; vfl-body-abschluss ein eigenes, unabhaengiges ziel-gf2 (siehe dort) - hier
;; unbekannt und irrelevant.
;; Rueckgabe bei ziel-modus=T: (frame ist-endpunkt-antwort) - der Aufrufer
;; (vfl-vf-einheit) muss die Frage dann NICHT erneut stellen. Bei ziel-modus=
;; nil (Default/mid-chain-Fortsetzung): unveraendertes Verhalten, Rueckgabe
;; nur frame.
;; --- Horizontaler Koerper: reiner Bauteil ---
;; Baut das horizontale Stueck aus FERTIGEN Antworten - keine Frage, kein
;; Dialog. Rueckgabe: neuer Frame (das Stueck endet flach, 0 Grad).
;;
;; ziel-modus bleibt ein EIGENER Parameter neben ende-code (der Fahrplan
;; wollte ihn ersetzen): die Separator-Subtraktionen haengen allein am
;; Ziel-Modus, nicht an der Endpunkt-Antwort - und ende-code darf nil sein
;; (abgebrochene Menuefrage). Mit nur einem Parameter waere genau dieser Fall
;; eine stille Verhaltensaenderung.
;;
;; REIHENFOLGE IST GEOMETRIE: jede dL-Subtraktion ist mit
;; (max *vfk-restlaenge-min-clamp* ...) geklammert, also nicht kommutativ,
;; und der auf_3-Insert sitzt BEWUSST zwischen Subtraktion 1 und 2 - sein
;; Fussabdruck wird GEMESSEN (vfl-projiziere-distanz), nicht geschaetzt.
;; Hier darf nichts umsortiert werden.
;; Klemmt v auf *vfk-restlaenge-min-clamp*, falls es darunter faellt, und
;; meldet das (headless-sicher via vfl-meldung statt einer interaktiven
;; Rueckfrage - der Bauteil selbst bleibt deterministisch/kopflos-tauglich,
;; siehe vf_spec.lsp; anders als im urspruenglichen einteiligen Entwurf kann
;; hier daher nicht mehr nachgefragt/rueckgebaut werden, nur informieren).
(defun vfl-hor-koerper-klemmen (v / geklemmt)
(setq geklemmt (max *vfk-restlaenge-min-clamp* v))
(if (< v *vfk-restlaenge-min-clamp*)
(vfl-meldung (ssg-textf "vfl-hinweis-horizontal-fussabdruck-geklemmt"
(list (rtos v 2 0) (rtos geklemmt 2 0)))))
geklemmt)
(defun vfl-hor-koerper-bauen (frame hz dL ziel-modus ende-code sep-vor sep-nach
gf2-laenge / pt m1 pt-vor-bogen)
(setq pt (car frame))
(if (and ziel-modus sep-vor) (setq dL (vfl-hor-koerper-klemmen (- dL *vfk-separator-laenge*))))
;; auf_3-Eintritt nur, wenn noch NICHT flach (sonst flache Zone fortsetzen).
;; dL ist die gewuenschte Reststrecke AB HIER (pt) - der reale Bogen-
;; Fussabdruck (gemessen, nicht aus der Tabellen-Masse geschaetzt - die
;; stimmt nach der Rotation nicht mehr exakt) wird von dL abgezogen, damit
;; das horizontale Stueck am gewuenschten Zielpunkt endet.
(if (not (vfl-frame-flach-p frame))
(progn
(setq pt-vor-bogen pt)
(setq m1 (get-bogen-mass bogen-auf 3))
(princ (ssg-text "vfl-bogen-auf3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) (car m1) (caddr m1) hz))
(setq dL (vfl-hor-koerper-klemmen (- dL (vfl-projiziere-distanz pt-vor-bogen pt hz))))))
(if (and ziel-modus sep-nach) (setq dL (vfl-hor-koerper-klemmen (- dL *vfk-separator-laenge*))))
;; Ausgangs-Fussabdruck (Vario_Bogen_ab_3 + Motorstation) nur reservieren,
;; wenn die Einheit tatsaechlich sofort schliesst (Antwort 1 oder 3); bei
;; Antwort 1 zusaetzlich die GF2 hinter dem Motor.
(if ziel-modus
(cond
((= ende-code "1")
(setq dL (vfl-hor-koerper-klemmen (- dL (car (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*))) *vfk-stations-laenge*
(* (if gf2-laenge gf2-laenge 0.0)
(cos (* *vfk-gefaelle-winkel* (/ pi 180.0))))))))
((= ende-code "3")
(setq dL (vfl-hor-koerper-klemmen (- dL (car (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*))) *vfk-stations-laenge*))))))
;; optionaler Separator VOR - in der horizontalen Ebene (0 Grad)
(if sep-vor (setq pt (vfl-sep-hz pt hz)))
;; horizontale Zwischenstrecke (0 Grad)
(princ (ssg-textf "vfl-horizontale-zwischenstrecke" (list (rtos dL 2 2))))
(setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt dL 0 hz))
(vfl-acc-vf-seg "horizontal" 0 dL)
;; optionaler Separator NACH (jetzt tatsaechlich bauen)
(if sep-nach (setq pt (vfl-sep-hz pt hz)))
;; KEIN ab_3 mehr -> das Stueck ENDET FLACH (0 Grad)
(make-frame-from-dir pt (hz-winkel->xu hz 0.0))
)
;; Frage "Ist der Endpunkt der Foerderer?" (Motorstation/weiterbauen/
;; Motorstation+Kettenende) - eigene Funktion, da an mehreren Stellen genutzt
;; (Ziel-Modus des horizontalen Koerpers UND die Fortsetzungsschleife von
;; vfl-vf-einheit). Zeigt im Wizard-Modus SELBST den Dialog (vflw_horizontal,
;; radio-basiert) und legt die Antwort in die Pending-Queue - der Konsolen-
;; Text bleibt darunter unveraendert stehen (Fallback bei Fehlern/GUI aus).
(defun vfl-frage-ist-endpunkt ( / dat ergebnis gende)
(princ (ssg-text "vfl-ist-endpunkt-frage"))
(princ (ssg-text "vfl-ja-nur-motorstation"))
(princ (ssg-text "vfl-nein-weiterbauen"))
(princ (ssg-text "vfl-ja-motorstation-kettenende"))
(if (vfl-wizard-aktiv)
(progn
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_horizontal" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-ist-endpunkt-frage")))
(set_tile "istende_1" "1")
(action_tile "accept"
"(setq gende (cond ((= (get_tile \"istende_0\") \"1\") \"0\")
((= (get_tile \"istende_2\") \"1\") \"2\")
(t \"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) (vflw-pending-push-all (list (itoa (1+ (atoi gende))))))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
)
)
(vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def2")
(list (ssg-text "vfl-ja-nur-motorstation")
(ssg-text "vfl-nein-weiterbauen")
(ssg-text "vfl-ja-motorstation-kettenende")) 2
"vfl-ist-endpunkt-frage"))
;; Frage "Ist das das Kettenende?" (Linie-GF-Segment-Schleife) - eigene
;; Funktion, da an zwei identischen Stellen genutzt (mit/ohne vorherigen
;; Separator-Einbau). Im Wizard-Modus zeigt sie SELBST den Dialog
;; (vflw_kettenende, radio-basiert) und legt die Antwort in die Pending-
;; Queue - analog zu vfl-frage-ist-endpunkt.
(defun vfl-frage-ist-kettenende ( / dat ergebnis gwahl antwort)
(princ (ssg-text "vfl-ist-kettenende-header"))
(princ (ssg-text "vfl-kettenende-opt-ja-es"))
(princ (ssg-text "vfl-kettenende-opt-ja-ohne-es"))
(princ (ssg-text "vfl-kettenende-opt-nein"))
(if (vfl-wizard-aktiv)
(progn
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_kettenende" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text "vfl-ist-kettenende-header")))
(action_tile "accept"
"(setq gwahl (cond ((= (get_tile \"wahl_ja_es\") \"1\") \"1\")
((= (get_tile \"wahl_ja_ohne_es\") \"1\") \"2\")
(t \"3\")))
(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) (vflw-pending-push-all (list gwahl)))
((= ergebnis 2) (setq *vfl-wizard-abbruch-grund* "zurueck"))
(t (setq *vfl-wizard-abbruch-grund* "abbrechen"))
)
)
)
)
)
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3")
(list (ssg-text "vfl-kettenende-opt-ja-es")
(ssg-text "vfl-kettenende-opt-ja-ohne-es")
(ssg-text "vfl-kettenende-opt-nein")) 3
"vfl-ist-kettenende-header"))
antwort)
;; Frage-Schale "ES-Element setzen?" (+ falls ja: Winkel/Seite) - ausgelagert
;; aus vfl-vf-einheit (Option 3 "Kettenende"), damit sie auch VOR einem
;; Winkel-Solve aufgerufen werden kann: der tatsaechliche ES-Fussabdruck
;; (ein-dx/ein-dz, per vfl-es-masse-setzen INNERHALB von vfl-frage-es-seite
;; gesetzt) muss dafuer VOR dem Solve feststehen, sonst waehlt dieser einen zu
;; flachen/langen Winkel und der spaeter noetige Schwanz (Motorstation+
;; Separator+ES) passt nicht mehr in die Reststrecke (siehe vfl-vf-einheit,
;; vorab-antwort-Parameter). Bei "Nein" werden ein-dx/ein-dz genullt (kein
;; ES-Fussabdruck reserviert) und der alte Wert als 3./4. Rueckgabewert
;; mitgegeben - der Aufrufer muss ihn nach getaner Zerlegung wiederherstellen.
;; Rueckgabe: (es-gewuenscht es-seite save-eindx save-eindz).
(defun vfl-es-element-abfragen ( / es-antwort es-gewuenscht es-seite save-eindx save-eindz)
(princ (ssg-text "vfl-es-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-es-nein-zielpunkt"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-es-setzen-frage")))
(setq es-antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-es-nein-zielpunkt")) 1
"vfl-es-setzen-frage"))
(setq es-gewuenscht (/= es-antwort "2"))
(if es-gewuenscht
(setq es-seite (vfl-frage-es-seite t))
(progn (setq save-eindx ein-dx save-eindz ein-dz)
(setq ein-dx 0.0 ein-dz 0.0)))
(list es-gewuenscht es-seite save-eindx save-eindz))
;; --- Horizontaler Koerper: Frage-Schale (Name unveraendert) ---
;; Fragt Separator vor/nach und - im Ziel-Modus - "Ist der Endpunkt der
;; Foerderer?", danach baut vfl-hor-koerper-bauen. Keine der drei Fragen
;; haengt an einem berechneten Wert, sie stehen darum alle vor dem Bau; die
;; Journal-Reihenfolge ist dieselbe wie zuvor.
;; Die Endpunkt-Antwort wird im Ziel-Modus mit zurueckgegeben (vor-antwort),
;; damit die Fortsetzungsschleife des Aufrufers sie nicht erneut erfragt.
(defun vfl-baue-horizontal-koerper (frame hz dL ziel-modus gf2-laenge /
sep-vor sep-nach ist-ende-antwort neu)
(princ (ssg-text "vfl-sep-vor-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-ja-nein-impl (list (ssg-text "vfl-sep-vor-frage"))))
(setq sep-vor (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2 "vfl-sep-vor-frage") "1"))
;; Separator NACH abfragen (noch nicht bauen) - im Ziel-Modus muss der
;; Fussabdruck vor der Laengenberechnung feststehen.
(princ (ssg-text "vfl-sep-nach-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-ja-nein-impl (list (ssg-text "vfl-sep-nach-frage"))))
(setq sep-nach (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2 "vfl-sep-nach-frage") "1"))
(if ziel-modus
(setq ist-ende-antwort (vfl-frage-ist-endpunkt)))
(setq neu (vfl-hor-koerper-bauen frame hz dL ziel-modus ist-ende-antwort
sep-vor sep-nach gf2-laenge))
(if ziel-modus (list neu ist-ende-antwort) neu)
)
;; ============================================================
;; OPTION 3: KETTENENDE AUS LAUFENDER VF-EINHEIT (ein Motor)
;; ============================================================
;; Zerlegt den verbleibenden GERADEN Lauf bis zum Ziel-ES mit der bewaehrten
;; STANDARD-Logik (wie aussen), aber fuer den Mid-Body-Fall:
;; - Der Einlauf (AS + GF1 + Separator + Umlenk) ist bereits gebaut und wird
;; NICHT beruecksichtigt -> aus-dx/aus-dz = 0.
;; - Fest vor dem ES stehen nur Motor(500) + Auslauf-Separator(300)
;; -> FESTE_HORIZONTAL = 800.
;; Ergebnis der Standard-Logik (GF2 = GF, VARIIERT mit dem Winkel):
;; steiler als 3 Grad / steigend -> gewinkeltes VF + GF2 (Winkeltabelle),
;; flacher als 3 Grad -> horizontales VF + GF2 (Rest-Laenge ueber
;; das horizontale Stueck ausgeglichen).
;; Die Hoehe kommt also aus VF-Winkel/horizontal + GF2, die ueberschuessige
;; Laenge aus dem horizontalen VF - genau die zweistufige Logik.
;; Rueckgabe: (typ winkel L_GF2 L_VF) - typ "GF"/"VF"/nil (wie
;; vfl-segment-entscheidung; L_GF2 varriert, Mindestwert siehe vfl-body-abschluss).
;; Sammelt Diagnosetext fuer einen fehlgeschlagenen Stufe-2-Versuch (siehe
;; vfl-stufe2-diagnose) - der Aufrufer (vfl-body-abschluss) haengt/zeigt ihn
;; NACH der endgueltigen FEHLER-Meldung an. Grund: Stufe 2 ist nur ein (evtl.
;; scheiternder) ERSTER Versuch, danach folgt oft noch Stufe 1 (Winkel-
;; Suche) - stuende die Stufe-2-Diagnose weiterhin sofort im Log, wuerde sie
;; sich zwischen ">>> Kettenende-Modus" und die Stufe-1-Winkeltabelle
;; schieben, obwohl sie inhaltlich zur (evtl. erst ganz am Ende sichtbaren)
;; FEHLER-Zeile gehoert. Gelingt Stufe 1 danach doch noch, bleibt der
;; gesammelte Text ungenutzt (kein "typ=nil" in vfl-body-abschluss) - so wird
;; ein erfolgreicher Log nicht mit Details eines verworfenen Zwischenversuchs
;; zugemuellt.
(defun vfl-diag-add (txt)
(setq *vfl-stufe2-diagnose-text*
(strcat (if *vfl-stufe2-diagnose-text* *vfl-stufe2-diagnose-text* "") txt)))
(defun vfl-stufe2-diagnose (deltaL deltaH horizontal-info schon-flach /
rad3 mass1 mass2 bogen-x1 bogen-z1 bogen-x2 bogen-z2
gf-total gueltig fixed-x k-term minh minl-mitgf
fest-planar fest-hoehe)
(vfl-diag-add (ssg-textf "vfl-stufe2-diagnose"
(list (rtos deltaL 2 0) (rtos deltaH 2 0)
(if horizontal-info (rtos (car horizontal-info) 2 1) "?")
(if horizontal-info (rtos (cadr horizontal-info) 2 1) "?")
(if (and horizontal-info (caddr horizontal-info)) "GUELTIG" "UNGUELTIG"))))
(setq rad3 (* *vfk-gefaelle-winkel* (/ pi 180.0)))
(setq mass2 (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(setq bogen-x2 (car mass2) bogen-z2 (caddr mass2))
(if schon-flach
(setq bogen-x1 0.0 bogen-z1 0.0)
(progn
(setq mass1 (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*)))
(setq bogen-x1 (+ (* (car mass1) (cos rad3)) (* (caddr mass1) (sin rad3))))
(setq bogen-z1 (+ (* (- (car mass1)) (sin rad3)) (* (caddr mass1) (cos rad3))))
)
)
(vfl-diag-add (ssg-textf "vfl-stufe2-diagnose-details"
(list (if schon-flach "JA" "NEIN")
(rtos aus-dx 2 1)
(rtos ein-dx 2 1) (rtos ein-dz 2 1)
(rtos bogen-x1 2 1) (rtos bogen-z1 2 1)
(rtos bogen-x2 2 1) (rtos bogen-z2 2 1)
(rtos FESTE_HORIZONTAL 2 1))))
;; Explizite Anzeige: wieviel Laenge/Hoehe der feste "Schwanz" (Stationen +
;; Separator + ES, OHNE die optionalen Uebergangsboegen) allein beansprucht -
;; direkte Antwort auf "was braucht Motorstation+Separator+ES". Das Label
;; haengt vom Budget-Kontext ab: FESTE_HORIZONTAL=800 (Kettenende, nur
;; Motor+Separator - der Eingang/Umlenkstation ist zu diesem Zeitpunkt schon
;; gebaut) vs. 1300 (frischer VF-Einheit-Eingang, zusaetzlich Umlenkstation -
;; siehe *vfk-feste-horizontal-kettenende*/-linienzug in vf_konstanten.lsp).
(setq fest-planar (+ ein-dx (* FESTE_HORIZONTAL (cos rad3))))
(setq fest-hoehe (+ ein-dz (- (* FESTE_HORIZONTAL (sin rad3)))))
(vfl-diag-add (ssg-textf
(if (<= (abs (- FESTE_HORIZONTAL *vfk-feste-horizontal-kettenende*)) 0.5)
"vfl-stufe2-fest-kettenende"
"vfl-stufe2-fest-eingang")
(list (rtos fest-planar 2 0) (rtos fest-hoehe 2 0))))
(setq gueltig (and horizontal-info (caddr horizontal-info)))
;; *vfl-stufe2-minl-vorschlag*/*vfl-stufe2-minh-vorschlag*: kurze Zahlenwerte
;; (kein Text) fuer die knappe Alert-Zusammenfassung in vfl-body-abschluss -
;; minh ist immer definiert (reine Funktion der festen Geometrie), minl nur,
;; wenn Variante 1 (GF nach Zielhoehe) ueberhaupt eine nicht-negative GF
;; ergibt - siehe Kommentar oben.
(setq *vfl-stufe2-minl-vorschlag* nil *vfl-stufe2-minh-vorschlag* nil)
(if (not gueltig)
(progn
(setq gf-total (if horizontal-info (car horizontal-info) nil))
(setq fixed-x (+ aus-dx ein-dx bogen-x1 bogen-x2 (* FESTE_HORIZONTAL (cos rad3))))
(setq k-term (+ aus-dz ein-dz (- (* FESTE_HORIZONTAL (sin rad3))) bogen-z1 bogen-z2))
(setq minh (- k-term))
(setq *vfl-stufe2-minh-vorschlag* minh)
;; Variante 1: Mindest-Streckenlaenge (L_VF=0, GF nach Zielhoehe)
(if (and gf-total (>= gf-total 0))
(progn
(setq minl-mitgf (+ fixed-x (* gf-total (cos rad3))))
(setq *vfl-stufe2-minl-vorschlag* minl-mitgf)
(vfl-diag-add (ssg-textf "vfl-stufe2-minl" (list (rtos minl-mitgf 2 0) (rtos deltaL 2 0)))))
(vfl-diag-add (ssg-textf "vfl-stufe2-minl-unmoeglich" (list (rtos minh 2 0) (rtos deltaH 2 0))))
)
;; Variante 2: Mindest-Hoehenaenderung (GF=0, Rest als gerader VF-Anteil)
(if (>= deltaL fixed-x)
(vfl-diag-add (ssg-textf "vfl-stufe2-minh" (list (rtos minh 2 0) (rtos deltaH 2 0))))
(vfl-diag-add (ssg-textf "vfl-stufe2-minh-unmoeglich" (list (rtos fixed-x 2 0) (rtos deltaL 2 0))))
)
)
)
(princ))
;; Stufe-3-Zusatzfrage: Position des horizontalen Fuellstuecks (vor ODER nach
;; dem S-Bogen) - wird NUR gestellt, wenn Stufe 3 tatsaechlich einen Treffer
;; liefert (seltener Fallback, siehe vfl-winkel-stufe-entscheidung). Generischer
;; vflw_wahl-Popup-Dialog ueber vfl-menu (Muster wie die AUS-Element-Seite-
;; Frage) - keine neue DCL-Sonderloesung noetig. Selbstbeschreibender String
;; "vor"/"nach" statt roher Index-Antwort (Projektkonvention).
(defun vfl-frage-stufe3-position (/ antwort)
(princ (ssg-text "vfl-frage-stufe3-position"))
(princ (ssg-text "vfl-opt-stufe3-vor"))
(princ (ssg-text "vfl-opt-stufe3-nach"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-opt-stufe3-vor")
(ssg-text "vfl-opt-stufe3-nach")) 1
"vfl-frage-stufe3-position"))
(if (= antwort "2") "nach" "vor"))
;; Gemeinsamer Bau-Helfer fuer EINEN VF-Koerper, optional MIT zusaetzlichem
;; horizontalem Fuellstueck (Stufe 3, siehe vfl-winkel-stufe-entscheidung/
;; vfl-stufe3-winkel-horizontal in vf_standard.lsp). Ersetzt den bis dahin an
;; zwei Stellen identisch duplizierten Aufruf (vfl-body-abschluss-bauen UND
;; vfl-vf-einheit): (vfl-frame-3grad (vfs-vf-koerper ... hzn) hzn) +
;; vfl-acc-vf-seg + Zaehler-Erhoehung.
;; L_hor/position nil oder L_hor<=0: unveraendertes Verhalten (ein einzelner
;; vfs-vf-koerper-Aufruf) - reiner Drop-in-Ersatz fuer Stufe 1/2, KEINE
;; Verhaltensaenderung dort.
;; Sonst: zwei vfs-vf-koerper-Aufrufe (S-Bogen bei winkel/L_VF, Fuellstueck
;; bei winkel=0/L_hor - baut sein eigenes auf_3/ab_3-Uebergangsbogenpaar
;; SELBST, siehe vfs-vf-koerper best-winkel=0-Sonderfall in vf_standard.lsp),
;; Reihenfolge nach position ("vor"/"nach" dem S-Bogen, vom Anwender gewaehlt).
;; Frame wird zwischen den Teilschritten jedesmal per vfl-frame-3grad neu
;; aufgebaut, jedes Teilstueck einzeln journalisiert (vfl-acc-vf-seg) - sonst
;; fehlt es im Export/Report.
;; vfl-nach-3grad (falls noetig) bleibt Sache des AUFRUFERS, wie bisher.
;; Rueckgabe: (list frame cnt-erhoehung), cnt-erhoehung = Anzahl eingefuegter
;; Koerper (1 ohne Fuellstueck, 2 mit).
(defun vfl-baue-vf-koerper-mit-fuellstueck (frame richtn winkel L_VF L_hor position hzn / cnt)
(setq cnt 0)
(if (and L_hor (> L_hor 1.0) position)
(if (= position "vor")
(progn
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn 0 L_hor hzn) hzn))
(vfl-acc-vf-seg "horizontal" 0 L_hor)
(setq cnt (1+ cnt))
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn winkel L_VF hzn) hzn))
(vfl-acc-vf-seg richtn winkel L_VF)
(setq cnt (1+ cnt))
)
(progn
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn winkel L_VF hzn) hzn))
(vfl-acc-vf-seg richtn winkel L_VF)
(setq cnt (1+ cnt))
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn 0 L_hor hzn) hzn))
(vfl-acc-vf-seg "horizontal" 0 L_hor)
(setq cnt (1+ cnt))
)
)
(progn
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn winkel L_VF hzn) hzn))
(vfl-acc-vf-seg richtn winkel L_VF)
(setq cnt (1+ cnt))
)
)
(list frame cnt)
)
;; Vereinheitlichte Stufe-1(Winkel-Tabelle)/Stufe-2(horizontal+GF)-Entscheidung.
;; Genutzt von ZWEI Aufrufern mit unterschiedlichem Fest-Budget:
;; - vfl-body-zerlegung (Kettenende innerhalb einer laufenden VF-Einheit
;; ODER "Neue Linie BIS Kettenende" mit als VF-Familie erkanntem
;; Startpunkt, siehe linie-ende-familie/vfl-body-abschluss - beide Faelle
;; brauchen KEINE eigene Umlenkstation):
;; feste-hz=*vfk-feste-horizontal-kettenende* (800, nur Motor+Separator -
;; der Eingang ist zu diesem Zeitpunkt schon gebaut bzw. entfaellt).
;; - vfl-vf-entscheidung ("Neue Linie: Ab/Auf VF" bzw. "BIS Kettenende" mit
;; NICHT eindeutig zuordenbarem Startpunkt, Eingang einer FRISCHEN
;; VF-Einheit): feste-hz=*vfl-feste-horizontal* (1300, Umlenkstation+
;; Separator+Motorstation).
;; schon-flach: nur fuer den Kettenende-Fortsetzungsfall relevant (Frame kann
;; dort schon flach sein, siehe vfl-baue-horizontal-koerper) - am Eingang
;; einer frischen VF-Einheit immer nil (Frame kommt frisch von der
;; Umlenkstation bei 3 Grad).
;; Rueckgabe: (typ winkel L_GF L_VF) bzw. bei einem Stufe-3-Treffer (typ
;; winkel L_GF L_VF L_hor position), typ="GF"/"VF"/nil (winkel=0 bei "VF"
;; heisst horizontales Stufe-2-Ergebnis). L_hor/position sind nur bei Stufe 3
;; belegt (siehe vfl-stufe3-winkel-horizontal, vf_standard.lsp) - fehlende
;; Listenelemente liefern ueber (nth ...) automatisch nil, alle Konsumenten
;; lesen ausschliesslich per nth. KEINE eigene Mindestlaengen-Pruefung - die
;; bleibt Sache der Aufrufer (unterschiedliche Schwellwerte: 800/1000).
(defun vfl-winkel-stufe-entscheidung (deltaL deltaH richtung schon-flach feste-hz /
save-ausdx save-ausdz save-feste
winkel-natuerlich wahl horizontal-info
stufe3-erg res)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
;; Gesammelten Stufe-2-Diagnosetext + Alert-Vorschlagswerte aus einem evtl.
;; vorherigen Aufruf verwerfen - der Aufrufer haengt/zeigt sie nur an, wenn
;; DIESER Aufruf scheitert (typ=nil).
(setq *vfl-stufe2-diagnose-text* nil)
(setq *vfl-stufe2-minl-vorschlag* nil *vfl-stufe2-minh-vorschlag* nil)
;; Budget-Globals temporaer auf das Aufrufer-Budget umbiegen (mit Restore).
(setq save-ausdx aus-dx save-ausdz aus-dz save-feste FESTE_HORIZONTAL)
(setq aus-dx 0.0 aus-dz 0.0 FESTE_HORIZONTAL feste-hz)
(setq res
(cond
;; praktisch flach: horizontales VF + GF2
((< deltaH 1.0)
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" schon-flach))
(vfl-stufe2-diagnose deltaL deltaH horizontal-info schon-flach)
(if (and horizontal-info (caddr horizontal-info))
(list "VF" 0 (car horizontal-info) (cadr horizontal-info))
(list nil nil nil nil)))
;; steigend: Stufe 1 (gewinkeltes VF) zuerst; scheitert das, Stufe 2
;; (horizontales VF + GF2) als Fallback. GF2 wird dabei GENAUSO gebaut
;; wie im "Ab"-Fall (vfs-vf-exit, fest +3 Grad, gleiche Neigung wie
;; Motorstation/Umlenkstation/Separator) - KEIN Vorzeichenwechsel, keine
;; Bau-Aenderung noetig. Das Ausgleichsprinzip: Motorstation+GF2 senken
;; IMMER ab; wird bei knapper Laenge weniger/kein GF2 verbaut (kuerzer
;; als das volle Laengenbudget), sinkt die Kette insgesamt weniger stark
;; ab und die dadurch freiwerdende Laenge wird mit einem horizontalen
;; VF-Stueck (0 Grad, keine weitere Hoehenaenderung) aufgefuellt statt
;; mit mehr GF2 - der Uebergangsbogen (ab_3, bereits in berechne-
;; horizontale-mitte eingerechnet) bleibt dabei unveraendert.
((= richtung "Auf")
(princ (ssg-text "vfl-stufe1-start"))
(setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Auf" feste-hz schon-flach))))
(if wahl
(list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl))
(progn
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Auf" schon-flach))
(vfl-stufe2-diagnose deltaL deltaH horizontal-info schon-flach)
(if (and horizontal-info (caddr horizontal-info))
(list "VF" 0 (car horizontal-info) (cadr horizontal-info))
(progn
;; Stufe 1 UND Stufe 2 gescheitert: Stufe 3 (steiler Tabellen-
;; winkel + horizontales Fuellstueck, vfl-stufe3-winkel-
;; horizontal in vf_standard.lsp) als letzter Fallback vor der
;; Ablehnung. Position (vor/nach dem S-Bogen) fragt der
;; Anwender NUR, wenn Stufe 3 tatsaechlich einen Treffer liefert.
(princ (ssg-text "vfl-stufe3-start"))
(setq stufe3-erg (vfl-stufe3-winkel-horizontal deltaL deltaH "Auf" feste-hz schon-flach))
(if (nth 4 stufe3-erg)
(list "VF" (nth 0 stufe3-erg) (nth 1 stufe3-erg) (nth 2 stufe3-erg)
(nth 3 stufe3-erg) (vfl-frage-stufe3-position))
(list nil nil nil nil)))))))
;; fallend: natuerlichen Neigungswinkel gegen die 3-Grad-Eigenneigung pruefen
(t
(setq winkel-natuerlich (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
(cond
;; KEIN "~3 Grad -> reine GF2 ohne Rechnung"-Kurzschluss mehr - frueher
;; hier: (list "GF" *vfk-gefaelle-winkel* nil nil) - L_GF/L_VF blieben
;; nil und vfl-body-abschluss musste GF2 dann selbst aus deltaL ALLEIN
;; herleiten - deltaH wurde dabei NIE geprueft, der Austrittsbogen
;; (bogen-x2) NIE abgezogen. Ergebnis: ein REALER Hoehenfehler (in
;; einem Livetest 2026-09-10 z.B. dZ=-40.5mm), sobald der natuerliche
;; Winkel nicht EXAKT 3,000 Grad war (nur nahe dran, per Toleranz
;; *vfl-gf-winkel-toleranz*=0.5 Grad). Stufe 1 (Tabellenwinkel 3 Grad
;; ist selbst ein Tabelleneintrag) loest deltaL UND deltaH exakt
;; simultan (vf-winkel-solve) und deckt den ~3-Grad-Fall daher
;; automatisch und PRAEZISE mit ab - kein separater Zweig noetig.
;; steiler als 3 Grad -> Stufe 1: gewinkeltes VF + GF2 (GF2 variiert mit
;; Winkel) zuerst; scheitert das (z.B. bei knapper Streckenlaenge -
;; "steiler als 3 Grad" heisst nur, dass der NATUERLICHE Winkel ueber
;; 3 Grad liegt, nicht dass die Tabelle bei JEDEM Winkel passt), Stufe
;; 2 (horizontales VF + GF2) als Fallback, analog zur "flacher"-
;; Verzweigung unten und zum "Auf"-Fallback oben.
((> winkel-natuerlich *vfk-gefaelle-winkel*)
(princ (ssg-text "vfl-stufe1-start"))
(setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Ab" feste-hz schon-flach))))
(if wahl
(list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl))
(progn
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" schon-flach))
(vfl-stufe2-diagnose deltaL deltaH horizontal-info schon-flach)
(if (and horizontal-info (caddr horizontal-info))
(list "VF" 0 (car horizontal-info) (cadr horizontal-info))
(list nil nil nil nil)))))
;; flacher als 3 Grad -> Stufe 2: horizontales VF + GF2
(t
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" schon-flach))
(vfl-stufe2-diagnose deltaL deltaH horizontal-info schon-flach)
(if (and horizontal-info (caddr horizontal-info))
(list "VF" 0 (car horizontal-info) (cadr horizontal-info))
(progn
(vfl-diag-add (ssg-text "vfl-stufe2-ungueltig"))
(princ (ssg-text "vfl-stufe1-start"))
(setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Ab" feste-hz schon-flach))))
(if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil)))))))))
;; Budget-Globals zuruecksetzen
(setq aus-dx save-ausdx aus-dz save-ausdz FESTE_HORIZONTAL save-feste)
res)
;; Duenner Wrapper: eigene Mindestlaenge (kuerzer als das Budget = kein
;; Abschluss baubar), sonst delegiert an vfl-winkel-stufe-entscheidung mit dem
;; Kettenende-Budget. es-gewuenscht=nil senkt das Budget von 800 (Motor+
;; Separator) auf 500 (nur Motor) - siehe vfl-body-budget.
(defun vfl-body-zerlegung (deltaL deltaH richtung schon-flach es-gewuenscht /
budget)
(setq budget (vfl-body-budget es-gewuenscht))
(if (< deltaL budget)
(list nil nil nil nil)
(vfl-winkel-stufe-entscheidung deltaL deltaH richtung schon-flach budget)))
;; Fragt Zielpunkt (XY) + Zielhoehe (Z) ab, zerlegt den Rest (vfl-body-
;; zerlegung, Standard-Logik) und baut den Koerper VOR dem Motor: gewinkeltes
;; VF (winkel>0) oder horizontales VF (winkel=0). GF2 (variiert mit dem Winkel,
;; Mindestwert *vfl-gf-min-laenge*=400) sitzt hinter dem Motor und wird als
;; Laenge zurueckgegeben (der Aufrufer setzt sie beim Auslauf ein und schliesst
;; mit Motor -> GF2 -> Separator -> ES ab). Speichert den Soll-Zielpunkt in
;; *vfl-ziel-punkt* fuer den Ist-Ziel-Report.
;; Rueckgabe: (frame anzahl-koerper letzt-hz gf2-laenge) oder nil.
;; --- Kettenende-Abschluss: reiner Bauteil ---
;; Zerlegt die Reststrecke und baut Koerper + Motor-Vorbereitung. Fragt
;; nichts mehr - die einzige Rueckfrage steckt in vfl-body-zerlegung
;; (vfl-waehle-winkel, nur wenn mehrere Winkel gueltig sind) und ist ueber
;; *vfl-winkel-idx-vorgabe* vorab beantwortbar.
;; Rueckgabe: (frame anzahl-koerper hz gf2-laenge) oder nil, wenn der Rest
;; nicht baubar ist.
;;
;; Signatur schlanker als im Fahrplan skizziert: letzt-hz und es-gewuenscht
;; werden hier nicht gebraucht. es-gewuenscht wirkt beim Aufrufer, der
;; ein-dx/ein-dz um den Aufruf herum nullt (kein ES-Fussabdruck reservieren);
;; letzt-hz wurde nur einer wirkungslosen Zuweisung zugefuehrt (siehe unten).
(defun vfl-body-abschluss-bauen (frame p-umlenk dL hzn hn schon-flach es-gewuenscht /
dH richtn rad3 dec typ w lgf lvf lhor position
bau-erg gf2 cnt
p0 tx ty letzt-hz antwort-gf2)
(setq dH (- hn (caddr (car frame))))
(setq richtn (if (>= dH 0.0) "Auf" "Ab"))
(setq dH (abs dH))
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
(princ (ssg-textf "vfl-kettenende-modus-ziel"
(list (rtos dL 2 0) (rtos dH 2 0) richtn)))
(setq dec (vfl-body-zerlegung dL dH richtn schon-flach es-gewuenscht))
(setq typ (nth 0 dec) w (nth 1 dec) lgf (nth 2 dec) lvf (nth 3 dec)
lhor (nth 4 dec) position (nth 5 dec))
(if (null typ)
(progn
(princ (ssg-text "vfl-fehler-rest-nicht-baubar"))
;; Gesammelte Stufe-2-Diagnose (siehe vfl-stufe2-diagnose/vfl-diag-add)
;; erst HIER, NACH der eigentlichen FEHLER-Zeile zeigen - sie gehoert
;; inhaltlich zur Begruendung, warum nichts gebaut werden konnte.
(if *vfl-stufe2-diagnose-text* (princ *vfl-stufe2-diagnose-text*))
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Kettenende-Abschluss nicht baubar (dL="
(rtos dL 2 0) " dH=" (rtos dH 2 0) " richtung=" richtn ")"))
nil)
(progn
(dbgmsg (strcat "GEOMETRIE: vfl-body-zerlegung ERFOLG (dL=" (rtos dL 2 0)
" dH=" (rtos dH 2 0) " richtung=" richtn
" typ=" typ " winkel=" (rtos (float w) 2 1)
" L_GF=" (if lgf (rtos lgf 2 0) "nil")
" L_VF=" (if lvf (rtos lvf 2 0) "nil") ")"))
;; Soll-ES-Punkt fuer den Ist-Ziel-Report merken (Startpunkt +
;; projizierter Laenge entlang der Fahrtrichtung).
(setq p0 (car frame))
(setq tx (+ (car p0) (* dL (cos (* hzn (/ pi 180.0))))))
(setq ty (+ (cadr p0) (* dL (sin (* hzn (/ pi 180.0))))))
(setq *vfl-ziel-punkt* (list tx ty hn))
(setq cnt 0)
;; Koerper VOR dem Motor: winkel 0 = horizontales VF, sonst gewinkeltes VF.
;; typ "GF" -> kein Koerper (Rest laeuft komplett ueber GF2).
(cond
;; Schon flach + horizontales Mittelstueck: OHNE vfs-vf-koerper
;; (das wuerde unbedingt auf_3+ab_3 einbauen) direkt als reine
;; Verlaengerung der bereits flachen Zone bauen - kein
;; ueberfluessiges Bogenpaar. Frame bleibt flach; der spaeter
;; ohnehin noetige Uebergang auf 3 Grad vor der Motorstation
;; (Ausgang in vfl-vf-einheit) erledigt den einzigen wirklich
;; noetigen Bogen.
((and schon-flach (= typ "VF") (= w 0) lvf (> lvf 1.0))
(setq frame (make-frame-from-dir
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" (car frame) lvf 0 hzn)
(hz-winkel->xu hzn 0.0)))
(vfl-acc-vf-seg "horizontal" 0 lvf)
(setq cnt (1+ cnt)))
;; Normalfall: gewinkelter ODER horizontaler Koerper - vfs-vf-koerper
;; braucht dafuer zwingend eine 3-Grad-Basis als Eingang. War der
;; Frame noch flach (schon-flach, aber ein echter Winkel w<>0
;; noetig), wird hier genau EINMAL konvertiert - kein Vorgriff mehr
;; am Funktionsanfang, daher kein doppeltes Bogenpaar.
;; BEKANNTE LUECKE: vfl-nach-3grad deckt nur flach->fallend (0->+3)
;; ab. Kommt der Frame hier STEIGEND an (-3 Grad, z.B. direkt nach
;; einer per Zweig C gebauten steigenden GF OHNE zwischenzeitliches
;; Kettenende), waere ein 6-Grad-Uebergang (vfl-bogen-uebergang,
;; wie im Linie-GF-Abschluss) noetig, den es hier noch NICHT gibt -
;; der Frame bliebe faelschlich steigend, vfs-vf-koerper baut dann
;; auf falscher Basis. schon-flach deckt nur den (haeufigeren)
;; flachen Fall ab (siehe berechne-alle-winkel/entry-dx/entry-dz).
((and (= typ "VF") lvf (> lvf 1.0))
(setq frame (vfl-nach-3grad frame))
(setq bau-erg (vfl-baue-vf-koerper-mit-fuellstueck frame richtn w lvf lhor position hzn))
(setq frame (car bau-erg) cnt (+ cnt (cadr bau-erg))))
)
;; ohne Wirkung: letzt-hz ist lokal und wird nicht mehr gelesen -
;; die Fahrtrichtung verlaesst die Funktion ueber die Rueckgabe.
;; Beim Umzug bewusst wortwoertlich uebernommen.
(setq letzt-hz hzn)
(vfl-20m-check p-umlenk (car frame))
;; GF2-Laenge (hinter dem Motor): aus der Zerlegung (variiert mit Winkel),
;; sonst (typ "GF") aus der 3-Grad-Geometrie abgeleitet. Mindestwert 400.
(setq gf2
(cond ((and lgf (> lgf 0.0)) lgf)
((= typ "GF")
(max 0.0 (- (/ (- dL (abs (if ein-dx ein-dx *vfk-as-es-fallback-dx*))) (cos rad3)) *vfk-feste-horizontal-kettenende*)))
(t 0.0)))
;; Nicht mehr stillschweigend auffuellen (fuehrte zu einer teils
;; grossen Zielpunkt-Abweichung, siehe Ist-Ziel-Report) - stattdessen
;; fragen: mit dem exakt berechneten (kleineren) Wert bauen (trifft
;; den Zielpunkt exakt, Default) ODER auf die uebliche Mindestlaenge
;; auffuellen (Zielpunkt verschiebt sich entsprechend weiter).
(if (and (> gf2 0.0) (< gf2 *vfl-gf-min-laenge*))
(progn
(princ (ssg-textf "vfl-frage-gf2-minimum"
(list (rtos gf2 2 0) (rtos *vfl-gf-min-laenge* 2 0))))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-ja-nein-impl
(list (ssg-textf "vfl-frage-gf2-minimum"
(list (rtos gf2 2 0) (rtos *vfl-gf-min-laenge* 2 0))))))
(setq antwort-gf2 (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 1
"vfl-frage-gf2-minimum"))
(if (= antwort-gf2 "2") (setq gf2 *vfl-gf-min-laenge*))))
(dbgmsg (strcat "GEOMETRIE ERFOLG: Kettenende-Abschluss gebaut (cnt=" (itoa cnt)
" gf2=" (rtos gf2 2 0) "), neue Position=" (dbg-tostring (car frame))))
(list frame cnt hzn gf2)
)
)
)
;; --- Kettenende-Abschluss: Frage-Schale (Name unveraendert) ---
;; "Alles fragen, dann alles bauen" geht hier NICHT: vfl-neue-linie-messen
;; braucht den Frame NACH vfl-nach-3grad, und die Hoehenvorschlaege brauchen
;; die gemessene Laenge und die aktuelle Kettenhoehe. Darum in dieser
;; Reihenfolge: flache Zone abschliessen -> Laenge messen -> Vorschlaege
;; berechnen -> Zielhoehe fragen -> bauen.
;; vorab-ziel-punkt (optional, Default nil): der ABSOLUTE Zielpunkt (Liste
;; x y z) steht bereits fest - z.B. weil er schon VOR dem Winkel-Solve der
;; VF-Einheit gepickt wurde (siehe vfl-vf-einheit, vorab-antwort="3"). Dann
;; NICHT nochmal per vfl-neue-linie-messen/vfl-hoehe-endpunkt-abfragen fragen
;; (der sonst noetige, fehleranfaellige zweite Klick auf denselben Punkt -
;; Nutzer-Wunsch), sondern Restlaenge/-hoehe direkt aus der aktuellen
;; Frame-Position zu diesem Punkt herleiten (vfl-projiziere-distanz, dieselbe
;; Technik wie bei der AS-Restlaengen-Korrektur). letzt-hz bleibt dabei die
;; Fahrtrichtung (unveraendert seit dem urspruenglichen Pick).
(defun vfl-body-abschluss (frame letzt-hz p-umlenk es-gewuenscht vorab-ziel-punkt /
linie-mess dL hzn hn schon-flach ergebnis dH richtn
hoehe-vorschlaege hoehe-ab hoehe-auf gueltig)
;; Schon-flach VOR jeder Konvertierung feststellen - NICHT mehr blind auf
;; 3 Grad zwingen, bevor feststeht, ob die Zerlegung ohnehin ein
;; horizontales Mittelstueck ergibt (dann waere die Konvertierung + der
;; Wiedereintritt in die flache Zone via vfs-vf-koerper ein ueberfluessiges
;; auf_3/ab_3-Bogenpaar - siehe Kommentar bei vfl-winkel-stufe-entscheidung).
;; Die Positions-Messung selbst funktioniert unabhaengig von der Neigung.
(setq schon-flach (vfl-frame-flach-p frame))
(setq gueltig t)
(if vorab-ziel-punkt
(setq dL (vfl-projiziere-distanz (car frame) vorab-ziel-punkt letzt-hz)
hzn letzt-hz
hn (caddr vorab-ziel-punkt))
(progn
(setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz))
(if (null linie-mess)
(setq gueltig nil)
(progn
(setq dL (car linie-mess) hzn (cadr linie-mess))
;; Baubare Vorschlaege (Ab/Auf) statt der unveraenderten Kettenhoehe
;; als Default - sonst waere dH=0 ("Auf", da (>= 0.0 0.0)) und der
;; Rest wird von vfl-body-zerlegung sofort als "nicht baubar"
;; abgelehnt (kleineres Budget als vfl-vf-entscheidung: nur
;; Motor+Separator, 800mm statt 1300mm) - siehe
;; vfl-body-hoehe-vorschlaege/vfl-body-machbar-p.
(setq hoehe-vorschlaege (vfl-body-hoehe-vorschlaege (caddr (car frame)) dL es-gewuenscht schon-flach))
(setq hoehe-ab (nth 0 hoehe-vorschlaege) hoehe-auf (nth 1 hoehe-vorschlaege))
(setq hn (vfl-hoehe-endpunkt-abfragen hoehe-ab hoehe-auf (caddr (car frame)) "kettenende"))
)
)
)
)
;; Nutzer-Entscheidung (2026-09-15): dL/hzn bleiben unveraendert entlang der
;; urspruenglich gemessenen/vorgegebenen Fahrtrichtung - KEINE Drehung mehr,
;; um den seitlichen Fussabdruck eines drehenden ES-Elements (ein-dy)
;; auszugleichen (siehe vfl-richtung-mit-drehendem-fussabdruck, jetzt nicht
;; mehr hier verwendet). Ein drehendes ES-Element (30/90 Grad) landet
;; dadurch mit einem natuerlichen, unvermeidbaren seitlichen Versatz neben
;; dem Zielpunkt - erwartetes Verhalten (Hauptstrang bleibt gerade), keine
;; zu behebende Abweichung.
(if (not gueltig)
(progn (princ (ssg-text "vfl-abgebrochen-kein-ziel")) nil)
(progn
(setq ergebnis (vfl-body-abschluss-bauen frame p-umlenk dL hzn hn schon-flach es-gewuenscht))
;; Klare Rueckmeldung statt nur der einfachen Bau-Fehlermeldung (die
;; steht schon in vfl-body-abschluss-bauen): die tatsaechlich gewaehlte
;; Zielhoehe + Strecke nennen, UND (falls vorhanden) die bereits VOR der
;; Hoehe-Abfrage berechneten baubaren Vorschlaege (hoehe-ab/hoehe-auf)
;; hier NOCHMAL zeigen - der Nutzer sieht sie sonst nur einmal vor der
;; Eingabe und muss beim Fehler wieder hochscrollen. hoehe-ab/hoehe-auf
;; sind nur hier (Frage-Schale) bekannt, darum die Zusatzmeldung hier
;; statt im reinen Bauteil.
(if (null ergebnis)
(progn
(setq dH (- hn (caddr (car frame))) richtn (if (>= dH 0.0) "Auf" "Ab"))
(setq dH (abs dH))
(if (or hoehe-ab hoehe-auf)
(princ (ssg-textf "vfl-fehler-rest-nicht-baubar-mit-vorschlag"
(list (rtos hn 2 0) (rtos dL 2 0) (rtos dH 2 0) richtn
(cond
((and hoehe-ab hoehe-auf)
(ssg-textf "vfl-vorschlag-ab-auf"
(list (rtos hoehe-ab 2 0) (rtos hoehe-auf 2 0))))
(hoehe-ab (ssg-textf "vfl-vorschlag-nur-ab" (list (rtos hoehe-ab 2 0))))
(t (ssg-textf "vfl-vorschlag-nur-auf" (list (rtos hoehe-auf 2 0))))))))
(princ (ssg-textf "vfl-fehler-rest-nicht-baubar-ohne-vorschlag"
(list (rtos hn 2 0) (rtos dL 2 0) (rtos dH 2 0) richtn))))
;; Kurze 2-Punkte-Zusammenfassung zusaetzlich als Alert-Popup (nicht
;; nur im Konsolen-Log) - zweiter Punkt nur, wenn Stufe 2 ueberhaupt
;; versucht wurde (siehe *vfl-stufe2-min*-vorschlag*, von
;; vfl-stufe2-diagnose gesetzt).
(alert
(strcat
(ssg-textf "vfl-alert-kettenende-p1" (list (rtos dL 2 0) (rtos dH 2 0) richtn))
(cond
((and *vfl-stufe2-minl-vorschlag* *vfl-stufe2-minh-vorschlag*)
(ssg-textf "vfl-alert-kettenende-p2-beide"
(list (rtos *vfl-stufe2-minl-vorschlag* 2 0) (rtos *vfl-stufe2-minh-vorschlag* 2 0))))
(*vfl-stufe2-minh-vorschlag*
(ssg-textf "vfl-alert-kettenende-p2-nur-minh" (list (rtos *vfl-stufe2-minh-vorschlag* 2 0))))
(*vfl-stufe2-minl-vorschlag*
(ssg-textf "vfl-alert-kettenende-p2-nur-minl" (list (rtos *vfl-stufe2-minl-vorschlag* 2 0))))
(t ""))))
)
)
ergebnis
)
)
)
;; --- VF-Einheit: Eingang (reiner Bauteil) ---
;; GF1 + Einlauf-Separator + Umlenkstation. Keine Frage, kein Dialog.
;; Rueckgabe: neuer Frame (Ausgang der Umlenkstation, 3-Grad-Basis).
;; Der Separator-Zaehler wird hier erhoeht, weil vfs-vf-entry den Separator
;; mitbaut - die *vfl-acc-*-Aufrufe muessen an derselben Stelle in derselben
;; Reihenfolge bleiben, sonst vertauschen sich die Komma-Listen L_VF_m/L_GF_m
;; im Sivas-Export (in der Zeichnung unsichtbar).
(defun vfl-vf-eingang-bauen (frame hz1 L_GF1-bau eingang-modus)
(setq frame (vfl-frame-3grad
(vfs-vf-entry (car frame) L_GF1-bau hz1 (equal eingang-modus "separator"))
hz1))
(if (> L_GF1-bau 0.1)
(vfl-acc-gf-seg L_GF1-bau (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
(if (not (equal eingang-modus "separator"))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))) ; Einlauf-Separator (in vfs-vf-entry)
frame)
;; --- VF-Einheit: Ausgang (reiner Bauteil) ---
;; Motorstation [+ GF2], KEIN Separator - der sitzt erst vor dem ES-Element
;; bzw. optional zwischen zwei Foerderern.
;; gf2-eff kommt FERTIG herein (siehe Aufrufstelle).
(defun vfl-vf-ausgang-bauen (frame letzt-hz gf2-eff)
;; Motorseite erfassen: derzeit immer "rechts" (nur diese DWG vorhanden;
;; die "links"-Einzel-DWG wird spaeter ergaenzt).
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
;; Motorstation braucht 3-Grad-Basis: falls die Kette gerade flach endet
;; (horizontales Stueck ohne ab_3), hier den ab_3-Uebergang nachholen.
(setq frame (vfl-nach-3grad frame))
(setq frame (vfl-frame-3grad
(vfs-vf-exit (car frame) gf2-eff letzt-hz nil) letzt-hz))
(if (> gf2-eff 0.1)
(vfl-acc-gf-seg gf2-eff (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
frame)
;; Rueckgabe: (frame anzahl-koerper ziel-ende)
;; vorab-antwort/vorab-es-gewuenscht/vorab-es-seite (optional, Default nil):
;; wurde "Ist der Endpunkt der Foerderer?" (+ ggf. "ES-Element setzen?") vom
;; Aufrufer bereits VOR diesem Aufruf gestellt (siehe vf-linienzug-modus,
;; "Linie-VF"-Zweig) - dann NICHT in der Fortsetzungsschleife nochmal fragen,
;; sondern die Antwort direkt fuer die ERSTE Runde uebernehmen. Nur fuer den
;; geneigten Erstkoerper relevant (winkel1<>0) - der horizontale Fall
;; (winkel1=0) hat sein eigenes vor-antwort ueber vfl-baue-horizontal-koerper.
;; vorab-ziel-punkt (nur bei vorab-antwort="3" relevant): der bereits VOR dem
;; Winkel-Solve absolut gepickte Zielpunkt (x y z) - wird 1:1 an
;; vfl-body-abschluss durchgereicht, damit dort NICHT nochmal ein zweiter
;; Endpunkt abgefragt wird (Nutzer-Wunsch: "der zweite Klick ist unnoetig").
;; L_hor1/L_hor1-position: nur bei einem Stufe-3-Treffer fuer das ERSTE
;; Koerper-Sub-Segment belegt (siehe vfl-vf-einheit-abschluss), sonst nil.
;; Die interne "weiterbauen"-Fortsetzung (ent aus vfl-segment-entscheidung,
;; s.u.) hat ihr EIGENES, unabhaengiges lhor/position - andere Entscheidung,
;; anderer Solve-Aufruf.
(defun vfl-vf-einheit (frame hz1 richtung1 winkel1 L_GF1 L_VF1 L_hor1 L_hor1-position
gf-am-ausgang eingang-modus
vorab-antwort vorab-es-gewuenscht vorab-es-seite vorab-ziel-punkt /
p-umlenk vf-count antwort L_GF-eff L_GF1-bau L_GF2-bau
linie-mess dL dH hn hzn richtn ent typ w lgf lvf lhor position bau-erg
letzt-hz fertig ziel-ende ziel-gf2 res3 gf2-eff entry-start
res-h vor-antwort es-gewuenscht erg-es save-eindx save-eindz
hoehe-vorschlaege hoehe-ab hoehe-auf
schon-flach winkel-hoehen-erg es-seite)
;; Vorbelegung: ES gewuenscht (Default) - nur bei "3 - Kettenende definieren"
;; wird explizit gefragt und ggf. auf nil gesetzt (siehe dort).
(setq es-gewuenscht t)
;; Gesamte Staustrecke (mind. *vfl-gf-min-laenge*) auf Einlauf/Ausgang
;; verteilen - AUSSER eingang-modus "gf"/"separator"/"keine": dort ist kein
;; GF1-Stumpf noetig (siehe vfl-eingang-modus-bestimmen).
(if (member eingang-modus '("gf" "separator" "keine"))
(setq L_GF-eff 0.0)
(setq L_GF-eff (max L_GF1 *vfl-gf-min-laenge*)))
(if gf-am-ausgang
(setq L_GF1-bau (/ L_GF-eff 2.0) L_GF2-bau (/ L_GF-eff 2.0)) ; halbe/halbe
(setq L_GF1-bau L_GF-eff L_GF2-bau 0.0)) ; alles am Einlauf
;; --- Eingang: [GF1] + [Separator] + Umlenkstation ---
;; entry-start/p-umlenk sind der Stand VOR bzw. NACH dem Eingang - die
;; horizontale Erstkoerper-Rechnung braucht beide (gemessener Fussabdruck).
;; eingang-modus "keine": Vorgaenger ist bereits Teil einer virtuellen
;; VF-Kette OHNE eigene Umlenkstation (z.B. Vario-Kurve als erstes
;; Kettenglied) - eine zweite Umlenkstation waere mechanisch sinnlos, der
;; Koerper knuepft direkt am uebergebenen frame an.
(setq entry-start (car frame))
(if (equal eingang-modus "keine")
(setq p-umlenk (car frame))
(progn
(setq frame (vfl-vf-eingang-bauen frame hz1 L_GF1-bau eingang-modus))
(setq p-umlenk (car frame))
)
)
;; --- Erstes Koerper-Sub-Segment ---
;; winkel1=0 => horizontaler Anfang (Option 3): mit Separator-vor/nach-Abfrage.
;; L_VF1 wird bei winkel1=0 vom Aufrufer (Modus 1, Option 3) als GESAMT-
;; Zielstrecke ab entry-start (dem gepickten Endpunkt) verstanden - abgezogen
;; werden daher:
;; 1) der reale Eingang-Fussabdruck (GF1+Separator+Umlenkstation, GEMESSEN
;; statt geschaetzt, ueber entry-start/p-umlenk)
;; 2) der Fussabdruck fuer einen MOEGLICHEN sofortigen Abschluss direkt
;; nach diesem Stueck: Vario_Bogen_ab_3 (Ausgangs-Uebergang zurueck auf
;; 3 Grad, Tabellen-Mass wie in vfl-nach-3grad) + Motorstation (500mm).
;; Falls die Kette hier NICHT sofort endet, wird dieser Fussabdruck
;; trotzdem reserviert - konsistent mit dem "Kettenende"-Verhalten an
;; anderer Stelle (lieber vorsichtig reservieren als ueberschiessen).
(if (= (fix winkel1) 0)
(progn
;; ziel-modus=T: Separator VOR/NACH + "Ist der Endpunkt der Foerderer?"
;; werden INNERHALB von vfl-baue-horizontal-koerper VOR der Laengen-
;; berechnung gestellt (siehe dortiger Kommentar) - die Antwort kommt
;; hier zurueck, damit die Schleife unten sie nicht nochmal erfragt.
(setq res-h (vfl-baue-horizontal-koerper frame hz1
(max *vfk-restlaenge-min-clamp* (- L_VF1 (vfl-projiziere-distanz entry-start p-umlenk hz1)))
t L_GF2-bau))
(setq frame (car res-h) vor-antwort (cadr res-h) vf-count 1)
)
(progn
;; vfs-vf-koerper braucht die 3-Grad-Basis als Eintritt - im Normalfall
;; liefert die Umlenkstation die bereits (vfl-nach-3grad ist dann No-op);
;; bei eingang-modus "keine" kann frame noch flach sein (z.B. direkt
;; nach einer Vario-Kurve) und muss hier erst konvertiert werden.
(setq frame (vfl-nach-3grad frame))
(setq bau-erg (vfl-baue-vf-koerper-mit-fuellstueck frame richtung1 winkel1 L_VF1 L_hor1 L_hor1-position hz1))
(setq frame (car bau-erg) vf-count (cadr bau-erg))
(setq vor-antwort vorab-antwort)
)
)
(setq letzt-hz hz1)
(vfl-20m-check p-umlenk (car frame))
;; --- Fortsetzungs-Schleife bis Foerderer-Ende ---
(setq fertig nil)
(while (not fertig)
;; War die Frage schon in vfl-baue-horizontal-koerper (ziel-modus) oder
;; bei der letzten Runde "Horizontaler Foerderer" beantwortet, hier NICHT
;; erneut fragen - sonst normal abfragen.
(if vor-antwort
(setq antwort vor-antwort vor-antwort nil)
(setq antwort (vfl-frage-ist-endpunkt))
)
(if (= antwort "1")
(setq fertig t)
(if (= antwort "3")
;; --- Option 3: Kettenende exakt am Zielpunkt (nur EIN Motor) ---
(progn
;; ES-Element hier gewuenscht (+ falls ja: Winkel/Seite) - kombinierter
;; Dialog wie AS-Element (vflw-gruppe-as-impl). Winkel/Seite werden
;; JETZT (nicht erst spaeter in vfl-vf-einheit-abschluss) erfragt, weil
;; sie den tatsaechlichen ES-Fussabdruck (ein-dx/ein-dz, per
;; vfl-es-masse-setzen INNERHALB von vfl-frage-es-seite gesetzt)
;; bestimmen - der muss VOR vfl-body-abschluss feststehen, sonst
;; rechnet die Streckenzerlegung mit dem falschen (alten) Fussabdruck
;; und die Kette trifft den Zielpunkt nicht exakt. Falls nein: ein-dx/
;; ein-dz waehrend der Zerlegung temporaer nullen, damit KEIN
;; ES-Fussabdruck reserviert wird - die Kette endet dann direkt am
;; Zielpunkt ohne Separator+ES.
;; War das schon VOR dem Winkel-Solve entschieden (vorab-antwort="3",
;; siehe Funktionskopf) - dann NICHT nochmal fragen (waere doppelt
;; journalisiert), ein-dx/ein-dz NICHT anfassen (stehen bereits korrekt,
;; der Aufrufer hat sie vor dem Solve gesetzt) UND vfl-body-abschluss
;; GAR NICHT mehr aufrufen: die schon VOR diesem Solve bekannte
;; Fahrtrichtungs-Korrektur (vfl-richtung-mit-drehendem-fussabdruck im
;; Aufrufer) macht den ersten Winkel-Solve bereits vollstaendig ES-
;; bewusst (laengs UND quer) - die dabei schon berechnete GF2-Laenge
;; (L_GF2-bau, aus der GF-Verteilungs-Frage) trifft den Zielpunkt daher
;; bereits exakt. Eine zweite, unabhaengige Loesung (vfl-body-abschluss)
;; war nur noetig, SOLANGE der erste Solve das ES-Element noch nicht
;; kannte - real beobachteter Bug: genau diese zweite, unabhaengige
;; Loesung konnte scheitern (z.B. "kein passender Winkel"), obwohl die
;; ERSTE Wahl bereits eine vollstaendig gueltige Gesamtloesung war.
(if (equal vorab-antwort "3")
(setq es-gewuenscht vorab-es-gewuenscht es-seite vorab-es-seite
ziel-gf2 L_GF2-bau ziel-ende t fertig t)
(progn
(setq erg-es (vfl-es-element-abfragen))
(setq es-gewuenscht (nth 0 erg-es) es-seite (nth 1 erg-es)
save-eindx (nth 2 erg-es) save-eindz (nth 3 erg-es))
(setq res3 (vfl-body-abschluss frame letzt-hz p-umlenk es-gewuenscht nil))
(if (not es-gewuenscht) (setq ein-dx save-eindx ein-dz save-eindz))
(if res3
(setq frame (nth 0 res3)
vf-count (+ vf-count (nth 1 res3))
letzt-hz (nth 2 res3)
ziel-gf2 (nth 3 res3)
ziel-ende t
fertig t))))
)
(progn
(princ (ssg-text "vfl-naechstes-element-vf"))
(princ (ssg-text "vfl-opt-horizontaler-foerderer"))
(princ (ssg-text "vfl-opt-vario-kurve"))
(princ (ssg-text "vfl-opt-auf-ab-foerderer"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-naechstes-im-vf-impl nil))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3")
(list (ssg-text "vfl-opt-horizontaler-foerderer")
(ssg-text "vfl-opt-vario-kurve")
(ssg-text "vfl-opt-auf-ab-foerderer")) 3
"vfl-naechstes-element-vf"))
(cond
;; --- Vario-Kurve (aendert hz) ---
((= antwort "2")
(setq frame (vfl-insert-vario-kurve frame))
(setq letzt-hz (car (frame->hz-winkel frame)))
)
;; --- Horizontaler Foerderer (folgt der aktuellen Fahrtrichtung) ---
((= antwort "1")
(setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz))
(if linie-mess
(progn
(setq dL (car linie-mess) hzn (cadr linie-mess))
(if (> dL 1.0)
(progn
;; ziel-modus=T: Separator VOR/NACH + "Ist der Endpunkt der
;; Foerderer?" werden VOR der Laengenberechnung gestellt
;; (siehe vfl-baue-horizontal-koerper) - Antwort kommt hier
;; zurueck und wird in der naechsten Schleifen-Runde
;; verwendet, statt erneut zu fragen.
(setq res-h (vfl-baue-horizontal-koerper frame hzn dL t L_GF2-bau))
(setq frame (car res-h) vor-antwort (cadr res-h))
(setq vf-count (1+ vf-count) letzt-hz hzn)
(vfl-20m-check p-umlenk (car frame))
)
(princ (ssg-text "vfl-linie-zu-kurz-uebersprungen"))
)
)
)
)
;; --- Auf/Ab-Foerderer (folgt der aktuellen Fahrtrichtung) ---
(t
;; Punkt 7: kommt die Kette hier bereits FLACH an (z.B. nach
;; Horizontal-VF/Vario-Kurve), gibt es keine sinnvolle Zielhoehe zum
;; Anpeilen - Auf/Ab wird dann direkt erfragt und aus einer
;; Winkel/Hoehe-Tabelle gewaehlt (vfl-waehle-winkel-hoehen-tabelle),
;; statt eine Zielhoehe abzufragen. schon-flach MUSS vor der
;; vfl-nach-3grad-Wandlung ermittelt werden.
(setq schon-flach (vfl-frame-flach-p frame))
;; gewinkeltes VF braucht 3-Grad-Basis -> flache Zone ggf. mit ab_3 beenden
(setq frame (vfl-nach-3grad frame))
(setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(if linie-mess
(progn
(setq dL (car linie-mess) hzn (cadr linie-mess))
(if (> dL 1.0)
(if schon-flach
(progn
(princ (ssg-text "vfl-frage-auf-ab-richtung"))
(princ (ssg-text "vfl-opt-richtung-auf"))
(princ (ssg-text "vfl-opt-richtung-ab"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-richtung-impl
(list (ssg-text "vfl-frage-auf-ab-richtung"))))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-opt-richtung-auf")
(ssg-text "vfl-opt-richtung-ab")) 1
"vfl-frage-auf-ab-richtung"))
(setq richtn (if (= antwort "2") "Ab" "Auf"))
(setq winkel-hoehen-erg
(vfl-waehle-winkel-hoehen-tabelle dL richtn (caddr (car frame))))
(if winkel-hoehen-erg
(progn
(setq w (nth 0 winkel-hoehen-erg) lvf (nth 2 winkel-hoehen-erg))
;; Ist-Ziel-Vergleich: vorhergesagte Endhoehe sichern, um
;; nach dem echten Bau (vfs-vf-koerper, unabhaengig
;; verifiziert) auf Abweichung zu pruefen - Sicherheitsnetz
;; fuer die neue Formel, ohne die reale Geometrie zu beeinflussen.
(setq hn (+ (caddr (car frame)) (nth 1 winkel-hoehen-erg)))
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn w lvf hzn) hzn))
(setq vf-count (1+ vf-count) letzt-hz hzn)
(vfl-acc-vf-seg richtn w lvf)
(vfl-20m-check p-umlenk (car frame))
(if (> (abs (- (caddr (car frame)) hn)) 5.0)
(princ (ssg-textf "vfl-winkel-hoehen-abweichung"
(list (rtos hn 2 0) (rtos (caddr (car frame)) 2 0)))))
)
(princ (ssg-text "vfl-linie-zu-kurz-simple"))
)
)
(progn
;; NUR-VF-Vorschlaege (nicht vfl-segment-hoehe-vorschlaege):
;; dieser Zweig setzt eine bestehende VF-Kette fort und lehnt
;; ein hier zurueckkommendes typ="GF" explizit ab (siehe
;; "vfl-segment-gf-nicht-erlaubt" unten) - der GF-Vorschlag
;; (3-Grad-Formel) waere hier also gerade NICHT baubar.
(setq hoehe-vorschlaege (vfl-vf-hoehe-vorschlaege (caddr (car frame)) dL))
(setq hoehe-ab (nth 0 hoehe-vorschlaege) hoehe-auf (nth 1 hoehe-vorschlaege))
(setq hn (vfl-hoehe-endpunkt-abfragen hoehe-ab hoehe-auf (caddr (car frame)) "endpunkt"))
(setq dH (- hn (caddr (car frame))))
(setq richtn (if (>= dH 0.0) "Auf" "Ab"))
(setq dH (abs dH))
(setq ent (vfl-segment-entscheidung dL dH richtn))
(setq typ (nth 0 ent) w (nth 1 ent) lgf (nth 2 ent) lvf (nth 3 ent)
lhor (nth 4 ent) position (nth 5 ent))
(if (and typ (= typ "VF"))
(progn
(setq bau-erg (vfl-baue-vf-koerper-mit-fuellstueck frame richtn w lvf lhor position hzn))
(setq frame (car bau-erg))
(setq vf-count (+ vf-count (cadr bau-erg)) letzt-hz hzn)
(vfl-20m-check p-umlenk (car frame))
)
(princ (ssg-text "vfl-segment-gf-nicht-erlaubt"))
)
)
)
(princ (ssg-text "vfl-linie-zu-kurz-simple"))
)
)
)
)
)
)
)
)
)
;; --- Ausgang: Motorstation [+ GF2 je nach Wahl], KEIN Separator ---
;; Der Separator sitzt erst vor dem ES-Element (Kettenende) bzw. optional
;; zwischen zwei Foerderern - nicht hier.
;; Motorseite erfassen: derzeit immer "rechts" (nur diese DWG vorhanden;
;; die "links"-Einzel-DWG wird spaeter ergaenzt).
;; Auslauf-GF2: im Kettenende-Modus (Option 3) neu berechnet (ziel-gf2),
;; sonst aus der GF-Verteilungs-Frage (L_GF2-bau). Die Auswahl steht
;; BEWUSST hier und nicht im Bauteil - sie ist die Stelle, an der sonst
;; still die falsche GF2 hinter dem Motor entsteht.
(setq gf2-eff (if ziel-ende ziel-gf2 L_GF2-bau))
(setq frame (vfl-vf-ausgang-bauen frame letzt-hz gf2-eff))
(list frame vf-count ziel-ende es-gewuenscht es-seite)
)
;; Rundet einen Winkel (Grad) auf das naechste 30-Grad-Vielfache DES WELT-
;; KOORDINATENSYSTEMS (absolut, nicht relativ zu einer Vorgaenger-Richtung).
;; Im System sind Fahrtrichtungen immer 30/60/90-Grad-Vielfache relativ zur
;; Zeichnung selbst - jede Abweichung (freier erster Klick, Bogen-Block-
;; Zeichnungsungenauigkeit) wird damit auf den naechsten gueltigen absoluten
;; Wert korrigiert, statt sich ueber die Kette aufzusummieren.
(defun vfl-hz-snappen-absolut (hz / n)
(setq n (/ hz 30.0))
(setq n (if (>= n 0.0) (fix (+ n 0.5)) (fix (- n 0.5))))
(* n 30.0)
)
;; Rotiert einen kompletten Frame (P xu yu zu) um die WELT-Z-Achse um delta
;; Grad - im Gegensatz zu (make-frame-from-dir P neue-xu) bleibt dabei die
;; urspruengliche Rollung (yu/zu, aus der echten Blockgeometrie gemessen)
;; erhalten. WICHTIG: make-frame-from-dir erzeugt yu/zu nach einer generischen
;; Konvention, die bei Bloecken mit eigener, nicht-generischer Ausrichtung
;; (z.B. Vario-Kurve) NICHT zur tatsaechlichen Verkettung passt - das fuehrte
;; empirisch zu einer um 90 Grad verdrehten Motorstation nach einem gesnappten
;; horizontalen Bogen. Eine reine Z-Drehung (nur X/Y von xu/yu/zu betroffen,
;; Z-Komponente unveraendert) behebt die winzige Snapping-Abweichung, ohne die
;; Rollung anzutasten.
(defun vfl-vec-um-z-drehen (v c s)
(list (- (* (car v) c) (* (cadr v) s))
(+ (* (car v) s) (* (cadr v) c))
(caddr v))
)
(defun vfl-frame-um-z-drehen (frame delta / rad c s)
(setq rad (* (float delta) (/ pi 180.0)))
(setq c (cos rad) s (sin rad))
(list (car frame)
(vfl-vec-um-z-drehen (cadr frame) c s)
(vfl-vec-um-z-drehen (caddr frame) c s)
(vfl-vec-um-z-drehen (cadddr frame) c s))
)
;; GF-Bogen (horizontale Kurve, Neigung bleibt wie im aktuellen Frame).
;; Fragt Winkel (30/60/90) und Seite interaktiv ab.
;; Nicht-interaktiver Kern: GF-Bogen mit gegebenem Winkel/Seite einfuegen.
;; Genutzt von der interaktiven Abfrage UND von den Pfad-Modi (Winkel/Seite
;; aus der Geometrie). Rueckgabe: neuer Frame.
(defun vfl-insert-gf-bogen-block (frame bwinkel bseite / blockname neuer-frame hz-gemessen hz-gesnappt)
(setq blockname (gf-bogen-blockname bwinkel bseite))
(princ (ssg-textf "vfl-fuege-block-ein" (list blockname)))
(dbgmsg (strcat "GEOMETRIE: vfl-insert-gf-bogen-block (block=" blockname
" bwinkel=" (itoa bwinkel) " bseite=" bseite ")"))
;; GF-Bogen zaehlen (Seite L/R + Winkel) -> Attribut GF_Bogen_L/R_xx
(setq *vfl-acc-gfbogen*
(vfl-inc-count *vfl-acc-gfbogen*
(strcat (if (= bseite "rechts") "R" "L") "_" (itoa bwinkel))))
(setq neuer-frame (insert-block-ks-to-ks blockname frame))
(if (null neuer-frame)
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Block " blockname " nicht eingefuegt"))
(progn
(setq hz-gemessen (car (frame->hz-winkel neuer-frame)))
(setq hz-gesnappt (vfl-hz-snappen-absolut hz-gemessen))
;; Reine Z-Drehung statt make-frame-from-dir-Neuaufbau: erhaelt die aus dem
;; Block gemessene Rollung (yu/zu) - siehe Kommentar bei vfl-frame-um-z-drehen.
(if (> (abs (- hz-gemessen hz-gesnappt)) 0.0001)
(setq neuer-frame (vfl-frame-um-z-drehen neuer-frame (- hz-gesnappt hz-gemessen))))
(dbgmsg (strcat "GEOMETRIE ERFOLG: GF-Bogen gebaut, neue Position="
(dbg-tostring (car neuer-frame))))
)
)
neuer-frame
)
;; Interaktiv (i18n): GF-Bogen-Winkel + Seite abfragen, dann Kern aufrufen.
(defun vfl-insert-gf-bogen (frame / bwinkel bseite antwort)
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-winkel-seite-impl
(list "vfl-gf-bogen-winkel-header"
(list (ssg-text "vfl-winkel-30") (ssg-text "vfl-winkel-60") (ssg-text "vfl-winkel-90"))
*vfk-gf-bogen-winkel*)))
(princ (ssg-text "vfl-gf-bogen-winkel-header"))
(princ (ssg-text "vfl-winkel-30"))
(princ (ssg-text "vfl-winkel-60"))
(princ (ssg-text "vfl-winkel-90"))
(setq bwinkel (vfl-menu-winkel (ssg-text "vfl-prompt-wahl-winkel-30-60-90")
(list (ssg-text "vfl-winkel-30") (ssg-text "vfl-winkel-60")
(ssg-text "vfl-winkel-90"))
*vfk-gf-bogen-winkel* 90 "vfl-gf-bogen-winkel-header"))
(princ (ssg-text "vfl-gf-bogen-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"vfl-gf-bogen-seite-header"))
(setq bseite (if (= antwort "2") "rechts" "links"))
(vfl-insert-gf-bogen-block frame bwinkel bseite)
)
;; Vario-Kurve-Blockname (links/rechts x 30/60/90 x TEF aussen/innen).
(defun vfl-kurve-blockname (kwinkel kseite kvariante)
(strcat "Vario_Kurve_" kseite "_" (itoa kwinkel) "_TEF_" kvariante)
)
;; Nicht-interaktiver Kern: Vario-Kurve mit gegebenem Winkel/Seite/Variante
;; einfuegen. Genutzt von der interaktiven Abfrage UND von den Pfad-Modi
;; (Winkel/Seite aus der Geometrie, Variante abgefragt). Rueckgabe: neuer Frame.
;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch
;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das
;; (siehe ks-normalize-name).
(defun vfl-insert-vario-kurve-block (frame kwinkel kseite kvariante /
blockname hz flach-frame neuer-frame
hz-gemessen hz-gesnappt)
(setq blockname (vfl-kurve-blockname kwinkel kseite kvariante))
(princ (ssg-textf "vfl-fuege-block-ein" (list blockname)))
;; Vario-Kurve zaehlen (Variante A=aussen/I=innen + Winkel) -> VF_Bogen_A/I_xx
(setq *vfl-acc-variokurve*
(vfl-inc-count *vfl-acc-variokurve*
(strcat (if (= kvariante "aussen") "A" "I") "_" (itoa kwinkel))))
;; Vario-Kurve ist ein HORIZONTALER Richtungswechsel (KEINE Neigung).
;; Der aktuelle Frame traegt die 3-Grad-Basisneigung - fuer die Kurve wird er
;; daher auf 0 Grad abgeflacht (Position + Fahrtrichtung bleiben erhalten).
(setq hz (car (frame->hz-winkel frame)))
(setq flach-frame (make-frame-from-dir (car frame) (hz-winkel->xu hz 0.0)))
(setq neuer-frame (insert-block-ks-to-ks blockname flach-frame))
;; Auf den absoluten 30-Grad-Raster snappen (siehe vfl-hz-snappen-absolut) -
;; gleiche Zeichnungsungenauigkeit wie bei GF-Bogen moeglich. Reine Z-Drehung
;; statt make-frame-from-dir-Neuaufbau: erhaelt die aus dem Block gemessene
;; Rollung (yu/zu) - siehe Kommentar bei vfl-frame-um-z-drehen. Ein Neuaufbau
;; ueber make-frame-from-dir fuehrte hier empirisch zu einer um 90 Grad
;; verdrehten Motorstation NACH der Vario-Kurve.
(setq hz-gemessen (car (frame->hz-winkel neuer-frame)))
(setq hz-gesnappt (vfl-hz-snappen-absolut hz-gemessen))
(if (> (abs (- hz-gemessen hz-gesnappt)) 0.0001)
(setq neuer-frame (vfl-frame-um-z-drehen neuer-frame (- hz-gesnappt hz-gemessen))))
neuer-frame
)
;; Vario-Kurve (horizontale Kurve, Neigung bleibt wie im aktuellen Frame).
;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch
;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das
;; (siehe ks-normalize-name).
;; Interaktiv (i18n): Vario-Kurve-Winkel + Seite + Variante abfragen, dann Kern.
;; Die Vario-Kurve bekommt - wie das ES-Element (vfl-frage-es-seite) - einen
;; EIGENEN STEP-Marker "Vario-Kurve", obwohl sie INNERHALB der VF-Einheit-
;; Schleife gebaut wird und keinen eigenen Hauptschleifen-Durchlauf hat. Damit
;; wird sie zu einem regulaeren, waehlbaren Glied und ist ueber die bestehende
;; Glied-Maschinerie (vfl-journal-glieder/-slice/-splice) editierbar. Der Marker
;; steht VOR den drei Eingaben (Winkel INT, Seite STR, Variante STR), sodass
;; diese als Glied-Inhalt darauf folgen. Beim Replay ueberspringt vfl-replay-pop
;; den Marker automatisch; die drei Werte poppen danach regulaer. Der Glied-Edit
;; liest allein aus dem Ketten-Journal (Segment-XDATA ist nur additive Deko),
;; daher ist KEIN Umbau der Segment-XDATA-Sicherung noetig.
(defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort)
(vfl-journal-mark "Vario-Kurve")
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-variokurve-impl nil))
(princ (ssg-text "vfl-variokurve-winkel-header"))
(princ (ssg-text "vfl-opt3-30grad"))
(princ (ssg-text "vfl-opt2-60grad"))
(princ (ssg-text "vfl-opt1-90grad"))
(setq kwinkel (vfl-menu-winkel (ssg-text "vfl-prompt-wahl-winkel-30-60-90")
(list (ssg-text "vfl-opt3-30grad") (ssg-text "vfl-opt2-60grad")
(ssg-text "vfl-opt1-90grad"))
*vfk-gf-bogen-winkel* 90 "vfl-variokurve-winkel-header"))
(princ (ssg-text "vfl-variokurve-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"vfl-variokurve-seite-header"))
(setq kseite (if (= antwort "2") "rechts" "links"))
(princ (ssg-text "vfl-variokurve-variante-header"))
(princ (ssg-text "vfl-variante-aussen"))
(princ (ssg-text "vfl-variante-innen"))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-variante-aussen") (ssg-text "vfl-variante-innen")) 2
"vfl-variokurve-variante-header"))
(setq kvariante (if (= antwort "1") "aussen" "innen"))
(vfl-insert-vario-kurve-block frame kwinkel kseite kvariante)
)
;; ============================================================
;; TEIL 3: KETTENANFANG (AS) / KETTENENDE (ES)
;; ============================================================
;; AS-Element am Kettenanfang. Wird IMMER FLACH eingefuegt (KS_EIN ohne
;; Neigung) - per Einzel-Insert-Test in BricsCAD bestaetigt (2026-07-24):
;; das AS-Element selbst hat keine Neigung, die Neigung beginnt erst im
;; nachfolgenden GF-Koerper (vfl-insert-gf-segment). typ/winkel sind aus
;; Call-Kompatibilitaet weiterhin Parameter, werden aber fuer die AS-eigene
;; Ausrichtung nicht mehr verwendet (KEIN vertikaler Tilt mehr, unabhaengig
;; vom folgenden Segmenttyp).
;; Rueckgabe: Frame am AS-Ausgang (KS_AUS).
(defun vfl-insert-as-element (typ startpunkt hz winkel as-seite /
ein-hz-as rad-h xu-ein as-turn)
;; Schwenk aus dem Block messen -> KS_EIN so drehen, dass KS_AUS entlang hz
;; zeigt (Grundriss-Versatz des 30-Grad-Elements bleibt beruecksichtigt).
(setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)))
(setq ein-hz-as (- hz as-turn))
(setq rad-h (* (float ein-hz-as) (/ pi 180.0)))
(setq xu-ein (list (cos rad-h) (sin rad-h) 0.0))
(insert-block-mixed-to-ks
(strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)
(make-frame-from-dir startpunkt xu-ein)
(caddr startpunkt) nil "KS_EIN")
)
;; Kettenanfang-Baustein: falls as-vorhanden, AS-Element einfuegen und die
;; GF/VF-Restlaenge um den tatsaechlichen AS-Fussabdruck kuerzen. Falls NICHT
;; as-vorhanden (Nutzer hat "Kein AS-Element" gewaehlt), beginnt die Kette
;; direkt am Startpunkt - deltaL bleibt die gemessene Rohlaenge (kein
;; Alle seit checkpoint (Ergebnis von (entlast), NIL falls Zeichnung vorher leer
;; war) neu erzeugten Entities wieder loeschen - Gegenteil von
;; vfl-modus-abbruch-sichern (das wickelt statt zu loeschen). Genutzt, wenn ein
;; Baustein (z.B. VF-Einheit-Eingang) sich im Nachhinein als sinnlos erweist
;; (zu kurz, Nutzer verzichtet auf "trotzdem bauen") - erst alle enames
;; sammeln, dann loeschen (entdel veraendert waehrend der Iteration die
;; Datenbank-Reihenfolge, siehe SSG_LIB_Commands.lsp).
(defun vfl-loesche-seit (checkpoint / e liste)
(setq liste '())
(setq e (if checkpoint (entnext checkpoint) (entnext)))
(while e (setq liste (cons e liste)) (setq e (entnext e)))
(foreach e liste (entdel e))
)
;; KS_AUS-Ursprung UND -Richtung (hz-Winkel in Grad) eines platzierten Blocks -
;; Massstab-bereinigte Kopie wie vfl-kette-ks-ursprung (Explode auf einer
;; skalierungsneutralen Kopie, dann geloescht), zusaetzlich mit der KS_AUS-
;; Achsrichtung: die Laengen-Streckung (XScaleFactor) verschiebt nur den
;; KS_AUS-URSPRUNG entlang der Blocklaenge (gegenueber KS_EIN), die
;; Achsrichtung des kleinen KS_AUS-Unterblocks selbst bleibt davon unberuehrt
;; (an der skalierungsneutralen Kopie unverfaelscht messbar). Rueckgabe:
;; (punkt . hz) oder nil (kein KS_AUS gefunden).
(defun vfl-kette-ks-aus-richtung (block-obj / sx copyobj ksdata kez kaz-raw kax-raw kaz hz)
(setq sx (vla-get-XScaleFactor block-obj))
(setq copyobj (vla-Copy block-obj))
(vla-put-XScaleFactor copyobj 1.0)
(vla-put-YScaleFactor copyobj 1.0)
(vla-put-ZScaleFactor copyobj 1.0)
(setq ksdata (extract-ks-from-block-raw copyobj))
(if (not (vlax-erased-p copyobj)) (vl-catch-all-apply 'vla-Delete (list copyobj)))
(setq kez (if (assoc "KS_EIN" ksdata) (car (cadr (assoc "KS_EIN" ksdata))) nil))
(setq kaz-raw (if (assoc "KS_AUS" ksdata) (car (cadr (assoc "KS_AUS" ksdata))) nil))
(setq kax-raw (if (assoc "KS_AUS" ksdata) (cadr (cadr (assoc "KS_AUS" ksdata))) nil))
(if (and kez kaz-raw kax-raw)
(progn
(setq kaz
(if (/= sx 1.0)
(list (+ (car kez) (* sx (- (car kaz-raw) (car kez))))
(+ (cadr kez) (* sx (- (cadr kaz-raw) (cadr kez))))
(+ (caddr kez) (* sx (- (caddr kaz-raw) (caddr kez)))))
kaz-raw))
(setq hz (/ (* (atan (- (cadr kax-raw) (cadr kaz-raw)) (- (car kax-raw) (car kaz-raw))) 180.0) pi))
(cons kaz hz)
)
nil
)
)
;; Sucht am gegebenen Punkt (Toleranz 1mm) einen KS_AUS eines vorhandenen
;; Vario-Kette-Bausteins der Zeichnung (lose Teile UND VF_n-Wrapper - gleicher
;; Scan wie vfl-kette-sammle-alle/Vario_Kette_Merge) und liefert dessen
;; Richtung (hz in Grad). Genutzt fuer den Kettenanfang bei GF-Bogen/Vario-
;; Kurve OHNE AS-Element: setzt der Nutzer den Startpunkt exakt auf den KS_AUS
;; eines bestehenden Bausteins (z.B. Fortsetzung einer schon gebauten Kette),
;; soll die neue Kurve dessen Richtung uebernehmen statt der Welt-X-Achse.
;; Rueckgabe: (hz . typ) oder nil, wenn kein KS_AUS in Toleranz gefunden
;; wurde. typ ist das vfl-kette-typ-Ergebnis des GEFUNDENEN Bausteins (bei
;; einem Wrapper-Kind dessen EIGENER Blockname, nicht "WRAPPER") - Basis fuer
;; vfl-kette-typ-familie (GF/VF/uneindeutig), genutzt von
;; vfl-keine-umlenkstation-p.
(defun vfl-ks-aus-hz-an-punkt (pt / tol ss i ename bname typ obj kinder kind
erg bester-d d hz-treffer typ-treffer kind-bname kind-typ)
(setq tol 1.0)
(setq bester-d nil hz-treffer nil typ-treffer nil)
(setq ss (ssget "X" '((0 . "INSERT"))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ename (ssname ss i))
(setq bname (cdr (assoc 2 (entget ename))))
(setq typ (vfl-kette-typ bname))
(cond
((= typ "WRAPPER")
(setq obj (vlax-ename->vla-object ename))
(setq kinder (vlax-invoke obj 'Explode))
(foreach kind kinder
(if (and (not (vlax-erased-p kind))
(= (vla-get-ObjectName kind) "AcDbBlockReference"))
(progn
(setq kind-bname (vla-get-Name kind))
(setq kind-typ (vfl-kette-typ kind-bname))
(setq erg (vfl-kette-ks-aus-richtung kind))
(if erg
(progn
(setq d (distance pt (car erg)))
(if (and (< d tol) (or (null bester-d) (< d bester-d)))
(setq bester-d d hz-treffer (cdr erg) typ-treffer kind-typ))
)
)
)
)
)
(foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind)))
)
((/= typ "UNBEKANNT")
(setq obj (vlax-ename->vla-object ename))
(setq erg (vfl-kette-ks-aus-richtung obj))
(if erg
(progn
(setq d (distance pt (car erg)))
(if (and (< d tol) (or (null bester-d) (< d bester-d)))
(setq bester-d d hz-treffer (cdr erg) typ-treffer typ))
)
)
)
)
(setq i (1+ i))
)
)
)
(if hz-treffer (cons hz-treffer typ-treffer) nil)
)
;; Grobe GF-/VF-Familie-Klassifikation eines vfl-kette-typ-Ergebnisses fuer die
;; Umlenkstations-Entscheidung am echten Kettenanfang (siehe
;; vfl-eingang-modus-bestimmen): AS/ES/STRECKE/SEP werden von BEIDEN Familien
;; genutzt (eine GF-Gerade UND das horizontale VF-Mittelstueck sind derselbe
;; Block "Staustrecke_SP_1000_mm") und bleiben daher absichtlich uneindeutig
;; (nil) - der Scan kann ein reines GF-Geraden-Ende grundsaetzlich NICHT vom
;; Ende eines VF-Horizontalstuecks unterscheiden.
(defun vfl-kette-typ-familie (typ)
(cond
((member typ '("WRAPPER" "KURVE" "UMLENK" "MOTOR" "BOGENAUF" "BOGENAB")) "VF")
((member typ '("GFBOGEN" "GFVERTBOGEN")) "GF")
(t nil)
)
)
;; Wie vfl-kette-typ-familie, aber fuer den SESSION-LOKALEN "letzter-typ"-
;; String (statt eines per Blockname erkannten XDATA-Typs) - fuer eine
;; laufende Fortsetzung (kettenanfang=nil) ist der Vorgaengertyp bereits
;; ohne KS_AUS-Scan bekannt. "Separator" zaehlt als GF-Familie (er folgt in
;; diesem Ablauf immer auf ein GF-Segment, siehe "Linie-GF"-Zweig).
;; WICHTIG: "VF" (eine gerade FERTIG gebaute VF-Einheit, Motorstation schon
;; eingefuegt) zaehlt hier BEWUSST NICHT zur "VF"-Familie - eine neue
;; VF-Einheit direkt danach braucht sehr wohl eine frische Umlenkstation
;; (siehe vfl-eingang-modus-bestimmen: nur "Vario-Kurve" mappt dort auf
;; eingang-modus="keine", "VF" fehlt dort bewusst und faellt auf den
;; Default/volle-Eingang-Fall zurueck). Nur "Vario-Kurve" hat keine eigene
;; Umlenkstation/keinen Abschluss - eine zweite waere mechanisch sinnlos.
(defun vfl-letzter-typ-familie (letzter-typ)
(cond
((equal letzter-typ "Vario-Kurve") "VF")
((member letzter-typ '("GF" "Separator")) "GF")
(t nil)
)
)
;; Eingang-Modus + L_GF-Stumpf fuer eine neue VF-Einheit bestimmen - EINE
;; gemeinsame Entscheidung fuer "Neue VF mit horizontalem Anfang" UND "Neue
;; Linie: Ab/Auf VF" (Punkt 5). Reihenfolge:
;; Fall 1 - letzter-typ="Separator"/"GF" (session-lokal bekannt, reduzierter
;; aber vorhandener Eingang - kein GF1-Stumpf, ggf. kein neuer Separator).
;; Fall 2 - letzter-typ="Vario-Kurve": die hat keine eigene Umlenkstation/
;; keinen Abschluss - eine zweite waere mechanisch sinnlos -> KEINE
;; Umlenkstation.
;; Fall 3 - echter Kettenanfang OHNE AS-Element (kettenanfang UND NICHT
;; as-vorhanden): am Startpunkt wird per KS_AUS-Scan (vfl-ks-aus-hz-an-
;; punkt) nachgesehen, was dort schon steht:
;; - eindeutig VF-Familie erkannt -> KEINE Umlenkstation.
;; - eindeutig GF-Familie (GF-Bogen) erkannt -> voller Eingang.
;; - NICHTS Eindeutiges (auch bei einer reinen GF-Geraden/VF-Horizontal-
;; stueck, die per Blockname nicht unterscheidbar sind - siehe
;; vfl-kette-typ-familie) -> der automatische Scan kann hier prinzipiell
;; nicht entscheiden, also EINE flache 3-Optionen-Frage an den Nutzer:
;; Option Eins - direkt Umlenkstation (kein GF-Stumpf); Option Zwei - GF-
;; Stumpf+Umlenkstation; Option Drei - ohne Umlenkstation (VF-Fortsetzung).
;; Fall 4 - sonst voller Eingang (GF1+Separator+Umlenkstation).
;; Rueckgabe: (lgf . eingang-modus).
(defun vfl-eingang-modus-bestimmen (letzter-typ kettenanfang as-vorhanden p-aktuell /
erg familie antwort)
(cond
((equal letzter-typ "Separator") (cons 0.0 "separator"))
((equal letzter-typ "GF") (cons 0.0 "gf"))
((equal letzter-typ "Vario-Kurve") (cons 0.0 "keine"))
((and kettenanfang (not as-vorhanden))
(setq erg (vfl-ks-aus-hz-an-punkt p-aktuell))
(setq familie (if erg (vfl-kette-typ-familie (cdr erg)) nil))
(cond
((equal familie "VF") (cons 0.0 "keine"))
((equal familie "GF") (cons *vfl-gf-min-laenge* nil))
(t
(princ (ssg-textf "vfl-frage-startpunkt-typ" (list (rtos *vfl-gf-min-laenge* 2 0))))
(princ (ssg-text "vfl-opt-eingang-direkt"))
(princ (ssg-textf "vfl-opt-eingang-mit-stumpf" (list (rtos *vfl-gf-min-laenge* 2 0))))
(princ (ssg-text "vfl-opt-eingang-ohne-umlenk"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-startpunkt-typ-impl nil))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def1")
(list (ssg-text "vfl-opt-eingang-direkt")
(ssg-textf "vfl-opt-eingang-mit-stumpf" (list (rtos *vfl-gf-min-laenge* 2 0)))
(ssg-text "vfl-opt-eingang-ohne-umlenk")) 1
"vfl-frage-startpunkt-typ"))
(cond
((= antwort "2") (cons *vfl-gf-min-laenge* nil))
((= antwort "3") (cons 0.0 "keine"))
(t (cons 0.0 "gf"))
)
)
)
)
(t (cons *vfl-gf-min-laenge* nil))
)
)
;; Kettenanfang-Baustein: falls as-vorhanden, AS-Element einfuegen und die
;; GF/VF-Restlaenge um den tatsaechlichen AS-Fussabdruck kuerzen. Falls NICHT
;; as-vorhanden (Nutzer hat "Kein AS-Element" gewaehlt), beginnt die Kette
;; direkt am Startpunkt - deltaL bleibt die gemessene Rohlaenge (kein
;; Fussabdruck abzuziehen). Rueckgabe: (frame deltaL).
;;
;; deltaL kommt als reine, bereits auf hz-neu projizierte Distanz vom
;; UNVERAENDERTEN p-aktuell herein (siehe vfl-in-abstand/vfl-neue-linie-
;; messen - dort wird NIE mehr ein absoluter Punkt gefuehrt). Der reale
;; AS-Austritt (car frame) liegt exakt auf derselben Achse hz-neu (das
;; AS-Element wird flach IN hz-neu eingefuegt, siehe vfl-insert-as-element) -
;; die noetige Restlaenge ist damit einfach die urspruengliche Distanz MINUS
;; die tatsaechliche (gemessene) AS-Fussabdrucklaenge, keine Punkt-Projektion
;; noetig (Ersatz fuer das fruehere vfl-projiziere-distanz auf pick-punkt).
(defun vfl-kettenanfang-baustein (p-aktuell hz-neu deltaL as-seite as-vorhanden / frame fussabdruck)
(if as-vorhanden
(progn
(setq frame (vfl-insert-as-element "GF" p-aktuell hz-neu 0.0 as-seite))
(setq fussabdruck (vfl-planar-dist p-aktuell (car frame)))
(setq deltaL (- deltaL fussabdruck))
(princ (ssg-textf "vfl-info-as-eingefuegt" (list (rtos deltaL 2 1))))
)
(progn
(setq frame (make-frame-from-dir p-aktuell (hz-winkel->xu hz-neu 0.0)))
(princ (ssg-text "vfl-info-kein-as"))
)
)
(list frame deltaL)
)
;; ES-Winkel (30/90) + Seite erst am Kettenende abfragen. Setzt *vfl-es-winkel*
;; und die ES-Masse (ein-dx/dz) fuer die Variante. Rueckgabe: Seite (links/rechts).
;;
;; Das ES-Element bekommt einen EIGENEN STEP-Marker "ES" (vfl-journal-mark),
;; obwohl es nicht in einem eigenen Hauptschleifen-Durchlauf, sondern am Ende
;; des letzten Segments gebaut wird. Damit wird ES zu einem regulaeren "Glied"
;; und ist ueber die bestehende Glied-Maschinerie (vfl-journal-glieder/-slice/
;; -splice) genauso editierbar wie ein GF-Bogen - ohne fehleranfaelligen
;; Tail-Sonderfall. Der Marker steht VOR den beiden ES-Eingaben (Winkel, Seite),
;; sodass diese als Glied-Inhalt darauf folgen. Beim Replay wird der Marker in
;; vfl-replay-pop automatisch uebersprungen; die beiden STR-Werte poppen danach
;; regulaer.
;; ES-Masse setzen (kein Bau, nur Globals): Winkel merken und die
;; ein-dx/ein-dz-Masse des ES-Elements laden. Aus der Frage-Schale gezogen,
;; damit der Daten-Pfad sie ohne Frage setzen kann.
;; *vfl-es-winkel* wird LAZY von den Blocknamen-Bauern gelesen (vfl-es-winkel
;; weiter oben) - es MUSS also vor dem ersten ES-Insert stehen, sonst waehlt
;; der Bau den falschen Block.
(defun vfl-es-masse-setzen (winkel seite)
(setq *vfl-es-winkel* winkel)
(vf-set-es-masse winkel seite)
seite)
;; Punkt (XY) + Hoehe (Z) abfragen und zu einem 3D-Punkt zusammenfuehren -
;; gemeinsame Schale fuer die frueher in vf-linienzug-modus/-modus2/-modus3
;; strukturgleich ausgeschriebene Startpunkt-Praeambel (Wizard-Hook, vfl-in-point,
;; vfl-in-real fuer die Hoehe, Z in die Koordinate uebernehmen). Die einzigen
;; Unterschiede sind die drei ssg-Textschluessel (Punkt-Prompt, Hoehen-Prompt,
;; Abbruch-Text) + der Wizard-Prompt - daher Parameter. Bricht bei nil-Punkt
;; per (exit) ab (wie zuvor an jeder Aufrufstelle; laeuft im Modus-Frame).
;; Rueckgabe: (x y z) mit z = abgefragte Hoehe (Default = gepickte Z).
(defun vfl-frage-punkt-hoehe (punkt-prompt-key hoehe-prompt-key abbruch-key wizard-hoehe-prompt / pkt hoehe)
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
(list punkt-prompt-key wizard-hoehe-prompt)))
(setq pkt (vfl-in-point nil (ssg-text punkt-prompt-key)))
(if (null pkt) (progn (princ (ssg-text abbruch-key)) (exit)))
(setq hoehe (vfl-in-real (ssg-textf hoehe-prompt-key (list (rtos (caddr pkt) 2 1)))))
(if (null hoehe) (setq hoehe (caddr pkt)))
(list (car pkt) (cadr pkt) hoehe))
;; AS-Winkel (30/90) + Seite abfragen. Gemeinsame Schale fuer die frueher
;; wortgleich in vf-linienzug-modus/-modus2/-modus3 UND vfl-qc-linie-mit-gf
;; ausgeschriebene AS-Praeambel (Winkel-Frage 30/90, Seiten-Frage links/rechts,
;; vf-set-as-masse) - Gegenstueck zu vfl-frage-es-seite. Setzt *vfl-as-winkel*
;; und die AS-Masse (aus-dx/dz) fuer die Variante. Rueckgabe: Seite (links/rechts).
;;
;; seiten-headerkey ist der EINZIGE Unterschied zwischen den Aufrufstellen
;; (modus1: "vfl-aus-seite-header", modus2: "gf-seite-aus-header") und daher
;; Parameter. Die je Modus unterschiedliche VORANGEHENDE Wizard-Vorbereitung
;; (vflw-gruppe-as-impl "AS setzen?" bzw. vflw-gruppe-winkel-seite-impl) bleibt
;; bewusst an der Aufrufstelle - die abzudeckende Winkel/Seite-Frage selbst ist
;; ueberall identisch. vf-frage-element-winkel/vflw-wahl zeigen den Wizard-
;; Winkeldialog bei aktivem Wizard-Modus schon selbst.
(defun vfl-frage-as-winkel-seite (seiten-headerkey / antwort as-seite)
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-as-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
(princ (ssg-text seiten-headerkey))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
seiten-headerkey))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
as-seite)
;; ES-Winkel (30/90) + Seite abfragen - MARKER-FREIE Schale fuer die Modi 2/3,
;; die das ES-Element als eigene Praeambel (Start/Ziel bereits fest) abfragen
;; und ihr eigenes Journal-/Masse-Schema fuehren. Unterscheidet sich bewusst
;; von vfl-frage-es-seite (Modus 1), das zusaetzlich einen Journal-Marker "ES"
;; setzt und ueber vfl-es-masse-setzen laeuft - das ist Teil des Modus-1-
;; Kettenglied-Replays und darf hier NICHT feuern. Setzt *vfl-es-winkel* und
;; die ES-Masse (ein-dx/dz). Rueckgabe: Seite (links/rechts).
(defun vfl-frage-es-winkel-seite (seiten-headerkey / antwort es-seite)
(princ (ssg-text "vf-winkel-ein-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-es-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite
(princ (ssg-text seiten-headerkey))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
seiten-headerkey))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vf-set-es-masse *vfl-es-winkel* es-seite) ; Masse fuer Variante
es-seite)
;; dialog-schon-gezeigt: T, wenn Winkel+Seite BEREITS ueber einen vorherigen
;; kombinierten Dialog (vflw-gruppe-as-impl, "ES-Element setzen?" + Winkel +
;; Seite in einem Bildschirm) abgefragt und in die Pending-Queue gelegt
;; wurden - dann NICHT nochmal den eigenen Winkel+Seite-Dialog zeigen (sonst
;; doppelter Dialog), nur die bereits wartenden Werte konsumieren. Sonst
;; (normaler Fall) nil - eigener Dialog wie bisher.
(defun vfl-frage-es-seite (dialog-schon-gezeigt / antwort es-seite)
(vfl-journal-mark "ES")
(if (and (vfl-wizard-aktiv) (not dialog-schon-gezeigt))
(vl-catch-all-apply 'vflw-gruppe-winkel-seite-impl
(list "vf-winkel-ein-header"
(list (ssg-text "vf-winkel-90") (ssg-text "vf-winkel-30"))
(list "90" "30"))))
(princ (ssg-text "vf-winkel-ein-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-es-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"gf-seite-ein-header"))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vfl-es-masse-setzen *vfl-es-winkel* es-seite)
es-seite
)
;; Separator (300mm) an der aktuellen Stelle einfuegen (bei 3-Grad-Neigung,
;; Frame-Kettung ueber KS). Rueckgabe: neuer Frame am Separator-Ausgang.
;; Genutzt fuer den optionalen Zwischen-Separator zwischen zwei Foerderern.
(defun vfl-insert-separator (frame / hz w sep-endpunkt)
(setq hz (car (frame->hz-winkel frame)))
(setq w (ssg-cfg-or "vario" "gefaelle_winkel" 3))
(setq sep-endpunkt
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" (car frame) hz w *vfk-separator-laenge* 0))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
(make-frame-from-dir sep-endpunkt (hz-winkel->xu hz w))
)
;; ES-Element am Kettenende: Separator (300mm) + ES-Element.
;; typ="GF": Neigung = winkel des GF-Segments.
;; typ="VF": Neigung = 3 Grad (Auslauf einer VF-Einheit endet auf 3 Grad).
;; Das ES-Element wird rein per KS-zu-KS an den Separator angekettet
;; (`insert-block-ks-to-ks`) - sein KS_EIN folgt exakt dem Separator-Ausgang
;; (Position + Neigung). KEIN Z-Ziel (anders als im Standalone-Gefaelle, wo eine
;; feste Endhoehe erzwungen wird): der Linienzug laeuft frei aus, ein Z-Ziel
;; wuerde die ES-Hoehe kuenstlich verschieben -> Versatz. hoehe-ziel wird daher
;; hier nicht mehr verwendet (bleibt fuer Signatur-Kompatibilitaet).
(defun vfl-insert-es-element (typ frame hz winkel hoehe-ziel es-seite /
w-eff sep-endpunkt sep-frame)
(setq w-eff (if (= typ "GF") winkel (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
(setq sep-endpunkt
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" (car frame) hz w-eff *vfk-separator-laenge* 0))
(setq sep-frame (make-frame-from-dir sep-endpunkt (hz-winkel->xu hz w-eff)))
(if (boundp '*vfl-acc-separator*)
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))) ; Separator vor ES
(insert-block-ks-to-ks (strcat "ES_Element_" (vfl-es-winkel) "_" es-seite) sep-frame)
)
;; ============================================================
;; TEIL 4: BLOCK-ERSTELLUNG (Nummerierung + Attribute)
;; ============================================================
(defun vfl-block-erstellen (vfl-nummer anzahl-gf anzahl-vf hoehe-von hoehe-bis
delta-l-total as-seite es-seite startpunkt lastEnt /
vfl-bname vfl-insert typ-str)
;; TYP: einsegmentige Gefaellestrecke ohne Bogen -> "Gefaellestrecke";
;; mit VF, Bogen oder mehreren GF-Segmenten -> "Streckengruppe".
(setq typ-str
(if (or (> anzahl-vf 0)
(> anzahl-gf 1)
(> (length *vfl-acc-gfbogen*) 0)
(> (length *vfl-acc-variokurve*) 0))
"Streckengruppe"
"Gefaellestrecke"))
(setq vfl-bname (strcat "VF_" (itoa vfl-nummer)))
;; Gemeinsamer Wrapper-Rumpf (ATTDEF/Sweep/Sepliste/Wrap/Layer/ID/Dim, siehe
;; vf-wrapper-bauen in vf_core). Die *vfl-acc-*-Attributliste baut hier der
;; Aufrufer (linienzug-spezifische Komma-Listen), der Rumpf kennt sie nicht.
(setq vfl-insert
(vf-wrapper-bauen vfl-nummer typ-str startpunkt lastEnt
(list
(cons "Bezeichnung" vfl-bname)
(cons "MONTAGEHOEHE_m" (rtos (/ (+ hoehe-von hoehe-bis) 2000.0) 2 3))
(cons "HOEHE_VON_mm" (itoa (fix hoehe-von)))
(cons "HOEHE_BIS_mm" (itoa (fix hoehe-bis)))
(cons "DELTA_H_mm" (itoa (fix (abs (- hoehe-bis hoehe-von)))))
(cons "DELTA_L_mm" (itoa (fix delta-l-total)))
(cons "TYP" typ-str)
(cons "SEITE_AS" as-seite)
(cons "WINKEL_AS" (if (boundp '*vfl-as-winkel*) *vfl-as-winkel* ""))
(cons "SEITE_ES" es-seite)
(cons "WINKEL_ES" (if (boundp '*vfl-es-winkel*) *vfl-es-winkel* ""))
;; ANZAHL_GF = alle GF-Stuecke: eigenstaendige GF-Segmente UND die GF1/GF2
;; jeder VF-Einheit (alle ueber vfl-acc-gf-seg in *vfl-acc-lgf* gesammelt).
(cons "ANZAHL_GF" (itoa (length *vfl-acc-lgf*)))
(cons "L_GF_m" (vfl-join-komma *vfl-acc-lgf*))
(cons "GF_WINKEL" (vfl-join-komma *vfl-acc-gfwinkel*))
;; GF-Boegen (Richtungswechsel im GF-Teil), gezaehlt nach Seite+Winkel
(cons "GF_Bogen_L_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_90")))
(cons "GF_Bogen_L_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_60")))
(cons "GF_Bogen_L_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_30")))
(cons "GF_Bogen_R_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_90")))
(cons "GF_Bogen_R_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_60")))
(cons "GF_Bogen_R_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_30")))
(cons "ANZAHL_VF" (itoa anzahl-vf))
(cons "MOTORSEITE" (vfl-join-komma *vfl-acc-motorseite*))
(cons "L_VF_m" (vfl-join-komma *vfl-acc-lvf*))
(cons "ANTRIEBFAHRTRICHTUNG" (vfl-join-komma *vfl-acc-richtung*))
(cons "VF_WINKEL" (vfl-join-komma *vfl-acc-winkel*))
;; Vario-Kurven (Richtungswechsel im VF-Teil), A=aussen / I=innen
(cons "VF_Bogen_A_90" (itoa (vfl-get-count *vfl-acc-variokurve* "A_90")))
(cons "VF_Bogen_A_60" (itoa (vfl-get-count *vfl-acc-variokurve* "A_60")))
(cons "VF_Bogen_A_30" (itoa (vfl-get-count *vfl-acc-variokurve* "A_30")))
(cons "VF_Bogen_I_90" (itoa (vfl-get-count *vfl-acc-variokurve* "I_90")))
(cons "VF_Bogen_I_60" (itoa (vfl-get-count *vfl-acc-variokurve* "I_60")))
(cons "VF_Bogen_I_30" (itoa (vfl-get-count *vfl-acc-variokurve* "I_30")))
(cons "ANZAHL_SEPARATOR" (itoa *vfl-acc-separator*)))))
(if vfl-insert (princ (ssg-textf "vfl-block-erstellt" (list vfl-bname typ-str))))
vfl-insert
)
;; Baut eine komplette VarioFoerderer-Einheit und schliesst sie ab:
;; GF-Verteilung fragen -> vfl-vf-einheit (Umlenk..Motor, mehrsegmentig)
;; -> Kettenende? Ja: Separator+ES (Ende); Nein: optionaler Zwischen-Separator.
;; winkel1=0 => horizontaler Anfangs-Koerper (Option "Neue horizontal VF").
;; auto-ende: T => keine Kettenende-Frage, es wird direkt Separator + ES
;; gesetzt (Option "Neue Linie BIS Kettenende").
;; Rueckgabe: (frame anzahl-koerper ende-flag es-seite-oder-nil).
;; Soll-Ist-Vergleich am Kettenende ausgeben (Zielpunkt aus dem
;; Modus-1-Zielmodus, gesetzt in vfl-body-abschluss). Stand vorher zweimal
;; wortgleich im Abschluss - einmal fuer "Kettenende ohne ES", einmal fuer
;; "Kettenende mit ES"; die Faelle unterscheiden sich nur darin, WANN sie
;; gemeldet werden, nicht WAS.
;; Loescht *vfl-ziel-punkt* danach: der Report gehoert zu genau einem
;; Kettenende, ein zweiter Aufruf soll nichts mehr melden.
(defun vfl-ziel-report (frame)
(if *vfl-ziel-punkt*
(progn
(princ (ssg-text "vfl-ist-ziel-vergleich-header"))
(princ (ssg-textf "vfl-soll-xyz"
(list (rtos (car *vfl-ziel-punkt*) 2 1)
(rtos (cadr *vfl-ziel-punkt*) 2 1)
(rtos (caddr *vfl-ziel-punkt*) 2 1))))
(princ (ssg-textf "vfl-ist-xyz"
(list (rtos (car (car frame)) 2 1)
(rtos (cadr (car frame)) 2 1)
(rtos (caddr (car frame)) 2 1))))
(princ (ssg-textf "vfl-abweichung-xyz"
(list (rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1)
(rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1)
(rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1))))
(setq *vfl-ziel-punkt* nil)))
(princ))
;; vorab-antwort/vorab-es-gewuenscht/vorab-es-seite/vorab-ziel-punkt: siehe
;; vfl-vf-einheit (Default nil - unveraendertes Verhalten fuer alle Aufrufer,
;; die diese Vorab-Entscheidung nicht kennen).
;; L_hor/L_hor-position: nur bei einem Stufe-3-Treffer belegt (siehe
;; vfl-winkel-stufe-entscheidung/vfl-stufe3-winkel-horizontal), sonst nil -
;; unveraendertes Verhalten fuer alle anderen Aufrufer.
(defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF L_hor L_hor-position
auto-ende gf-verteilung-fest eingang-modus
vorab-antwort vorab-es-gewuenscht vorab-es-seite vorab-ziel-punkt /
antwort res es-s ende es-gewuenscht es-seite-vorab)
;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf.
;; gf-verteilung-fest: Aufrufer erzwingt die Antwort (z.B. "2", wenn L_GF
;; wegen eingang-modus ohnehin 0.0 ist - die Frage waere dann sinnlos).
(if gf-verteilung-fest
(setq antwort gf-verteilung-fest)
(progn
(princ (ssg-text "vfl-gf-verteilung-header"))
(princ (ssg-text "vfl-gf-verteilung-haelfte"))
(princ (ssg-text "vfl-gf-verteilung-ganz-einlauf"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-gf-verteilung-impl (list (ssg-text "vfl-gf-verteilung-header") "1" "2")))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-gf-verteilung-haelfte")
(ssg-text "vfl-gf-verteilung-ganz-einlauf")) 2
"vfl-gf-verteilung-header"))))
(setq res (vfl-vf-einheit frame hz richtung winkel L_GF L_VF L_hor L_hor-position (= antwort "1") eingang-modus
vorab-antwort vorab-es-gewuenscht vorab-es-seite vorab-ziel-punkt))
(setq frame (nth 0 res) es-gewuenscht (nth 3 res) es-seite-vorab (nth 4 res))
;; Kettenende? Bei auto-ende (Kettenende-Modus) ohne Frage direkt ES setzen.
;; ziel-ende (Option 3 IN der VF-Einheit) OHNE ES-Wunsch (dort abgefragt,
;; siehe vfl-vf-einheit): Kette endet direkt hier, kein Separator+ES, keine
;; weitere Frage. ziel-ende MIT ES-Wunsch ODER auto-ende (Option 4): ohne
;; Frage direkt Separator + ES. Sonst normal fragen - zwischen einem AS und
;; ES koennen mehrere Foerderer liegen.
(if (and (nth 2 res) (not es-gewuenscht))
(setq antwort "kein-es")
(if (or auto-ende (nth 2 res))
(setq antwort "1")
(progn
(princ (ssg-text "vfl-ist-kettenende-frage"))
(princ (ssg-text "vfl-ja-separator-es"))
(princ (ssg-text "vfl-nein-weiterbauen"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-ist-kettenende-2opt-impl nil))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja-separator-es")
(ssg-text "vfl-nein-weiterbauen")) 2
"vfl-ist-kettenende-frage"))
)
)
)
(cond
((= antwort "kein-es")
(setq ende t)
;; Ist-Ziel-Report auch ohne ES (Vergleich Soll-Zielpunkt vs. tatsaechliches
;; Kettenende nach GF2/Motor).
(vfl-ziel-report frame)
)
((= antwort "1")
;; War die ES-Seite (+Winkel) schon in vfl-vf-einheit erfragt (Option 3,
;; ziel-ende - dort VOR vfl-body-abschluss noetig, siehe dortiger
;; Kommentar), hier NICHT erneut fragen (waere doppelt journalisiert und
;; ein-dx/ein-dz wurden dort schon fuer die Zerlegung genutzt).
(setq es-s (if es-seite-vorab es-seite-vorab (vfl-frage-es-seite nil)))
(setq frame (vfl-insert-es-element "VF" frame
(car (frame->hz-winkel frame)) 0.0
(caddr (car frame)) es-s))
(setq ende t)
;; Ist-Ziel-Report (Option 3): Soll-ES (aus vfl-body-abschluss) vs. Ist-ES.
(vfl-ziel-report frame)
)
(t
(princ (ssg-text "vfl-sep-an-stelle-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-ja-nein-impl (list (ssg-text "vfl-sep-an-stelle-frage"))))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-sep-an-stelle-frage"))
(if (= antwort "1") (setq frame (vfl-insert-separator frame)))
)
)
(list frame (nth 1 res) ende es-s)
)
;; ============================================================
;; TEIL 5: HAUPTBEFEHL - MODUS 1 (MANUELLE EINGABE)
;; ============================================================
(defun vf-linienzug-modus ( / startpunkt start-hoehe as-seite es-seite antwort wahl
p-aktuell linie-mess hoehe-neu hoehe-bis deltaL deltaH richtung hz-neu
entscheidung typ winkel L_GF L_VF lhor stufe3-position vf-einheit-res
frame letzter-typ fertig linie-ende-modus rad3
anzahl-gf anzahl-vf vfl-nummer lastEnt seg-lastEnt
gf-max-winkel gf-ok kettenanfang
as-vorhanden erg old-error vfl-ins dbg-an
hoehe-vorschlaege hoehe-ab hoehe-auf
gf-laenge-modus gf-steigend-modus sep-vor-gf sep-nach-gf
sep-anzahl erg-bogen vf-eingang-lgf vf-eingang-modus
eingang-laenge winkel-hoehen-erg
bogen-mass fest-drop fest-laenge eingang-fertig
linie-ende-familie linie-ende-untermodus
res3 save-eindx save-eindz es-gewuenscht
startpunkt-familie gf-kettenende-antwort
vorab-antwort vorab-es-gewuenscht vorab-es-seite
save-eindx-vorab save-eindz-vorab erg-es vorab-ziel-punkt
rad3-sep sep-eindx-add sep-eindz-add)
;; "Zurueck"/"Abbrechen"-Flag ganz am Anfang zuruecksetzen (auch schon vor
;; der ersten Praeambel-Frage) - sonst wuerde ein von einem VORHERIGEN Lauf
;; 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). Wird ausserdem in vfl-acc-reset erneut
;; zurueckgesetzt (spaeter im Ablauf) sowie unmittelbar vor jedem "Zurueck"-
;; Neuaufruf in vfl-modus-abbruch-sichern.
(setq *vfl-wizard-abbruch-grund* nil)
;; *vfl-journal* VOR dem allerersten vfl-in-*-Aufruf zuruecksetzen (nicht
;; *vfl-replay-queue* - ein REPLAY-getriebener Aufrufer wie vsp-bau-aus-spec
;; hat sie ueber vfl-journal-replay-start bereits VOR diesem Aufruf befuellt,
;; siehe Kommentar bei vfl-journal-reset-lauf). Frueher stand dieser Reset
;; ERST kurz vor der Hauptschleife (nach Startpunkt/Hoehe/AS-Praeambel) -
;; realer Bug: die bereits aufgezeichnete Praeambel wurde dadurch selbst
;; wieder geloescht, das gespeicherte Journal begann mit dem ERSTEN
;; STEP-Marker statt mit PT (sichtbar als vsp-bau-aus-spec-DESYNC "Token 1:
;; erwartet PT..., gebaut STEP...", betraf ausnahmslos JEDE Kette).
(vfl-journal-reset-lauf)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-modus1-header"))
(princ "\n=========================================")
(princ (ssg-text "vfl-modus1-beschreibung"))
;; --- Debug-Session (Schalter "vfl-modus1", DEFAULT AN) ------------------
;; (dbg-schalter-off "vfl-modus1") deaktiviert bei Bedarf das Loggen.
;; Geloggt wird ueber vfl-journal-record/-mark/-steplabel (siehe dort) -
;; das erfasst automatisch JEDE interaktive Eingabe dieses Modus (Punkte,
;; Hoehen, Winkel, Menue-Auswahlen) samt Glied-Uebergaengen, ohne dass jede
;; einzelne Aufrufstelle im Bau-Ablauf separat instrumentiert werden muss.
(setq dbg-an (vfl-dbg-session-start "vfl-modus1" "vfl_modus1.dbg"
"vf-linienzug-modus" "=== SESSION Modus 1 (Manuelle Eingabe) START ==="))
;; Modus-1-Zusatz: falls dieser Lauf ein Replay ist (Editieren/Fortsetzen,
;; *vfl-replay-queue* gesetzt), die EINGEHENDE Replay-Queue als JSON ausgeben -
;; VOR dem Neuaufbau, daher auch bei einem Absturz mitten im Replay sichtbar
;; (anders als das XDATA-JOURNAL-JSON in vfl-journal-xdata-schreiben, das erst
;; nach erfolgreichem Bau laeuft). So laesst sich ein Desync direkt an der
;; Eingangs-Sequenz ablesen. (M1-spezifisch, daher nicht im Session-Helfer.)
(if dbg-an
(progn
(if *vfl-replay-queue*
(dbgmsg (strcat "REPLAY-QUEUE-JSON " (vfl-journal->json *vfl-replay-queue*)))
(dbgmsg "LIVE-BAU (kein Replay)"))
(dbgflush)))
(vfl-gf-abhaengigkeit-sicherstellen "vfl-alert-gf-modul-fehlt")
;; --- Abbruch-Sicherung scharf schalten (VOR dem ersten Prompt!) ---
;; Ab hier kann jederzeit Geometrie entstehen. Ein *error*-Handler faengt
;; jeden Abbruch (ESC / (exit) / Laufzeitfehler) ab und WICKELT die bereits
;; eingefuegte Teil-Geometrie (alles nach lastEnt) zu einem VF_n-Block mit
;; dem vollen aktuellen Eingabe-Journal als XDATA (vfl-modus-abbruch-sichern)
;; - die Geometrie bleibt stehen und ist per Doppelklick sofort weiter
;; editierbar/fortsetzbar (kein Rollback mehr, kein separater
;; "Fortsetzen"-Mechanismus noetig).
;; Die Installation MUSS vor dem allerersten vfl-in-*-Aufruf erfolgen: ein
;; echtes ESC (nicht ein leeres Enter) loest bei JEDEM get*-Aufruf sofort
;; *error* aus (nicht nil) - ohne den Handler wuerde ein ESC in diesem
;; Fenster auf den vorherigen Handler zurueckfallen (im Editier-Pfad: der
;; ssg-start-Handler ohne Wickeln - der bereits geloeschte Original-Block
;; waere dann ersatzlos weg). lastEnt/old-error/vfl-nummer/anzahl-gf/
;; anzahl-vf/startpunkt/frame/as-seite/es-seite sind zur Aufrufzeit
;; dynamisch gebunden und daher im Handler-Lambda sichtbar (AutoLISP
;; dynamic scoping, gilt fuer die gesamte Laufzeit dieses Aufrufs, auch
;; tief verschachtelt z.B. in vfl-vf-einheit).
(setq vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
(setq old-error *error*)
;; Scharfen Abbruch-Wickel-Handler installieren (gemeinsam fuer alle drei
;; Modi, siehe vfl-abbruch-handler-installieren). old-error/lastEnt/vfl-nummer/
;; anzahl-gf/anzahl-vf/startpunkt/frame/as-seite/es-seite/dbg-an sind hier als
;; Locals gebunden und werden vom Handler zur Abbruchzeit dynamisch gesehen.
(vfl-abbruch-handler-installieren "linienzug")
;; Startpunkt + Hoehe (gemeinsame Praeambel-Schale, siehe vfl-frage-punkt-hoehe).
(setq startpunkt (vfl-frage-punkt-hoehe "vfl-prompt-startpunkt-kette"
"vfl-prompt-hoehe-startpunkt-kette" "vfl-abgebrochen" "Starthoehe (Z, mm):"))
;; Startpunkt-Erkennung VOR der AS-Frage: liegt der Punkt auf dem KS_AUS
;; EINES beliebigen bestehenden Kettenbausteins (GF ODER VF, beliebiges
;; Segment), ist ein AS-Element ueberfluessig - die Kette knuepft direkt
;; an. WICHTIG: der Gate ist bewusst "erg gefunden", NICHT "Familie
;; aufgeloest" - viele Bausteine (Staustrecke_SP_1000_mm/Separator) sind
;; per Blockname allein GF/VF-uneindeutig (vfl-kette-typ-familie liefert
;; dafuer nil), zaehlen aber trotzdem eindeutig als "hier steht schon ein
;; Kettenbaustein" - genau dieser Fall (Kettenende = ein gewoehnliches
;; GF-Geradenstueck) fragte bisher faelschlich noch nach dem AS-Element.
;; startpunkt-familie bleibt nil in diesem uneindeutigen Fall; die Meldung
;; faellt dann auf einen neutralen Text zurueck (kein falsches "GF"/"VF").
;; Nur wenn GAR KEIN KS_AUS in Toleranz gefunden wurde, wird wie bisher
;; gefragt.
(setq erg (vfl-ks-aus-hz-an-punkt startpunkt))
(setq startpunkt-familie (if erg (vfl-kette-typ-familie (cdr erg)) nil))
(if erg
(progn
(princ (ssg-textf "vfl-as-auto-erkannt" (list (if startpunkt-familie startpunkt-familie (ssg-text "vfl-familie-neutral")))))
(setq as-vorhanden nil))
(progn
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-as-setzen-frage")))
(princ (ssg-text "vfl-as-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-as-nein"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-as-nein")) 1
"vfl-as-setzen-frage"))
(setq as-vorhanden (/= antwort "2"))))
;; *vfl-as-winkel*/*vfl-es-winkel* sind Globals (fuer vfl-as-winkel/-es-winkel-
;; Zugriff aus AS-/ES-Einfuegefunktionen) und muessen pro Kette zurueckgesetzt
;; werden - sonst wuerde ein WINKEL_AS-Attribut den Wert der VORHERIGEN Kette
;; tragen, wenn diesmal kein AS gewaehlt wird.
(setq *vfl-as-winkel* nil *vfl-es-winkel* nil)
(if as-vorhanden
(setq as-seite (vfl-frage-as-winkel-seite "vfl-aus-seite-header"))
)
;; ES-Seite wird erst am Kettenende abgefragt (siehe vfl-frage-es-seite),
;; da das ES-Element erst dort eingefuegt wird.
(setq p-aktuell startpunkt)
(setq letzter-typ nil fertig nil frame nil)
(setq anzahl-gf 0 anzahl-vf 0)
(vfl-acc-reset)
;; *vfl-journal*-Reset steht jetzt GANZ AM ANFANG der Funktion (vor der
;; Startpunkt/Hoehe/AS-Praeambel) - siehe Kommentar dort. Hier NICHT mehr
;; noetig (und schaedlich: wuerde die bereits aufgezeichnete Praeambel
;; dieses Laufs wieder loeschen).
(while (not fertig)
;; --- Naechstes Element bestimmen ---
;; Nach einem GF-Segment ODER einer geschlossenen VF-Einheit (beide enden
;; auf 3-Grad-Neigung) darf ein GF-Bogen oder eine neue Linie folgen. Nur
;; am Kettenanfang folgt direkt eine neue Linie. Vario-Kurven werden
;; INNERHALB der VF-Einheit behandelt (vfl-vf-einheit).
;; Menue immer anzeigen; GF-Bogen nur, wenn bereits ein Frame existiert
;; (am Kettenanfang gibt es keinen Vorgaenger-Rahmen fuer einen Bogen).
;; Lueckenlose Nummerierung: GF-Bogen (nur mit Frame) ist immer Option 1;
;; ohne Frame ruecken die uebrigen Optionen auf 1..4 auf.
;; "Neue Linie" ist in zwei explizite Zweige aufgeteilt (GF / Ab-Auf-VF) -
;; der Nutzer legt den Segmenttyp direkt fest, keine Geometrie-Automatik
;; mehr wie bei "Neue Linie BIS Kettenende" (die bleibt unveraendert und
;; nutzt weiterhin vfl-segment-entscheidung).
(if (not *vfl-forciere-qc-modus*) (princ (ssg-text "vfl-naechstes-element-header")))
(setq linie-ende-modus nil)
;; Glied-Checkpoint am Iterationskopf setzen; Label wird nach der Auswahl
;; nachgetragen (vfl-journal-steplabel), damit jedes Glied seine eigene
;; Menue-Auswahl + Segment-Eingaben vollstaendig umschliesst (fuer den
;; gliedweisen Ruecksprung beim Editieren).
;; seg-lastEnt: Schnappschuss VOR diesem Glied, fuer die Segment-XDATA
;; (vfl-segment-xdata-sichern, siehe Ende der cond unten) - dieselbe
;; Hilfsfunktion wie beim Ketten-lastEnt (oben), damit ATTRIB/SEQEND-
;; Ketten eines vorherigen INSERTs konsistent uebersprungen werden.
(setq seg-lastEnt (vf-lastent-ohne-attribute))
(vfl-journal-mark "?")
;; Erzwungener QC-Modus (Linienzug-Modus 4/5 im Typ-Dispatcher
;; c:VarioFoerderer, *vfl-forciere-qc-modus* = "4"/"5"): das Menue
;; "Naechstes Element waehlen" komplett ueberspringen - diese Ketten
;; bestehen IMMER nur aus dem einen "Linie-GF"-Glied (QC baut AS bis ES
;; selbst und setzt fertig). Nur am allerersten Glied wirksam (kettenanfang);
;; das Consumer-seitige Zuruecksetzen erfolgt in vfl-qc-linie-mit-gf.
(if *vfl-forciere-qc-modus*
(setq wahl "Linie-GF")
(progn
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-naechstes-element-impl
(list (null frame) (if (null frame) startpunkt-familie nil))))
(if frame
(progn
(princ (ssg-text "vfl-menu-gf-bogen-1"))
(princ (ssg-text "vfl-menu-linie-gf-2"))
(princ (ssg-text "vfl-menu-linie-vf-3"))
(princ (ssg-text "vfl-menu-horizontal-vf-4"))
(princ (ssg-text "vfl-menu-linie-ende-5"))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-5-def2")
(list (ssg-text "vfl-menu-gf-bogen-1")
(ssg-text "vfl-menu-linie-gf-2")
(ssg-text "vfl-menu-linie-vf-3")
(ssg-text "vfl-menu-horizontal-vf-4")
(ssg-text "vfl-menu-linie-ende-5")) 2
"vfl-naechstes-element-header"))
(setq wahl (cond ((= antwort "1") "GF-Bogen")
((= antwort "3") "Linie-VF")
((= antwort "4") "Horizontal-VF")
((= antwort "5") (setq linie-ende-modus t) "Linie")
(t "Linie-GF"))) ; "2" oder leer
)
(progn
;; Kettenanfang: 6 Optionen statt 4 - GF-Bogen und Vario-Kurve sind
;; hier ZUSAETZLICH waehlbar (stueckweiser Aufbau kann auch mit einer
;; horizontalen Kurve beginnen, z.B. Fortsetzung einer bereits an
;; anderer Stelle gebauten Teilkette). Beide brauchen dafuer keine
;; eigene Laengenmessung, nur eine Referenzrichtung - siehe die
;; KS_AUS-Erkennung (vfl-ks-aus-hz-an-punkt) in den beiden Zweigen
;; unten.
(princ (ssg-text "vfl-menu-gf-bogen-ka-1"))
(princ (ssg-text "vfl-menu-variokurve-ka-2"))
(princ (ssg-text "vfl-menu-linie-gf-ka-3"))
(princ (ssg-text "vfl-menu-linie-vf-ka-4"))
(princ (ssg-text "vfl-menu-horizontal-vf-ka-5"))
(princ (ssg-text "vfl-menu-linie-ende-ka-6"))
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-6-def3")
(list (ssg-text "vfl-menu-gf-bogen-ka-1")
(ssg-text "vfl-menu-variokurve-ka-2")
(ssg-text "vfl-menu-linie-gf-ka-3")
(ssg-text "vfl-menu-linie-vf-ka-4")
(ssg-text "vfl-menu-horizontal-vf-ka-5")
(ssg-text "vfl-menu-linie-ende-ka-6")) 3
"vfl-naechstes-element-header"))
(setq wahl (cond ((= antwort "1") "GF-Bogen")
((= antwort "2") "Vario-Kurve")
((= antwort "4") "Linie-VF")
((= antwort "5") "Horizontal-VF")
((= antwort "6") (setq linie-ende-modus t) "Linie")
(t "Linie-GF"))) ; "3" oder leer
)
)
)) ;; Ende (progn ...) / (if *vfl-forciere-qc-modus* ...)
;; Segmenttyp steht fest -> Glied-Label nachtragen (fuer die Edit-Liste).
;; Die Auswahl selbst wurde bereits automatisch echot (vfl-echo-antwort,
;; zentral in vfl-in-value/-value-p verankert).
(vfl-journal-steplabel wahl)
(progn
(cond
((= wahl "GF-Bogen")
;; Als ALLERERSTES Kettenglied (frame=nil) braucht eine Kurve technisch
;; eine Referenzrichtung, von der aus Winkel+Seite gemessen werden -
;; eine zusaetzliche Punktwahl nur zur Richtungsbestimmung ist
;; ueberfluessig (kein eigenes Segment, keine Laenge wird dabei
;; gemessen). Liegt der gewaehlte Startpunkt exakt auf dem KS_AUS eines
;; bestehenden Vario-Kette-Bausteins (Fortsetzung einer schon gebauten
;; Kette), wird dessen Richtung uebernommen; sonst Standard Welt-0
;; Grad/+X-Achse. Das AS-Element wird ganz normal ueber
;; vfl-kettenanfang-baustein eingefuegt (deltaL dabei irrelevant, da
;; hier kein Segment gebaut wird - Wert wird verworfen).
(if (null frame)
(progn
(setq hz-neu (car (vfl-ks-aus-hz-an-punkt p-aktuell)))
(if (null hz-neu) (setq hz-neu 0.0))
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu 0.0 as-seite as-vorhanden))
(setq frame (nth 0 erg))
)
)
(setq frame (vfl-insert-gf-bogen frame))
(setq p-aktuell (car frame))
)
((= wahl "Vario-Kurve")
;; Gleiche Kettenanfang-Behandlung wie GF-Bogen oben (KS_AUS-
;; Richtungsuebernahme bei Fortsetzung, sonst Welt-0 Grad).
(if (null frame)
(progn
(setq hz-neu (car (vfl-ks-aus-hz-an-punkt p-aktuell)))
(if (null hz-neu) (setq hz-neu 0.0))
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu 0.0 as-seite as-vorhanden))
(setq frame (nth 0 erg))
)
)
(setq frame (vfl-insert-vario-kurve frame))
(setq p-aktuell (car frame))
;; letzter-typ merken: eine Vario-Kurve hat KEINE eigene Umlenkstation
;; und ist mechanisch Teil einer VF-Kette - ein direkt folgendes
;; "Neue Linie: Ab/Auf VF"/"Horizontal-VF" baut daher (via
;; vfl-eingang-modus-bestimmen, eingang-modus="keine") KEINE zweite
;; Umlenkstation.
(setq letzter-typ "Vario-Kurve")
)
;; --- Neue horizontal VF: VF-Einheit mit horizontalem Anfangs-Koerper ---
((= wahl "Horizontal-VF")
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
(setq kettenanfang (null frame))
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen, reale
;; Restlaenge aus dem tatsaechlichen KS_AUS nachrechnen (siehe
;; vfl-kettenanfang-baustein).
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
;; KEINE pauschale "Umlenk+Motor"-Mindestlaenge mehr hier: der noetige
;; Fussabdruck haengt davon ab, ob gleich eine Motorstation folgt oder
;; weitergebaut wird - genau das fragt vfl-baue-horizontal-koerper
;; ("Ist der Endpunkt der Foerderer?") und rechnet mit dem REAL
;; gemessenen Fussabdruck (siehe vfl-vf-einheit). Hier bleibt nur der
;; Degenerationsschutz wie bei "Neue Linie: GF".
(if (< deltaL 1.0)
(progn
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Horizontal-VF zu kurz (deltaL="
(rtos deltaL 2 0) ")"))))
(progn
;; Eingang haengt vom VORHERIGEN Kettenglied ab (letzter-typ) bzw.
;; am echten Kettenanfang vom KS_AUS-Scan - siehe
;; vfl-eingang-modus-bestimmen (gemeinsam mit "Neue Linie: Ab/Auf
;; VF").
(setq erg (vfl-eingang-modus-bestimmen letzter-typ kettenanfang as-vorhanden p-aktuell))
(setq vf-eingang-lgf (car erg) vf-eingang-modus (cdr erg))
;; Bei einem vollen Neuaufbau des Eingangs (modus=nil, GF1 wird
;; frisch gebaut) wird GF1 nicht pauschal auf *vfl-gf-min-laenge*
;; gesetzt, sondern aus einer abgefragten Zielhoehe berechnet - der
;; Rest bleibt wie bisher horizontal. Bei den anderen Eingangs-Modi
;; ("separator"/"gf"/"keine" - Fortsetzung nach einem Vorglied) wird
;; ohnehin kein neues GF1 gebaut, daher unveraendert.
(if (null vf-eingang-modus)
(progn
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(setq rad3 (* *vfk-gefaelle-winkel* (/ pi 180.0)))
(setq bogen-mass (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*)))
;; Hoehen- bzw. Laengenanteil der FIXEN Elemente (Separator +
;; Umlenkstation + Uebergangsbogen), OHNE GF1 - empirisch
;; bestaetigt: jedes Element traegt Schraeglaenge*sin(3 Grad) an
;; Hoehe bei, der Uebergangsbogen einen festen, winkelunabhaengigen
;; dx/dz-Fussabdruck aus der Bogen-Tabelle.
(setq fest-drop (+ (* *vfk-separator-laenge* (sin rad3))
(* *vfk-stations-laenge* (sin rad3))
(caddr bogen-mass)))
(setq fest-laenge (+ *vfk-separator-laenge* *vfk-stations-laenge* (car bogen-mass)))
(setq eingang-fertig nil)
(while (not eingang-fertig)
(setq eingang-fertig t)
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl
(list (- (caddr p-aktuell) fest-drop))))
(setq hoehe-neu
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-eingang-gf1"
(list (rtos (- (caddr p-aktuell) fest-drop) 2 1)))))
(if (null hoehe-neu) (setq hoehe-neu (- (caddr p-aktuell) fest-drop)))
(setq deltaH (- (caddr p-aktuell) hoehe-neu))
(cond
((<= deltaH 0.0)
(vfl-meldung (ssg-text "vfl-alert-eingang-kann-nicht-steigen"))
(setq vf-eingang-lgf nil))
((< deltaH fest-drop)
(vfl-meldung (ssg-textf "vfl-alert-eingang-hoehe-zu-klein" (list (rtos fest-drop 2 0))))
(setq eingang-fertig nil))
(t
(setq vf-eingang-lgf (/ (- deltaH fest-drop) (sin rad3)))
(if (> (+ vf-eingang-lgf fest-laenge) deltaL)
(progn
(vfl-meldung (ssg-textf "vfl-alert-eingang-hoehe-zu-gross"
(list (rtos (- (caddr p-aktuell) fest-drop
(* (- deltaL fest-laenge) (sin rad3))) 2 0))))
(setq vf-eingang-lgf nil))
)
)
)
)
)
)
;; VF-Einheit mit horizontalem ersten Koerper (winkel=0, L_VF=deltaL) -
;; nur bauen, wenn vf-eingang-lgf gueltig ist (s.o.). Ist es nil (Abbruch
;; wegen unpassender Zielhoehe), wird NICHTS gebaut - die aeussere
;; Schleife zeigt danach automatisch wieder "Naechstes Element waehlen".
(if vf-eingang-lgf
(progn
(if dbg-an
(dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss horizontal (deltaL=" (rtos deltaL 2 0)
" L_GF=" (rtos vf-eingang-lgf 2 0) " L_VF=" (rtos deltaL 2 0)
" eingang-modus=" (if vf-eingang-modus vf-eingang-modus "voll") ")")))
;; GF-Verteilungsfrage entfaellt hier ("2" = alles am Einlauf, kein
;; GF2 fest vorgegeben): L_GF ist nur der strukturelle Mindest-
;; Eingang, das Ausgangs-Ende regelt allein die mit/ohne-
;; Motorstation-Frage (siehe vfl-baue-horizontal-koerper).
(setq vf-einheit-res
(vfl-vf-einheit-abschluss frame hz-neu "Ab" 0 vf-eingang-lgf deltaL nil nil nil "2" vf-eingang-modus
nil nil nil nil))
(setq frame (nth 0 vf-einheit-res))
(setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res)))
(if (nth 2 vf-einheit-res) (setq fertig t))
(if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res)))
(setq letzter-typ "VF")
(setq p-aktuell (car frame))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: Horizontal-VF-Einheit gebaut, neue Position="
(dbg-tostring p-aktuell))))
)
)
)
)
)
;; --- Neue Linie: GF (Nutzer legt den Typ explizit fest) ---
((= wahl "Linie-GF")
(setq kettenanfang (null frame))
(setq gf-max-winkel (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
(setq gf-ok nil sep-vor-gf nil sep-nach-gf nil)
;; NEU: Vorfrage "Wie soll die Laenge bestimmt werden?" - IMMER
;; gezeigt. gf-laenge-modus="2" => Zielhoehe zuerst (Zweig B), "3" =>
;; steigende GF (Sonderfall, Zweig C, KEIN Separator), sonst (Default
;; "1") Endpunkt waehlen (Zweig A, heutiges Verhalten + Separator).
(setq gf-laenge-modus "1")
;; Erzwungener QC-Modus (Linienzug-Modus 4/5 im Typ-Dispatcher
;; c:VarioFoerderer, *vfl-forciere-qc-modus*): Frage komplett
;; ueberspringen, gf-laenge-modus direkt auf den erzwungenen Wert
;; setzen. Flag NACH Verbrauch zuruecksetzen (gilt nur fuer dieses
;; eine, erste Glied).
(if *vfl-forciere-qc-modus*
(progn
(setq gf-laenge-modus *vfl-forciere-qc-modus*)
(setq *vfl-forciere-qc-modus* nil)
)
(progn
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-gf-laenge-modus-impl nil))
(princ (ssg-text "vfl-gf-laenge-modus-header"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-endpunkt"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-hoehe"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-steigend"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-qc"))
(setq gf-laenge-modus (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-gf-laenge-modus-opt-endpunkt")
(ssg-text "vfl-gf-laenge-modus-opt-hoehe")
(ssg-text "vfl-gf-laenge-modus-opt-steigend")
(ssg-text "vfl-gf-laenge-modus-opt-qc")) 1
"vfl-gf-laenge-modus-header"))
)
)
;; Option 4 ("QC Linie mit GF"): eigenstaendiger, vollstaendig
;; berechneter AS->ES-Ablauf (vfl-qc-linie-mit-gf) - baut Kettenende
;; SELBST (setzt fertig direkt), braucht daher NICHT die gemeinsame
;; Kettenende-/ES-Vorfrage und NICHT den Zweig-A/B/C-Abschluss unten
;; (der von einer normal weiterlaufenden GF ausgeht). Nur am echten
;; Kettenanfang sinnvoll (braucht eine eigene AS-Seite) - siehe Gate
;; in vfl-qc-linie-mit-gf. Option 5 ("QC Linie mit GF und U-Form",
;; vfl-qc-linie-mit-gf-uform) funktioniert nach demselben Muster -
;; ebenfalls eigenstaendig, baut Kettenende selbst.
(cond
((= gf-laenge-modus "4") (vfl-qc-linie-mit-gf))
((= gf-laenge-modus "5") (vfl-qc-linie-mit-gf-uform))
(t
(progn
;; NEU: Kettenende/ES JETZT fragen - VOR der Laengen-/Gefaelle-
;; Berechnung -, damit ein gewuenschtes ES-Element (Antwort "1") mit
;; seinem echten Fussabdruck (ein-dx/ein-dz, ueber vf-set-as-masse-
;; Gegenstueck vfl-es-masse-setzen INNERHALB von vfl-frage-es-seite
;; gesetzt) SOFORT von der Ziel-Laenge/-Hoehe abgezogen wird (siehe die
;; drei Zweige unten) - statt es nach dem fertigen Bau nur noch
;; anzuhaengen, wodurch die Kette bisher um genau diesen Fussabdruck
;; ueber den gepickten Punkt/die Zielhoehe hinausschoss. Analog zur
;; Separator VOR/NACH-Reservierung, die schon vorher erfolgt.
;; gf-kettenende-antwort wird im gemeinsamen Abschluss unten
;; wiederverwendet statt die Frage dort ein zweites Mal zu stellen.
;; BEKANNTE RESTUNGENAUIGKEIT (Zweig C, steigend): der Ausgleichsbogen
;; zurueck auf die fallende Basis (vfl-bogen-uebergang im Abschluss,
;; NACH dem Bau dieser GF) hat einen eigenen Fussabdruck, der hier
;; NICHT mitgerechnet wird (analoge Luecke zu vfl-nach-3grad am
;; Kettenende, siehe dortiger Kommentar) - die ein-dx/ein-dz-Reservierung
;; unten ist daher fuer Zweig C eine Naeherung, kein exakter Treffer.
(setq gf-kettenende-antwort (vfl-frage-ist-kettenende))
(setq es-seite nil)
(if (= gf-kettenende-antwort "1")
(setq es-seite (vfl-frage-es-seite nil)))
(cond
((= gf-laenge-modus "3")
;; --- Zweig C: Steigende GF (Sonderfall, bis gf-max-winkel Grad) ---
;; Eigenstaendig: KEIN Separator (gilt nur fuer die normale
;; fallende GF). Innerhalb dieses Zweigs nochmal dieselbe Wahl
;; (Endpunkt vs. Zielhoehe), mit Ziel-Richtung "Auf" statt "Ab".
;; Der noetige Uebergangsbogen (falls die Vorgaenger-Neigung nicht
;; schon zur steigenden Basis passt) wird zentral im gemeinsamen
;; Abschluss unten ueber vfl-bogen-uebergang eingefuegt.
(princ (ssg-text "vfl-gf-laenge-modus-header"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-endpunkt"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-hoehe"))
(if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-gf-steigend-untermodus-impl nil))
(setq gf-steigend-modus (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-gf-laenge-modus-opt-endpunkt")
(ssg-text "vfl-gf-laenge-modus-opt-hoehe")) 1
"vfl-gf-laenge-modus-header"))
(if (= gf-steigend-modus "2")
(progn
;; --- Zweig C2: Zielhoehe zuerst (steigend) ---
(if kettenanfang
(progn
(setq hz-neu (vfl-in-richtung p-aktuell (ssg-text "vfl-prompt-richtung-waehlen")))
(if (null hz-neu) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu 1.0e9 as-seite as-vorhanden))
(setq frame (nth 0 erg) p-aktuell (car frame))
)
(setq hz-neu (car (frame->hz-winkel frame)))
)
(setq gf-ok t)
(setq hoehe-neu
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt"
(list (rtos (caddr p-aktuell) 2 1)))))
(if (null hoehe-neu) (setq hoehe-neu (caddr p-aktuell)))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
;; ES-Fussabdruck (Hoehen-Anteil) VORAB reservieren, siehe
;; Kommentar bei gf-kettenende-antwort oben.
(if (= gf-kettenende-antwort "1")
(setq deltaH (max 0.0 (- deltaH (abs ein-dz)))))
(if (< deltaH 0.0)
(progn
(vfl-meldung (ssg-text "vfl-alert-gf-steigend-falsche-richtung"))
(setq gf-ok nil))
(progn
(setq winkel
(vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel-steigend" (list (rtos gf-max-winkel 2 1)))))
(if (null winkel) (setq winkel gf-max-winkel))
(if (or (< winkel 0.0) (> winkel gf-max-winkel))
(progn
(vfl-meldung (ssg-textf "vfl-alert-winkel-ungueltig-steigend"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
(if (and (< winkel 1.0e-6) (> deltaH 1.0e-6))
(progn
(vfl-meldung (ssg-textf "vfl-alert-winkel-ungueltig-steigend"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
(progn
(setq deltaL
(if (< winkel 1.0e-6) 0.0
(/ deltaH (/ (sin (* winkel (/ pi 180.0))) (cos (* winkel (/ pi 180.0)))))))
(if (< deltaL 1.0)
(progn (princ (ssg-text "vfl-fehler-linie-zu-kurz")) (setq gf-ok nil)))
(setq winkel (- winkel))
)
)
)
)
)
)
(progn
;; --- Zweig C1: Endpunkt waehlen (steigend) ---
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
(if (< deltaL 1.0)
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
;; ES-Fussabdruck VORAB reservieren, siehe Kommentar bei
;; gf-kettenende-antwort oben.
(if (= gf-kettenende-antwort "1")
(setq deltaL (- deltaL (abs ein-dx))))
(if (< deltaL 1.0)
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
(setq gf-ok t)
(setq winkel
(vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel-steigend" (list (rtos gf-max-winkel 2 1)))))
(if (null winkel) (setq winkel gf-max-winkel))
(if (or (< winkel 0.0) (> winkel gf-max-winkel))
(progn
(vfl-meldung (ssg-textf "vfl-alert-winkel-ungueltig-steigend"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
(setq winkel (- winkel))
)
)
)
)
)
)
)
)
((= gf-laenge-modus "2")
;; --- Zweig B: Zielhoehe zuerst festlegen, Laenge wird berechnet ---
(if kettenanfang
(progn
(setq hz-neu (vfl-in-richtung p-aktuell (ssg-text "vfl-prompt-richtung-waehlen")))
(if (null hz-neu) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu 1.0e9 as-seite as-vorhanden))
(setq frame (nth 0 erg) p-aktuell (car frame))
)
(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))
(princ (ssg-text "vfl-sep-vor-gf-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-vor-gf (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-sep-vor-gf-frage") "1"))
(princ (ssg-text "vfl-sep-nach-gf-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-nach-gf (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-sep-nach-gf-frage") "1"))
;; ES-Element (vfl-insert-es-element) bringt seinen eigenen
;; Separator VOR dem ES-Block schon mit - ein zusaetzlicher
;; Separator NACH waere ein zweiter, direkt anschliessender
;; Separator (real beobachteter Bug). gf-kettenende-antwort steht
;; schon vor dieser Frage fest (siehe oben).
(if (and sep-nach-gf (= gf-kettenende-antwort "1"))
(progn
(vfl-meldung (ssg-text "vfl-sep-nach-durch-es-ueberschrieben"))
(setq sep-nach-gf nil)))
(setq sep-anzahl (+ (if sep-vor-gf 1 0) (if sep-nach-gf 1 0)))
(setq gf-ok t)
(setq hoehe-neu
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt"
(list (rtos (vfl-gf-hoehe-vorschlag (caddr p-aktuell)) 2 1)))))
(if (null hoehe-neu) (setq hoehe-neu (vfl-gf-hoehe-vorschlag (caddr p-aktuell))))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
(setq deltaH (abs deltaH))
(if (= richtung "Auf")
(progn
(vfl-meldung (ssg-text "vfl-alert-gf-kann-nicht-steigen"))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-GF (Zielhoehe zuerst) kann nicht steigen"
" (deltaH=" (rtos deltaH 2 0) ")")))
(setq gf-ok nil))
(progn
(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.
(if (= gf-kettenende-antwort "1")
(setq deltaH (max 0.0 (- deltaH (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)))
(princ (ssg-text "vfl-gefaelle-festlegen-header"))
(setq winkel
(vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel-laenge-berechnet" (list (rtos gf-max-winkel 2 1)))))
(if (null winkel) (setq winkel gf-max-winkel))
(if (or (<= winkel 0.0) (> winkel gf-max-winkel))
(progn
(vfl-meldung (ssg-textf "vfl-alert-winkel-ungueltig"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
(progn
(setq deltaL (/ deltaH (/ (sin (* winkel (/ pi 180.0))) (cos (* winkel (/ pi 180.0))))))
(if (< deltaL 1.0)
(progn (princ (ssg-text "vfl-fehler-linie-zu-kurz")) (setq gf-ok nil)))
)
)
)
)
)
(t
;; --- Zweig A: Endpunkt waehlen (heutiges Verhalten + Separator) ---
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
(if (< deltaL 1.0)
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
;; (Richtung hz-neu jetzt bekannt) und die GF-Restlaenge aus dem
;; TATSAECHLICHEN KS_AUS nachrechnen (siehe vfl-kettenanfang-
;; baustein). Keine Fussabdruck-Schaetzung mehr: sowohl KS_EIN-
;; als auch Ursprung-basierte Vorab-Messung ignorieren die
;; Drehteller-Rotation, die insert-block-mixed-to-ks beim
;; echten Einfuegen anwendet, und liefern daher einen falschen
;; Wert (empirisch bestaetigt: ~210mm Schaetzung vs.
;; tatsaechlich ~420mm noetiger Versatz).
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
;; Nach dem AS-Einfuegen kann die reale Restlaenge (aus dem
;; tatsaechlichen KS_AUS neu gemessen) kleiner als der
;; urspruenglich gepickte Rohwert sein - bei einem knapp
;; gepickten Punkt sogar NEGATIV. Sofortiger Abbruch DIESES
;; Zweigs (kein Weiterfragen fuer ein Segment, das ohnehin
;; nicht gebaut werden kann).
(if (< deltaL 1.0)
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
(setq gf-ok t)
;; Separator VOR/NACH JETZT fragen, BEVOR Hoehe/Winkel
;; berechnet wird - gueltige Trennstellen GF-GF bzw.
;; GF-Umlenkstation. Beide Laengen (genaehert mit dem
;; Referenzwinkel gf-max-winkel, der tatsaechliche
;; GF-Winkel steht erst danach fest) werden SOFORT vom
;; 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))
(princ (ssg-text "vfl-sep-vor-gf-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-vor-gf (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-sep-vor-gf-frage") "1"))
(princ (ssg-text "vfl-sep-nach-gf-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-nach-gf (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-sep-nach-gf-frage") "1"))
;; ES-Element bringt seinen eigenen Separator VOR dem
;; ES-Block schon mit - siehe Kommentar im Zweig B oben.
(if (and sep-nach-gf (= gf-kettenende-antwort "1"))
(progn
(vfl-meldung (ssg-text "vfl-sep-nach-durch-es-ueberschrieben"))
(setq sep-nach-gf nil)))
(setq sep-anzahl (+ (if sep-vor-gf 1 0) (if sep-nach-gf 1 0)))
(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.
(if (= gf-kettenende-antwort "1")
(setq deltaL (- deltaL (abs ein-dx))))
(if (< deltaL 1.0)
(progn (princ (ssg-text "vfl-fehler-linie-zu-kurz")) (setq gf-ok nil)))
(if gf-ok
(progn
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-gefaelle-impl
(list (vfl-gf-hoehe-vorschlag (caddr p-aktuell)) nil t)))
(princ (ssg-text "vfl-gefaelle-festlegen-header"))
(princ (ssg-text "vfl-gefaelle-opt-hoehe"))
(princ (ssg-text "vfl-gefaelle-opt-winkel"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-gefaelle-opt-hoehe")
(ssg-text "vfl-gefaelle-opt-winkel")) 2
"vfl-gefaelle-festlegen-header"))
(if (= antwort "2")
(progn
;; Winkel direkt vorgeben - deltaH ergibt sich aus
;; deltaL*tan(winkel). deltaL ist hier schon um
;; Separator VOR/NACH reduziert.
(setq winkel
(vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel" (list (rtos gf-max-winkel 2 1)))))
(if (null winkel) (setq winkel gf-max-winkel))
(if (or (<= winkel 0.0) (> winkel gf-max-winkel))
(progn
(vfl-meldung (ssg-textf "vfl-alert-winkel-ungueltig"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
(progn
(setq richtung "Ab")
(setq deltaH (* deltaL (/ (sin (* winkel (/ pi 180.0)))
(cos (* winkel (/ pi 180.0))))))
)
)
)
(progn
;; Gegebene Hoehe - Winkel wird daraus abgeleitet
;; und gegen den GF-Maximalwinkel geprueft.
(setq hoehe-neu
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt"
(list (rtos (vfl-gf-hoehe-vorschlag (caddr p-aktuell)) 2 1)))))
(if (null hoehe-neu) (setq hoehe-neu (vfl-gf-hoehe-vorschlag (caddr p-aktuell))))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
(setq deltaH (abs deltaH))
(vfl-echo-endpunkt-hoehe p-aktuell deltaL hz-neu hoehe-neu deltaH richtung)
(if (> sep-anzahl 0)
(setq deltaH (max 0.0 (- deltaH (* sep-anzahl *vfk-separator-laenge* (sin rad3))))))
(cond
((= richtung "Auf")
(vfl-meldung (ssg-text "vfl-alert-gf-kann-nicht-steigen"))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-GF kann nicht steigen"
" (deltaL=" (rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0) ")")))
(setq gf-ok nil))
(t
(setq winkel (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
(if (> winkel gf-max-winkel)
(progn
(vfl-meldung (ssg-textf "vfl-alert-gefaelle-zu-steil"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-GF zu steil (deltaL="
(rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0)
" winkel=" (rtos winkel 2 1) " max=" (rtos gf-max-winkel 2 1) ")")))
(setq gf-ok nil))
)
)
)
)
)
)
)
)
)
)
)
)
)
;; --- Gemeinsamer Abschluss fuer ALLE drei Zweige ---
(if gf-ok
(progn
;; Uebergangsbogen(n) IMMER pruefen (vfl-gf-bogen-uebergang ist ein
;; No-Op, wenn die aktuelle Frame-Neigung schon zur Ziel-Neigung
;; passt - eigene Pruefung intern via t0=basis-ziel). Frueher nur
;; fuer den Steigend-Sonderfall (winkel<0) und "Vorgaenger war
;; steigend" ausgeloest - das uebersah reale Faelle wie flach->
;; fallend (z.B. nach einem horizontalen GF-Stueck) und fallend->
;; flach (z.B. vor einem horizontalen GF-Stueck), die genauso einen
;; Bogen brauchen (Nutzer-Befund 2026-09-12: fehlende 3-Grad-Boegen
;; zwischen Separator/fallender GF und einer horizontalen GF).
(progn
(setq erg-bogen (vfl-gf-bogen-uebergang frame winkel))
(setq frame (car erg-bogen))
(setq deltaL (- deltaL (cadr erg-bogen)))
(if (< deltaL 1.0)
(progn (princ (ssg-text "vfl-fehler-linie-zu-kurz")) (setq gf-ok nil)))
)
(if gf-ok
(progn
;; Separator VOR (Antwort aus der Vorab-Frage oben) - VOR
;; dem GF-Segment selbst einfuegen, am GF-Winkel.
(if sep-vor-gf
(progn
(setq frame (make-frame-from-dir
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car frame) hz-neu winkel *vfk-separator-laenge* 0)
(hz-winkel->xu hz-neu winkel)))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
)
)
(if dbg-an
(dbgmsg (strcat "GEOMETRIE: vfl-insert-gf-segment (deltaL=" (rtos deltaL 2 0)
" hz=" (rtos hz-neu 2 1) " winkel=" (rtos winkel 2 1) ")")))
(setq frame (vfl-insert-gf-segment (car frame) hz-neu deltaL winkel))
(setq anzahl-gf (1+ anzahl-gf))
(vfl-acc-gf-seg (/ deltaL (cos (* (float winkel) (/ pi 180.0)))) winkel)
(setq letzter-typ "GF")
(setq p-aktuell (car frame))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: GF-Segment gebaut, neue Position="
(dbg-tostring p-aktuell))))
;; Separator NACH (Antwort aus der Vorab-Frage oben) - DIREKT
;; nach dem GF-Segment einfuegen, noch VOR der Kettenende-
;; Frage.
(if sep-nach-gf
(progn
(setq frame (make-frame-from-dir
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car frame) hz-neu winkel *vfk-separator-laenge* 0)
(hz-winkel->xu hz-neu winkel)))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
(setq letzter-typ "Separator")
(setq p-aktuell (car frame))
)
)
;; Kettenende/ES: BEREITS vor der Laengen-/Gefaelle-Berechnung
;; erfragt (gf-kettenende-antwort/es-seite oben) - hier NICHT
;; nochmal fragen (waere doppelt journalisiert und ein-dx/
;; ein-dz wurden dort schon fuer die Reservierung genutzt).
(cond
((= gf-kettenende-antwort "1")
;; ES-Element-Hardware gibt es nur fuer die Anfahrt auf der
;; STANDARD Fallend-Basis (+gefaelle-winkel) - kommt die
;; Kette hier steigend ODER FLACH an (z.B. Zweig C mit
;; winkel=0), fehlt sonst der Uebergangsbogen und das
;; ES-Element wuerde in der falschen Orientierung
;; angehaengt. IMMER pruefen (nicht nur bei winkel<0) -
;; vfl-gf-bogen-uebergang ist bei einer bereits fallenden
;; Ankunft ein No-Op (Nutzer-Befund 2026-09-12: horizontal
;; vor ES fehlte der 3-Grad-Bogen).
(setq erg-bogen (vfl-gf-bogen-uebergang frame *vfk-gefaelle-winkel*))
(setq frame (car erg-bogen))
(setq winkel *vfk-gefaelle-winkel*)
(setq frame (vfl-insert-es-element "GF" frame hz-neu winkel
(caddr (car frame)) es-seite))
(setq fertig t))
((= gf-kettenende-antwort "2") (setq fertig t))
)
)
)
)
)
) ;; Ende (progn ...) Zweig A/B/C (gf-laenge-modus <> "4"/"5")
) ;; Ende (t ...)
) ;; Ende (cond (gf-laenge-modus "4"/"5"/sonst) ...)
)
;; --- Neue Linie: Ab/Auf VF (Nutzer legt den Typ explizit fest) ---
((= wahl "Linie-VF")
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
(setq kettenanfang (null frame))
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen, reale
;; Restlaenge aus dem tatsaechlichen KS_AUS nachrechnen (siehe
;; vfl-kettenanfang-baustein).
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
(if (< deltaL *vfk-vf-mindestlaenge*)
(princ (ssg-text "vfl-fehler-vf-kurz"))
(progn
;; Eingang haengt vom VORHERIGEN Kettenglied ab (letzter-typ) bzw.
;; am echten Kettenanfang vom KS_AUS-Scan - siehe
;; vfl-eingang-modus-bestimmen (gemeinsam mit "Neue VF mit
;; horizontalem Anfang").
(setq erg (vfl-eingang-modus-bestimmen letzter-typ kettenanfang as-vorhanden p-aktuell))
(setq L_GF (car erg) vf-eingang-modus (cdr erg))
(if vf-eingang-modus
;; Reduzierter Eingang (Separator/GF/keine): L_GF ist danach immer
;; 0.0 (vfl-vf-einheit zerlegt L_GF-eff sowieso auf 0.0) - keine
;; frei waehlbare GF-Laenge mehr, mit der ein 2-Unbekannten-Solve
;; (vfl-vf-entscheidung) eine beliebige Zielhoehe treffen koennte.
;; Daher direkt Richtung+Winkel/Hoehen-Tabelle statt Zielhoehe-
;; Abfrage (siehe vfl-eingang-modus-bestimmen).
(progn
(princ (ssg-text "vfl-frage-auf-ab-richtung"))
(princ (ssg-text "vfl-opt-richtung-auf"))
(princ (ssg-text "vfl-opt-richtung-ab"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-richtung-impl
(list (ssg-text "vfl-frage-auf-ab-richtung"))))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-opt-richtung-auf")
(ssg-text "vfl-opt-richtung-ab")) 1
"vfl-frage-auf-ab-richtung"))
(setq richtung (if (= antwort "2") "Ab" "Auf"))
;; Anders als bei "keine" (Vario-Kurve, dort wird NICHTS gebaut)
;; wird bei "gf"/"separator" tatsaechlich noch Separator+
;; Umlenkstation (bzw. nur Umlenkstation) eingefuegt, BEVOR der
;; Kletter-Koerper beginnt - das verbraucht reale Laenge/Hoehe
;; (beide auf 3-Grad-Basis), die hier VOR dem Tabellen-Aufruf
;; abgezogen werden muss, sonst waere die Tabelle zu optimistisch.
(setq eingang-laenge
(cond
((equal vf-eingang-modus "gf") (+ *vfk-separator-laenge* *vfk-stations-laenge*))
((equal vf-eingang-modus "separator") *vfk-stations-laenge*)
(t 0.0)))
(setq winkel-hoehen-erg
(vfl-waehle-winkel-hoehen-tabelle
(- deltaL (* eingang-laenge (cos (* *vfk-gefaelle-winkel* (/ pi 180.0)))))
richtung
(- (caddr p-aktuell) (* eingang-laenge (sin (* *vfk-gefaelle-winkel* (/ pi 180.0)))))))
(if (null winkel-hoehen-erg)
(princ (ssg-text "vfl-linie-zu-kurz-simple"))
(progn
(setq winkel (nth 0 winkel-hoehen-erg) L_VF (nth 2 winkel-hoehen-erg))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss reduzierter Eingang (deltaL="
(rtos deltaL 2 0) " richtung=" richtung
" winkel=" (rtos (float winkel) 2 1)
" L_VF=" (rtos L_VF 2 0)
" eingang-modus=" vf-eingang-modus ")")))
(setq vf-einheit-res
(vfl-vf-einheit-abschluss frame hz-neu richtung winkel L_GF L_VF nil nil nil "2" vf-eingang-modus
nil nil nil nil))
(setq frame (nth 0 vf-einheit-res))
(setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res)))
(if (nth 2 vf-einheit-res) (setq fertig t))
(if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res)))
(setq letzter-typ "VF")
(setq p-aktuell (car frame))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: VF-Einheit reduzierter Eingang gebaut, neue Position="
(dbg-tostring p-aktuell))))
)
)
)
(progn
;; Erst fragen, ob DIESER Endpunkt schon das Kettenende ist (+
;; falls ja: ES-Element setzen), DANN erst Zielhoehe/Winkel
;; berechnen - analog zu vfl-baue-horizontal-koerper (horizontaler
;; Erstkoerper). Vorher wurde die Frage erst NACH dem Bau des
;; ersten (Winkel-)Segments gestellt (in der Fortsetzungsschleife
;; von vfl-vf-einheit) - dann war ein evtl. noetiger ES-
;; Fussabdruck (Motorstation+Separator+ES) beim Winkel-Solve noch
;; nicht reserviert, der gewaehlte Winkel konnte zu viel Strecke
;; verbrauchen und der zwingend zweite, separate Endpunkt-Pick
;; fuer den "Schwanz" schlug dann mangels Reststrecke fehl (Nutzer-
;; Ruecksprache). ein-dx/ein-dz (ES-Fussabdruck) wirken bereits
;; automatisch in vfl-vf-hoehe-vorschlaege/vfl-vf-entscheidung
;; (ueber vfl-winkel-machbar-p) - hier muss nur die Reihenfolge
;; stimmen.
(setq vorab-antwort (vfl-frage-ist-endpunkt))
(setq vorab-es-gewuenscht nil vorab-es-seite nil
save-eindx-vorab nil save-eindz-vorab nil)
(setq sep-eindx-add 0.0 sep-eindz-add 0.0)
(if (= vorab-antwort "3")
(progn
(setq erg-es (vfl-es-element-abfragen))
(setq vorab-es-gewuenscht (nth 0 erg-es) vorab-es-seite (nth 1 erg-es)
save-eindx-vorab (nth 2 erg-es) save-eindz-vorab (nth 3 erg-es))
;; vfl-insert-es-element baut IMMER einen eigenen Separator
;; (300mm, 3 Grad) VOR dem ES-Block - das ist NICHT Teil des
;; ueber vf-set-es-masse gemessenen ein-dx/ein-dz (die messen
;; nur den ES-Block selbst, siehe Bibliotheks-Init-Log
;; "ES_90: dx=436 dz=-65"). Fuer den Solve zusaetzlich
;; reservieren, sonst fehlt genau dieser Fussabdruck im
;; Ergebnis - real gemessener Bug (BricsCAD-Test): dX=-299.6mm
;; dZ=-15.7mm, exakt der Separator-Fussabdruck bei 3 Grad
;; (300*cos3=299.6, 300*sin3=15.7). Nach dem Solve/Bau wieder
;; abgezogen (siehe Restaurierung unten), damit ein-dx/ein-dz
;; danach wieder den reinen ES-Block-Fussabdruck zeigen.
(if vorab-es-gewuenscht
(progn
(setq rad3-sep (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
(setq sep-eindx-add (* *vfk-separator-laenge* (cos rad3-sep))
sep-eindz-add (* *vfk-separator-laenge* (sin rad3-sep)))
(setq ein-dx (+ ein-dx sep-eindx-add)
ein-dz (- ein-dz sep-eindz-add))))))
(setq hoehe-vorschlaege (vfl-vf-hoehe-vorschlaege (caddr p-aktuell) deltaL))
(setq hoehe-ab (nth 0 hoehe-vorschlaege) hoehe-auf (nth 1 hoehe-vorschlaege))
(setq hoehe-neu (vfl-hoehe-endpunkt-abfragen hoehe-ab hoehe-auf (caddr p-aktuell) "linienendpunkt"))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
(setq deltaH (abs deltaH))
(vfl-echo-endpunkt-hoehe p-aktuell deltaL hz-neu hoehe-neu deltaH richtung)
;; Absoluter Zielpunkt dieses (einzigen) Picks - nur bei "3"
;; gebraucht: wird bis nach vfl-vf-einheit durchgereicht, damit
;; vfl-body-abschluss NICHT nochmal denselben Punkt abfragt
;; (siehe vfl-vf-einheit/vfl-body-abschluss, vorab-ziel-punkt).
(setq vorab-ziel-punkt
(if (= vorab-antwort "3")
(list (+ (car p-aktuell) (* deltaL (cos (* (float hz-neu) (/ pi 180.0)))))
(+ (cadr p-aktuell) (* deltaL (sin (* (float hz-neu) (/ pi 180.0)))))
hoehe-neu)
nil))
;; Nutzer-Entscheidung (2026-09-15): der Hauptstrang (GF1/Klettern/
;; GF2/Motorstation) behaelt IMMER die urspruenglich gepickte
;; Fahrtrichtung (hz-neu/deltaL bleiben unveraendert) - KEINE
;; Vorab-Drehung mehr, um den seitlichen ES-Versatz (ein-dy)
;; auszugleichen. Ein drehendes ES-Element (30/90 Grad) landet
;; dadurch mit einem natuerlichen, unvermeidbaren seitlichen
;; Versatz neben dem urspruenglich gepickten Punkt - das ist
;; erwartetes Verhalten (Prinzip: Hauptstrang bleibt gerade, ES
;; faellt "natuerlich" dorthin, wohin sein eigener Fussabdruck
;; fuehrt), keine zu behebende Abweichung. ein-dx/ein-dz (Laengs/
;; Hoehe) werden weiterhin ganz normal ueber vfl-winkel-machbar-p
;; reserviert (siehe vfl-vf-entscheidung).
(setq entscheidung (vfl-vf-entscheidung deltaL deltaH richtung))
(setq typ (nth 0 entscheidung) winkel (nth 1 entscheidung)
L_GF (nth 2 entscheidung) L_VF (nth 3 entscheidung)
lhor (nth 4 entscheidung) stufe3-position (nth 5 entscheidung))
(if (null typ)
(progn
(vfl-meldung (ssg-textf "vfl-alert-vf-nicht-baubar"
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
;; Gesammelte Stufe-2-Diagnose (falls versucht) + kompaktes
;; 2-Punkte-Alert mit Mindestwerten - analog vfl-body-abschluss.
(if *vfl-stufe2-diagnose-text* (princ *vfl-stufe2-diagnose-text*))
(vfl-meldung
(strcat
(ssg-textf "vfl-alert-vf-entscheidung-p1" (list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung))
(cond
((and *vfl-stufe2-minl-vorschlag* *vfl-stufe2-minh-vorschlag*)
(ssg-textf "vfl-alert-vf-entscheidung-p2-beide"
(list (rtos *vfl-stufe2-minl-vorschlag* 2 0) (rtos *vfl-stufe2-minh-vorschlag* 2 0))))
(*vfl-stufe2-minh-vorschlag*
(ssg-textf "vfl-alert-vf-entscheidung-p2-nur-minh" (list (rtos *vfl-stufe2-minh-vorschlag* 2 0))))
(*vfl-stufe2-minl-vorschlag*
(ssg-textf "vfl-alert-vf-entscheidung-p2-nur-minl" (list (rtos *vfl-stufe2-minl-vorschlag* 2 0))))
(t ""))))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-VF nicht baubar (deltaL="
(rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0)
" richtung=" richtung ")"))))
(progn
(if dbg-an
(dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss (deltaL=" (rtos deltaL 2 0)
" deltaH=" (rtos deltaH 2 0) " richtung=" richtung
" winkel=" (rtos (float winkel) 2 1)
" L_GF=" (rtos L_GF 2 0) " L_VF=" (rtos L_VF 2 0) ")")))
(setq vf-einheit-res
(vfl-vf-einheit-abschluss frame hz-neu richtung winkel L_GF L_VF lhor stufe3-position nil nil nil
vorab-antwort vorab-es-gewuenscht vorab-es-seite
vorab-ziel-punkt))
(setq frame (nth 0 vf-einheit-res))
(setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res)))
(if (nth 2 vf-einheit-res) (setq fertig t))
(if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res)))
(setq letzter-typ "VF")
(setq p-aktuell (car frame))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: VF-Einheit gebaut, neue Position="
(dbg-tostring p-aktuell))))
)
)
;; ein-dx/ein-dz (ES-Fussabdruck) nach diesem gesamten Aufruf
;; wiederherstellen - sowohl im Erfolgs- als auch im "nicht
;; baubar"-Fehlerfall, sonst wuerde eine genullte/aufaddierte
;; ES-Groesse in eine spaetere, unabhaengige ES-Entscheidung an
;; anderer Stelle in dieser Kette durchsickern: bei "ES nein" auf
;; den Zustand VOR der Frage zuruecksetzen, bei "ES ja" die oben
;; addierte Separator-Reservierung wieder abziehen (ein-dx/ein-dz
;; zeigen danach wieder den reinen ES-Block-Fussabdruck).
(if (= vorab-antwort "3")
(if vorab-es-gewuenscht
(setq ein-dx (- ein-dx sep-eindx-add) ein-dz (+ ein-dz sep-eindz-add))
(setq ein-dx save-eindx-vorab ein-dz save-eindz-vorab)))
)
)
)
)
)
((= wahl "Linie") ;; --- Neue Linie BIS Kettenende ---
;; GF/VF-Entscheidung: wird der Startpunkt eindeutig einer bestehenden
;; VF- oder GF-Kette zugeordnet (linie-ende-familie), entscheidet DAS
;; die Bau-Logik - nur wenn nicht eindeutig, greift die automatische
;; Machbarkeits-Entscheidung (vfl-segment-entscheidung).
(setq kettenanfang (null frame))
;; Startpunkt-Typ erkennen: bei einer laufenden Fortsetzung ist der
;; Vorgaengertyp schon bekannt (letzter-typ); am echten Kettenanfang
;; OHNE AS-Element wird wie bei vfl-eingang-modus-bestimmen per
;; KS_AUS-Scan erkannt (Rueckgabe (hz . typ) - typ wird bei VF-Familie
;; unten fuer die Flach/3-Grad-Unterscheidung gebraucht). Steht schon
;; ein AS-Element (as-vorhanden), ist der Anfang per Definition
;; neutral/nicht zuordenbar.
(setq erg (if (and kettenanfang (not as-vorhanden))
(vfl-ks-aus-hz-an-punkt p-aktuell)
nil))
(setq linie-ende-familie
(if kettenanfang
(if erg (vfl-kette-typ-familie (cdr erg)) nil)
(vfl-letzter-typ-familie letzter-typ)))
(cond
;; --- Startpunkt als VF-Familie erkannt: KEINE eigene Umlenkstation
;; noetig (Vorgaenger Vario-Kurve/Umlenk/Motor/Bogen bzw. laufende
;; VF-Fortsetzung). Strukturell IDENTISCH zu "Option 3: Kettenende
;; exakt am Zielpunkt" INNERHALB einer laufenden VF-Einheit
;; (vfl-vf-einheit): derselbe Stufe-1/Stufe-2-Diagnose-Baustein
;; (vfl-body-abschluss, Budget OHNE Umlenkstation -
;; *vfk-feste-horizontal-kettenende*) + Motorstation/GF2
;; (vfl-vf-ausgang-bauen) + ES-Element - KEIN Rueckfall auf eine
;; reine Winkeltabelle noetig (anders als bei "Neue Linie: Ab/Auf
;; VF" mit reduziertem Eingang): hier gibt es keinen GF1-Stumpf,
;; dessen Wegfall die 2-Unbekannten-Loesung stoeren wuerde - die
;; volle Freiheit (Winkel + GF2) bleibt erhalten, exakte Zielhoehe
;; ist also weiterhin moeglich.
((equal linie-ende-familie "VF")
(if kettenanfang
;; Kettenanfang auf einer bestehenden VF-Kette: Frame
;; konstruieren (Vario-Kurve endet flach, alle anderen VF-Typen
;; auf der 3-Grad-Basis) - der eigentliche Endpunkt-Pick erfolgt
;; gleich INNERHALB von vfl-body-abschluss.
(setq frame (make-frame-from-dir p-aktuell
(hz-winkel->xu (car erg)
(if (equal (cdr erg) "KURVE") 0.0 *vfk-gefaelle-winkel*)))))
;; ES-Element hier gewuenscht (+ falls ja: Winkel/Seite) - wie bei
;; "Option 3" (vfl-vf-einheit) VOR vfl-body-abschluss erfragt, weil
;; der tatsaechliche ES-Fussabdruck (ein-dx/ein-dz) die
;; Streckenzerlegung beeinflusst.
(princ (ssg-text "vfl-es-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-es-nein-zielpunkt"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-es-setzen-frage")))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-es-nein-zielpunkt")) 1
"vfl-es-setzen-frage"))
(setq es-gewuenscht (/= antwort "2"))
(if es-gewuenscht
(setq es-seite (vfl-frage-es-seite t))
(progn (setq save-eindx ein-dx save-eindz ein-dz) (setq ein-dx 0.0 ein-dz 0.0)))
(setq res3 (vfl-body-abschluss frame (car (frame->hz-winkel frame)) (car frame) es-gewuenscht nil))
(if (not es-gewuenscht) (setq ein-dx save-eindx ein-dz save-eindz))
(if (null res3)
(if dbg-an
(dbgmsg "GEOMETRIE FEHLGESCHLAGEN: Linie (VF-Familie, Kettenende) nicht baubar"))
(progn
(setq anzahl-vf (+ anzahl-vf (nth 1 res3)))
(setq frame (vfl-vf-ausgang-bauen (nth 0 res3) (nth 2 res3) (nth 3 res3)))
(if es-gewuenscht
(setq frame (vfl-insert-es-element "VF" frame (car (frame->hz-winkel frame)) 0.0
(caddr (car frame)) es-seite)))
(vfl-ziel-report frame)
(setq letzter-typ "VF" p-aktuell (car frame) fertig t)
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: Linie (VF-Familie, Kettenende) gebaut, neue Position="
(dbg-tostring p-aktuell))))
)
)
)
;; --- Startpunkt als GF-Familie erkannt ODER nicht eindeutig ---
(t
;; Fahrtrichtung folgt dem vorherigen Element (Frame); nur das
;; erste Segment (frame=nil) definiert die Richtung frei.
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
(if (< deltaL 1.0)
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
;; (immer flach, typ-unabhaengig - siehe vfl-insert-as-element;
;; welcher Segmenttyp folgt, steht hier noch nicht fest), reale
;; Restlaenge aus dem tatsaechlichen KS_AUS nachrechnen (siehe
;; vfl-kettenanfang-baustein).
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
;; Nach dem AS-Einfuegen kann die reale Restlaenge (aus dem
;; tatsaechlichen KS_AUS neu gemessen) kleiner als der urspruenglich
;; gepickte Rohwert sein - bei einem knapp gepickten Punkt sogar
;; NEGATIV. Ohne diese zweite Pruefung wuerde die Kurzsegment-
;; Automatik unten (< 1000mm) mit negativem deltaL trotzdem ein
;; "erfolgreiches" GF-Segment bauen (entartete/unsichtbare Strecke,
;; das naechste Element - z.B. ein GF-Bogen - erscheint dann direkt
;; am AS-Element, obwohl der Nutzer davor noch eine Linie wollte).
(if (< deltaL 1.0)
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
;; Segment-Typ bestimmen. Kurzsegment (deltaL < 1000 mm): KEINE
;; Hoehenabfrage - automatisch 3-Grad-Gefaellestrecke. Grund: ein VF
;; braucht >= 1000 mm deltaL (Umlenk- + Motorstation = 500+500 mm),
;; und eine GF ist mindestens 3 Grad geneigt. Die Endhoehe ergibt
;; sich damit fest aus deltaH = deltaL*tan(3 Grad).
;; Im Kettenende-Modus (Option 4) wird IMMER nach der Zielhoehe
;; gefragt (Kurzsegment-Automatik hier ueberspringen).
(if (and (< deltaL *vfk-vf-mindestlaenge*) (not linie-ende-modus))
(progn
(setq typ "GF" winkel *vfk-gefaelle-winkel* richtung "Ab" L_GF nil L_VF nil)
(setq deltaH (* deltaL (/ (sin (* *vfk-gefaelle-winkel* (/ pi 180.0)))
(cos (* *vfk-gefaelle-winkel* (/ pi 180.0))))))
(setq hoehe-neu (- (caddr p-aktuell) deltaH))
(princ (ssg-textf "vfl-info-kurzes-segment"
(list (rtos deltaL 2 0) (rtos deltaH 2 1))))
)
(progn
(setq hoehe-vorschlaege (vfl-segment-hoehe-vorschlaege (caddr p-aktuell) deltaL))
(setq hoehe-ab (nth 0 hoehe-vorschlaege) hoehe-auf (nth 1 hoehe-vorschlaege))
(setq hoehe-neu (vfl-hoehe-endpunkt-abfragen hoehe-ab hoehe-auf (caddr p-aktuell) "linienendpunkt"))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
(setq deltaH (abs deltaH))
(vfl-echo-endpunkt-hoehe p-aktuell deltaL hz-neu hoehe-neu deltaH richtung)
;; Kettenende-Modus (Option 6, "Neue Linie BIS Kettenende"):
;; ES-Element wird HIER IMMER gebaut (das verspricht schon
;; der Menuetext) - Winkel/Seite deshalb JETZT erfragen
;; (vfl-frage-es-seite, setzt ein-dx/ein-dz via
;; vf-set-es-masse), BEVOR die Fussabdruck-Reservierung
;; unten laeuft - vorher liefen beide mit veralteten/
;; zufaelligen ein-dx/ein-dz (die echte Frage kam bisher
;; erst spaeter, redundant, INNERHALB von vfl-vf-einheit -
;; Nutzer-Ruecksprache: derselbe Fehler wie bei "Neue
;; Linie: Ab/Auf VF", hier nur eine Stufe frueher versteckt).
;; vorab-ziel-punkt (der bereits gepickte Zielpunkt) wird bis
;; zu vfl-vf-einheit durchgereicht, damit fuer den "Auf"-Fall
;; (VF-Einheit noetig) KEIN zweiter Klick mehr noetig ist.
(setq vorab-antwort "3" vorab-es-gewuenscht t)
(setq vorab-es-seite (vfl-frage-es-seite nil))
(setq vorab-ziel-punkt
(list (+ (car p-aktuell) (* deltaL (cos (* (float hz-neu) (/ pi 180.0)))))
(+ (cadr p-aktuell) (* deltaL (sin (* (float hz-neu) (/ pi 180.0)))))
hoehe-neu))
;; Kettenende-Modus (Option 4): Der abgefragte Endpunkt (XY+Z)
;; ist das exakte Ende der Kette NACH Separator + ES-Element.
;; Deren Footprint (Separator 300 mm bei ~3 Grad + ES-Element
;; ein-dx/ein-dz) muss vom baubaren GF/VF-Segment reserviert
;; werden, damit das ES-Element genau am Zielpunkt endet.
;; Naeherung: Separator-Neigung = 3 Grad (Auslauf).
;; LAENGE: reiner Budget-Verbrauch, IMMER abziehen (Separator+ES
;; nehmen unabhaengig von der Richtung ein Stueck der Gesamt-
;; Spannweite weg).
;; HOEHE: Separator+ES senken IMMER ab (Ausgleichsprinzip,
;; unabhaengig von "Auf"/"Ab"). Bei "Ab" darf man das wie
;; bisher von deltaH ABZIEHEN (Kletterer+GF muessen dann
;; entsprechend WENIGER absinken, der Rest erledigt der
;; Schwanz). Bei "Auf" ist das GENAU VERKEHRT: der Schwanz
;; senkt NACH dem Solve nochmal ab, also muss Kletterer+GF
;; VORHER entsprechend MEHR steigen, um das wieder
;; auszugleichen - hier muss ADDIERT werden. Exakt dieselbe
;; Auf/Ab-Asymmetrie wie in berechne-alle-winkel selbst
;; (dort +feste-hz*sin3 bei Auf, -feste-hz*sin3 bei Ab -
;; siehe vf_standard.lsp). Realer Bug (falsches Vorzeichen
;; bei "Auf"): ES landete ca. 2*(Separator+ES-Hoehe) zu tief
;; (Livetest 2026-09-18, Abweichung 161mm bei Separator*sin3+
;; |ein-dz| = 15.7+65 = 80.7mm - genau die Haelfte).
(if linie-ende-modus
(progn
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3))
(/ pi 180.0)))
(setq deltaL (max 1.0 (- deltaL (* *vfk-separator-laenge* (cos rad3))
(abs (if ein-dx ein-dx 0.0)))))
(setq deltaH
(if (= richtung "Auf")
(+ deltaH (* *vfk-separator-laenge* (sin rad3))
(abs (if ein-dz ein-dz 0.0)))
(max 0.0 (- deltaH (* *vfk-separator-laenge* (sin rad3))
(abs (if ein-dz ein-dz 0.0))))))
(princ (ssg-textf "vfl-info-kettenende-footprint"
(list (rtos deltaL 2 0) (rtos deltaH 2 0))))
)
)
;; ein-dx/ein-dz waehrend der Typ-/Winkel-Entscheidung
;; (vfl-vf-entscheidung/vfl-segment-entscheidung, nur im
;; "Auf"-Fall relevant) temporaer nullen: der ES-Fussabdruck
;; wurde oben BEREITS von deltaL/deltaH abgezogen - eine
;; zweite Reservierung INNERHALB des Solvers waere doppelt
;; (analog zu vfl-vf-winkel, das aus-dx/aus-dz aus demselben
;; Grund temporaer nullt). Nach der Entscheidung sofort
;; wiederhergestellt - der spaetere Bau (vfl-vf-einheit)
;; braucht die echten Werte nicht mehr (er nutzt L_GF2-bau
;; direkt), aber andere Stellen in dieser Kette schon.
(setq save-eindx-vorab ein-dx save-eindz-vorab ein-dz)
(setq ein-dx 0.0 ein-dz 0.0)
;; Aus einer fruehren Schleifen-Iteration stehengebliebene
;; Stufe-3-Werte NICHT versehentlich fuer dieses Segment
;; wiederverwenden - nur die beiden entscheidung-Zweige
;; unten setzen sie ggf. neu.
(setq lhor nil stufe3-position nil)
(if (equal linie-ende-familie "GF")
(progn
;; --- Startpunkt als GF-Familie erkannt ---
;; Dieselbe Endpunkt-/Zielhoehe-Wahl wie "Neue
;; Linie: GF" (Zweig A/B) statt der generischen
;; Automatik - eine reine Gefaellestrecke kann
;; nicht steigen. Stufe-2-Diagnosevariablen
;; zuruecksetzen: dieser Zweig ruft
;; vfl-vf-entscheidung NICHT auf, ein evtl. noch
;; von einem frueheren Versuch gesetzter Text/
;; Vorschlag darf bei einem hier fehlschlagenden
;; GF-Segment nicht faelschlich mit angezeigt
;; werden (siehe gemeinsamer "typ=nil"-
;; Meldungsblock unten).
(setq *vfl-stufe2-diagnose-text* nil)
(setq *vfl-stufe2-minl-vorschlag* nil *vfl-stufe2-minh-vorschlag* nil)
(if (= richtung "Auf")
;; Steigend: wie im "nicht eindeutig"-Zweig
;; (vfl-segment-entscheidung) NICHT sofort
;; aufgeben - eine bestehende GF-Kette darf
;; durchaus in eine frische VF-Einheit (eigene
;; Umlenk-/Motorstation) uebergehen. Direkt
;; vfl-vf-entscheidung aufrufen (identisch zu dem,
;; was vfl-segment-entscheidung fuer "Auf" ohnehin
;; getan haette) - der gemeinsame Baubereich unten
;; (typ="GF" vs. sonst) baut ein typ="VF"-Ergebnis
;; bereits unveraendert ueber vfl-vf-einheit-
;; abschluss (mit eigener Umlenkstation), genau wie
;; bei "Neue Linie: Ab/Auf VF". Realer Bug-Fall:
;; vorher wurde hier IMMER typ=nil gesetzt, obwohl
;; ein baubarer VF-Weg existierte (Nutzer-Meldung).
(setq entscheidung (vfl-vf-entscheidung deltaL deltaH richtung)
typ (nth 0 entscheidung) winkel (nth 1 entscheidung)
L_GF (nth 2 entscheidung) L_VF (nth 3 entscheidung)
lhor (nth 4 entscheidung) stufe3-position (nth 5 entscheidung))
(progn
(princ (ssg-text "vfl-gf-laenge-modus-header"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-endpunkt"))
(princ (ssg-text "vfl-gf-laenge-modus-opt-hoehe"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-gf-steigend-untermodus-impl nil))
(setq linie-ende-untermodus
(vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-gf-laenge-modus-opt-endpunkt")
(ssg-text "vfl-gf-laenge-modus-opt-hoehe")) 1
"vfl-gf-laenge-modus-header"))
(if (= linie-ende-untermodus "2")
(progn
(setq winkel *vfk-gefaelle-winkel*)
(setq deltaL
(/ deltaH (/ (sin (* winkel (/ pi 180.0))) (cos (* winkel (/ pi 180.0))))))
(if (< deltaL 1.0)
(setq typ nil)
(setq typ "GF" L_GF nil L_VF nil)))
(progn
(setq winkel (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
(if (> winkel *vfk-gefaelle-winkel*)
(setq typ nil)
(setq typ "GF" L_GF nil L_VF nil)))
)
)
)
)
;; --- Nicht eindeutig zuordenbar: bisherige Automatik ---
(progn
(setq entscheidung (vfl-segment-entscheidung deltaL deltaH richtung))
(setq typ (nth 0 entscheidung) winkel (nth 1 entscheidung)
L_GF (nth 2 entscheidung) L_VF (nth 3 entscheidung)
lhor (nth 4 entscheidung) stufe3-position (nth 5 entscheidung)))
)
)
)
;; ein-dx/ein-dz wiederherstellen (siehe Nullung oben).
(setq ein-dx save-eindx-vorab ein-dz save-eindz-vorab)
(if (null typ)
(progn
(vfl-meldung (ssg-textf "vfl-alert-segment-nicht-baubar"
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
;; Gesammelte Stufe-2-Diagnose (falls versucht) + kompaktes
;; 2-Punkte-Alert mit Mindestwerten - analog vfl-body-abschluss.
(if *vfl-stufe2-diagnose-text* (princ *vfl-stufe2-diagnose-text*))
(vfl-meldung
(strcat
(ssg-textf "vfl-alert-vf-entscheidung-p1" (list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung))
(cond
((and *vfl-stufe2-minl-vorschlag* *vfl-stufe2-minh-vorschlag*)
(ssg-textf "vfl-alert-vf-entscheidung-p2-beide"
(list (rtos *vfl-stufe2-minl-vorschlag* 2 0) (rtos *vfl-stufe2-minh-vorschlag* 2 0))))
(*vfl-stufe2-minh-vorschlag*
(ssg-textf "vfl-alert-vf-entscheidung-p2-nur-minh" (list (rtos *vfl-stufe2-minh-vorschlag* 2 0))))
(*vfl-stufe2-minl-vorschlag*
(ssg-textf "vfl-alert-vf-entscheidung-p2-nur-minl" (list (rtos *vfl-stufe2-minl-vorschlag* 2 0))))
(t ""))))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie (automatisch) nicht baubar"
" (deltaL=" (rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0)
" richtung=" richtung ")"))))
(progn
(if (= typ "GF")
(progn
;; --- reine Gefaellestrecke ---
(if dbg-an
(dbgmsg (strcat "GEOMETRIE: vfl-insert-gf-segment (deltaL=" (rtos deltaL 2 0)
" hz=" (rtos hz-neu 2 1) " winkel=" (rtos (float winkel) 2 1) ")")))
(setq frame (vfl-insert-gf-segment (car frame) hz-neu deltaL winkel))
(setq anzahl-gf (1+ anzahl-gf))
;; GF-Segment erfassen (Schraeglaenge = deltaL/cos(winkel))
(vfl-acc-gf-seg (/ deltaL (cos (* (float winkel) (/ pi 180.0)))) winkel)
(setq letzter-typ "GF")
(setq p-aktuell (car frame))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: GF-Segment gebaut, neue Position="
(dbg-tostring p-aktuell))))
;; Kettenende-Modus (Option 6): ES-Element direkt setzen,
;; Winkel/Seite wurden bereits VOR dem Solve erfragt
;; (vorab-es-seite) - kein "Ist Kettenende?" noetig,
;; linie-ende-modus ist in diesem "Linie"-Zweig immer T.
(setq es-seite vorab-es-seite)
(setq frame (vfl-insert-es-element "GF" frame hz-neu winkel
(caddr (car frame)) es-seite))
(setq fertig t)
)
(progn
;; --- VarioFoerderer-Einheit (Umlenk..Motor, mehrsegmentig) ---
;; linie-ende-modus=T -> direkt Kettenende (Separator + ES).
;; vorab-antwort/-es-gewuenscht/-es-seite/-ziel-punkt (oben
;; VOR dem Solve erfragt/berechnet) werden durchgereicht,
;; damit vfl-vf-einheit weder "Ist der Endpunkt?" nochmal
;; fragt noch einen zweiten Klick braucht (Nutzer-Wunsch,
;; identischer Fix wie bei "Neue Linie: Ab/Auf VF").
(if dbg-an
(dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss (deltaL=" (rtos deltaL 2 0)
" deltaH=" (rtos deltaH 2 0) " richtung=" richtung
" winkel=" (rtos (float winkel) 2 1)
" L_GF=" (rtos L_GF 2 0) " L_VF=" (rtos L_VF 2 0)
" linie-ende-modus=" (if linie-ende-modus "T" "nil") ")")))
(setq vf-einheit-res
(vfl-vf-einheit-abschluss frame hz-neu richtung winkel L_GF L_VF lhor stufe3-position
linie-ende-modus nil nil
vorab-antwort vorab-es-gewuenscht vorab-es-seite
vorab-ziel-punkt))
(setq frame (nth 0 vf-einheit-res))
(setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res)))
(if (nth 2 vf-einheit-res) (setq fertig t))
(if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res)))
(setq letzter-typ "VF")
(setq p-aktuell (car frame))
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: VF-Einheit gebaut, neue Position="
(dbg-tostring p-aktuell))))
)
)
)
)
)
)
)
)
)
)
)
)
;; Segment-XDATA: alle seit seg-lastEnt neu erzeugten Entities dieses
;; Glieds mit ihrer eigenen Journal-Teilsequenz markieren (rein additiv,
;; siehe vfl-segment-xdata-sichern) - muss laufen, WAEHREND die Entities
;; noch frei in der Zeichnung liegen (vor dem -BLOCK-Sweep in
;; vfl-block-erstellen unten).
(vl-catch-all-apply 'vfl-segment-xdata-sichern (list seg-lastEnt wahl))
;; Fortschritts-Echo: aktuelle Kettenposition nach diesem Glied (egal
;; welcher wahl-Zweig lief) - siehe vfl-echo-position.
(vfl-echo-position p-aktuell)
)
)
(setq hoehe-bis (caddr (car frame)))
;; DELTA_L: planare Gesamtdistanz Start -> Kettenende
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite
startpunkt lastEnt))
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug" +
;; Chunks) -> spaeter per Doppelklick editierbar (vfl-edit-ent).
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins "linienzug"))
;; Erfolgreicher Abschluss: *error* zuruecksetzen.
(setq *error* old-error)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-kette-eingefuegt"))
(princ "\n=========================================")
(if dbg-an
(progn
(dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer)
" (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")"))
(dbgmsg "=== SESSION Modus 1 ENDE ===")
(dbgreturn (list "VF" vfl-nummer))
(dbgclose)))
(princ)
)
;; ============================================================
;; EDITIEREN: gliedweise zuruecknehmen + Neuaufbau per Replay
;; ============================================================
;; Aufgerufen aus c:VARIOFOERDERER_EDIT (Doppelklick auf VF_n mit XDATA-Marker
;; "linienzug", egal ob fertiggestellt oder durch einen Abbruch gewickelt).
;; Liest das Eingabe-Journal vom Block, listet die Glieder, laesst per
;; DCL-Dialog (vfl-dlg-position) eine Sektion waehlen, auf die zurueckgesetzt
;; wird, loescht den alten Block und baut die Kette neu: die behaltenen
;; Glieder werden stumm abgespielt, danach laeuft die Eingabe interaktiv fuer
;; die geaenderten/neuen Glieder weiter. Vorbelegung im Dialog = voller Stand
;; -> Doppelklick + sofort OK setzt einen abgebrochenen Bau nahtlos fort.
;; Marker-Dispatch: "linienzug" (Modus 1) -> abschnittsweises Zuruecksetzen
;; wie bisher; "linienzug2" (Modus 2) -> voller Reset ohne Sektionswahl
;; (vfl-edit-ent2) - Modus 2s Klassifizierungs-Schleife traegt keine
;; Glied-Marker, ein Sektions-Dialog wie bei Modus 1 ist dafuer (noch) nicht
;; vorgesehen.
;; ============================================================
;; EINZELSEGMENT-BEARBEITUNG (ein Glied aendern, Rest behalten)
;; ============================================================
;; Idee: das Ketten-Journal ist die vollstaendige, wiederabspielbare Bau-
;; Anleitung. Ein einzelnes Glied editieren = dessen Journal-Teilsequenz durch
;; eine neue ersetzen (vfl-journal-splice) und danach das GESAMTE ersetzte
;; Journal still abspielen (vfl-journal-replay-start + vf-linienzug-modus) -
;; exakt derselbe Mechanismus wie der Sektions-Ruecksprung, nur mit chirurgisch
;; ersetztem statt abgeschnittenem Journal. Die Glieder VOR dem geaenderten
;; spielen identisch wie zuvor ab (gleicher Frame), das geaenderte Glied mit
;; neuen Werten, die Glieder DANACH mit ihren ORIGINAL-Werten - aber ab dem
;; neuen Austritts-Frame des geaenderten Glieds neu verkettet. Das leistet die
;; bestehende Replay-Schleife von allein (jedes Glied baut relativ zum Frame
;; des Vorgaengers), ohne Zusatzlogik.
;;
;; Umfang: sauber einzeln editierbar sind Glieder mit reiner Winkel-/Seiten-
;; Entscheidung ohne Punkt-/Hoehen-Eingabe: GF-Bogen (Winkel 30/60/90 + Seite),
;; AS-Element (Winkel 30/90 + Seite, liegt in der Praeambel) und ES-Element
;; (Winkel 30/90 + Seite, eigenes STEP-Glied seit vfl-frage-es-seite). Andere
;; Glieder (Linie-GF/-VF, Horizontal-VF, Linie-bis-Ende) enthalten Punktwahl +
;; Hoehen und teils VF-interne Vario-Kurven - fuer die ist der Sektions-
;; Ruecksprung ("rueck") der passende Weg. Sie werden hier mit einem Hinweis
;; abgewiesen (statt eine halbfertige In-Place-Bearbeitung anzubieten).
;; Neue Journal-Teilsequenz fuer einen GF-Bogen aus den im Dialog gewaehlten
;; Werten bauen. Aufbau exakt wie vom Live-Bau erzeugt: STEP-Eintrag, dann
;; ("STR" . "1") fuer die "Naechstes Element waehlen"-Menueantwort (Option 1 =
;; GF-Bogen, siehe vf-linienzug-modus Hauptschleife - vfl-journal-mark setzt
;; den STEP-Checkpoint VOR dieser Menuefrage, vfl-journal-steplabel schreibt
;; danach nur das Label um, fuegt aber KEINEN neuen Eintrag ein; die
;; Menueantwort bleibt also als eigener Journal-Eintrag direkt nach dem STEP
;; stehen), dann ("INT" . winkel) + ("STR" . seite-code) aus
;; vfl-insert-gf-bogen (vfl-menu-winkel Winkel, vfl-menu Seite). winkel ist der
;; ECHTE Winkelwert 30/60/90 (kein Index mehr), seite-code "1"=links,
;; "2"=rechts. Ein GF-Bogen kann nie das erste Kettenglied sein (am
;; Kettenanfang bietet das Menue "GF-Bogen" gar nicht erst an, siehe
;; Hauptschleife) - die Menueantwort ist daher immer aus dem 5er-Menue (frame
;; vorhanden) und immer "1". Rueckgabe: forward-order Journal-Teilsequenz.
;; Struktur kommt aus *vfl-glied-schema* ("GF-Bogen": menue winkel seite) -
;; hier nur der Adapter (Aufrufsignatur bleibt winkel/seite-code).
(defun vfl-gf-bogen-slice-bauen (winkel seite-code)
(vfl-schema-slice-bauen "GF-Bogen" (list "1" winkel seite-code)))
;; Aktuellen (Winkel, Seiten-Code) aus einer bestehenden GF-Bogen-Slice lesen
;; (fuer die Dialog-Vorbelegung). Liest ueber das Schema (menue/winkel/seite)
;; und wirft das menue-Feld weg. Der Winkel wird zusaetzlich ueber
;; vfl-winkel-normieren auf 30/60/90 gebracht (faengt auch Alt-Journals mit
;; Index 1/2/3 ab: idx-Werte werden zum Default 90 normiert - solche Altbloecke
;; sind ohnehin selten und der Nutzer sieht/korrigiert den Winkel im
;; vorbelegten Dialog). Defaults: menue "1", Winkel 90, Seite links "1".
(defun vfl-gf-bogen-slice-werte (slice / werte w s)
(setq werte (vfl-schema-slice-werte "GF-Bogen" slice (list "1" 90 "1")))
(setq w (cadr werte) s (caddr werte))
(list (vfl-winkel-normieren w *vfk-gf-bogen-winkel* 90) s))
;; Pre-fill-faehiger Winkel+Seite-Dialog fuer den GF-Bogen (nutzt das
;; bestehende vflw_winkel_seite-Tile aus dem Wizard-DCL, aber mit Vorbelegung
;; auf die aktuellen Werte - anders als vflw-gruppe-winkel-seite-impl, das
;; immer bei 0 startet und daher nicht wiederverwendet werden kann, ohne den
;; Live-Bau zu beruehren). Rueckgabe: (winkel seite-code) oder nil bei
;; Abbruch. winkel 30/60/90 (echter Wert), seite-code "1"/"2".
(defun vfl-glied-gf-bogen-dialog (vor-winkel vor-seite-code /
dat dcl-pfad ergebnis gwinkel gseite)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vflw_winkel_seite" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat))
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
(progn
(set_tile "kopf" (ssg-text "vfl-gf-bogen-winkel-header"))
(set_tile (strcat "winkel_" (itoa vor-winkel)) "1")
(set_tile (if (= vor-seite-code "2") "seite_rechts" "seite_links") "1")
(action_tile "accept"
"(setq gwinkel (cond ((= (get_tile \"winkel_30\") \"1\") 30)
((= (get_tile \"winkel_60\") \"1\") 60)
(t 90)))
(setq gseite (if (= (get_tile \"seite_rechts\") \"1\") \"2\" \"1\"))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(list gwinkel gseite)
nil))))
;; Pre-fill-faehiger Winkel+Seite+Variante-Dialog fuer die Vario-Kurve (nutzt
;; das bestehende vflw_variokurve-Tile mit Vorbelegung). Wizard-Optionsreihen-
;; folge: Winkel (30 60 90), Seite (links rechts), Variante (aussen innen) -
;; genau wie vflw-gruppe-variokurve-impl. vor-* sind die aktuellen Werte:
;; vor-winkel echter Wert 30/60/90, vor-seite-code/vor-variante-code je "1"/"2".
;; Rueckgabe: (winkel seite-code variante-code) oder nil bei Abbruch.
(defun vfl-glied-vario-dialog (vor-winkel vor-seite-code vor-variante-code /
dat dcl-pfad ergebnis gwinkel gseite gvariante)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vflw_variokurve" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat))
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
(progn
(set_tile "kopf" (ssg-text "vfl-variokurve-winkel-header"))
(set_tile (strcat "winkel_" (itoa vor-winkel)) "1")
(set_tile (if (= vor-seite-code "2") "seite_rechts" "seite_links") "1")
(set_tile (if (= vor-variante-code "2") "variante_innen" "variante_aussen") "1")
(action_tile "accept"
"(setq gwinkel (cond ((= (get_tile \"winkel_30\") \"1\") 30)
((= (get_tile \"winkel_60\") \"1\") 60)
(t 90)))
(setq gseite (if (= (get_tile \"seite_rechts\") \"1\") \"2\" \"1\"))
(setq gvariante (if (= (get_tile \"variante_innen\") \"1\") \"2\" \"1\"))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(list gwinkel gseite gvariante)
nil))))
;; Pre-fill-faehiger Winkel+Seite-Dialog fuer AS/ES-Element: nur ZWEI
;; Winkel-Optionen (90/30, in genau dieser Listen-Reihenfolge - wie
;; vf-frage-element-winkel/vflw-gruppe-winkel-seite-impl), Winkel als STRING
;; "90"/"30" (nicht Index). kopf-key waehlt die Kopfzeile (AS: vf-winkel-aus-
;; header, ES: vf-winkel-ein-header). Rueckgabe: (winkel-str seite-code) oder
;; nil bei Abbruch. seite-code "1"=links / "2"=rechts.
(defun vfl-glied-as-es-dialog (kopf-key vor-winkel-str vor-seite-code /
dat dcl-pfad ergebnis gwinkel gseite)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vflw_winkel_seite_30_90" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat))
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
(progn
(set_tile "kopf" (ssg-text kopf-key))
(set_tile (if (= vor-winkel-str "30") "winkel_30" "winkel_90") "1")
(set_tile (if (= vor-seite-code "2") "seite_rechts" "seite_links") "1")
(action_tile "accept"
"(setq gwinkel (if (= (get_tile \"winkel_30\") \"1\") \"30\" \"90\"))
(setq gseite (if (= (get_tile \"seite_rechts\") \"1\") \"2\" \"1\"))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(list gwinkel gseite)
nil))))
;; --- AS-/ES-Element (Winkel 30/90 + Seite links/rechts) ---
;; AS und ES sind KEINE ueber das Hauptmenue gewaehlten Glieder, ihre Slice
;; traegt daher KEINE fuehrende Menue-Antwort (anders als der GF-Bogen). Aufbau:
;; AS: gehoert in die PRAEAMBEL (vor dem 1. STEP), Eintraege: STR(winkel)
;; STR(seite) - siehe vf-linienzug-modus Kettenanfang. AS ist damit KEIN
;; STEP-Glied und wird ueber die Praeambel-Splice (vfl-journal-splice-as)
;; bearbeitet.
;; ES: hat seit vfl-frage-es-seite einen EIGENEN STEP-Marker "ES" und ist
;; damit ein regulaeres Glied. Slice: STEP("ES") STR(winkel) STR(seite).
;; winkel-str ist bei beiden "30" oder "90" (Rueckgabe vf-frage-element-winkel,
;; via vfl-in-value "STR" journalisiert), seite-code "1"=links / "2"=rechts.
;; Aktuelle (winkel-str seite-code) aus einer ES-Glied-Slice lesen (2 STR nach
;; dem STEP: erst Winkel, dann Seite). Struktur/Defaults aus *vfl-glied-schema*
;; ("ES": winkel seite). Defaults 90/links.
(defun vfl-es-slice-werte (slice)
(vfl-schema-slice-werte "ES" slice (list "90" "1")))
;; Neue ES-Glied-Slice bauen: STEP("ES") + STR(winkel) + STR(seite), Struktur
;; aus dem Schema.
(defun vfl-es-slice-bauen (winkel-str seite-code)
(vfl-schema-slice-bauen "ES" (list winkel-str seite-code)))
;; --- Vario-Kurve (Winkel 30/60/90 + Seite + Variante) --------------------
;; Slice: STEP("Vario-Kurve") INT(winkel) STR(seite) STR(variante), Struktur aus
;; *vfl-glied-schema* ("Vario-Kurve"). winkel echter Wert 90/60/30 (kein Index),
;; seite/variante als Menue-Code "1"/"2" (seite: 1=links/2=rechts, variante:
;; 1=aussen/2=innen - genau wie im Live-Bau vfl-insert-vario-kurve
;; journalisiert). Aktuelle Werte aus einer bestehenden Slice lesen; Defaults
;; 90/links/innen (innen = Live-Bau-Default, vfl-menu-Vorgabe 2).
(defun vfl-vario-slice-werte (slice / werte)
(setq werte (vfl-schema-slice-werte "Vario-Kurve" slice (list 90 "1" "2")))
;; Winkel gegen Fremdwerte absichern (analog GF-Bogen).
(list (vfl-winkel-normieren (car werte) *vfk-gf-bogen-winkel* 90)
(cadr werte) (caddr werte)))
;; Neue Vario-Kurve-Slice bauen.
(defun vfl-vario-slice-bauen (winkel seite-code variante-code)
(vfl-schema-slice-bauen "Vario-Kurve" (list winkel seite-code variante-code)))
;; Neue Vario-Kurve-Slice bauen, die den SCHWANZ der alten Slice erhaelt.
;; WICHTIG - Sonderfall gegenueber GF-Bogen/ES: Die Vario-Kurve ist das EINZIGE
;; STEP-Glied, das MITTEN in einem umschliessenden Konstrukt (der VF-Einheit)
;; steht. Nach ihren drei eigenen Werten (INT winkel, STR seite, STR variante)
;; folgen im Journal - noch VOR dem naechsten STEP - weitere Antworten der
;; VF-Einheit-Schleife ("Ist Endpunkt?", "Naechstes VF-Element?" usw.). Ein
;; naiver vfl-journal-splice (der die GANZE Slice bis zum naechsten STEP
;; ersetzt) wuerde diese nachfolgenden VF-Antworten VERWERFEN und beim Replay
;; die restliche Kette verschieben (Bug, adversarial verifiziert). Daher hier:
;; nur die drei Vario-Felder direkt nach dem STEP ersetzen, ALLE weiteren
;; Eintraege der alten Slice unveraendert anhaengen. alt-slice = die vom
;; vfl-journal-slice gelieferte Original-Slice dieses Vario-Glieds.
;; Rueckgabe: neue Slice (STEP INT STR STR + originaler Schwanz).
(defun vfl-vario-slice-splicen (alt-slice winkel seite-code variante-code /
schwanz rest n)
;; Schwanz = alt-slice OHNE das fuehrende STEP und die naechsten drei
;; Eintraege (winkel/seite/variante). Robust ueber die feste Feldzahl (3)
;; des Vario-Schemas statt ueber kind-Rateraten.
(setq rest (cdr alt-slice)) ; STEP weg
(setq n 0)
(while (and rest (< n 3)) ; die drei Vario-Felder weg
(setq rest (cdr rest) n (1+ n)))
(setq schwanz rest) ; alles Weitere (VF-Antworten) bleibt
(append (vfl-vario-slice-bauen winkel seite-code variante-code) schwanz))
;; AS-Werte aus der PRAEAMBEL lesen: die beiden STR direkt VOR dem 1. STEP, die
;; auf den AS-ja/nein-STR folgen (Reihenfolge im Journal: PT REAL STR(ja/nein)
;; [STR(winkel) STR(seite)]). Nur gueltig, wenn AS vorhanden (as-ja /= "2").
;; Rueckgabe: (winkel-str seite-code) oder nil, wenn kein AS.
(defun vfl-as-werte-lesen (journal / praeambel str-liste)
(setq praeambel (vfl-journal-praeambel journal))
(setq str-liste '())
(foreach e praeambel
(if (= (car e) "STR") (setq str-liste (cons (cdr e) str-liste))))
(setq str-liste (reverse str-liste)) ; [ja/nein, winkel, seite] in Reihenfolge
(if (and (>= (length str-liste) 3) (/= (car str-liste) "2"))
(list (cadr str-liste) (caddr str-liste))
nil))
;; Praeambel (alle Eintraege vor dem 1. STEP) als Liste in Reihenfolge.
(defun vfl-journal-praeambel (journal / out done)
(setq out '() done nil)
(foreach e journal
(if (and (not done) (= (car e) "STEP")) (setq done t))
(if (not done) (setq out (cons e out))))
(reverse out))
;; AS-Winkel/Seite in der Praeambel ersetzen (die beiden STR nach dem
;; ja/nein-STR), Rest des Journals unveraendert. Erwartet, dass AS vorhanden
;; ist (3 STR in der Praeambel). Gibt das komplette neue Journal zurueck.
(defun vfl-journal-splice-as (journal winkel-str seite-code / out str-idx done)
(setq out '() str-idx 0 done nil)
(foreach e journal
(cond
(done (setq out (cons e out))) ; ab 1. STEP: unveraendert
((= (car e) "STEP") (setq done t) (setq out (cons e out)))
((= (car e) "STR")
(setq str-idx (1+ str-idx))
(cond
((= str-idx 2) (setq out (cons (cons "STR" winkel-str) out))) ; AS-Winkel
((= str-idx 3) (setq out (cons (cons "STR" seite-code) out))) ; AS-Seite
(t (setq out (cons e out))))) ; ja/nein bleibt
(t (setq out (cons e out))))) ; PT/REAL bleiben
(reverse out))
;; Einzelnes Glied bearbeiten. glieder = Glied-Label-Liste (Bau-Reihenfolge,
;; enthaelt jetzt ggf. das synthetische "AS" ganz vorne und "ES" als regulaeres
;; Glied). journal = volles Ketten-Journal. Waehlt per Liste ein Glied, laesst
;; dessen Eigenschaften aendern (GF-Bogen, AS, ES), ersetzt die Teilsequenz und
;; baut die Kette komplett neu auf (stummer Voll-Replay). Bricht der Neuaufbau
;; ab, wickelt der bestehende *error*-Handler in vf-linienzug-modus den
;; Zwischenstand - kein Sonderfall noetig.
;;
;; glieder-alle = die dem Picker angezeigte Liste (inkl. evtl. "AS" an Position
;; 1); pos ist 1-basiert darauf. STEP-Glieder (GF-Bogen, ES, ...) werden ueber
;; ihren STEP-Index angesprochen - dieser ist pos MINUS 1, falls "AS" als
;; synthetischer erster Listeneintrag vorhanden ist (AS ist kein STEP).
(defun vfl-edit-glied (ent journal glieder-alle has-as / pos label
step-idx alt-slice vorwerte neuwerte neu-slice spliced)
(setq pos (vfl-dlg-position glieder-alle))
(if (null pos)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
(setq label (nth (1- pos) glieder-alle))
;; STEP-Index eines gewaehlten STEP-Glieds: bei vorhandenem "AS"-Listenkopf
;; um 1 nach vorne verschoben (AS belegt Listenposition 1, ist aber kein STEP).
(setq step-idx (if has-as (1- pos) pos))
(cond
;; --- AS-Element (Praeambel, kein STEP) ---
((= label "AS")
(setq vorwerte (vfl-as-werte-lesen journal))
(if (null vorwerte)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
(setq neuwerte (vfl-glied-as-es-dialog "vf-winkel-aus-header"
(car vorwerte) (cadr vorwerte)))
(if (null neuwerte)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
(setq spliced (vfl-journal-splice-as journal (car neuwerte) (cadr neuwerte)))
(entdel ent)
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
(vfl-journal-replay-start spliced)
(vf-linienzug-modus))
;; --- ES-Element (eigenes STEP-Glied) ---
((= label "ES")
(setq alt-slice (vfl-journal-slice journal step-idx))
(setq vorwerte (vfl-es-slice-werte alt-slice))
(setq neuwerte (vfl-glied-as-es-dialog "vf-winkel-ein-header"
(car vorwerte) (cadr vorwerte)))
(if (null neuwerte)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
(setq neu-slice (vfl-es-slice-bauen (car neuwerte) (cadr neuwerte)))
(setq spliced (vfl-journal-splice journal step-idx neu-slice))
(entdel ent)
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
(vfl-journal-replay-start spliced)
(vf-linienzug-modus))
;; --- GF-Bogen (STEP-Glied mit fuehrender Menue-Antwort) ---
((= label "GF-Bogen")
(setq alt-slice (vfl-journal-slice journal step-idx))
(setq vorwerte (vfl-gf-bogen-slice-werte alt-slice))
(setq neuwerte (vfl-glied-gf-bogen-dialog (car vorwerte) (cadr vorwerte)))
(if (null neuwerte)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
(setq neu-slice (vfl-gf-bogen-slice-bauen (car neuwerte) (cadr neuwerte)))
(setq spliced (vfl-journal-splice journal step-idx neu-slice))
(entdel ent)
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
;; Voller stummer Replay des gespliceten Journals: die Queue beschreibt
;; die Kette bis zum Ende, daher faellt vf-linienzug-modus nicht in den
;; Live-Modus, sondern baut 1:1 mit dem geaenderten Glied fertig.
(vfl-journal-replay-start spliced)
(vf-linienzug-modus))
;; --- Vario-Kurve (STEP-Glied INNERHALB einer VF-Einheit) ---
;; Gleiche Slice/Splice/Replay-Maschinerie wie GF-Bogen; die Vario-Kurve hat
;; seit vfl-insert-vario-kurve einen eigenen STEP-Marker und ist damit ein
;; regulaeres Glied. Aendert Winkel/Seite/Variante, Rest der Kette bleibt.
((= label "Vario-Kurve")
(setq alt-slice (vfl-journal-slice journal step-idx))
(setq vorwerte (vfl-vario-slice-werte alt-slice))
(setq neuwerte (vfl-glied-vario-dialog (car vorwerte) (cadr vorwerte) (caddr vorwerte)))
(if (null neuwerte)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
;; Schwanz-erhaltende Slice: die Vario-Kurve steht MITTEN in der VF-Einheit,
;; nach ihren 3 Werten folgen weitere VF-Antworten in derselben Slice. Nur
;; die 3 Vario-Felder ersetzen, den Rest behalten (siehe
;; vfl-vario-slice-splicen) - sonst verschiebt sich beim Replay die Kette.
(setq neu-slice (vfl-vario-slice-splicen alt-slice
(car neuwerte) (cadr neuwerte) (caddr neuwerte)))
(setq spliced (vfl-journal-splice journal step-idx neu-slice))
(entdel ent)
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
(vfl-journal-replay-start spliced)
(vf-linienzug-modus))
(t
(alert (ssg-textf "vfl-glied-nicht-editierbar"
(list (vfl-glied-label-text label))))
(princ (ssg-text "vfl-edit-abgebrochen"))))
(princ))
;; ============================================================
;; Nicht-interaktiver Dimensions-Konverter (fuer die Batch-Umschaltung
;; SSG_DIM_ALL_2D / SSG_DIM_ALL_3D, aufgerufen aus ssg-dim-alle-umwandeln).
;; ============================================================
;; Baut einen Linienzug-VF_n-Block (Modus 1 "linienzug" ODER Modus 2
;; "linienzug2") in der gewuenschten Zieldimension neu auf, indem das komplette
;; Eingabe-Journal STUMM (Replay-Queue, keine DCL-/Konsolen-Fragen) mit
;; erzwungenem *ssg-ils-dim*-Override abgespielt wird. Muster: vf-konvertiere-ent
;; (vf_standard.lsp), aber ohne Attribut-Reimport - der Startpunkt und alle
;; Eingaben stecken vollstaendig im Journal (erster PT-Eintrag = Startpunkt).
;;
;; Das Dim-XDATA wird NICHT hier geschrieben, sondern automatisch von
;; vfl-block-erstellen (Phase A) auf den NEUEN Block - explizites Nachschreiben
;; wuerde auf den bereits geloeschten alten Ename zielen.
;;
;; vl-catch-all-apply schuetzt vor (exit)/Fehlern im Bau (z.B. KS-Problem bei
;; einem 2D-Koerperblock ohne gueltiges KS), damit die Batch-Schleife weiterlaeuft
;; und der Override sicher zurueckgesetzt wird. Rueckgabe: T bei Erfolg, sonst nil.
;; Bekannte Grenze (nur Modus 2): das Replay von vfl-in-selection braucht die
;; Original-Pfadobjekte; wurden sie geloescht, schlaegt der Konverter fuer diesen
;; Block sauber fehl (sichtbar am nicht erhoehten Batch-Zaehler). Modus 3
;; ("linienzug3") hat diese Grenze NICHT: es replayt die Segment-Essenz (SEGS)
;; aus dem Journal, nicht die Objekt-Handles - unabhaengig von den Original-LINE/ARC.
(defun vfl-konvertiere-ent (ent ziel-dim / bname xd marker journal ok)
(setq bname (cdr (assoc 2 (entget ent))))
(setq xd (vfl-journal-xdata-lesen ent)) ; (marker . journal) oder nil
(setq marker (car xd) journal (cdr xd))
(if (and (wcmatch bname "VF_*")
(member marker '("linienzug" "linienzug2" "linienzug3"))
journal
;; Alte OBJS-"linienzug2"-Bloecke (ohne SEGS) NICHT konvertieren -
;; ihr Replay ist mit dem SEGS-Umbau nicht mehr fahrbar (harter
;; Schnitt, wie im Doppelklick-Pfad vfl-edit-ent). Sie ueberspringen
;; (nil zurueck), damit die Batch-Schleife sauber weiterlaeuft.
(or (/= marker "linienzug2") (vfl-journal-hat-segs-p journal)))
(progn
(setq *ssg-ils-dim* ziel-dim) ; Zieldim erzwingen
(entdel ent) ; alten Block weg
(vfl-journal-replay-start journal) ; volle Queue, KEIN Truncate
(setq ok (vl-catch-all-apply
(cond ((= marker "linienzug2") 'vf-linienzug-modus2)
((= marker "linienzug3") 'vf-linienzug-modus3)
(t 'vf-linienzug-modus))))
(setq *ssg-ils-dim* nil) ; Override zuruecksetzen
;; Fehlgeschlagene Konvertierung NICHT stumm verschlucken: der alte Block
;; ist per entdel schon weg, die Teil-Geometrie liegt frei in der
;; Zeichnung (der *error*-Handler in vf-linienzug-modus kann hier nicht
;; greifen, weil vl-catch-all-apply den Abbruch vorher abfaengt - das ist
;; hier gewollt, damit die Batch-Schleife weiterlaeuft). Meldung mit
;; Blockname, damit der betroffene Block auffindbar bleibt.
(if (vl-catch-all-error-p ok)
(progn
(princ (ssg-textf "vfl-konvert-fehler"
(list bname (vl-catch-all-error-message ok))))
nil)
T))
nil))
(defun vfl-edit-ent (ent / xd marker journal glieder glieder-alle has-as n i pos trunc edit-modus dim)
(setq xd (vfl-journal-xdata-lesen ent))
(if (null xd)
(progn (alert (ssg-text "vfl-edit-kein-journal")) (exit)))
(setq marker (car xd) journal (cdr xd))
;; Dimension des Bestandsblocks merken, damit der Doppelklick-Neubau
;; dimensionstreu bleibt (sonst baut er in der globalen DXFM_DIM, weil beim
;; Doppelklick kein *ssg-ils-dim*-Override aktiv ist). Wird VOR dem entdel
;; gelesen; der Override greift beim anschliessenden Replay/Weiterbau.
(setq dim (ssg-dim-xdata-lesen ent))
(cond
((= marker "linienzug2")
;; Harter Schnitt: nur SEGS-Bloecke (neue Fassung) sind per Doppelklick
;; neu aufbaubar. Alte OBJS-Bloecke (Objekt-Handles statt Segment-Essenz)
;; wuerden im Replay falsche Daten in den Bau geben - klar abweisen statt
;; zu crashen.
(if (vfl-journal-hat-segs-p journal)
(vfl-edit-ent2 ent journal)
(alert (ssg-text "vfl-edit-m2-obsolet"))))
((= marker "linienzug3") (vfl-edit-ent3 ent journal))
(t
(progn
(setq glieder (vfl-journal-glieder journal))
(setq n (length glieder))
;; AS ist kein STEP-Glied (steht in der Praeambel). Fuer den Glied-Edit
;; wird es als synthetischer erster Listeneintrag "AS" vorangestellt,
;; falls in der Kette ein AS vorhanden ist (vfl-as-werte-lesen liefert
;; dann nicht nil). has-as steuert in vfl-edit-glied den STEP-Index-
;; Versatz (AS belegt Listenposition 1, ist aber kein STEP). Der Sektions-
;; Ruecksetz-Modus nutzt weiterhin die reine STEP-Liste (glieder), ES ist
;; darin bereits als eigenes Glied enthalten.
(setq has-as (and (vfl-as-werte-lesen journal) t))
(setq glieder-alle (if has-as (cons "AS" glieder) glieder))
;; NEU: zuerst Modus waehlen (Sektion zuruecksetzen ODER ein einzelnes
;; Glied bearbeiten). Alte Bloecke ohne Segment-XDATA funktionieren in
;; beiden Zweigen, da beide allein aus dem Ketten-Journal arbeiten.
(setq edit-modus (vfl-dlg-modus n))
(cond
((null edit-modus)
(princ (ssg-text "vfl-edit-abgebrochen")))
((= edit-modus "glied")
(vfl-edit-glied ent journal glieder-alle has-as))
(t
;; --- bestehender Ablauf: Sektion zuruecksetzen (unveraendert) ---
(princ (ssg-textf "vfl-edit-kette-header" (list (itoa n))))
(setq i 1)
(foreach g glieder
(princ (strcat "\n " (itoa i) ") " (vfl-glied-label-text g)))
(setq i (1+ i)))
(setq pos (vfl-dlg-position glieder))
(if (null pos)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
(setq trunc (vfl-journal-truncate journal pos))
;; Alten Block entfernen (wie Standard/Etage: entdel + kompletter Neuaufbau).
;; Bricht der Neuaufbau selbst ab, wickelt vfl-modus-abbruch-sichern den
;; Zwischenstand automatisch zu einem neuen Block - kein Sonderfall noetig.
(entdel ent)
(princ (ssg-textf "vfl-edit-abgespielt" (list (itoa pos) (itoa (- n pos)))))
;; Behaltene Glieder abspielen, dann live weiterbauen. Dimensionstreu:
;; Override auf die Dimension des Bestandsblocks, danach zuruecksetzen.
(if dim (setq *ssg-ils-dim* dim))
(vfl-journal-replay-start trunc)
;; WICHTIG: DIREKTER Aufruf, KEIN vl-catch-all-apply!
;; Der Neuaufbau ist interaktiv - bricht der Nutzer ihn ab (ESC ->
;; (exit) im Bau-Ablauf), MUSS der *error*-Handler in
;; vf-linienzug-modus laufen und die bis dahin gebaute Teil-Geometrie
;; zu einem VF_n-Block wickeln. Ein vl-catch-all-apply faengt den
;; Abbruch VOR *error* ab: der Handler kaeme nie zum Zug, der alte
;; Block ist durch das entdel oben aber schon weg - die ganze Kette
;; bliebe als loses Einzelteil-Haufen ohne Block in der Zeichnung
;; liegen (nicht mehr per Doppelklick editierbar). Genau das war der
;; Fehler "VF-Block aufgebrochen".
;; Das Abraeumen des Dim-Overrides uebernimmt im Abbruchfall der
;; Handler selbst (dort ebenfalls (setq *ssg-ils-dim* nil)), denn
;; die naechste Zeile wird dann nicht mehr erreicht.
(vf-linienzug-modus)
(setq *ssg-ils-dim* nil))))))
(princ))
;; T, wenn das Journal einen SEGS-Eintrag traegt (Modus 2 NEU / Modus 3 - die
;; Kette ist per Segment-Essenz selbst-enthalten). Alte Modus-2-Bloecke tragen
;; hier stattdessen einen OBJS-Eintrag (Objekt-Handles) - fuer die ist der
;; SEGS-Replay nicht mehr fahrbar (harter Schnitt, siehe vfl-edit-ent).
(defun vfl-journal-hat-segs-p (journal)
(and (vl-some (function (lambda (e) (equal (car e) "SEGS"))) journal) t))
;; Modus-2/3-Block per Doppelklick zuruecksetzen: voller Reset - die komplette
;; gespeicherte Eingabe wird 1:1 stumm abgespielt, identischer Neuaufbau. Kein
;; Sektions-Dialog; der Nutzer kann den neu entstandenen Block danach ganz
;; normal weiterbearbeiten oder loeschen.
;;
;; bau-fn = die Modus-Bau-Funktion, die das Journal abspielt: 'vf-linienzug-modus2
;; fuer Marker "linienzug2" (Pfad-Objekte per OBJS-Handles) bzw.
;; 'vf-linienzug-modus3 fuer "linienzug3" (Segment-Essenz per SEGS - unabhaengig
;; von den Original-Objekten). Beide Modi haben eine flache Klassifizierungs-
;; Schleife ohne editierbare Einzelglieder, daher derselbe volle Reset.
(defun vfl-edit-ent-voll (ent journal bau-fn / dim)
;; Dimension des Bestandsblocks VOR dem entdel merken und beim Neubau als
;; Override erzwingen (dimensionstreuer Doppelklick-Neubau, sonst globale
;; DXFM_DIM). Danach Override zuruecksetzen.
(setq dim (ssg-dim-xdata-lesen ent))
(entdel ent)
(princ (ssg-text "vfl-edit2-reset-info"))
(if dim (setq *ssg-ils-dim* dim))
(vfl-journal-replay-start journal)
;; DIREKTER Aufruf, KEIN vl-catch-all-apply - identische Begruendung wie im
;; Sektions-Zweig von vfl-edit-ent (siehe dortiger Kommentar): der alte Block
;; ist per entdel schon weg, bei einem Abbruch muss der *error*-Handler der
;; Modus-Funktion die Teil-Geometrie wickeln. Den Dim-Override raeumt im
;; Abbruchfall der Handler ab. bau-fn ist ein Funktions-SYMBOL (quoted beim
;; Aufruf) - ueber apply aufrufen, nicht als (bau-fn) (das riefe die Funktion
;; namens "bau-fn" auf, nicht den durchgereichten Wert).
(apply bau-fn nil)
(setq *ssg-ils-dim* nil)
(princ))
;; Rueckwaertskompatibler Wrapper (Modus 2). vfl-edit-ent3 fuer Modus 3.
(defun vfl-edit-ent2 (ent journal) (vfl-edit-ent-voll ent journal 'vf-linienzug-modus2))
(defun vfl-edit-ent3 (ent journal) (vfl-edit-ent-voll ent journal 'vf-linienzug-modus3))
;; ============================================================
;; RECOVERY: Kette aus der Sektions-XDATA der Zeichnung neu aufbauen
;; ============================================================
;; Wofuer: bleibt eine Linienzug-Kette als LOSE Geometrie ohne VF_n-Block in
;; der Zeichnung liegen (der Block war schon per entdel weg, der Neuaufbau
;; wurde abgebrochen und konnte nicht gewickelt werden), ist sie nicht mehr per
;; Doppelklick editierbar. Die Eingaben sind aber nicht verloren: jedes Entity
;; traegt den Journal-Abschnitt der Iteration, in der es entstand
;; (SSG_VF_EDIT_SEG, indiziert mit dem ERSTEN Glied-Index darin - siehe
;; vfl-segment-xdata-sichern), und die Entities der ersten Iteration
;; zusaetzlich die Praeambel (SSG_VF_EDIT_PRE). Daraus laesst sich das
;; Ketten-Journal zusammensetzen und die Kette identisch neu bauen - diesmal
;; sauber als VF_n-Block mit Ketten-XDATA.
;;
;; Quelle ist AUSSCHLIESSLICH die Zeichnung selbst. Die .dbg-Dateien sind
;; reine Ausgabe und werden hier bewusst NICHT gelesen (sie werden bei jedem
;; Lauf neu angelegt, siehe dbgopen).
;;
;; Ablauf: Geometrie waehlen -> Sektionen sammeln und nach Glied-Index sortieren
;; -> Journal (Praeambel + Glieder 1..k) stumm abspielen -> danach normal
;; weiterbauen. Die alte Geometrie wird erst NACH einem erfolgreichen Neuaufbau
;; geloescht (bricht der Neuaufbau ab, bleibt sie samt ihrer XDATA stehen und
;; der Versuch ist wiederholbar).
;; Praeambel interaktiv erfragen - nur fuer Altbestand ohne SSG_VF_EDIT_PRE
;; (Ketten, die vor der Einfuehrung der Praeambel-XDATA gebaut wurden).
;; Reihenfolge/Arten MUESSEN dem Kopf von vf-linienzug-modus entsprechen:
;; PT (Startpunkt), REAL (Starthoehe), STR (AS ja="1"/nein="2") und bei AS
;; zusaetzlich STR (Winkel "30"/"90") + STR (Seite links="1"/rechts="2").
;; Rueckgabe: Praeambel-Journal oder nil (Abbruch).
(defun vfl-praeambel-erfragen ( / p h as w s out)
(princ (ssg-text "vfl-restore-keine-praeambel"))
(setq p (getpoint (ssg-text "vfl-prompt-startpunkt-kette")))
(if (null p)
nil
(progn
(setq h (getreal (ssg-textf "vfl-prompt-hoehe-startpunkt-kette"
(list (rtos (caddr p) 2 1)))))
(if (null h) (setq h (caddr p)))
(initget "Ja Nein")
(setq as (getkword (ssg-text "vfl-restore-frage-as")))
(if (null as) (setq as "Ja"))
(setq out (list (cons "PT" p) (cons "REAL" h)
(cons "STR" (if (= as "Nein") "2" "1"))))
(if (/= as "Nein")
(progn
;; gleiche Frage wie im Bau-Ablauf (liefert "30"/"90")
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq w (vf-frage-element-winkel "vf-winkel-aus-header"))
(initget "Links Rechts")
(setq s (getkword (ssg-text "vfl-restore-frage-as-seite")))
(if (null s) (setq s "Links"))
(setq out (append out (list (cons "STR" w)
(cons "STR" (if (= s "Rechts") "2" "1")))))))
out)))
;; Sektionen aus einer Auswahl sammeln. Rueckgabe: Liste (idx . slice),
;; aufsteigend nach idx, jeder Index nur EINMAL (alle Entities eines Gliedes
;; tragen dieselbe Slice).
(defun vfl-sektionen-sammeln (ss / i n ent seg idx out)
(setq out '() i 0 n (sslength ss))
(while (< i n)
(setq ent (ssname ss i))
(setq seg (vfl-journal-xdata-lesen-seg ent))
(if seg
(progn
(setq idx (car seg))
(if (not (assoc idx out)) (setq out (cons (cons idx (cdr seg)) out)))))
(setq i (1+ i)))
(vl-sort out (function (lambda (a b) (< (car a) (car b))))))
;; Praeambel aus der Auswahl lesen (erstes Entity, das eine traegt).
(defun vfl-praeambel-sammeln (ss / i n pre)
(setq i 0 n (sslength ss) pre nil)
(while (and (< i n) (null pre))
(setq pre (vfl-journal-xdata-lesen-pre (ssname ss i)))
(setq i (1+ i)))
pre)
(defun c:VF_SEKTION_RESTORE ( / ss sektionen pre journal teile k erwartet luecke
i n sek e alt-liste)
(princ (ssg-text "vfl-restore-prompt-auswahl"))
(setq ss (ssget))
(cond
((null ss) (princ (ssg-text "vfl-abgebrochen")))
((null (setq sektionen (vfl-sektionen-sammeln ss)))
(princ (ssg-text "vfl-restore-keine-sektionen")))
(t
;; Sektionen aneinanderhaengen, solange sie LUECKENLOS ab Glied 1
;; anschliessen. Ein Sektions-Record ist mit dem Index seines ERSTEN
;; Gliedes abgelegt und kann mehrere Glieder enthalten (VF-Einheit mit
;; Vario-Kurven) - der naechste erwartete Index ist daher
;; erster-Index + Anzahl der Glieder darin, nicht einfach +1.
;; Bei einer Luecke wird nur der Anfang wiederhergestellt: ein fehlendes
;; Glied in der Mitte wuerde alle folgenden an die falsche Position setzen.
(setq teile '() k 0 erwartet 1 luecke nil)
(foreach sek sektionen
(if (and (not luecke) (= (car sek) erwartet))
(progn
(setq teile (cons (cdr sek) teile))
(setq k (+ k (vfl-steps-zaehlen (cdr sek))))
(setq erwartet (1+ k)))
(setq luecke t)))
(if luecke
(princ (ssg-textf "vfl-restore-luecke" (list (itoa erwartet) (itoa k)))))
(if (= k 0)
(princ (ssg-text "vfl-restore-keine-sektionen"))
(progn
;; Praeambel: aus der Zeichnung, sonst erfragen (Altbestand ohne
;; SSG_VF_EDIT_PRE).
(setq pre (vfl-praeambel-sammeln ss))
(if (null pre) (setq pre (vfl-praeambel-erfragen)))
(if (null pre)
(princ (ssg-text "vfl-abgebrochen"))
(progn
(setq journal (apply 'append (cons pre (reverse teile))))
(princ (ssg-textf "vfl-restore-gefunden"
(list (itoa k) (itoa (length journal)))))
;; Enames der alten Geometrie merken - geloescht wird ERST nach
;; einem erfolgreichen Neuaufbau (siehe unten).
(setq alt-liste '() i 0 n (sslength ss))
(while (< i n)
(setq alt-liste (cons (ssname ss i) alt-liste))
(setq i (1+ i)))
;; Neu bauen. DIREKTER Aufruf: bricht der Bau ab, wickelt der
;; *error*-Handler in vf-linienzug-modus den Zwischenstand zu
;; einem Block - und die Zeilen danach (Loeschen) laufen NICHT
;; mehr. Die alte Geometrie samt ihrer Sektions-XDATA bleibt also
;; erhalten und der Versuch ist wiederholbar.
(vfl-journal-replay-start journal)
(vf-linienzug-modus)
;; Erfolg: alte lose Geometrie entfernen. Sie liegt VOR lastEnt und
;; ist deshalb nicht im neuen Block gelandet (vgl.
;; vfl-block-erstellen), wuerde aber deckungsgleich darunter
;; liegenbleiben.
(foreach e alt-liste (if e (entdel e)))
(princ (ssg-textf "vfl-restore-geloescht"
(list (itoa (length alt-liste)))))))))))
(princ))
;; DCL-Dialog nach Doppelklick: Editier-Modus waehlen.
;; n = Anzahl Glieder (nur fuer die Kopfzeile). Vorbelegung "rueck" (das
;; bisherige Verhalten, geringste Ueberraschung). Rueckgabe: "rueck", "glied"
;; oder nil (Abbrechen/Escape). Bei fehlendem/kaputtem DCL faellt der Dialog
;; auf "rueck" zurueck (statt die Bearbeitung ganz zu blockieren) - so bleibt
;; der bestehende Editierpfad auch dann erreichbar.
(defun vfl-dlg-modus (n / dcl-pfad dat wahl ergebnis)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit_modus.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vfl_edit_modus" dat))
(progn
(if dat (unload_dialog dat))
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad)))
"rueck") ; Fallback: bisheriges Verhalten
(progn
;; Nur der Kopftext wird zur Laufzeit gesetzt; die Optionslabels stehen
;; statisch (deutsch) im DCL - siehe vfl_edit_modus.dcl. get_tile "modus"
;; liefert den key des gewaehlten radio_button. Default "modus_rueck" ist
;; im DCL per value="1" vorbelegt.
(set_tile "kopf" (ssg-textf "vfl-dlg-modus-kopf" (list (itoa n))))
(action_tile "accept" "(setq wahl (get_tile \"modus\")) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((/= ergebnis 1) nil)
((= wahl "modus_glied") "glied")
(t "rueck"))))) ; modus_rueck (o. leer) = zuruecksetzen
;; DCL-Dialog: Sektion waehlen, auf die die Kette zurueckgesetzt wird.
;; glieder = Liste der Glied-Labels (interne Tokens, vfl-journal-glieder), in
;; Bau-Reihenfolge. Vorbelegung auf den letzten Eintrag (voller Stand = reines
;; Fortsetzen ohne Kuerzung). Rueckgabe: gewaehlte Position (1-basiert) oder
;; nil bei Abbrechen/Escape.
(defun vfl-dlg-position (glieder / n dcl-pfad dat idx ergebnis i)
(setq n (length glieder))
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vfl_edit" dat))
(progn (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
(progn
(set_tile "kopf" (ssg-textf "vfl-dlg-kopf-sektionen" (list (itoa n))))
(start_list "position")
(setq i 1)
(foreach g glieder
(add_list (strcat (itoa i) " - " (vfl-glied-label-text g)))
(setq i (1+ i)))
(end_list)
(set_tile "position" (itoa (1- n))) ; letzter Eintrag vorbelegt (0-basierter Index)
(action_tile "accept" "(setq idx (atoi (get_tile \"position\"))) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1) (1+ idx) nil)
)
)
)
;; ============================================================
;; DIAGNOSE: Blockstruktur (KS_EIN/KS_AUS) untersuchen
;; ============================================================
;; Zeigt, wie ein Block intern aufgebaut ist - insbesondere, ob KS_EIN/KS_AUS
;; auf der ersten Explode-Ebene als Unterbloecke liegen und welche Laengen ihre
;; Achslinien haben (ks-line-axis erwartet X~1/~100, Y~2, Z~3). Damit laesst
;; sich klaeren, warum extract-ks-from-block bei den Vario_Kurve-Bloecken
;; "KS_EIN/KS_AUS fehlen" meldet.
;; Aufruf in BricsCAD: VFL_KS_DIAG -> Blockname eingeben.
(defun c:VFL_KS_DIAG ( / bname obj subs s nm inner il ilnm ps pe len)
(setq bname (getstring "\nBlockname fuer KS-Diagnose: "))
(setq bname (ensure-block-loaded bname))
(if (not (tblsearch "BLOCK" bname))
(progn (princ (strcat "\nBlock '" bname "' nicht gefunden.")) (exit)))
(setq obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) bname 1.0 1.0 1.0 0))
(princ (strcat "\n=================================================="))
(princ (strcat "\n=== Struktur von '" bname "' (Ebene 1) ==="))
(setq subs (vlax-invoke obj 'Explode))
(foreach s subs
(if (not (vlax-erased-p s))
(progn
(setq nm (vla-get-ObjectName s))
(if (= nm "AcDbBlockReference")
(progn
(princ (strcat "\n BlockRef: '" (vla-get-Name s) "' (Ebene 2:)"))
(setq inner (vlax-invoke s 'Explode))
(foreach il inner
(if (not (vlax-erased-p il))
(progn
(setq ilnm (vla-get-ObjectName il))
(cond
((= ilnm "AcDbLine")
(setq ps (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint il))))
(setq pe (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint il))))
(setq len (vec-length (list (- (car pe)(car ps))
(- (cadr pe)(cadr ps))
(- (caddr pe)(caddr ps)))))
(princ (strcat "\n Line len=" (rtos len 2 3)
" axis=" (if (ks-line-axis len) (ks-line-axis len) "?"))))
((= ilnm "AcDbBlockReference")
(princ (strcat "\n BlockRef(verschachtelt): '" (vla-get-Name il) "'")))
(t (princ (strcat "\n " ilnm)))
)
(vla-Delete il)
)
)
)
)
(princ (strcat "\n " nm))
)
(vla-Delete s)
)
)
)
(princ "\n=== Ende Diagnose ===")
(princ "\n==================================================")
(princ)
)
;; ============================================================
;; REGISTRIERUNG
;; ============================================================
;; berechne-fn/einfuege-fn werden fuer "linienzug" NICHT im normalen Schema
;; verwendet (eigener Befehlsablauf, siehe Kommentar am Dateianfang) - beide
;; sind daher nur Platzhalter, die c:VarioFoerderer nie aufruft (Dispatch
;; erfolgt dort direkt auf vf-linienzug-modus).
(defun vfl-berechne-platzhalter (deltaL deltaH richtung seite)
(princ "\n[vf_linienzug] FEHLER: berechne-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.")
(list nil nil nil nil)
)
(defun vfl-einfuege-platzhalter (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz)
(princ "\n[vf_linienzug] FEHLER: einfuege-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.")
startpunkt
)
;; ============================================================
;; MODUS 2: 3D-OBJEKTE WAEHLEN (Meilenstein 1 - GF-Teil)
;; ============================================================
;; Baut die Kette aus einem GEZEICHNETEN Pfad (LINE/ARC). Ablauf:
;; Objekte waehlen -> gf-sortiere-objekte -> gf-analysiere-kette
;; -> Eck-Winkel-Vorpruefung -> segmentweise (Variante B) live bauen -> ES.
;; In diesem Meilenstein ist NUR der GF-Teil aktiv (GF-Gerade mit eigener
;; Neigung <=3 Grad, GF-Bogen). Die VF-Zweige sind als TODO (Meilenstein 2)
;; markiert und werden uebersprungen.
;; Bekannte Naeherungen (in BricsCAD verifizieren):
;; - Eck-Trimmung nur an erster/letzter Geraden (-aus-dx bzw. -300-ein-dx,
;; wie gf-linienzug-modus); Separatoren VOR GF-Boegen noch NICHT gesetzt.
;; - GF-Bogen hat feste Eigen-Neigung -> bei unterschiedlichen Nachbar-
;; Neigungen entsteht ein (akzeptierter) Knick.
;; Alle Eck-Winkel des Pfades gegen 30/60/90 Grad pruefen (Toleranz tol).
;; Rueckgabe: nil (alle ok) oder der erste abweichende Winkel (Grad).
(defun vfl2-pruefe-eckwinkel (kette tol / item obj sa ea sweep bad)
(setq bad nil)
(foreach item kette
(setq obj (car item))
(if (and (null bad) (= (vla-get-ObjectName obj) "AcDbArc"))
(progn
(setq sa (vla-get-StartAngle obj) ea (vla-get-EndAngle obj))
(setq sweep (if (>= ea sa) (- ea sa) (+ (- ea sa) (* 2.0 pi))))
(setq sweep (* sweep (/ 180.0 pi)))
(if (not (or (< (abs (- sweep 30.0)) tol)
(< (abs (- sweep 60.0)) tol)
(< (abs (- sweep 90.0)) tol)))
(setq bad sweep))
)
)
)
bad
)
;; AS-Element fuer Modus 2 (GF): gemischte Verankerung.
;; - Laengsrichtung (entlang hz): KS_EIN auf den Startpunkt (Laengsposition)
;; - Querrichtung (senkrecht hz): KS_AUS auf den Pfad (Kettenmittellinie)
;; Umsetzung: (1) AS mit KS_EIN am Startpunkt platzieren, (2) Querversatz des
;; KS_AUS zum Pfad messen, (3) AS senkrecht zu hz um -Versatz verschieben.
;; Ergebnis: KS_EIN.X = Startpunkt.X, KS_EIN quer um das AS-Y-Mass versetzt,
;; KS_AUS liegt exakt auf dem Pfad -> die ganze Kette folgt der Mittellinie.
;; Rueckgabe: (korrigierter) Frame am KS_AUS.
;; winkel-Parameter bleibt aus Call-Kompatibilitaet bestehen (vfl2-insert-as-vf
;; ruft mit 0.0), wird aber NICHT mehr fuer eine Kippung verwendet: das AS-
;; Element hat keine eigene Neigung (per Einzel-Insert-Test in BricsCAD
;; bestaetigt, siehe vfl-insert-as-element in Modus 1) - unabhaengig vom
;; folgenden Segmenttyp (GF/VF) wird es IMMER flach eingefuegt.
(defun vfl2-insert-as-gf (startpunkt hz winkel as-seite /
ein-hz-as rad-h xu-ein frame blk ks-aus
rad-hz perp-x perp-y d-perp sx sy as-turn
rad-ein de-x de-y de-dot-np t-shift)
;; Schwenk aus dem AS-Block MESSEN (30/90/gerade), KS_EIN so drehen, dass
;; KS_AUS entlang hz zeigt: ein-hz = hz - plan-turn.
(setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)))
(setq ein-hz-as (- hz as-turn))
(setq rad-h (* (float ein-hz-as) (/ pi 180.0)))
(setq xu-ein (list (cos rad-h) (sin rad-h) 0.0))
;; (1) KS_EIN auf den Startpunkt (Laengsposition korrekt)
(setq frame (insert-block-mixed-to-ks
(strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)
(make-frame-from-dir startpunkt xu-ein)
(caddr startpunkt) "KS_EIN" "KS_EIN"))
(setq blk (entlast))
;; (2) Querversatz des KS_AUS zum Pfad (Einheits-Querrichtung senkrecht zu hz)
(setq ks-aus (car frame))
(setq rad-hz (* (float hz) (/ pi 180.0)))
(setq perp-x (- (sin rad-hz)) perp-y (cos rad-hz)) ; Normale zum Pfad
(setq d-perp (+ (* (- (car ks-aus) (car startpunkt)) perp-x)
(* (- (cadr ks-aus) (cadr startpunkt)) perp-y)))
;; (3) AS ENTLANG der KS_EIN-Achse verschieben (nicht senkrecht zum Pfad):
;; damit landet KS_AUS auf dem Pfad UND der Startpunkt bleibt auf der KS_EIN-
;; Achse. Beim 90-Grad-Element ist die KS_EIN-Achse senkrecht zum Pfad -> das
;; ist identisch zum bisherigen Querschub.
(setq rad-ein (* (float ein-hz-as) (/ pi 180.0)))
(setq de-x (cos rad-ein) de-y (sin rad-ein)) ; KS_EIN-Achsrichtung
(setq de-dot-np (+ (* de-x perp-x) (* de-y perp-y)))
(setq t-shift (if (> (abs de-dot-np) 1e-6) (/ d-perp de-dot-np) 0.0))
(setq sx (* (- t-shift) de-x) sy (* (- t-shift) de-y))
(if (> (abs t-shift) 1e-6)
(vla-Move (vlax-ename->vla-object blk)
(vlax-3D-point '(0.0 0.0 0.0)) (vlax-3D-point (list sx sy 0.0))))
;; (4) korrigierten KS_AUS-Frame zurueckgeben (Richtung unveraendert)
(list (list (+ (car ks-aus) sx) (+ (cadr ks-aus) sy) (caddr ks-aus))
(cadr frame) (caddr frame) (cadddr frame))
)
;; VF-Start-AS (Modus 2): identische Platzierung wie beim GF-Start, aber FLACH
;; (0 Grad Neigung). Das AS wird mit KS_EIN auf den Startpunkt gesetzt und dann
;; senkrecht zu hz auf den Pfad geschoben (reine KS-Kettung, KS_AUS auf Pfad).
;; Damit liegt auch eine mit VF beginnende Kette auf dem gezeichneten Pfad.
(defun vfl2-insert-as-vf (startpunkt hz as-seite)
(vfl2-insert-as-gf startpunkt hz 0.0 as-seite))
;; VF-Einheit OEFFNEN (Modus 2): GF1 (Basis-Staustrecke) + Separator +
;; Umlenkstation. Rueckgabe: Frame nach der Umlenkstation (Beginn reiner VF).
(defun vfl2-vf-open (frame hz / f)
(setq f (vfl-frame-3grad (vfs-vf-entry (car frame) *vfl-gf-min-laenge* hz nil) hz))
(if (> *vfl-gf-min-laenge* 0.1)
(vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
f)
;; VF-Einheit SCHLIESSEN (Modus 2): Motorstation + GF2 (Basis), KEIN Separator
;; (der sitzt erst am Kettenende bzw. optional zwischen Foerderern). Rueckgabe:
;; Frame nach GF2.
(defun vfl2-vf-close (frame hz / f)
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
(setq f (vfl-frame-3grad (vfs-vf-exit (car frame) *vfl-gf-min-laenge* hz nil) hz))
(if (> *vfl-gf-min-laenge* 0.1)
(vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
f)
;; Vario-Winkel (Vertikalbogen) auf die verfuegbaren Werte 3..51 einrasten.
(defun vfl2-snap-vfwinkel (w / liste best bd d)
(setq liste (ssg-cfg-or "vario" "bogen_winkel" '(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq best (car liste) bd 1e9)
(foreach x liste (setq d (abs (- x w))) (if (< d bd) (setq bd d best x)))
best)
;; --- Segment-Essenz einer selektierten Pfad-Kette (Modus 3) --------------
;; Fuehrt die 5-Feld-Bau-Segmente aus gf-analysiere-kette mit den absoluten
;; Start-/Endpunkten aus gf-sortiere-objekte (kette: (ent sp ep umk)) zu der
;; selbstbeschreibenden 9-Feld-Form zusammen, die das SEGS-Journal traegt:
;; (typ hz laenge bwinkel bseite spx spy epx epy)
;; Beide Listen sind gleich lang und in derselben Reihenfolge (segmente wurde
;; genau aus kette abgeleitet). spx/spy/epx/epy sind die planaren XY der
;; Segment-Enden - sie ersetzen den spaeteren direkten kette-Zugriff (AS-
;; Trimmung am ersten Segment, Soll-Ende-Report), sodass der Bau OHNE die
;; Original-Entities auskommt und beim Replay aus dem Journal gespeist wird.
(defun vfl-kette->segmente9 (kette segmente / out i seg item sp ep)
(setq out '() i 0)
(foreach seg segmente
(setq item (nth i kette) sp (cadr item) ep (caddr item))
(setq out (cons (list (nth 0 seg) (nth 1 seg) (nth 2 seg) (nth 3 seg) (nth 4 seg)
(car sp) (cadr sp) (car ep) (cadr ep))
out))
(setq i (1+ i)))
(reverse out))
;; 2D-Laenge eines Pfad-Objekts: LINE = Abstand Start-Endpunkt, ARC = Sehne
;; (Abstand Start-Endpunkt, dasselbe Mass wie gf-analysiere-kette es fuer die
;; Segmentlaenge nutzt). Nicht-LINE/ARC liefern 0.0 (werden dadurch als "zu
;; kurz" ausgewertet und verworfen). Rein lesend, ohne Nebeneffekt.
(defun vfl-obj-2d-laenge (obj / objname sp ep)
(setq objname (vla-get-ObjectName obj))
(if (or (= objname "AcDbLine") (= objname "AcDbArc"))
(progn
(setq sp (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint obj))))
(setq ep (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint obj))))
(gf-abstand-2d sp ep))
0.0))
;; Aus einer Objektliste alle Elemente unter *vfk-pfad-min-segmentlaenge*
;; herauswerfen (Geister-/Artefakt-Segmente, z.B. von einer Rechteck-Auswahl
;; miterfasste Mini-Objekte). Rueckgabe: (behalten-liste . verworfen-anzahl).
;; Reine Filterung, keine Meldung - der Aufrufer entscheidet ueber die Warnung.
(defun vfl-filter-mini-objekte (obj-liste / behalten verworfen)
(setq behalten '() verworfen 0)
(foreach obj obj-liste
(if (< (vfl-obj-2d-laenge obj) *vfk-pfad-min-segmentlaenge*)
(setq verworfen (1+ verworfen))
(setq behalten (cons obj behalten))))
(cons (reverse behalten) verworfen))
;; Objektauswahl + Analyse (Live) ODER Segment-Essenz aus dem Journal (Replay).
;; Gegenstueck zu vfl-in-selection, aber persistiert NICHT die Entity-Handles,
;; sondern die abgeleitete 9-Feld-Segmentliste (Journal-Art "SEGS"). Damit ist
;; der Modus-3-Block im XDATA vollstaendig beschrieben und der Doppelklick-Neubau
;; unabhaengig davon, ob die urspruenglichen LINE/ARC noch existieren.
;; Rueckgabe: die 9-Feld-Segmentliste oder nil (Abbruch/leer). filter/startpunkt
;; wie bei der Live-Auswahl; ecke-tol wird nur im Live-Zweig fuer die
;; Eck-Vorpruefung gebraucht (Replay-Daten sind bereits geprueft eingefroren).
(defun vfl-in-segmente (filter startpunkt ecke-tol / popped ss k obj-liste kette segmente ecke-bad segs9 filter-erg verworfen)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped
;; --- Replay: fertige Segment-Essenz direkt aus dem Journal ---
(progn
(setq segs9 (car popped))
(if (null segs9)
(if (vfl-headless-p) (vfl-headless-abbruch "SEGS-leer")))
segs9)
;; --- Live: Objekte waehlen, sortieren, analysieren, dann journalisieren ---
(progn
(if (vfl-headless-p) (vfl-headless-abbruch "SEGS"))
(setq ss (ssget filter))
(if (null ss)
(progn (vfl-journal-record "NIL" nil) nil)
(progn
;; Auswahlsatz -> VLA-Objektliste (wie im frueheren vfl-in-selection).
(setq obj-liste '() k 0)
(while (< k (sslength ss))
(setq obj-liste (cons (vlax-ename->vla-object (ssname ss k)) obj-liste))
(setq k (1+ k)))
(setq obj-liste (reverse obj-liste))
;; Geister-/Mini-Objekte VOR der Sortierung ausfiltern: ein von einer
;; Rechteck-Auswahl miterfasstes winziges Segment (unter
;; *vfk-pfad-min-segmentlaenge*) wuerde sonst per Nearest-Neighbor
;; stumm in die Kette gehaengt und ein Geister-Bauteil erzeugen (realer
;; Bug: 14-mm-Bogen am Kettenende). Verworfene mit Grund melden.
(setq filter-erg (vfl-filter-mini-objekte obj-liste))
(setq obj-liste (car filter-erg) verworfen (cdr filter-erg))
(if (> verworfen 0)
(vfl-meldung (ssg-textf "vfl-m3-mini-objekte-verworfen"
(list (itoa verworfen) (rtos *vfk-pfad-min-segmentlaenge* 2 0)))))
(setq kette (if obj-liste (gf-sortiere-objekte obj-liste startpunkt) nil))
(if (null kette)
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar"))
(vfl-journal-record "NIL" nil) nil)
(progn
(setq segmente (gf-analysiere-kette kette))
(setq ecke-bad (vfl2-pruefe-eckwinkel kette ecke-tol))
(if ecke-bad
(progn
(vfl-meldung (ssg-textf "vfl-vwnb-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
(vfl-journal-record "NIL" nil) nil)
(progn
(setq segs9 (vfl-kette->segmente9 kette segmente))
(vfl-journal-record "SEGS" segs9)
segs9)))))))))
(defun vf-linienzug-modus3 ( / ss obj-liste startpunkt start-hoehe as-seite
es-seite kette segmente segmente9 n i seg seg-ent typ hz laenge
bwinkel bseite frame antwort winkel deltaL
anzahl-gf anzahl-vf vfl-nummer lastEnt hoehe-bis
ecke-bad first-line last-line letzt-winkel
aus ein soll-ende ist-ende run-typ richtn best-w
kvariante L_VF ent-fp rad3 just-open
dbg-an old-error dbg-old-error vfl-ins)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-vwnb-titel"))
(princ "\n=========================================")
;; --- 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-
;; Auswahlen) laufen ueber die vfl-in-*-Wrapper und werden dadurch
;; automatisch ueber vfl-journal-record mitgeloggt (siehe dort) - hier nur
;; noch Session-Start/-Ende + Zwischenergebnisse, die NICHT direkt aus einer
;; Nutzereingabe stammen (Analyse-Ergebnis, Segment-Header, Bau-Ergebnis).
;; *vfl-journal* wird - wie bei Modus 1/2 - als XDATA (Marker "linienzug3")
;; persistiert und ist damit per Doppelklick editierbar (vfl-edit-ent3, voller
;; Reset-Replay). Statt der Objekt-Handles traegt es die Segment-ESSENZ (SEGS,
;; siehe vfl-in-segmente): der Block ist selbst-enthalten und der Neubau
;; unabhaengig von den urspruenglichen LINE/ARC.
;; FRUEHER *error*-Handler: schliesst nur die dbg-Datei sauber, falls waehrend
;; der Pfad-/Praeambel-Phase (noch keine Geometrie) abgebrochen wird. Der
;; eigentliche Abbruch-WICKLER (Teil-Geometrie zu einem VF_n-Block sichern)
;; wird erst nach dem Setup scharf geschaltet (siehe unten), sobald
;; vfl-nummer/lastEnt feststehen - analog Modus 2.
(setq dbg-an (vfl-dbg-session-start "vfl-modus3" "vfl_modus3.dbg"
"vf-linienzug-modus3" "=== SESSION Modus 3 (Vorwaerts-Nachbau) START ==="))
(vfl-dbg-hook-installieren)
(vfl-gf-abhaengigkeit-sicherstellen "vfl-m3-alert-gf-modul")
;; --- 1./3. Pfad-Objekte + Segment-Essenz: siehe Schritt 3 unten. ---
;; Auswahl UND Ableitung laufen zusammen in vfl-in-segmente, weil die
;; Sortierung den Startpunkt braucht (Schritt 2) - die Objektauswahl steht
;; daher NACH der Startpunkt-/AS-Praeambel, nicht mehr davor. Journalisiert
;; wird nur noch die abgeleitete Segment-Essenz (SEGS), nicht die Handles.
;; --- 2. Startpunkt (hoehere Seite) + Hoehe + AS-Seite ---
;; Startpunkt + Hoehe (gemeinsame Praeambel-Schale, siehe vfl-frage-punkt-hoehe).
(setq startpunkt (vfl-frage-punkt-hoehe "vfl-m3-prompt-startpunkt"
"vfl-prompt-hoehe-startpunkt" "vfl-abgebrochen" "Starthoehe (Z, mm):"))
;; AS-Element (in Modus 3 immer gesetzt): Winkel(30/90) + Seite als EIN
;; Gruppen-Dialog. vflw-gruppe-winkel-seite-impl legt Winkel ("90"/"30")
;; und Seite ("1"/"2") in *vflw-pending* ab - genau die Reihenfolge, die
;; die beiden Reads unten erwarten. AS-Winkel ueber vfl-in-value (pending-
;; aware; vf-frage-element-winkel selbst ist es NICHT), damit der vom Dialog
;; abgelegte Wert konsumiert wird statt live erneut zu fragen.
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-winkel-seite-impl
(list "vf-winkel-aus-header"
(list (ssg-text "vf-winkel-90") (ssg-text "vf-winkel-30"))
(list "90" "30"))))
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-as-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
(if dbg-an (progn (dbgmsg "AS-Winkel:") (dbg '*vfl-as-winkel*) (dbgflush)))
(princ (ssg-text "vfl-vwnb-aus-seite-menu"))
(setq as-seite (if (= (vfl-in-string (ssg-text "prompt-wahl-1-2")) "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
;; --- 3. Pfad waehlen + Sortieren + Analysieren + Eck-Vorpruefung ---
;; vfl-in-segmente kapselt Live (ssget -> gf-sortiere-objekte ->
;; gf-analysiere-kette -> Eck-Vorpruefung -> 9-Feld-Essenz) UND Replay
;; (fertige Essenz aus dem SEGS-Journal). Persistiert die Segment-Essenz
;; statt der Objekt-Handles - damit ist der Block selbst-enthalten und der
;; Doppelklick-Neubau (vfl-edit-ent3) braucht die Original-LINE/ARC nicht.
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq segmente9 (vfl-in-segmente '((0 . "LINE,ARC")) startpunkt *vfk-eckwinkel-toleranz*))
(if (null segmente9) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
;; segmente = 5-Feld-Bausicht (typ hz laenge bwinkel bseite), abgeleitet aus
;; der 9-Feld-Essenz - der bestehende Bau unten arbeitet unveraendert damit.
(setq segmente (mapcar (function (lambda (s) (list (nth 0 s) (nth 1 s) (nth 2 s) (nth 3 s) (nth 4 s))))
segmente9))
(if dbg-an
(progn
(dbgmsg (strcat "ANALYSE: " (itoa (length segmente)) " Segment(e) erkannt"))
(dbg 'segmente)
(dbgflush)))
;; --- 5. Setup ---
(setq aus (if aus-dx aus-dx *vfk-as-es-fallback-dx*) ein (if ein-dx ein-dx *vfk-as-es-fallback-dx*))
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
;; Entry-Fussabdruck (planar) einer VF-Einheit: GF1(Basis)+Separator(300)+Umlenk(500)
(setq ent-fp (* (+ *vfl-gf-min-laenge* *vfk-separator-laenge* *vfk-stations-laenge*) (cos rad3)))
(setq run-typ nil)
(setq vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
(vfl-acc-reset)
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
;; --- Abbruch-Sicherung ab hier scharf (analog Modus 1/2) ---
;; Ab Schritt 6 kann jederzeit Geometrie entstehen. Der Wickler sichert die
;; bis zum Abbruch gebaute Teil-Geometrie als VF_n-Block mit dem vollen
;; Journal (Marker "linienzug3") - sie bleibt stehen und ist per Doppelklick
;; fortsetz-/editierbar. Loest den fruehen dbg-Hook ab (Ruecksprungziel bleibt
;; dbg-old-error) und uebernimmt das dbgclose. *ssg-ils-dim* zuruecksetzen:
;; Begruendung siehe gleichlautende Stelle in vf-linienzug-modus.
(setq old-error dbg-old-error)
;; Scharfen Abbruch-Wickel-Handler installieren (gemeinsam, siehe
;; vfl-abbruch-handler-installieren).
(vfl-abbruch-handler-installieren "linienzug3")
(setq n (length segmente))
;; erste/letzte "Linie" fuer die Trimmung bestimmen
(setq first-line -1 last-line -1 i 0)
(while (< i n)
(if (= (car (nth i segmente)) "Linie")
(progn (if (< first-line 0) (setq first-line i)) (setq last-line i)))
(setq i (1+ i)))
(if (< first-line 0)
(progn (vfl-meldung (ssg-text "vfl-vwnb-alert-keine-gerade")) (exit)))
;; --- 6. Bau-Schleife (Meilenstein 2: GF + VF-Laeufe, Run-State-Machine) ---
;; run-typ: nil / "GF" / "VF". Beim Wechsel GF<->VF wird die VF-Einheit
;; geoeffnet (GF1+Separator+Umlenk) bzw. geschlossen (Motor+GF2).
;; v1-Naeherung Laenge: Entry-Fussabdruck wird vom ersten VF-Koerper abgezogen;
;; der Exit (Motor+GF2) wird beim Schliessen ANGEHAENGT (verlaengert den VF-Lauf
;; ggue. dem gezeichneten Pfad; feinere Laengen-Reservierung -> spaeter).
(setq i 0)
(while (< i n)
(setq seg (nth i segmente) typ (car seg) hz (cadr seg))
;; seg-ent: KEINE Live-Entity mehr - Modus 3 baut jetzt aus der Segment-
;; Essenz (SEGS), nicht aus durchgereichten LINE/ARC. Damit entfaellt das
;; kosmetische Pfad-Segment-Highlight (vfl-seg-highlight ist nil-sicher).
;; Der Wegfall ist bewusst: die Essenz macht den Bau/Replay unabhaengig von
;; den Original-Objekten, ein Highlight haette beim Doppelklick-Neubau ohnehin
;; keine Entity mehr zum Hervorheben.
(setq seg-ent nil)
;; Wizard: alle Fragen dieses Segments in EINEM Dialog erfassen (die
;; unveraenderten vfl-in-*-Aufrufe unten konsumieren die Antworten aus
;; *vflw-pending*). Bei einem Bogen ist Vario-Kurve nur im offenen VF-Lauf
;; erlaubt - deshalb die Variante-Antwort nur mitschicken, wenn run-typ="VF"
;; (sonst konsumiert der Aufrufer sie nicht und sie wuerde ins naechste
;; Segment lecken).
(if (vfl-wizard-aktiv)
(progn
(vfl-seg-highlight seg-ent T)
(if (= typ "Linie")
(vflw-seg-linie-m3-impl
(vfl-seg-kopf (1+ i) n
(strcat "Gerade L=" (rtos (caddr seg) 2 0) " mm hz=" (rtos hz 2 1)))
*vfk-gefaelle-winkel* 3)
(vflw-seg-bogen-impl
(vfl-seg-kopf (1+ i) n
(strcat "Eck/Bogen " (itoa (nth 3 seg)) " Grad " (nth 4 seg)))
(= run-typ "VF"))) ; Modus 3: Vario nur im offenen VF-Lauf
(vfl-seg-highlight seg-ent nil)))
(cond
;; ===================== GERADE =====================
((= typ "Linie")
(setq laenge (caddr seg))
(princ (ssg-textf "vfl-m3-seg-gerade"
(list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1))))
(if dbg-an
(dbgmsg (strcat "SEGMENT " (itoa (1+ i)) "/" (itoa n)
" GERADE (laenge=" (rtos laenge 2 0) " hz=" (rtos hz 2 1) ")")))
(princ (ssg-text "vfl-vwnb-typ-gerade"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2-3-4")))
(cond
;; --- GF-Gerade ---
((or (= antwort "") (= antwort "1"))
(if (= run-typ "VF") ; offenen VF-Lauf schliessen
(progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
(setq run-typ nil)))
(setq winkel (vfl-in-real (ssg-text "vfl-m3-prompt-gf-neigung")))
(if (null winkel) (setq winkel *vfk-gefaelle-winkel*))
(if (> winkel *vfk-gefaelle-winkel*)
(progn (princ (ssg-text "vfl-m3-hinweis-gf-max")) (setq winkel *vfk-gefaelle-winkel*)))
(if (null frame)
(setq frame (vfl2-insert-as-gf startpunkt hz winkel as-seite)))
(setq deltaL laenge)
;; erste Gerade: AS-Fussabdruck ENTLANG des Pfads exakt aus KS_AUS abziehen
(if (= i first-line)
(setq deltaL (- deltaL
(+ (* (- (car (car frame)) (car startpunkt)) (cos (* hz (/ pi 180.0))))
(* (- (cadr (car frame)) (cadr startpunkt)) (sin (* hz (/ pi 180.0))))))))
(if (= i last-line) (setq deltaL (- deltaL *vfk-separator-laenge* ein)))
(setq deltaL (max *vfk-restlaenge-min-clamp* deltaL))
(setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel))
(vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel)
(setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel run-typ "GF"))
;; --- VF-Gerade (Ab / Auf / Horizontal) ---
(t
(setq richtn (cond ((= antwort "3") "Auf") ((= antwort "4") "horizontal") (t "Ab")))
(setq just-open nil)
(if (null frame) ; AS (flach) am Kettenanfang, KS_AUS auf Pfad
(setq frame (vfl2-insert-as-vf startpunkt hz as-seite)))
(if (not (= run-typ "VF")) ; VF-Einheit oeffnen
(progn (setq frame (vfl2-vf-open frame hz))
(setq run-typ "VF" just-open t)))
(if (= richtn "horizontal")
(setq best-w 0)
(progn
(setq best-w (vfl-in-int (ssg-text "vfl-vwnb-prompt-vario-winkel")))
(if (null best-w) (setq best-w 3))
(setq best-w (vfl2-snap-vfwinkel best-w))
(if dbg-an (progn (dbgmsg "Vario-Winkel (gesnapt):") (dbg 'best-w) (dbgflush)))))
(setq L_VF laenge)
(if just-open (setq L_VF (- L_VF ent-fp))) ; Entry-Fussabdruck reservieren
(setq L_VF (max *vfk-restlaenge-min-clamp* L_VF))
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn best-w L_VF hz) hz))
(vfl-acc-vf-seg richtn best-w L_VF)
(setq anzahl-vf (1+ anzahl-vf) run-typ "VF"))))
;; ===================== ECK / BOGEN =====================
((= typ "Bogen")
(setq bwinkel (nth 3 seg) bseite (nth 4 seg))
(princ (ssg-textf "vfl-m3-seg-bogen"
(list (itoa (1+ i)) (itoa n) (itoa bwinkel) bseite)))
(if dbg-an
(dbgmsg (strcat "SEGMENT " (itoa (1+ i)) "/" (itoa n)
" BOGEN (bwinkel=" (itoa bwinkel) " bseite=" bseite ")")))
(princ (ssg-text "vfl-m3-typ-bogen"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2")
;; --- Vario-Kurve (nur im VF-Lauf) ---
(if (not (= run-typ "VF"))
(princ (ssg-text "vfl-vwnb-kurve-nur-vf"))
(progn
(princ (ssg-text "vfl-m3-variante-frage"))
(setq kvariante (if (= (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")) "1") "aussen" "innen"))
(setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite kvariante))))
;; --- GF-Bogen ---
(progn
(if (null frame)
(progn (vfl-meldung (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit)))
(if (= run-typ "VF") ; VF-Lauf vor GF-Bogen schliessen
(progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
(setq run-typ nil)))
(setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite))
(setq run-typ "GF"))))
)
(setq i (1+ i)))
;; --- 7. Kettenende: offenen VF-Lauf schliessen, dann Separator + ES ---
(if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit)))
;; vfl-frage-es-seite nutzt intern bereits vfl-in-value/vfl-menu - wird also
;; automatisch mitgeloggt, kein manueller dbgmsg noetig.
(setq es-seite (vfl-frage-es-seite nil))
(if (= run-typ "VF")
(progn
(setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
(setq frame (vfl-insert-es-element "VF" frame (car (frame->hz-winkel frame))
0.0 (caddr (car frame)) es-seite)))
(setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame))
(if letzt-winkel letzt-winkel *vfk-gefaelle-winkel*) (caddr (car frame)) es-seite)))
;; --- 8. Block + Journal-XDATA + Ist-Ziel-Report ---
(setq hoehe-bis (caddr (car frame)))
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt))
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug3") ->
;; spaeter per Doppelklick editierbar (vfl-edit-ent3: voller Reset-Replay wie
;; Modus 2, aus der Segment-Essenz statt aus Objekt-Handles).
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins "linienzug3"))
;; Endpunkt des letzten gezeichneten Segments - aus der Segment-Essenz
;; (epx/epy des letzten Segments), nicht mehr aus den Original-Entities.
;; Damit stimmt der Soll-Ende-Report auch beim Doppelklick-Neubau, wenn die
;; urspruenglichen LINE/ARC laengst weg sind.
(setq soll-ende (list (nth 7 (last segmente9)) (nth 8 (last segmente9))))
(setq ist-ende (car frame)) ; ES-KS_AUS
(princ "\n\n=========================================")
(princ (ssg-text "vfl-vwnb-eingefuegt"))
(princ (ssg-textf "vfl-vwnb-soll-ende"
(list (rtos (car soll-ende) 2 1) (rtos (cadr soll-ende) 2 1))))
(princ (ssg-textf "vfl-vwnb-ist-ende"
(list (rtos (car ist-ende) 2 1) (rtos (cadr ist-ende) 2 1) (rtos (caddr ist-ende) 2 1))))
(princ (ssg-textf "vfl-vwnb-abweichung-xy"
(list (rtos (- (car ist-ende) (car soll-ende)) 2 1)
(rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1))))
(princ "\n=========================================")
;; --- Debug-Session sauber abschliessen ---
(setq *error* old-error)
(if dbg-an
(progn
(dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer)
" (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")"))
(dbg 'soll-ende)
(dbg 'ist-ende)
(dbgmsg "=== SESSION Modus 3 ENDE ===")
(dbgreturn (list "VF" vfl-nummer))
(dbgclose)))
(princ)
)
;; ============================================================
;; MODUS 3: Pfad + Ziel-Hoehe (Randwert-Solver) - M3a
;; Schritt 1+2: Geruest + Klassifizierung + Anker-Report. NOCH KEIN Bauen.
;; Details siehe doc/VarioFoerderer_Linienzug_Prinzipien.md, Abschnitt 14.
;; ============================================================
;; Signierte Z-Aenderung (mm) einer GF-Geraden: negativ = Abfall.
;; l-planar = XY-Planlaenge (aus Pfad), winkel = Neigung in Grad (fallend).
;; Ueber die Planlaenge gilt dz = -L * tan(winkel) (Fussabdruck bleibt L,
;; die 3D-Laenge waechst mit L/cos, siehe Doc 14.1).
(defun vfl3-gf-dz (l-planar winkel / rad)
(setq rad (* (float winkel) (/ pi 180.0)))
(- (* (float l-planar) (/ (sin rad) (cos rad)))))
;; Signierte Z-Aenderung eines Plan-Eintrags.
;; GF-Gerade -> -L*tan(winkel)
;; GF-Bogen -> dz aus gf-bogen-masse (Block-KS)
;; Vario-Kurve -> 0 (auf 0 Grad geflacht)
;; VF-Gerade -> nil (unbekannt = Teil der Bruecke)
(defun vfl3-seg-dz (e)
(cond
((= (car e) "Linie")
(if (= (nth 3 e) "GF") (vfl3-gf-dz (caddr e) (nth 4 e)) nil))
((= (car e) "Bogen")
(if (= (nth 5 e) "Vario-Kurve")
0.0
(cadr (gf-bogen-masse (nth 3 e) (nth 4 e)))))
(t 0.0)))
;; Loest die VF-Bruecke ueber den Modus-1-Solver berechne-alle-winkel.
;; Die Bruecke sitzt MITTIG in der Kette -> KEIN terminales AS/ES
;; (aus-dx/aus-dz/ein-dx/ein-dz = 0), feste-hz = *vfl-feste-horizontal* (1300:
;; Umlenk 500 + Motor 500 + Einlauf-Separator 300). GF1/GF2 bleiben fest 3 Grad,
;; ihre Laenge variiert (das ist der Ausgleich, siehe Doc 14.3).
;; dH-signiert: negativ = Auf (steigt), positiv = Ab (faellt).
;; Rueckgabe: (winkel L_GF L_VF richtung) oder nil (kein passender Winkel).
(defun vfl3-solve-bruecke (span dH-signiert extra-fest /
o-adx o-adz o-eix o-eiz richtung fh res winkel)
(setq richtung (if (< dH-signiert 0) "Auf" "Ab"))
(setq fh (+ (if (boundp '*vfl-feste-horizontal*) *vfl-feste-horizontal* 1300.0)
(if extra-fest extra-fest 0.0)))
;; terminale AS/ES-Masse fuer die mittige Bruecke ausblenden (Save/Restore)
(setq o-adx aus-dx o-adz aus-dz o-eix ein-dx o-eiz ein-dz)
(setq aus-dx 0.0 aus-dz 0.0 ein-dx 0.0 ein-dz 0.0)
(setq res (berechne-alle-winkel span (abs dH-signiert) richtung fh nil))
(setq aus-dx o-adx aus-dz o-adz ein-dx o-eix ein-dz o-eiz)
(setq winkel (car res))
(if winkel (list winkel (cadr res) (caddr res) richtung) nil))
;; GF-Bogen-dz, wenn der Bogen bei Neigung theta (Grad) KS-gekettet wird:
;; der lokale (dx,dz) des Blocks wird um theta gekippt.
;; Z-Anteil = -dx*sin(theta) + dz*cos(theta) (negativ = Abfall)
(defun vfl3-bogen-dz-incl (bwinkel bseite theta / m dx dz rad)
(setq m (gf-bogen-masse bwinkel bseite) dx (car m) dz (cadr m))
(setq rad (* (float theta) (/ pi 180.0)))
(+ (* (- dx) (sin rad)) (* dz (cos rad))))
;; Exakter Gesamt-Abstieg (positiv, mm) des BACK-Laufs (Plan-Segmente ab
;; start-idx bis n-1) PLUS Auslauf-Separator (300 mm, bei aktueller Neigung) +
;; ES-Eigen-dz. Spiegelt den tatsaechlichen Bau (Trimmung der letzten Geraden um
;; 300+ein-fp, GF-Bogen bei Neigung). Eintritts-Neigung = 3 Grad (die Bruecke
;; endet mit GF2 auf 3 Grad). So wird die Junction-Hoehe exakt statt geschaetzt.
(defun vfl3-dback (plan start-idx n last-idx ein-fp / i seg drop inc w dL rad)
(setq drop 0.0 inc *vfk-gefaelle-winkel* i start-idx)
(while (< i n)
(setq seg (nth i plan))
(cond
((= (car seg) "Linie")
(setq w (nth 4 seg) dL (caddr seg))
(if (= i last-idx) (setq dL (- dL *vfk-separator-laenge* ein-fp)))
(setq dL (max *vfk-restlaenge-min-clamp* dL))
(setq rad (* (float w) (/ pi 180.0)))
(setq drop (+ drop (* dL (/ (sin rad) (cos rad)))))
(setq inc w))
((= (car seg) "Bogen")
(if (= (nth 5 seg) "GF-Bogen")
(setq drop (- drop (vfl3-bogen-dz-incl (nth 3 seg) (nth 4 seg) inc))))))
(setq i (1+ i)))
;; Auslauf-Separator (300 mm bei aktueller Neigung inc) + ES-Eigen-dz
(setq rad (* (float inc) (/ pi 180.0)))
(setq drop (+ drop (* *vfk-separator-laenge* (/ (sin rad) (cos rad)))))
(setq drop (+ drop (abs (if ein-dz ein-dz 65.0))))
drop)
;; Feste (von der Kletterlaenge UNABHAENGIGE) Z-Aenderung einer VF-Einheit bei
;; Kletterwinkel w (ohne GF2, das wird gemessen): GF1+Sep(300)+Umlenk(500)+
;; Motor(500) (alle 3 Grad, senkend) + je Kletterer zwei Boegen + je
;; Horizontal-Mitte-Koerper zwei 3-Grad-Uebergangsboegen. Einbau-Rotationen wie
;; in vfs-vf-koerper; Bogen-dz_eff = -dx*sin(rot) + dz_roh*cos(rot) (am Log
;; verifiziert). So ist die Hoehe rein rechnerisch bestimmt -> Kletterlaenge folgt.
(defun vfl3-einheit-fix-dz (w n-climb n-hor gf1 richtung /
pi180 rad3 s3 tot m1 m2 r1 r2 dz1 dz2)
(setq pi180 (/ pi 180.0) rad3 (* *vfk-gefaelle-winkel* pi180) s3 (sin rad3) tot 0.0)
;; feste 3-Grad-Teile senken immer ab (GF1 + Separator + Umlenk + Motor)
(setq tot (- tot (* (+ (float gf1) *vfk-separator-laenge* *vfk-stations-laenge* *vfk-stations-laenge*) s3)))
;; Kletterer-Boegen (Rotationen wie vfs-vf-koerper: 1. Bogen @3, 2. Bogen @(3-w)/(w+3))
(if (= richtung "Auf")
(setq m1 (get-bogen-mass bogen-auf w) r1 rad3
m2 (get-bogen-mass bogen-ab w) r2 (* (- *vfk-gefaelle-winkel* w) pi180))
(setq m1 (get-bogen-mass bogen-ab w) r1 rad3
m2 (get-bogen-mass bogen-auf w) r2 (* (+ w *vfk-gefaelle-winkel*) pi180)))
(setq dz1 (+ (* (- (car m1)) (sin r1)) (* (caddr m1) (cos r1))))
(setq dz2 (+ (* (- (car m2)) (sin r2)) (* (caddr m2) (cos r2))))
(setq tot (+ tot (* n-climb (+ dz1 dz2))))
;; Horizontal-Mitte-Koerper: auf_3@3 + ab_3@0
(setq m1 (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*)) m2 (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(setq dz1 (+ (* (- (car m1)) (sin rad3)) (* (caddr m1) (cos rad3))))
(setq dz2 (caddr m2))
(setq tot (+ tot (* n-hor (+ dz1 dz2))))
tot)
;; Fester PLANARER (XY-)Fussabdruck einer VF-Einheit bei Kletterwinkel w
;; (ohne die Kletter-Strecken selbst): Stationen (GF1+Sep+Umlenk+Motor, @3 Grad)
;; + je Kletterer die zwei Boegen + je Horizontal-Mitte-Koerper die zwei
;; 3-Grad-Boegen. dx_eff = dx*cos(rot) + dz_roh*sin(rot) (am Log verifiziert).
;; Dient der Winkelwahl: Fussabdruck + Kletter-Planlaenge soll die Lauflaenge treffen.
(defun vfl3-einheit-fix-dx (w n-climb n-hor gf1 richtung /
pi180 rad3 tot m1 m2 r1 r2 dx1 dx2)
(setq pi180 (/ pi 180.0) rad3 (* *vfk-gefaelle-winkel* pi180) tot 0.0)
(setq tot (* (+ (float gf1) *vfk-separator-laenge* *vfk-stations-laenge* *vfk-stations-laenge*) (cos rad3))) ; Stationen planar
(if (= richtung "Auf")
(setq m1 (get-bogen-mass bogen-auf w) r1 rad3
m2 (get-bogen-mass bogen-ab w) r2 (* (- *vfk-gefaelle-winkel* w) pi180))
(setq m1 (get-bogen-mass bogen-ab w) r1 rad3
m2 (get-bogen-mass bogen-auf w) r2 (* (+ w *vfk-gefaelle-winkel*) pi180)))
(setq dx1 (+ (* (car m1) (cos r1)) (* (caddr m1) (sin r1))))
(setq dx2 (+ (* (car m2) (cos r2)) (* (caddr m2) (sin r2))))
(setq tot (+ tot (* n-climb (+ dx1 dx2))))
(setq m1 (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*)) m2 (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(setq dx1 (+ (* (car m1) (cos rad3)) (* (caddr m1) (sin rad3)))) ; auf_3 @ 3
(setq dx2 (car m2)) ; ab_3 @ 0
(setq tot (+ tot (* n-hor (+ dx1 dx2))))
tot)
;; Uebergang von der 3-Grad-Kletterbasis in die FLACHE Zone (0 Grad): EIN auf_3-Bogen
;; (Rotation 3 Grad). Rueckgabe: neuer Punkt.
(defun vfl3-flach-ein (pt hz / m)
(setq m (get-bogen-mass bogen-auf 3))
(insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt 3 (car m) (caddr m) hz))
;; Uebergang aus der flachen Zone (0 Grad) zurueck auf 3-Grad-Basis: EIN ab_3-Bogen
;; (Rotation 0 Grad). Rueckgabe: neuer Punkt.
(defun vfl3-flach-aus (pt hz / m)
(setq m (get-bogen-mass bogen-ab 3))
(insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" pt 0 (car m) (caddr m) hz))
;; Kletter-Segment loesen und Winkel WAEHLEN LASSEN (Modus-1-Solver + vfl-waehle-winkel).
;; Mittige Bruecke -> KEIN terminales AS/ES (Masse auf 0, Save/Restore). feste = fester
;; Horizontal-Anteil des Kletter-Segments (Umlenk+Separator = 800; Motor sitzt spaeter
;; am Kettenende). Rueckgabe: (winkel L_GF L_VF richtung) oder nil.
(defun vfl3-waehle-winkel (span dH-signiert feste /
o-adx o-adz o-eix o-eiz richtung res wahl)
(setq richtung (if (< dH-signiert 0) "Auf" "Ab"))
(setq o-adx aus-dx o-adz aus-dz o-eix ein-dx o-eiz ein-dz)
(setq aus-dx 0.0 aus-dz 0.0 ein-dx 0.0 ein-dz 0.0)
(setq res (berechne-alle-winkel span (abs dH-signiert) richtung feste nil))
(setq aus-dx o-adx aus-dz o-adz ein-dx o-eix ein-dz o-eiz)
(setq wahl (vfl-waehle-winkel (nth 3 res)))
(if wahl (list (car wahl) (cadr wahl) (caddr wahl) richtung) nil))
;; ES-Element-Fussabdruck ENTLANG/QUER zu einer Fahrtrichtung seg-hz (Welt-
;; Komponenten), aus der REALEN Blockgeometrie (vf-element-ks-info) berechnet.
;; Kernstueck von vfl3-es-fueller, hier ausgelagert, damit AUCH die feste-vf-
;; Berechnung in vf-linienzug-modus2 (Fall hor-pairs=0, OHNE flache
;; Zone/vfl3-es-fueller) denselben Wert nutzen kann, statt den ES-Laengsanteil
;; im Laengenbudget des Solvers stillschweigend zu vergessen (realer Bug:
;; Kette ueberschoss um ungefaehr along-es+Separator, siehe dortiger Kommentar).
;; Rueckgabe: (list along-es perp-es) oder nil, wenn der Block nicht lesbar
;; ist (Aufrufer faellt dann auf eine grobe Naeherung zurueck).
(defun vfl3-es-vektor (es-block seg-hz / info theta dpx dpy npx npy phi vx vy vwx vwy)
(setq info (vf-element-ks-info es-block))
(if (null info)
nil
(progn
(setq theta (* seg-hz (/ pi 180.0)))
(setq dpx (cos theta) dpy (sin theta)) ; seg-hz Richtung
(setq npx (- (sin theta)) npy (cos theta)) ; senkrecht zu seg-hz
(setq phi (* (- seg-hz (car info)) (/ pi 180.0))) ; Block -> Welt
(setq vx (caddr info) vy (cadddr info))
(setq vwx (- (* vx (cos phi)) (* vy (sin phi)))) ; V_es (Welt)
(setq vwy (+ (* vx (sin phi)) (* vy (cos phi))))
(list (+ (* vwx dpx) (* vwy dpy)) (+ (* vwx npx) (* vwy npy)))
)
)
)
;; Letzte Fueller-Laenge so, dass der Endpunkt auf der ES-KS_AUS-Achse liegt.
;; pt = Fueller-Start (flach 0 Grad), seg-hz = letzte Richtung, es-block = ES-Block,
;; gf2 = erwartete GF2-Laenge, rad3 = 3 Grad (rad). Modell: der Schwanz (Fueller +
;; ab_3 + Motor + GF2 + Separator + ES) verschiebt sich starr entlang seg-hz.
;; KS_AUS = pt + (fill + C)*dp + perp-es*np
;; C = 196 (ab_3) + (Motor 500 + GF2 + Sep 300)*cos3 + along-es
;; Achse u_a = seg-hz + (KS_AUS.xu - KS_EIN.xu)_Block ; (Endpunkt-KS_AUS)*n_a=0 -> fill
(defun vfl3-es-fueller (pt endp seg-hz es-block gf2 rad3 /
vek theta dpx dpy npx npy info
along-es perp-es ua na-x na-y cc dp-na np-na ep-na)
(setq vek (vfl3-es-vektor es-block seg-hz))
(if (null vek)
(- (+ (* (- (car endp) (car pt)) (cos (* seg-hz (/ pi 180.0))))
(* (- (cadr endp) (cadr pt)) (sin (* seg-hz (/ pi 180.0)))))
(+ 196.0 (* (+ *vfk-feste-horizontal-kettenende* gf2) (cos rad3)))) ; Fallback: Along-Naeherung
(progn
(setq info (vf-element-ks-info es-block))
(setq theta (* seg-hz (/ pi 180.0)))
(setq dpx (cos theta) dpy (sin theta)) ; seg-hz Richtung
(setq npx (- (sin theta)) npy (cos theta)) ; senkrecht zu seg-hz
(setq along-es (car vek) perp-es (cadr vek))
(setq ua (* (+ seg-hz (- (cadr info) (car info))) (/ pi 180.0))) ; KS_AUS-Achse
(setq na-x (- (sin ua)) na-y (cos ua)) ; senkrecht zur KS_AUS-Achse
(setq cc (+ 196.0 (* (+ *vfk-feste-horizontal-kettenende* gf2) (cos rad3)) along-es))
(setq dp-na (+ (* dpx na-x) (* dpy na-y)))
(setq np-na (+ (* npx na-x) (* npy na-y)))
(setq ep-na (+ (* (- (car endp) (car pt)) na-x) (* (- (cadr endp) (cadr pt)) na-y)))
(if (> (abs dp-na) 1e-6)
(- (/ (- ep-na (* perp-es np-na)) dp-na) cc)
100.0))))
(defun vf-linienzug-modus2 ( / ss k obj-liste startpunkt start-hoehe as-seite
endpunkt end-hoehe es-seite kette segmente segmente9 n i seg
seg-ent
typ hz laenge bwinkel bseite antwort winkel klass
plan e ecke-bad vf-start vf-ende dz z-front
z-junction dH-bruecke span-bruecke dH-gesamt
vf-count in-vf richtn req-w loesung
aus ein first-line last-line frame deltaL
br-winkel br-gf1 br-gf2 br-lvf br-richtn pt
letzt-winkel vfl-nummer lastEnt anzahl-gf anzahl-vf
hoehe-bis soll-ende ist-ende old-error vfl-ins
vf-run-member carrier-idx kv-variante seg-hz letzt-koerper-hz
vf-first-line vf-last-line climber-span mid-hor
br-lvf this-lvf
nach-kurve nach-vf sep-vor-gf sep-nach-gf
n-climb n-hor target-climb winkel-list
fdz fdx wslope lvf planar-len ang-diff best-diff w
climb-thresh longest-idx climbers nonclimber-len
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
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
m2-lauf-antwort m2-offenes-ende es-frueh-abgelehnt
m2-front-antwort m2-offener-anfang m2-kein-gf1-vorne entry-fixed)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-m3-titel"))
(princ "\n=========================================")
;; *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
;; kurz vor Phase B (nach der Pfadauswahl UND der Startpunkt/Hoehe/AS-
;; Praeambel) und loeschte damit die bereits aufgezeichnete Praeambel dieses
;; Laufs selbst wieder.
(vfl-journal-reset-lauf)
;; --- Debug-Session (Schalter "vfl-modus2", DEFAULT AN) ------------------
;; (dbg-schalter-off "vfl-modus2") deaktiviert bei Bedarf. Alle Eingaben
;; laufen bereits durchgehend ueber die vfl-in-*-Wrapper (siehe unten) und
;; werden dadurch automatisch ueber vfl-journal-record mitgeloggt (analog
;; Modus 1). Ein FRUEHER, duenner *error*-Hook schliesst die Datei bereits
;; sauber, falls waehrend Phase A (Klassifizierungsfragen, noch keine
;; Geometrie) abgebrochen wird - die eigentliche Abbruch-Sicherung (Wickeln
;; der Teil-Geometrie) wird erst spaeter zu Beginn von Phase B installiert
;; (siehe dortiger Kommentar) und uebernimmt das Schliessen dann von hier.
(setq dbg-an (vfl-dbg-session-start "vfl-modus2" "vfl_modus2.dbg"
"vf-linienzug-modus2" "=== SESSION Modus 2 (3D-Objekte + Ziel-Hoehe) START ==="))
(vfl-dbg-hook-installieren)
(vfl-gf-abhaengigkeit-sicherstellen "vfl-m3-alert-gf-modul")
;; --- 1./4. Pfad-Objekte + Segment-Essenz: siehe Schritt 4 unten. ---
;; Auswahl UND Ableitung laufen zusammen in vfl-in-segmente (Live: ssget ->
;; gf-sortiere-objekte -> gf-analysiere-kette -> Eck-Vorpruefung -> SEGS;
;; Replay: fertige Essenz aus dem Journal). Persistiert die Segment-Essenz
;; statt der Objekt-Handles - der Block ist damit selbst-enthalten und der
;; Doppelklick-Neubau unabhaengig von den Original-LINE/ARC (behebt den
;; frueheren OBJS-Replay-Drift). Da vfl-in-segmente den startpunkt fuer die
;; Sortierung braucht, steht die Auswahl NACH der Startpunkt-Praeambel.
;; --- 2. Startpunkt + Z + AS-Seite ---
;; Startpunkt + Hoehe (gemeinsame Praeambel-Schale). start-hoehe wird spaeter
;; vom Solver gebraucht (z-front/dH-gesamt) - aus der Z-Koordinate ziehen.
(setq startpunkt (vfl-frage-punkt-hoehe "vfl-m3-prompt-startpunkt"
"vfl-prompt-hoehe-startpunkt" "gf-status-abgebrochen" "Starthoehe (Z, mm):"))
(setq start-hoehe (caddr startpunkt))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-as-setzen-frage")))
(princ (ssg-text "vfl-as-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-m3-as-nein"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-m3-as-nein")) 1
"vfl-as-setzen-frage"))
(setq as-vorhanden (/= antwort "2"))
;; Globals pro Lauf zuruecksetzen (siehe Kommentar in vf-linienzug-modus).
(setq *vfl-as-winkel* nil *vfl-es-winkel* nil)
(if as-vorhanden
(setq as-seite (vfl-frage-as-winkel-seite "gf-seite-aus-header"))
)
;; --- 3. Endpunkt + Z + ES-Seite (NEU in Modus 3) ---
;; Endpunkt + Zielhoehe (gemeinsame Praeambel-Schale). end-hoehe wird spaeter
;; vom Solver gebraucht (z-junction/dH-gesamt) - aus der Z-Koordinate ziehen.
(setq endpunkt (vfl-frage-punkt-hoehe "vfl-m3-prompt-endpunkt"
"vfl-m3-prompt-zielhoehe" "gf-status-abgebrochen" "Zielhoehe (Z, mm):"))
(setq end-hoehe (caddr endpunkt))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-es-setzen-frage")))
(princ (ssg-text "vfl-es-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-es-nein-zielpunkt"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-es-nein-zielpunkt")) 1
"vfl-es-setzen-frage"))
(setq es-vorhanden (/= antwort "2"))
(if es-vorhanden
(setq es-seite (vfl-frage-es-winkel-seite "gf-seite-ein-header"))
)
;; --- 4. Pfad waehlen + Sortieren + Analysieren + Eck-Vorpruefung ---
;; vfl-in-segmente kapselt Live + Replay und persistiert die Segment-Essenz
;; (SEGS) statt der Objekt-Handles - siehe Schritt 1 oben und Modus 3.
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq segmente9 (vfl-in-segmente '((0 . "LINE,ARC")) startpunkt *vfk-eckwinkel-toleranz*))
(if (null segmente9) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
;; segmente = 5-Feld-Bausicht (typ hz laenge bwinkel bseite) aus der 9-Feld-
;; Essenz - die Klassifizierungs-Schleife unten arbeitet unveraendert damit.
(setq segmente (mapcar (function (lambda (s) (list (nth 0 s) (nth 1 s) (nth 2 s) (nth 3 s) (nth 4 s))))
segmente9))
;; --- 5. Klassifizierung (Phase A: nur speichern, nichts bauen) ---
;; Plan-Eintrag Gerade: ("Linie" hz laenge klass winkel) klass=GF/VF
;; Plan-Eintrag Bogen : ("Bogen" hz chord bwinkel bseite klass)
(setq n (length segmente) i 0 plan '())
(while (< i n)
(setq seg (nth i segmente) typ (car seg) hz (cadr seg) laenge (caddr seg))
;; seg-ent: KEINE Live-Entity mehr - Modus 2 baut jetzt aus der Segment-
;; Essenz (SEGS), nicht aus durchgereichten LINE/ARC (siehe Modus 3). Damit
;; entfaellt das kosmetische Pfad-Segment-Highlight (vfl-seg-highlight ist
;; nil-sicher). Bewusst: die Essenz macht Bau/Replay unabhaengig von den
;; Original-Objekten, ein Highlight haette beim Doppelklick-Neubau ohnehin
;; keine Entity mehr.
(setq seg-ent nil)
;; Wizard: alle Fragen dieses Segments in EINEM Dialog erfassen (die
;; unveraenderten vfl-menu/vfl-in-*-Aufrufe unten konsumieren die Antworten
;; aus *vflw-pending*). Der nach-kurve-Fall stellt keine Frage (auto-VF) ->
;; kein Dialog. Ebenso nach-vf bei einem Bogen: Vario-Kurve ist dann
;; erzwungen (eine VF-Einheit kann nicht in einen GF-Bogen auslaufen).
(if (and (vfl-wizard-aktiv)
(not (and (= typ "Linie") nach-kurve))
(not (and (= typ "Bogen") nach-vf)))
(progn
(vfl-seg-highlight seg-ent T)
(if (= typ "Linie")
(vflw-seg-linie-m2-impl
(vfl-seg-kopf (1+ i) n
(strcat "Gerade L=" (rtos laenge 2 0) " mm hz=" (rtos hz 2 1)))
*vfk-gefaelle-winkel*)
(vflw-seg-bogen-impl
(vfl-seg-kopf (1+ i) n
(strcat "Eck/Bogen " (itoa (nth 3 seg)) " Grad " (nth 4 seg)))
T)) ; Modus 2: Vario-Kurve immer erlaubt
(vfl-seg-highlight seg-ent nil)))
(cond
((= typ "Linie")
(princ (ssg-textf "vfl-m3-seg-gerade"
(list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1))))
(cond
;; Direkt nach einer Vario-Kurve: automatisch VF (keine Abfrage) -
;; die Kurve sitzt mitten in der VF-Einheit, es MUSS VF folgen.
(nach-kurve
(princ (ssg-text "vfl-m3-auto-vf"))
(setq plan (cons (list "Linie" hz laenge "VF" nil) plan))
(setq nach-kurve nil nach-vf t))
(t
(princ (ssg-text "vfl-m3-typ-gerade"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list "GF (Neigungswinkel)" "VF (Bruecke)") 1
"vfl-m3-typ-gerade"))
(if (= antwort "2")
(progn
(setq plan (cons (list "Linie" hz laenge "VF" nil) plan))
(setq nach-vf t))
(progn
(setq winkel (vfl-in-real (ssg-text "vfl-m3-prompt-gf-neigung")))
(if (null winkel) (setq winkel *vfk-gefaelle-winkel*))
(if (> winkel *vfk-gefaelle-winkel*)
(progn (princ (ssg-text "vfl-m3-hinweis-gf-max")) (setq winkel *vfk-gefaelle-winkel*)))
;; Separator VOR/NACH diesem GF-Stueck (analog Modus 1) - die
;; Planlaenge bleibt hier UNVERAENDERT (reale Pfadlaenge, fuer
;; die Anker-Vorschau noetig); die Trennung in GF-Koerper+
;; Separator passiert erst beim Bauen (Phase B).
(princ (ssg-text "vfl-sep-vor-gf-frage"))
(setq sep-vor-gf (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-sep-vor-gf-frage") "1"))
(princ (ssg-text "vfl-sep-nach-gf-frage"))
(setq sep-nach-gf (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-sep-nach-gf-frage") "1"))
(setq plan (cons (list "Linie" hz laenge "GF" winkel sep-vor-gf sep-nach-gf) plan))
(setq nach-vf nil))))))
((= typ "Bogen")
(setq bwinkel (nth 3 seg) bseite (nth 4 seg))
(princ (ssg-textf "vfl-m3-seg-bogen"
(list (itoa (1+ i)) (itoa n) (itoa bwinkel) bseite)))
(if nach-vf
(setq antwort "2") ; nach VF-Gerade: Vario-Kurve erzwungen, keine Typ-Frage
(progn
(princ (ssg-text "vfl-m3-typ-bogen"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list "GF-Bogen" "Vario-Kurve") 1
"vfl-m3-typ-bogen"))))
(setq nach-vf nil)
(if (= antwort "2")
(progn
(princ (ssg-text "vfl-m3-variante-frage"))
(setq kv-variante (if (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
(list (ssg-text "vfl-variante-aussen") (ssg-text "vfl-variante-innen")) 2
"vfl-m3-variante-frage")
"1") "aussen" "innen"))
(setq plan (cons (list "Bogen" hz laenge bwinkel bseite "Vario-Kurve" kv-variante) plan))
(setq nach-kurve t)) ; naechste Gerade automatisch VF
(progn
(setq plan (cons (list "Bogen" hz laenge bwinkel bseite "GF-Bogen" nil) plan))
(setq nach-kurve nil)))))
(setq i (1+ i)))
(setq plan (reverse plan))
;; --- 6. VF-Lauf finden: VF-Geraden UND Vario-Kurven bilden EINEN Lauf ---
;; (Vario-Kurve gehoert in die VF-Einheit, unterbricht den Lauf also NICHT).
(setq vf-start -1 vf-ende -1 vf-count 0 in-vf nil i 0)
(foreach e plan
;; NICHT "member" nennen: eine gleichnamige Lokale verdeckt in AutoLISP das
;; Builtin member, das weiter unten im selben Scope gebraucht wird.
(setq vf-run-member (or (and (= (car e) "Linie") (= (nth 3 e) "VF"))
(and (= (car e) "Bogen") (= (nth 5 e) "Vario-Kurve"))))
(if vf-run-member
(progn
(if (not in-vf) (setq vf-count (1+ vf-count) vf-start i in-vf t))
(setq vf-ende i))
(setq in-vf nil))
(setq i (1+ i)))
(if (/= vf-count 1)
(progn
;; Konsolen-Diagnose (fuer den Log / dbg-Nachvollzug) ...
(princ (ssg-textf "vfl-m3-vf-laeufe" (list (itoa vf-count))))
(princ (ssg-text "vfl-m3-vf-lauf-noetig"))
(princ (ssg-text "vfl-m3-vf-lauf-m3b"))
;; ... UND als sichtbare Meldung, damit die Abweisung nicht in der
;; Konsole untergeht (vfl-meldung zeigt bei erlaubter GUI ein alert,
;; headless nur princ - blockiert also einen Batch-Lauf nicht).
(vfl-meldung (ssg-textf "vfl-m3-vf-lauf-alert" (list (itoa vf-count))))
(exit)))
;; Traeger-Stueck = laengste VF-Gerade im Lauf (traegt die ganze Hoehe).
(setq carrier-idx -1 i vf-start)
(while (<= i vf-ende)
(setq seg (nth i plan))
(if (and (= (car seg) "Linie") (= (nth 3 seg) "VF"))
(if (or (< carrier-idx 0) (> (caddr seg) (caddr (nth carrier-idx plan))))
(setq carrier-idx i)))
(setq i (1+ i)))
(if (< carrier-idx 0)
(progn (princ (ssg-text "vfl-m3-vf-lauf-ohne-gerade")) (exit)))
;; --- 7. Anker rechnen ---
;; Vorwaerts: Start-Z durch alle Front-Segmente (Index < vf-start).
(setq z-front (float start-hoehe) i 0)
(while (< i vf-start)
(setq dz (vfl3-seg-dz (nth i plan)))
(if dz (setq z-front (+ z-front dz)))
(setq i (1+ i)))
;; Rueckwaerts: Ziel-Z durch alle Back-Segmente (Index > vf-ende).
;; Vorwaerts gilt Z_next = Z_prev + dz -> rueckwaerts Z_prev = Z_next - dz.
(setq z-junction (float end-hoehe) i (1- n))
(while (> i vf-ende)
(setq dz (vfl3-seg-dz (nth i plan)))
(if dz (setq z-junction (- z-junction dz)))
(setq i (1- i)))
;; Bruecken-Spannweite = Summe der VF-Geraden-Planlaengen im Lauf.
(setq span-bruecke 0.0 i vf-start)
(while (<= i vf-ende)
(setq seg (nth i plan))
(if (= (car seg) "Linie") (setq span-bruecke (+ span-bruecke (caddr seg))))
(setq i (1+ i)))
(setq dH-bruecke (- z-front z-junction))
(setq dH-gesamt (- (float start-hoehe) (float end-hoehe)))
;; --- 8. Anker-Report (noch kein Bauen) ---
(princ "\n\n=========================================")
(princ (ssg-text "vfl-m3-anker-vorschau-header"))
(princ "\n=========================================")
(princ (ssg-textf "vfl-m3-start-hoehe" (list (rtos (float start-hoehe) 2 1))))
(princ (ssg-textf "vfl-m3-ziel-hoehe" (list (rtos (float end-hoehe) 2 1))))
(princ (ssg-textf "vfl-m3-delta-h-gesamt" (list (rtos dH-gesamt 2 1))))
(princ (ssg-textf "vfl-m3-vf-lauf-segmente" (list (itoa (1+ vf-start)) (itoa (1+ vf-ende)))))
(princ (ssg-textf "vfl-m3-front-anker-vorschau" (list (rtos z-front 2 1))))
(princ (ssg-textf "vfl-m3-junction-anker-vorschau" (list (rtos z-junction 2 1))))
;; Vorzeichen = Richtung (VF ist angetrieben, kann steigen UND fallen).
(setq richtn (cond ((< dH-bruecke -0.1) (ssg-text "vfl-m3-richtung-auf"))
((> dH-bruecke 0.1) (ssg-text "vfl-m3-richtung-ab"))
(t (ssg-text "vfl-m3-richtung-horizontal"))))
(setq req-w (if (> span-bruecke 1.0)
(* (atan (/ (abs dH-bruecke) span-bruecke)) (/ 180.0 pi))
0.0))
(princ (ssg-textf "vfl-m3-bruecke-dh" (list (rtos dH-bruecke 2 1) (rtos span-bruecke 2 0))))
(princ (ssg-textf "vfl-m3-bruecke-richtung" (list richtn)))
(princ (ssg-text "vfl-m3-vf-angetrieben"))
(princ (ssg-textf "vfl-m3-mittlere-neigung" (list (rtos req-w 2 1))))
(if (> req-w *vfk-vario-winkel-max*)
(princ (ssg-text "vfl-m3-warnung-zu-steil"))
(princ (ssg-text "vfl-m3-vario-bereich-ok")))
(princ (ssg-text "vfl-m3-anker-hinweis"))
(princ "\n=========================================")
;; --- Lauf-Anfang waehlen, NUR wenn der VF-Lauf der Pfadanfang ist (kein
;; Front-Lauf davor) - sonst bleibt die Steuerung komplett unveraendert (AS-
;; Element aus der Upfront-Frage, Umlenkstation+GF1+Separator immer gebaut).
;; Muss VOR der Phase-B2-Fussabdruck-Berechnung (entry-fixed) feststehen.
(setq m2-offener-anfang nil m2-kein-gf1-vorne nil)
(if (= vf-start 0)
(progn
(princ (ssg-text "vfl-m3-lauf-anfang-header"))
(princ (ssg-text "vfl-m3-lauf-anfang-opt-offen"))
(princ (ssg-text "vfl-m3-lauf-anfang-opt-umlenk"))
(princ (ssg-text "vfl-m3-lauf-anfang-opt-umlenk-gf1"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-m2-lauf-anfang-impl (list (ssg-text "vfl-m3-lauf-anfang-header"))))
(setq m2-front-antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3")
(list (ssg-text "vfl-m3-lauf-anfang-opt-offen")
(ssg-text "vfl-m3-lauf-anfang-opt-umlenk")
(ssg-text "vfl-m3-lauf-anfang-opt-umlenk-gf1")) 3
"vfl-m3-lauf-anfang-header"))
(cond
((= m2-front-antwort "1")
(setq as-vorhanden nil m2-offener-anfang t)
(princ (ssg-text "vfl-m3-lauf-anfang-offen-hinweis")))
((= m2-front-antwort "2") (setq m2-kein-gf1-vorne t)))))
;; --- Lauf-Abschluss waehlen, NUR wenn der VF-Lauf das Pfadende ist (kein
;; Back-Lauf danach) - sonst bleibt die Steuerung komplett unveraendert
;; (es-vorhanden aus der Upfront-Frage, Motorstation immer gebaut). "Ohne
;; Motorstation" muss VOR der Phase-B2-Zielhoehen-Berechnung feststehen,
;; da sie die Separator/ES-Naeherung in vfl3-dback wieder aufhebt.
(setq m2-offenes-ende nil)
(if (= vf-ende (1- n))
(progn
;; es-frueh-abgelehnt: die Upfront-Frage ("ES-Element setzen?", vor der
;; Segment-Klassifizierung) wurde bereits mit "Nein" beantwortet - dann
;; hier NICHT nochmal die volle 3-Optionen-Auswahl anbieten (verwirrend,
;; siehe Nutzer-Feedback: Option 3 widerspricht der schon getroffenen
;; Entscheidung). Console UND Wizard bekommen dieselbe reduzierte Liste.
(setq es-frueh-abgelehnt (not es-vorhanden))
(princ (ssg-text "vfl-m3-lauf-abschluss-header"))
(princ (ssg-text "vfl-m3-lauf-abschluss-opt-offen"))
(princ (ssg-text "vfl-m3-lauf-abschluss-opt-motor"))
(if (not es-frueh-abgelehnt) (princ (ssg-text "vfl-m3-lauf-abschluss-opt-motor-es")))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-m2-lauf-abschluss-impl
(list (ssg-text "vfl-m3-lauf-abschluss-header") es-frueh-abgelehnt)))
(setq m2-lauf-antwort (vfl-menu (ssg-text (if es-frueh-abgelehnt
"vfl-prompt-wahl-1-2-def2"
"vfl-prompt-wahl-1-3-def2"))
(if es-frueh-abgelehnt
(list (ssg-text "vfl-m3-lauf-abschluss-opt-offen")
(ssg-text "vfl-m3-lauf-abschluss-opt-motor"))
(list (ssg-text "vfl-m3-lauf-abschluss-opt-offen")
(ssg-text "vfl-m3-lauf-abschluss-opt-motor")
(ssg-text "vfl-m3-lauf-abschluss-opt-motor-es"))) 2
"vfl-m3-lauf-abschluss-header"))
(cond
((= m2-lauf-antwort "1")
(setq es-vorhanden nil m2-offenes-ende t)
(princ (ssg-text "vfl-m3-lauf-abschluss-offen-hinweis")))
((and (= m2-lauf-antwort "3") (not es-frueh-abgelehnt))
(setq es-vorhanden t)
(if (null es-seite) (setq es-seite (vfl-frage-es-seite nil))))
(t (setq es-vorhanden nil)))))
;; ================= PHASE B: BAUEN (messen statt schaetzen) =================
;; VF-Lauf darf mehrsegmentig sein (VF-Geraden + Vario-Kurven, EINE VF-Einheit).
;; Nummerierung + Akkumulatoren + AS/ES-Fussabdruecke. Ohne AS-Element (aus-
;; vorhanden=nil) faellt der Fussabdruck weg - die Kette beginnt direkt am
;; Startpunkt, also 0 statt Block-/Fallback-Mass.
(setq aus (if as-vorhanden (if aus-dx aus-dx *vfk-as-es-fallback-dx*) 0.0)
ein (if es-vorhanden (if ein-dx ein-dx *vfk-as-es-fallback-dx*) 0.0))
(setq vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
(vfl-acc-reset)
;; *vfl-journal*-Reset steht jetzt GANZ AM ANFANG der Funktion (vor der
;; Pfadauswahl/Praeambel) - siehe Kommentar dort. Hier NICHT mehr noetig
;; (und schaedlich: wuerde die bereits aufgezeichnete Praeambel dieses
;; Laufs wieder loeschen).
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
;; --- Abbruch-Sicherung ab hier scharf (analog Modus 1, siehe dortiger
;; Kommentar) - Phase A (oben) baut noch keine Geometrie, ein Abbruch
;; waehrend der Klassifizierungsfragen haette also ohnehin nichts zu
;; wickeln. Ab Phase B kann jederzeit Geometrie entstehen.
;; *error* ist hier bereits der fruehe dbg-Hook vom Funktionsanfang - wir
;; loesen ihn komplett ab (Ruecksprungziel ist dbg-old-error, NICHT der
;; dbg-Hook selbst) und uebernehmen das dbgclose gleich mit, sonst wuerde
;; bei einem Abbruch ab hier doppelt geschlossen.
(setq old-error dbg-old-error)
;; Scharfen Abbruch-Wickel-Handler installieren (loest den fruehen dbg-Hook ab,
;; Ruecksprungziel bleibt dbg-old-error via old-error). Gemeinsam fuer alle
;; Modi - siehe vfl-abbruch-handler-installieren.
(vfl-abbruch-handler-installieren "linienzug2")
;; erste/letzte Gerade fuer AS/ES-Trimmung bestimmen
(setq first-line -1 last-line -1 i 0)
(while (< i n)
(if (= (car (nth i plan)) "Linie")
(progn (if (< first-line 0) (setq first-line i)) (setq last-line i)))
(setq i (1+ i)))
;; --- B1: FRONT-Lauf bauen (Segmente 0 .. vf-start-1) -> Front-Anker MESSEN ---
(princ (ssg-text "vfl-m3-phase-b1"))
(setq i 0)
(while (< i vf-start)
(setq seg (nth i plan) typ (car seg) hz (cadr seg))
(cond
((= typ "Linie")
(setq winkel (nth 4 seg) sep-vor-gf (nth 5 seg) sep-nach-gf (nth 6 seg))
;; AS zuerst platzieren (falls gewuenscht), damit der echte KS_AUS bekannt
;; ist. Ohne AS-Element beginnt die Kette direkt am Startpunkt (flach) -
;; die nachfolgende Fussabdruck-Trimmung wird dann automatisch zu 0, da
;; (car frame) bereits gleich startpunkt ist.
(if (null frame)
(setq frame (if as-vorhanden
(vfl2-insert-as-gf startpunkt hz winkel as-seite)
(make-frame-from-dir startpunkt (hz-winkel->xu hz 0.0)))))
(setq deltaL (caddr seg))
;; erste Gerade: AS-Fussabdruck ENTLANG des Pfads exakt aus KS_AUS abziehen
;; (das Block-Maß aus-dx stimmt nach dem Achs-Versatz nicht mehr).
(if (= i first-line)
(setq deltaL (- deltaL
(+ (* (- (car (car frame)) (car startpunkt)) (cos (* hz (/ pi 180.0))))
(* (- (cadr (car frame)) (cadr startpunkt)) (sin (* hz (/ pi 180.0))))))))
;; Separator(en) VOR/NACH aus der Klassifizierung (Punkt 1): die reale
;; Planlaenge (deltaL, oben aus dem gemessenen Pfad) bleibt fuer die
;; Anker-Vorschau unangetastet - erst HIER, beim tatsaechlichen Bauen,
;; wird der GF-Koerper um die Separator-Laenge(n) verkuerzt.
(if sep-vor-gf (setq deltaL (- deltaL *vfk-separator-laenge*)))
(if sep-nach-gf (setq deltaL (- deltaL *vfk-separator-laenge*)))
(setq deltaL (max *vfk-restlaenge-min-clamp* deltaL))
(if sep-vor-gf
(progn
(setq frame (make-frame-from-dir
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car frame) hz winkel *vfk-separator-laenge* 0)
(hz-winkel->xu hz winkel)))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))))
(setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel))
(vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel)
(setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel)
(if sep-nach-gf
(progn
(setq frame (make-frame-from-dir
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car frame) hz winkel *vfk-separator-laenge* 0)
(hz-winkel->xu hz winkel)))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*)))))
((= typ "Bogen")
(setq bwinkel (nth 3 seg) bseite (nth 4 seg) klass (nth 5 seg))
(if (= klass "GF-Bogen")
(progn
(if (null frame)
(progn (vfl-meldung (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit)))
(setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite)))
(princ (ssg-text "vfl-m3-kurve-front-uebersprungen")))))
(setq i (1+ i)))
;; Front-Anker (gemessen). Falls die VF-Bruecke ganz vorne liegt: AS (falls
;; gewuenscht) jetzt setzen.
(setq hz (cadr (nth vf-start plan)))
(if (null frame)
(setq frame (if as-vorhanden
(vfl2-insert-as-vf startpunkt hz as-seite)
(make-frame-from-dir startpunkt (hz-winkel->xu hz 0.0)))))
(setq z-front (caddr (car frame)))
;; --- B2: Back-Abstieg -> Junction; Kletterer + Horizontal-Mitte bestimmen ---
(setq z-junction (+ (float end-hoehe)
(vfl3-dback plan (1+ vf-ende) n last-line ein)))
;; Offenes Ende (kein Motor/Separator/ES danach) ODER Motor+GF2 OHNE ES
;; danach (Lauf-Abschluss "Motorstation", es-vorhanden nil - Motor selbst
;; ist bereits ueber dH-adj/*vfk-bruecke-korrektur* separat eingerechnet,
;; siehe Phase B weiter unten): vfl3-dback's Tail-Naeherung (reserviert
;; IMMER einen Separator+ES-Fussabdruck) ist in BEIDEN Faellen falsch - die
;; Zielhoehe fuer den Loeser ist exakt end-hoehe. Realer Bug, bis dahin nur
;; fuer m2-offenes-ende behandelt: "Motorstation ohne ES" fiel durch dieselbe
;; Luecke und bekam einen unkorrigierten Hoehenfehler in Groesse des
;; faelschlich angenommenen Separator+ES-Abstiegs.
(if (or m2-offenes-ende (not es-vorhanden)) (setq z-junction (float end-hoehe)))
(setq dH-bruecke (- z-front z-junction))
;; Modell: EIN Vario mit Horizontal-Mitte. Nur VF-Geraden, die LANG GENUG sind
;; (Vertikalboegen brauchen viel Platz), tragen die Hoehe (Kletterer, gleicher
;; Winkel). Zu kurze VF-Geraden werden horizontal (nur Anschluss/Motor).
;; Mindestens die laengste VF-Gerade klettert immer.
(setq climb-thresh (if (boundp '*vfl-min-climber-laenge*) *vfl-min-climber-laenge* 3000.0))
(setq longest-idx -1 i vf-start)
(while (<= i vf-ende)
(setq seg (nth i plan))
(if (and (= (car seg) "Linie") (= (nth 3 seg) "VF"))
(if (or (< longest-idx 0) (> (caddr seg) (caddr (nth longest-idx plan))))
(setq longest-idx i)))
(setq i (1+ i)))
(setq climbers '() climber-span 0.0 nonclimber-len 0.0 nonclimber-cnt 0
nkurve 0 kurve-chords 0.0 i vf-start)
(while (<= i vf-ende)
(setq seg (nth i plan))
(cond
((and (= (car seg) "Linie") (= (nth 3 seg) "VF"))
(if (or (= i longest-idx) (>= (caddr seg) climb-thresh))
(setq climbers (cons i climbers) climber-span (+ climber-span (caddr seg)))
(setq nonclimber-len (+ nonclimber-len (caddr seg)) nonclimber-cnt (1+ nonclimber-cnt))))
((= (car seg) "Bogen")
(setq nkurve (1+ nkurve) kurve-chords (+ kurve-chords (caddr seg)))))
(setq i (1+ i)))
(setq climbers (reverse climbers) n-climb (length climbers))
;; Flache Zone (Kurve + horizontale Fueller) hat GENAU EIN Uebergangspaar
;; (ein auf_3 rein, ein ab_3 raus), unabhaengig von der Zahl der Fueller/Kurven.
(setq hor-pairs (if (or (> nkurve 0) (> nonclimber-cnt 0)) 1 0))
(setq run-span (+ climber-span nonclimber-len kurve-chords))
;; Laengen-Obergrenze fuer eine angetriebene VF-Einheit (Konstruktions-
;; grenze, siehe *vfk-vf-laenge-max*) - nur Hinweis, kein Abbruch.
(if (> run-span *vfk-vf-laenge-max*)
(vfl-meldung (ssg-textf "vfl-m3-alert-vf-zu-lang"
(list (rtos (/ run-span 1000.0) 2 1) (rtos (/ *vfk-vf-laenge-max* 1000.0) 2 1)))))
(setq br-gf1 *vfl-gf-min-laenge*) ; feste kleine GF1
(setq br-richtn (if (< dH-bruecke 0) "Auf" "Ab"))
(setq target-climb (- z-junction z-front)) ; noetige Netto-Hoehe (Auf>0)
;; Kletter-Segment als Standard-Vario loesen; GF wird BERECHNET (L_GF) und der
;; Winkel WAEHLBAR (mehrere gueltige -> Nutzer waehlt). feste = 800 (Umlenk+Sep;
;; Motor sitzt am Kettenende). Die flache Zone gleicht danach die Laenge aus.
(princ (ssg-text "vfl-m3-standard-vario-header"))
(princ (ssg-textf "vfl-m3-front-anker-gemessen" (list (rtos z-front 2 1))))
(princ (ssg-textf "vfl-m3-junction-exakt" (list (rtos z-junction 2 1))))
(princ (ssg-textf "vfl-m3-kletter-info"
(list (rtos target-climb 2 1) (itoa n-climb) (itoa nkurve) (itoa nonclimber-cnt))))
;; feste-Horizontal + Hoehen-Anpassung fuer den Solver:
;; - Mit flacher Zone: Motor sitzt am Kettenende (nicht im Kletter-Segment) ->
;; feste = entry-fixed (Umlenk+Sep, ODER weniger bei Lauf-Anfang-Wahl).
;; berechne rechnet Motor-/Uebergangs-Abstieg NICHT, daher Kletterhoehe
;; um diese Abstiege anpassen (GF2 bleibt ~0) - ausser bei offenem Ende.
;; - Ohne flache Zone (Einzel-Bruecke): feste = entry-fixed + Motor (0 bei
;; offenem Ende), keine Hoehen-Anpassung.
(setq rad3v (* *vfk-gefaelle-winkel* (/ pi 180.0)))
;; Eingangs-Fussabdruck haengt von der Lauf-Anfang-Wahl ab (siehe oben) -
;; Default (beide Flags nil) ergibt exakt die bisherigen 800/1300.
(setq entry-fixed
(cond (m2-offener-anfang 0.0)
(m2-kein-gf1-vorne *vfk-stations-laenge*)
(t (+ *vfk-stations-laenge* *vfk-separator-laenge*))))
(setq es-along-fix 0.0)
(if (> hor-pairs 0)
(setq feste-vf entry-fixed
dH-adj (- dH-bruecke (+ (* *vfk-stations-laenge* (sin rad3v)) *vfk-bruecke-korrektur*))) ; Motor + auf_3/ab_3
(progn
;; OHNE flache Zone gibt es KEIN vfl3-es-fueller, das den Separator+ES-
;; Laengsanteil selbststaendig gegen den echten Zielpunkt korrigiert -
;; beide fehlten hier bislang komplett im Laengenbudget des Solvers
;; (realer Bug: die Kette ueberschoss um ungefaehr Separator+along-es,
;; am ES-Turn als Querabweichung zur KS_AUS-Achse sichtbar geworden).
;; WICHTIG: NUR die Laenge korrigieren, NICHT ueber feste-vf/dH-adj -
;; feste-vf fliesst in berechne-alle-winkel per sin(3°) AUCH in die
;; Hoehenbilanz ein, waehrend die reale Hoehe von Separator+ES bereits
;; VOLLSTAENDIG ueber z-junction/vfl3-dback erfasst ist (Separator dort
;; per tan(3°), ES-Eigenhoehe per ein-dz - siehe dortiger Kommentar).
;; Ueber feste-vf haette das die Hoehe ein zweites Mal (und fuer
;; along-es sogar physikalisch falsch, da along-es keinen sin(3°)-
;; Hoehenanteil hat) veraendert - realer Folgefehler beim ersten
;; Test dieses Fixes (dZ=38.6mm, vorher exakt 0).
(setq feste-vf (+ entry-fixed (if m2-offenes-ende 0.0 *vfk-stations-laenge*))
dH-adj dH-bruecke)
(if es-vorhanden
(progn
(setq es-vek-fix (vfl3-es-vektor
(strcat "ES_Element_" (vfl-es-winkel) "_" es-seite)
(cadr (nth vf-ende plan))))
(setq es-along-fix
(+ (* *vfk-separator-laenge* (cos rad3v)) (if es-vek-fix (car es-vek-fix) 0.0)))))))
;; Offenes Ende (m2-offenes-ende): kein Motor wird gebaut, die obige
;; Motor-Abstiegs-Korrektur darf dann NICHT abgezogen werden - der Solver
;; soll die volle dH-bruecke exakt treffen (Ziel = z-junction = end-hoehe).
(if m2-offenes-ende (setq dH-adj dH-bruecke))
;; es-along-fix (reine Laenge, siehe oben) NUR aus dem Laengenbudget (span)
;; abziehen - NICHT aus feste-vf, sonst floss es faelschlich ueber sin(3°)
;; auch in die Hoehenbilanz ein (siehe Kommentar oben).
(setq wahl3 (vfl3-waehle-winkel (- climber-span es-along-fix) dH-adj feste-vf))
(if (null wahl3)
(progn
;; Stufe 2: KEIN Tabellenwinkel passt (der/die Kletterer sind bei JEDER
;; Neigung zu kurz fuer Umlenkstation+2 Vertikalboegen) - ganzer Lauf wird
;; flach gebaut, wie die bereits vorhandenen "kurzen" VF-Geraden. Die
;; komplette Hoehe wandert in GF1 (reine Kompensation, darf legitim
;; (nahe) 0 sein).
(princ (ssg-text "vfl-m3-kletter-zu-kurz-flach"))
(setq nonclimber-len (+ nonclimber-len climber-span)
nonclimber-cnt (+ nonclimber-cnt n-climb))
(setq climbers '() n-climb 0 climber-span 0.0)
;; hor-pairs war ggf. 0 (reine Einzel-Bruecke ohne Kurve/Fueller) - jetzt
;; gibt es garantiert mindestens einen Fueller (den ex-Kletterer), also
;; feste-vf/dH-adj auf die flache-Zone-Variante nachziehen.
(if (<= hor-pairs 0)
(progn
(setq hor-pairs 1)
(setq feste-vf entry-fixed
dH-adj (- dH-bruecke (+ (* *vfk-stations-laenge* (sin rad3v)) *vfk-bruecke-korrektur*)))))
(if m2-offenes-ende (setq dH-adj dH-bruecke))
(setq br-winkel (fix *vfk-gefaelle-winkel*) br-lvf 0.0
br-richtn (if (< dH-adj 0) "Auf" "Ab")
gf-total (/ (abs dH-adj) (/ (sin rad3v) (cos rad3v))))
(princ (ssg-textf "vfl-m3-kletter-flach-gf" (list (rtos gf-total 2 0)))))
(setq br-winkel (car wahl3) gf-total (cadr wahl3) br-lvf (caddr wahl3) br-richtn (cadddr wahl3)))
;; GF-Verteilung: 1 = alles am Einlauf (GF1); 2 = 1/2 GF1 + 1/2 GF2; 3 = alles
;; am Auslauf (GF2) - erzwungen (kein GF1-Platz), wenn der Lauf-Anfang ohne
;; GF1 gewaehlt wurde (offener Anfang ODER Umlenkstation direkt). Bei 1/2/1/2
;; wird der im Kletter-Segment durch das halbe GF1 frei werdende Platz mit
;; einem horizontalen Fueller-A gefuellt; GF2 (~1/2 L_GF) sitzt hinter dem
;; Motor, der ES-Laengen-Abschluss zieht seinen Fussabdruck ab (Fueller-B
;; wird kuerzer).
(princ (ssg-text "vfl-m3-gf-verteilung"))
(if (or m2-offener-anfang m2-kein-gf1-vorne)
(progn
(setq br-gf-mode 3 br-gf1 0.0 br-gf2-exp gf-total filler-A-len 0.0)
(princ (ssg-text "vfl-m3-gf-verteilung-alles-auslauf")))
(progn
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-gf-verteilung-impl (list (ssg-text "vfl-m3-gf-verteilung") "2" "1")))
(setq br-gf-mode
(if (= (vfl-menu (ssg-text "prompt-wahl-1-2")
(list "Alles am Einlauf (GF1)" "1/2 GF1 + 1/2 GF2") 1
"vfl-m3-gf-verteilung") "2") 2 1))
(if (= br-gf-mode 2)
(setq br-gf1 (/ gf-total 2.0) br-gf2-exp (/ gf-total 2.0)
filler-A-len (* (/ gf-total 2.0) (cos rad3v)))
(setq br-gf1 gf-total br-gf2-exp 0.0 filler-A-len 0.0))))
(setq filler-a-done nil)
(princ (ssg-textf "vfl-m3-vario-ergebnis"
(list (itoa br-winkel)
(if (= br-richtn "Auf") (ssg-text "vfl-m3-richtung-auf-kurz")
(ssg-text "vfl-m3-richtung-ab-kurz"))
(rtos br-lvf 2 0)
(rtos gf-total 2 0)
(cond ((= br-gf-mode 2) (ssg-text "vfl-m3-vert-halb"))
((= br-gf-mode 3) (ssg-text "vfl-m3-vert-auslauf"))
(t (ssg-text "vfl-m3-vert-ganz"))))))
;; --- B3: Standard-Vario (Klettern, 3-Grad-Basis) + flache Zone (0 Grad) ---
;; Die flache Zone (Vario-Kurve + horizontaler Fueller) haengt EINMAL ueber auf_3
;; ein und EINMAL ueber ab_3 aus; Kurve und Fueller sind bei 0 Grad DIREKT
;; verbunden (keine Zwischen-Boegen). Der horizontale Fueller gleicht die
;; Restlaenge aus (letztes Stueck vor dem Motor getrimmt).
(setq pt (car frame) letzt-koerper-hz (cadr (nth vf-start plan)) flat-p nil)
;; Lauf-Anfang: offener Anfang ueberspringt Umlenkstation komplett; sonst
;; GF1 (0, wenn m2-kein-gf1-vorne oder GF-Verteilung das so ergab) + ggf.
;; Separator (uebersprungen bei m2-kein-gf1-vorne) + Umlenk (3 Grad).
(if (not m2-offener-anfang)
(progn
(setq pt (vfs-vf-entry pt br-gf1 letzt-koerper-hz m2-kein-gf1-vorne))
(vfl-acc-gf-seg br-gf1 3)))
(setq i vf-start)
(while (<= i vf-ende)
(setq seg (nth i plan) seg-hz (cadr seg))
(cond
;; --- Kletterer (geneigt, 3-Grad-Basis) ---
((and (= (car seg) "Linie") (member i climbers))
(if flat-p (progn (setq pt (vfl3-flach-aus pt seg-hz)) (setq flat-p nil)))
(setq this-lvf (max *vfk-restlaenge-min-clamp* (* br-lvf (/ (caddr seg) climber-span))))
(setq pt (vfs-vf-koerper pt br-richtn br-winkel this-lvf seg-hz))
(vfl-acc-vf-seg br-richtn br-winkel this-lvf)
(setq anzahl-vf (1+ anzahl-vf) letzt-koerper-hz seg-hz))
;; --- kurze VF-Gerade -> horizontaler Fueller (0 Grad) ---
((= (car seg) "Linie")
(setq flat-zone-erste (not flat-p))
(if (not flat-p)
(progn (setq pt (vfl3-flach-ein pt letzt-koerper-hz)) (setq flat-p t)
;; Fueller-A: der im Kletter-Segment durch 1/2 GF1 frei werdende Platz
(if (and (> filler-A-len 0.1) (not filler-a-done))
(progn (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm"
pt filler-A-len 0 letzt-koerper-hz))
(vfl-acc-vf-seg "horizontal" 0 filler-A-len)
(setq anzahl-vf (1+ anzahl-vf) filler-a-done t)))))
(if (= i vf-ende)
;; letzter Fueller, MIT ES-Element (unveraendert): Laenge so, dass der
;; ENDPUNKT auf der ES-KS_AUS-ACHSE liegt (Spiegel der AS-Regel). Der
;; Schwanz (Fueller + ab_3 + Motor + GF2 + Separator + ES) verschiebt
;; sich starr entlang seg-hz mit dem Fueller; KS_AUS = pt + (fill + C)*
;; dp + perp-es*np, Achse u_a = seg-hz + ES-Turn. Aus (Endpunkt -
;; KS_AUS)*n_a = 0 folgt fill (n_a senkrecht zu u_a). OHNE ES-Element
;; (Nutzerwunsch): keine Achsen-Korrektur noetig, da nach Motor+GF2
;; nichts mehr gebaut wird - Fueller zielt direkt auf den Endpunkt.
(setq fill-len
(if es-vorhanden
(vfl3-es-fueller pt endpunkt seg-hz
(strcat "ES_Element_" (vfl-es-winkel) "_" es-seite)
br-gf2-exp rad3v)
(- (+ (* (- (car endpunkt) (car pt)) (cos (* seg-hz (/ pi 180.0))))
(* (- (cadr endpunkt) (cadr pt)) (sin (* seg-hz (/ pi 180.0)))))
(* (+ *vfk-stations-laenge* br-gf2-exp) (cos rad3v)))
)
)
(setq fill-len (caddr seg)))
;; Kritische Fueller-Position (direkt nach Umlenkstation ODER direkt vor
;; Motorstation) zu kurz fuer den geforderten Wert - statt still zu
;; klemmen, den Nutzer warnen (Zielhoehe/-position wird dann nicht exakt
;; erreicht, siehe vfl-m3-warnung-gf2-negativ fuer die Hoehen-Seite).
(if (and (< fill-len *vfk-restlaenge-min-clamp*) (or flat-zone-erste (= i vf-ende)))
(vfl-meldung (ssg-textf
(if flat-zone-erste "vfl-m3-warnung-fueller-eingang-zu-kurz"
"vfl-m3-warnung-fueller-ausgang-zu-kurz")
(list (rtos fill-len 2 0) (rtos *vfk-restlaenge-min-clamp* 2 0)))))
(setq fill-len (max *vfk-restlaenge-min-clamp* fill-len))
(setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt fill-len 0 seg-hz))
(vfl-acc-vf-seg "horizontal" 0 fill-len) (setq anzahl-vf (1+ anzahl-vf))
(setq letzt-koerper-hz seg-hz))
;; --- Vario-Kurve (flach, direkt bei 0 Grad) ---
((= (car seg) "Bogen")
(if (not flat-p)
(progn (setq pt (vfl3-flach-ein pt letzt-koerper-hz)) (setq flat-p t)
;; Fueller-A: der im Kletter-Segment durch 1/2 GF1 frei werdende Platz
(if (and (> filler-A-len 0.1) (not filler-a-done))
(progn (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm"
pt filler-A-len 0 letzt-koerper-hz))
(vfl-acc-vf-seg "horizontal" 0 filler-A-len)
(setq anzahl-vf (1+ anzahl-vf) filler-a-done t)))))
(setq bwinkel (nth 3 seg) bseite (nth 4 seg) kv-variante (nth 6 seg))
(setq frame (make-frame-from-dir pt (hz-winkel->xu letzt-koerper-hz 0.0)))
(setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite
(if kv-variante kv-variante "innen")))
(setq pt (car frame))
(if (< i vf-ende) (setq letzt-koerper-hz (cadr (nth (1+ i) plan))))))
(setq i (1+ i)))
(if m2-offenes-ende
;; Bewusst offenes Ende (kein Motor/Separator/ES) - Lauf bleibt flach
;; (0 Grad) genau dort stehen, wo die Bau-Schleife endete; KEIN
;; Rueck-Uebergang auf 3 Grad, KEINE Motorstation/GF2.
(setq frame (make-frame-from-dir pt (hz-winkel->xu letzt-koerper-hz 0.0)))
(progn
(if flat-p (progn (setq pt (vfl3-flach-aus pt letzt-koerper-hz)) (setq flat-p nil))) ; zurueck 3 Grad
;; Motorstation + GF2 in EINEM Schritt mit dem im Solve (vfl3-waehle-
;; winkel/GF-Verteilung, siehe br-gf2-exp oben) bereits geplanten Wert -
;; NICHT mehr unabhaengig aus der gemessenen Resthoehe neu herleiten.
;; Die alte Zwei-Loesungen-Variante (Motor mit L_GF2=0.0, GF2 danach aus
;; z-aftermotor/z-junction gemessen) widersprach der Fueller-Position
;; (fill-len, vfl3-es-fueller), die bereits br-gf2-exp als GF2-Laenge
;; angenommen hatte - jede Differenz zwischen den beiden GF2-Werten
;; verschob das Kettenende entlang der Fahrtrichtung (realer Bug:
;; "letztes Segment baut zu lang"). Identische Fehlerklasse wie der
;; bereits behobene Modus-1-Bug (vfl-body-abschluss, siehe Memory
;; project_vf_einheit_ist_endpunkt_reihenfolge).
;; Bekannte Restunsicherheit: *vfk-bruecke-korrektur* (vf_konstanten.lsp,
;; empirischer Fixwert fuer Motor+auf_3/ab_3) bestimmt indirekt die
;; Genauigkeit von br-gf2-exp - sollte trotzdem noch ein kleiner
;; Hoehen-Restfehler auftreten (nicht das urspruengliche Laengs-
;; Ueberschiessen), ist dieser Fixwert der erste Verdaechtige.
(setq pt (vfs-vf-exit pt br-gf2-exp letzt-koerper-hz nil))
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
(if (> br-gf2-exp 0.1)
(vfl-acc-gf-seg (/ br-gf2-exp (cos (* *vfk-gefaelle-winkel* (/ pi 180.0)))) (fix *vfk-gefaelle-winkel*)))
(setq frame (vfl-frame-3grad pt letzt-koerper-hz))))
(setq hz letzt-koerper-hz)
;; --- B4: BACK-Lauf bauen (Segmente vf-ende+1 .. n-1) ---
(setq i (1+ vf-ende))
(while (< i n)
(setq seg (nth i plan) typ (car seg) hz (cadr seg))
(cond
((= typ "Linie")
(setq winkel (nth 4 seg) deltaL (caddr seg)
sep-vor-gf (nth 5 seg) sep-nach-gf (nth 6 seg))
;; Footprint fuer Separator(300)+ES nur reservieren, wenn ES-Element
;; gewuenscht ist (ein=0 sonst, siehe oben) - ohne ES entfaellt auch
;; der abschliessende Separator.
(if (= i last-line) (setq deltaL (- deltaL (if es-vorhanden *vfk-separator-laenge* 0.0) ein)))
;; Separator(en) VOR/NACH aus der Klassifizierung (Punkt 1, wie B1).
(if sep-vor-gf (setq deltaL (- deltaL *vfk-separator-laenge*)))
(if sep-nach-gf (setq deltaL (- deltaL *vfk-separator-laenge*)))
(setq deltaL (max *vfk-restlaenge-min-clamp* deltaL))
(if sep-vor-gf
(progn
(setq frame (make-frame-from-dir
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car frame) hz winkel *vfk-separator-laenge* 0)
(hz-winkel->xu hz winkel)))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))))
(setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel))
(vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel)
(setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel)
(if sep-nach-gf
(progn
(setq frame (make-frame-from-dir
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car frame) hz winkel *vfk-separator-laenge* 0)
(hz-winkel->xu hz winkel)))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*)))))
((= typ "Bogen")
(setq bwinkel (nth 3 seg) bseite (nth 4 seg) klass (nth 5 seg))
(if (= klass "GF-Bogen")
(setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite))
(princ (ssg-text "vfl-m3-kurve-back-uebersprungen")))))
(setq i (1+ i)))
;; --- B5: Kettenende Separator + ES (nur falls gewuenscht) ---
(if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit)))
(if es-vorhanden
(setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame))
(if letzt-winkel letzt-winkel *vfk-gefaelle-winkel*) (caddr (car frame)) es-seite)))
;; ---------- Block + Ist-Ziel-Report ----------
(setq hoehe-bis (caddr (car frame)))
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt))
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug2") ->
;; spaeter per Doppelklick editierbar (vfl-edit-ent2: voller Reset, kein
;; Sektions-Dialog wie bei Modus 1 - siehe dortiger Kommentar).
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins "linienzug2"))
;; Erfolgreicher Abschluss: *error* zuruecksetzen.
(setq *error* old-error)
(setq soll-ende endpunkt ist-ende (car frame))
(princ "\n\n=========================================")
(princ (ssg-text "vfl-m3-fertig-header"))
(princ (ssg-textf "vfl-m3-ziel-soll"
(list (rtos (car soll-ende) 2 1) (rtos (cadr soll-ende) 2 1) (rtos (caddr soll-ende) 2 1))))
(princ (ssg-textf "vfl-m3-es-ist"
(list (rtos (car ist-ende) 2 1) (rtos (cadr ist-ende) 2 1) (rtos (caddr ist-ende) 2 1))))
(princ (ssg-textf "vfl-m3-abweichung"
(list (rtos (- (car ist-ende) (car soll-ende)) 2 1)
(rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1)
(rtos (- (caddr ist-ende) (caddr soll-ende)) 2 1))))
;; Zerlegung bezogen auf die ES-KS_AUS-ACHSE: Quer (senkrecht zur Achse) soll
;; ~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))))
(princ (ssg-text "vfl-m3-achse-hinweis"))
(princ "\n=========================================")
(if dbg-an
(progn
(dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer)
" (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")"))
(dbg 'soll-ende)
(dbg 'ist-ende)
(dbgmsg "=== SESSION Modus 2 ENDE ===")
(dbgreturn (list "VF" vfl-nummer))
(dbgclose)))
(princ)
)
;; ============================================================
;; TEIL 5: KETTE ZUSAMMENFUEHREN
;; ============================================================
;; Vario_Kette_Merge: eine Kette aus bereits in der Zeichnung liegenden
;; Vario-Foerderer-Bausteinen (lose Einzelteile WIE AUCH bereits fertig
;; gewickelte VF_n-Bloecke, in beliebiger Mischung) wird ab einem gewaehlten
;; Start-Baustein ueber die reale KS_AUS->KS_EIN-Nachbarschaft verfolgt und zu
;; EINEM neuen Gesamt-VF_n-Block verschmolzen. Die Attribute werden dabei aus
;; der gefundenen Bausteinfolge NEU hergeleitet (dieselben Akkumulatoren/
;; Formeln wie beim interaktiven Bau in Modus 1/2 - vfl-acc-*,
;; ssg-strecke-attrib-defs -, nur rueckwirkend nach dem Auffinden statt
;; waehrend des Bauens gefuellt). Nur VORWAERTS ab dem gewaehlten
;; Start-Baustein (keine Rueckwaerts-Suche).
;;
;; Alle beteiligten Bausteintypen tragen laut Nutzerbestaetigung ein eigenes
;; KS_EIN/KS_AUS (auch Umlenk-/Motorstation, Vertikalboegen, das gestreckte
;; Zwischenstueck und der Separator) - die Verkettung laeuft daher komplett
;; ueber KS-Nachbarschaft, keine Bounding-Box-Geometrie noetig.
;;
;; Ein angetroffener VF_n-Wrapper wird beim Erfassen SOFORT (temporaer) in
;; seine Sub-Elemente aufgeloest, die dann wie von Anfang an lose Bauteile
;; behandelt werden (vfl-kette-sammle-alle) - eine fruehere Fassung versuchte
;; stattdessen, fuer einen Wrapper EINEN Gesamt-KS_EIN/KS_AUS per "welcher
;; Punkt hat kein Gegenstueck"-Heuristik zu bestimmen; das schlug bei langen
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl (siehe
;; [[project_vario_kette_merge]] Update 6).
;; Toleranzen (mm) fuer die Nachbarschaftspruefung zwischen zwei Bausteinen:
;; <= tol-eng -> gilt als sauber verbunden, Kette geht weiter
;; <= tol-weit -> sieht verbunden aus, ist es aber nicht -> Warnung, Kettenende
;; > tol-weit -> kein Zusammenhang, normales (stilles) Kettenende
(if (null *vfl-kette-tol-eng*) (setq *vfl-kette-tol-eng* 2.0))
(if (null *vfl-kette-tol-weit*) (setq *vfl-kette-tol-weit* 100.0))
;; Kleine Feld-Zugriffe auf einen Ketten-Datensatz
;; (ename bname ks-ein-punkt ks-aus-punkt wrapper-ename)
;; ename = nil und wrapper-ename gesetzt: Sub-Element eines aufgeloesten
;; VF_n-Wrappers (wrapper-ename = dessen Original-Ename). Sonst: eigenstaen-
;; diges Bauteil (ename gesetzt, wrapper-ename nil).
(defun vfl-kette-rec-ename (rec) (nth 0 rec))
(defun vfl-kette-rec-bname (rec) (nth 1 rec))
(defun vfl-kette-rec-ein (rec) (nth 2 rec))
(defun vfl-kette-rec-aus (rec) (nth 3 rec))
(defun vfl-kette-rec-wrapper (rec) (nth 4 rec))
;; String an einem Trennzeichen aufteilen (reine Teilstring-Suche, keine
;; Wildcards). Bei "_"-Trennung eines Bausteinnamens liefert das die
;; Namensteile unabhaengig vom Dimensions-Suffix (_2D/_3D) - der steht immer
;; am Ende und wird von den (nur von vorne indizierenden) Zugriffen unten
;; ignoriert.
(defun vfl-kette-split (str delim / pos ergebnis rest)
(setq ergebnis '() rest str)
(while (setq pos (vl-string-search delim rest))
(setq ergebnis (append ergebnis (list (substr rest 1 pos))))
(setq rest (substr rest (+ pos 1 (strlen delim))))
)
(append ergebnis (list rest))
)
(defun vfl-kette-teil (bname idx) (nth idx (vfl-kette-split bname "_")))
;; Bausteintyp aus dem Blocknamen ableiten. Scanner/Separator_SP (manuelle
;; Sensor-Bloecke, siehe count_sep_scan.lsp) gehoeren NICHT zur Kette selbst
;; und tauchen hier bewusst nicht auf.
;; VF- vs. GF-Vertikalboegen: BEIDE Familien teilen den Praefix
;; "Vario_Bogen_auf/ab_" - die VF-Bibliothek (init-bibliothek, Winkel 3-51)
;; traegt zusaetzlich "_TEF_" im Namen, die GF-eigenen Boegen (nur 3/6 Grad,
;; data/ils/Vario_Bogen_ab/auf_3/6_rechts.dwg, siehe vfl-gf-bogen-init) NICHT -
;; die "_TEF_"-Pruefung MUSS daher vor der generischen Pruefung stehen (cond
;; nimmt den ERSTEN Treffer). Damit erkennt ein KS_AUS-Scan (vfl-ks-aus-hz-an-
;; punkt/vfl-kette-typ-familie) eine mit einem GF-eigenen Bogen endende Kette
;; weiterhin korrekt als GF-Familie, nicht als VF.
(defun vfl-kette-typ (bname)
(cond
((wcmatch bname "VF_*") "WRAPPER")
((wcmatch bname "AS_Element_*") "AS")
((wcmatch bname "ES_Element_*") "ES")
((wcmatch bname "Gefaellebogen_*") "GFBOGEN")
((wcmatch bname "Vario_Kurve_*") "KURVE")
((wcmatch bname "Vario_Umlenkstation_*") "UMLENK")
((wcmatch bname "Vario_Motorstation_*") "MOTOR")
((wcmatch bname "Vario_Bogen_auf_*_TEF_*") "BOGENAUF")
((wcmatch bname "Vario_Bogen_ab_*_TEF_*") "BOGENAB")
((wcmatch bname "Vario_Bogen_auf_*") "GFVERTBOGEN")
((wcmatch bname "Vario_Bogen_ab_*") "GFVERTBOGEN")
((wcmatch bname "Staustrecke_SP_1000_mm*") "STRECKE")
((wcmatch bname "Staustrecke_Separator_SP_300_mm*") "SEP")
(t "UNBEKANNT")
)
)
;; Gemessene Neigung (Grad, positiv=abwaerts wie frame->hz-winkel) zwischen
;; zwei Welt-Punkten.
(defun vfl-kette-neigung (ein aus / dx dy dz horiz)
(setq dx (- (car aus) (car ein)) dy (- (cadr aus) (cadr ein)) dz (- (caddr aus) (caddr ein)))
(setq horiz (sqrt (+ (* dx dx) (* dy dy))))
(if (> horiz 1e-6) (* (atan (- dz) horiz) (/ 180.0 pi)) 0.0)
)
(defun vfl-kette-round (x) (atoi (rtos x 2 0)))
;; Attribut-Wert auf "" erzwingen. ssg-attrib-set-on ueberspringt leere Werte
;; bewusst als "keine Ueberschreibung" (ATTDEF-Default bleibt stehen) - hier
;; soll das Feld aber ABSICHTLICH geleert werden (z.B. SEITE_AS/SEITE_ES,
;; wenn die Kette kein AS-/ES-Element hat und der ATTDEF-Default "rechts"
;; sonst faelschlich stehen bliebe).
(defun vfl-kette-attrib-leeren (ent tag / obj ed typ etag)
(setq obj (entnext ent))
(while obj
(setq ed (entget obj))
(setq typ (cdr (assoc 0 ed)))
(if (equal typ "SEQEND")
(setq obj nil)
(progn
(if (and (equal typ "ATTRIB") (equal (cdr (assoc 2 ed)) tag))
(progn (entmod (subst (cons 1 "") (assoc 1 ed) ed)) (entupd obj)))
(setq obj (entnext obj))
)
)
)
)
;; KS_EIN/KS_AUS-URSPRUNGSPUNKTE (Welt-Koordinaten, keine Richtung) eines
;; Bausteins ermitteln - robust gegen NICHT-UNIFORME Skalierung (z.B.
;; Staustrecke_SP_1000_mm, das per insert-inclined-scaled-block auf die
;; reale Segmentlaenge gestreckt wird). extract-ks-from-block-raw
;; (vf_core.lsp) klassifiziert die 3 Achslinien im KS-Sub-Block ueber ihre
;; ABSOLUTE LAENGE (ks-line-axis, feste Baender ~1/~100 Einheiten) - wird die
;; Fahrtrichtungs-Achslinie mitgestreckt, faellt sie aus diesem Raster und
;; die Extraktion schlaegt still fehl (empirisch bestaetigt: bei den meisten
;; Staustrecke-Instanzen "KS_EIN/KS_AUS FEHLT"). Uebernimmt daher die in
;; ks_segmente.lsp (kseg-collect-lose) bereits bewaehrte Methode: an einer
;; KOPIE die Skalierung auf 1:1:1 zuruecksetzen (Marker wieder nominal lang,
;; Extraktion funktioniert normal), KS_EIN/KS_AUS dort lesen, danach den
;; KS_AUS-Versatz mit dem echten XScaleFactor zurueckrechnen (die Streckung
;; wirkt lokal rein auf der Block-X-Achse/Docking-Richtung; nach Rotation ins
;; Weltsystem hat der Versatzvektor i.A. X-/Y-/Z-Anteile, die Streckung wirkt
;; aber auf alle drei mit demselben Faktor sx - Y/Z-Skalierung bleibt bei
;; dieser Teilefamilie immer 1.0). Kopie wird sofort wieder geloescht -
;; block-obj selbst bleibt unveraendert.
;; Rueckgabe: (("KS_EIN" . punkt) ("KS_AUS" . punkt)) - je nur wenn gefunden.
(defun vfl-kette-ks-ursprung (block-obj / sx copyobj ksdata kez kaz ergebnis)
(setq sx (vla-get-XScaleFactor block-obj))
(setq copyobj (vla-Copy block-obj))
(vla-put-XScaleFactor copyobj 1.0)
(vla-put-YScaleFactor copyobj 1.0)
(vla-put-ZScaleFactor copyobj 1.0)
(setq ksdata (extract-ks-from-block-raw copyobj))
(if (not (vlax-erased-p copyobj)) (vl-catch-all-apply 'vla-Delete (list copyobj)))
(setq kez (if (assoc "KS_EIN" ksdata) (car (cadr (assoc "KS_EIN" ksdata))) nil))
(setq kaz (if (assoc "KS_AUS" ksdata) (car (cadr (assoc "KS_AUS" ksdata))) nil))
(if (and kez kaz (/= sx 1.0))
(setq kaz (list
(+ (car kez) (* sx (- (car kaz) (car kez))))
(+ (cadr kez) (* sx (- (cadr kaz) (cadr kez))))
(+ (caddr kez) (* sx (- (caddr kaz) (caddr kez))))
))
)
(setq ergebnis '())
(if kez (setq ergebnis (cons (cons "KS_EIN" kez) ergebnis)))
(if kaz (setq ergebnis (cons (cons "KS_AUS" kaz) ergebnis)))
ergebnis
)
;; Alle Vario-Kette-Bausteine der Zeichnung einsammeln (lose Einzelteile UND
;; die Sub-Elemente bereits gewickelter VF_n - siehe vfl-kette-typ). Ein
;; angetroffener VF_n-Wrapper wird SOFORT (temporaer) in seine Sub-Elemente
;; aufgeloest und JEDES Sub-Element als eigener Datensatz mit direkt lesbarem
;; KS_EIN/KS_AUS erfasst - keine "welcher Punkt hat kein Gegenstueck"-
;; Heuristik fuer einen Gesamt-Punkt mehr noetig (die schlug bei langen
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl, siehe
;; [[project_vario_kette_merge]]). Die Kettenverfolgung faedelt die
;; Sub-Elemente danach ueber ihre echten KS-Punkte in der richtigen
;; Reihenfolge auf - unabhaengig von der Explode-Reihenfolge.
;; ename = nil fuer ein Sub-Element eines Wrappers (die temporaere
;; Explode-Kopie wurde bereits wieder geloescht); wrapper-ename identifiziert
;; in diesem Fall den ORIGINAL-Wrapper (fuer den finalen Merge-Schritt).
;; Rueckgabe: Liste von (ename bname ein aus wrapper-ename).
(defun vfl-kette-sammle-alle ( / ss i ename bname typ obj kinder kind
sub-ks child-bname child-ks records)
(setq records '())
(setq ss (ssget "X" '((0 . "INSERT"))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ename (ssname ss i))
(setq bname (cdr (assoc 2 (entget ename))))
(setq typ (vfl-kette-typ bname))
(cond
((= typ "WRAPPER")
(setq obj (vlax-ename->vla-object ename))
(setq kinder (vlax-invoke obj 'Explode))
(foreach kind kinder
(if (and (not (vlax-erased-p kind))
(= (vla-get-ObjectName kind) "AcDbBlockReference"))
(progn
(setq child-bname (vla-get-Name kind))
(setq child-ks (vfl-kette-ks-ursprung kind))
(setq records
(cons (list nil child-bname
(cdr (assoc "KS_EIN" child-ks))
(cdr (assoc "KS_AUS" child-ks))
ename)
records))
)
)
)
(foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind)))
)
((/= typ "UNBEKANNT")
(setq obj (vlax-ename->vla-object ename))
(setq sub-ks (vfl-kette-ks-ursprung obj))
(setq records
(cons (list ename bname
(cdr (assoc "KS_EIN" sub-ks))
(cdr (assoc "KS_AUS" sub-ks))
nil)
records))
)
)
(setq i (1+ i))
)
)
)
records
)
;; Naechsten Datensatz in rest-liste suchen, dessen KS_EIN am naechsten am
;; gegebenen KS_AUS-Punkt liegt. Rueckgabe: (rec . abstand) oder nil.
(defun vfl-kette-naechster (aus-punkt rest-liste / rec bester bester-d d)
(setq bester nil bester-d nil)
(foreach rec rest-liste
(if (vfl-kette-rec-ein rec)
(progn
(setq d (distance aus-punkt (vfl-kette-rec-ein rec)))
(if (or (null bester-d) (< d bester-d))
(progn (setq bester rec) (setq bester-d d)))
)
)
)
(if bester (cons bester bester-d) nil)
)
;; Kette ab start-rec NUR VORWAERTS verfolgen. Rueckgabe: (list kette warnung)
;; kette = Liste der Datensaetze in Ketten-Reihenfolge (mind. start-rec)
;; warnung = (letzter-bname kandidat-bname abstand) wenn eine Luecke im
;; tol-weit-Band gefunden wurde, sonst nil.
;; letzter-fund = (rec . abstand) des zuletzt geprueften (aber verworfenen)
;; Kandidaten - Diagnose-Hilfe, wenn die Kette bei Laenge 1
;; endet (dann kein warnung, aber evtl. trotzdem ein Fund
;; ausserhalb von tol-weit).
;; verdaechtig = Liste (vorgaenger-bname naechster-bname abstand) fuer jeden
;; Anschluss, dessen Abstand > 0.5mm war - eine echte, absichtlich
;; gebaute KS-zu-KS-Verbindung sollte praktisch bei 0mm liegen;
;; ein spuerbarer (aber noch innerhalb tol-eng liegender)
;; Abstand deutet auf eine ZUFAELLIG nahe, aber NICHT wirklich
;; zusammengehoerige Stelle hin (z.B. zwei unabhaengige Linien,
;; die im Layout nahe beieinander liegen/sich kreuzen).
(defun vfl-kette-verfolgen (start-rec alle-records / rest kette aktuell fund fertig warnung letzter-fund verdaechtig)
(setq rest (vl-remove start-rec alle-records))
(setq kette (list start-rec))
(setq aktuell start-rec)
(setq warnung nil)
(setq letzter-fund nil)
(setq verdaechtig '())
(setq fertig nil)
(while (not fertig)
(setq fund (vfl-kette-naechster (vfl-kette-rec-aus aktuell) rest))
(setq letzter-fund fund)
(cond
((null fund) (setq fertig T))
((<= (cdr fund) *vfl-kette-tol-eng*)
(if (> (cdr fund) *vfk-kette-anschluss-warnung*)
(setq verdaechtig (cons (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)) verdaechtig)))
(setq aktuell (car fund))
(setq kette (append kette (list aktuell)))
(setq rest (vl-remove aktuell rest))
(setq letzter-fund nil)
)
((<= (cdr fund) *vfl-kette-tol-weit*)
(setq warnung (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)))
(setq fertig T)
)
(t (setq fertig T))
)
)
(list kette warnung letzter-fund verdaechtig)
)
;; Attribute des neuen Gesamt-Blocks aus der gefundenen Bausteinfolge
;; herleiten: dieselben Akkumulatoren (vfl-acc-*) wie beim interaktiven Bau,
;; hier rueckwirkend anhand der Bausteinfolge gefuellt statt waehrend des
;; Bauens. Sub-Elemente eines bereits gewickelten VF_n wurden beim Erfassen
;; (vfl-kette-sammle-alle) bereits aufgeloest und durchlaufen hier dieselbe
;; Typ-Klassifikation wie von Anfang an lose Bauteile - lose Einzelteile und
;; fertige VF_n lassen sich dadurch beliebig mischen. chain-start/chain-end =
;; Gesamt-KS_EIN/KS_AUS der ganzen Kette (Welt-Z liefert Hoehe-von/-bis
;; direkt, kein erneutes Auslesen noetig).
;; Rueckgabe: (list attribut-alist typ-str).
(defun vfl-kette-baue-attribute (kette neuer-bname chain-start chain-end /
rec typ bname anzahl-vf phase entry-info gemessen betrag richtung
as-seite es-seite as-winkel es-winkel delta-l erster letzter ergebnis typ-str
bname-winkel)
(vfl-acc-reset)
(setq anzahl-vf 0)
(setq phase "gf")
(setq entry-info nil)
(setq delta-l 0.0)
;; Leer (nicht "rechts") als Default: falls die Kette (Ausnahmefall) ohne
;; eigenes AS-/ES-Element beginnt/endet, soll das im Attribut auch als
;; "keins vorhanden" erkennbar bleiben statt eine falsche Seite vorzutaeuschen.
(setq as-seite "" es-seite "")
(setq as-winkel "" es-winkel "")
(setq erster (car kette))
(setq letzter (car (reverse kette)))
(foreach rec kette
(setq bname (vfl-kette-rec-bname rec))
(setq typ (vfl-kette-typ bname))
(if (and (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))
(setq delta-l (+ delta-l (distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec)))))
(cond
;; Wrapper-Records gibt es nicht mehr - ein angetroffener VF_n wurde
;; bereits beim Erfassen (vfl-kette-sammle-alle) in seine Sub-Elemente
;; aufgeloest; jedes davon durchlaeuft hier dieselbe Typ-Klassifikation
;; wie ein von Anfang an loses Bauteil.
((= typ "AS")
(if (equal rec erster)
(progn
(setq as-seite (vfl-kette-teil bname 3))
(setq as-winkel (vfl-kette-teil bname 2)))))
((= typ "ES")
(if (equal rec letzter)
(progn
(setq es-seite (vfl-kette-teil bname 3))
(setq es-winkel (vfl-kette-teil bname 2)))))
((= typ "GFBOGEN")
;; Gefaellebogen_<seite>_<winkel>_R500
(setq *vfl-acc-gfbogen*
(vfl-inc-count *vfl-acc-gfbogen*
(strcat (if (= (vfl-kette-teil bname 1) "rechts") "R" "L") "_" (vfl-kette-teil bname 2)))))
((= typ "KURVE")
;; Vario_Kurve_<seite>_<winkel>_TEF_<variante>
(setq *vfl-acc-variokurve*
(vfl-inc-count *vfl-acc-variokurve*
(strcat (if (= (vfl-kette-teil bname 5) "aussen") "A" "I") "_" (vfl-kette-teil bname 3)))))
((= typ "UMLENK")
(setq phase "vf")
(setq anzahl-vf (1+ anzahl-vf))
(setq entry-info nil))
((= typ "MOTOR")
;; Vario_Motorstation_500mm_<seite>
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list (vfl-kette-teil bname 3))))
(setq phase "gf")
(setq entry-info nil))
((or (= typ "BOGENAUF") (= typ "BOGENAB"))
(if (null entry-info)
(setq entry-info rec) ; erster Bogen des Koerper-Tripels
(progn
;; Winkel bevorzugt DIREKT aus dem Blocknamen des ersten Bogens
;; lesen (z.B. "Vario_Bogen_auf_15_TEF_rechts" -> "15") - fuer
;; jeden echten Tabellenwinkel > 3 Grad eindeutig. NUR bei "3"
;; bleibt eine Messung noetig, weil auf_3/ab_3 SOWOHL fuer einen
;; echten 3-Grad-S-Bogen ALS AUCH fuer die Stufe-2-Horizontal-
;; Mitte (winkel=0, vfs-vf-koerper-Sonderfall) verwendet werden.
;; Die vorherige Chord-Messung (Anfang Bogen1 bis Ende Bogen2)
;; verwaesserte bei echten S-Boegen >3 Grad den gemessenen
;; Winkel Richtung der 3-Grad-Basis (gewichteter Mittelwert ueber
;; Bogen1+Gerade+Bogen2 statt des reinen Geraden-Winkels) - realer
;; Bug: 15 Grad im Modell wurden nach Vario_Kette_Merge zu 11
;; Grad (Livetest 2026-09-18).
(setq bname-winkel (vfl-kette-teil (vfl-kette-rec-bname entry-info) 3))
(if (and bname-winkel (/= bname-winkel "3"))
(progn
(setq betrag (atoi bname-winkel))
(setq richtung (if (wcmatch (vfl-kette-rec-bname entry-info) "*_auf_*") "Auf" "Ab")))
(progn
(setq gemessen (vfl-kette-neigung (vfl-kette-rec-ein entry-info) (vfl-kette-rec-aus rec)))
(setq betrag (vfl-kette-round (abs gemessen)))
(setq richtung (if (< gemessen 0.0) "Auf" "Ab"))))
(vfl-acc-vf-seg richtung betrag
(distance (vfl-kette-rec-aus entry-info) (vfl-kette-rec-ein rec)))
(setq entry-info nil)
)
)
)
((= typ "STRECKE")
(if (= phase "gf")
(vfl-acc-gf-seg
(distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))
(abs (vfl-kette-neigung (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))))
;; Innerhalb eines Koerper-Tripels traegt das Zwischenstueck selbst
;; nichts direkt bei - Laenge/Neigung werden beim schliessenden
;; Bogen (s.o.) aus der Gesamtspanne des Tripels gemessen.
)
)
((= typ "SEP")
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*)))
)
)
(setq typ-str
(if (or (> anzahl-vf 0) (> (length *vfl-acc-lgf*) 1)
(> (length *vfl-acc-gfbogen*) 0) (> (length *vfl-acc-variokurve*) 0))
"Streckengruppe" "Gefaellestrecke"))
(setq ergebnis
(list
(cons "Bezeichnung" neuer-bname)
(cons "ARTINR" "6220")
(cons "MONTAGEHOEHE_m" (rtos (/ (+ (caddr chain-start) (caddr chain-end)) 2000.0) 2 3))
(cons "HOEHE_VON_mm" (itoa (fix (caddr chain-start))))
(cons "HOEHE_BIS_mm" (itoa (fix (caddr chain-end))))
(cons "DELTA_H_mm" (itoa (fix (abs (- (caddr chain-end) (caddr chain-start))))))
(cons "DELTA_L_mm" (itoa (fix delta-l)))
(cons "TYP" typ-str)
(cons "SEITE_AS" as-seite)
(cons "WINKEL_AS" as-winkel)
(cons "SEITE_ES" es-seite)
(cons "WINKEL_ES" es-winkel)
(cons "ANZAHL_GF" (itoa (length *vfl-acc-lgf*)))
(cons "L_GF_m" (vfl-join-komma *vfl-acc-lgf*))
(cons "GF_WINKEL" (vfl-join-komma *vfl-acc-gfwinkel*))
(cons "GF_Bogen_L_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_90")))
(cons "GF_Bogen_L_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_60")))
(cons "GF_Bogen_L_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_30")))
(cons "GF_Bogen_R_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_90")))
(cons "GF_Bogen_R_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_60")))
(cons "GF_Bogen_R_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_30")))
(cons "ANZAHL_VF" (itoa anzahl-vf))
(cons "MOTORSEITE" (vfl-join-komma *vfl-acc-motorseite*))
(cons "L_VF_m" (vfl-join-komma *vfl-acc-lvf*))
(cons "ANTRIEBFAHRTRICHTUNG" (vfl-join-komma *vfl-acc-richtung*))
(cons "VF_WINKEL" (vfl-join-komma *vfl-acc-winkel*))
(cons "VF_Bogen_A_90" (itoa (vfl-get-count *vfl-acc-variokurve* "A_90")))
(cons "VF_Bogen_A_60" (itoa (vfl-get-count *vfl-acc-variokurve* "A_60")))
(cons "VF_Bogen_A_30" (itoa (vfl-get-count *vfl-acc-variokurve* "A_30")))
(cons "VF_Bogen_I_90" (itoa (vfl-get-count *vfl-acc-variokurve* "I_90")))
(cons "VF_Bogen_I_60" (itoa (vfl-get-count *vfl-acc-variokurve* "I_60")))
(cons "VF_Bogen_I_30" (itoa (vfl-get-count *vfl-acc-variokurve* "I_30")))
(cons "ANZAHL_SEPARATOR" (itoa *vfl-acc-separator*))
)
)
(list ergebnis typ-str)
)
(defun c:Vario_Kette_Merge ( / sel start-ename start-bname alle-records start-rec
start-obj start-ins kandidaten bester-d d r
lauf kette warnung naechster-fund merge-ss leaf-enames aufgeloeste-wrapper
chain-start chain-end neuer-bname
rec kinder kind erg aggregiert typ-str neuer-insert def
leaf-ename leaf-obj leaf-noch-da verdaechtig v)
(ssg-start "Vario_Kette_Merge" nil)
(princ (ssg-text "vfl-kette-titel"))
(setq sel (entsel (ssg-text "vfl-kette-start-waehlen")))
(if (null sel)
(progn (princ (ssg-text "vfl-kette-kein-objekt")) (ssg-end) (exit)))
(setq start-ename (car sel))
(setq start-bname (cdr (assoc 2 (entget start-ename))))
(if (= (vfl-kette-typ (if start-bname start-bname "")) "UNBEKANNT")
(progn
(princ (ssg-textf "vfl-kette-kein-vf-block" (list (if start-bname start-bname "?"))))
(ssg-end) (exit)))
(setq alle-records (vfl-kette-sammle-alle))
(setq start-rec nil)
(foreach rec alle-records (if (equal (vfl-kette-rec-ename rec) start-ename) (setq start-rec rec)))
(if (and (null start-rec) (= (vfl-kette-typ start-bname) "WRAPPER"))
(progn
;; Nutzer hat einen VF_n-Wrapper direkt gewaehlt - der wurde beim
;; Erfassen bereits in seine Sub-Elemente aufgeloest (keins davon
;; traegt mehr diesen ename). Das Sub-Element mit KS_EIN am naechsten
;; zum InsertionPoint des Wrappers gilt als dessen Kettenanfang - das
;; ist per Bauart (ssg-block-wrap-welt bekommt immer den Kettenanfang
;; als Basispunkt) exakt der richtige Punkt.
(setq start-obj (vlax-ename->vla-object start-ename))
(setq start-ins (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint start-obj))))
(setq kandidaten (vl-remove-if-not
(function (lambda (r) (and (equal (vfl-kette-rec-wrapper r) start-ename) (vfl-kette-rec-ein r))))
alle-records))
(setq bester-d nil)
(foreach r kandidaten
(setq d (distance start-ins (vfl-kette-rec-ein r)))
(if (or (null bester-d) (< d bester-d)) (progn (setq start-rec r) (setq bester-d d)))
)
)
)
(if (null start-rec)
(progn
(princ (ssg-textf "vfl-kette-start-nicht-gefunden-diag"
(list (itoa (length alle-records)) (if start-bname start-bname "?")
(itoa (length (vl-remove-if-not
(function (lambda (r) (equal (vfl-kette-rec-bname r) start-bname)))
alle-records))))))
(ssg-end) (exit)))
(if (null (vfl-kette-rec-ein start-rec))
(progn (princ (ssg-text "vfl-kette-start-ohne-ks-ein")) (ssg-end) (exit)))
(setq lauf (vfl-kette-verfolgen start-rec alle-records))
(setq kette (car lauf))
(setq warnung (cadr lauf))
(setq naechster-fund (caddr lauf))
(setq verdaechtig (nth 3 lauf))
(if (< (length kette) 2)
(progn
(princ (ssg-textf "vfl-kette-diag-startbaustein"
(list (vfl-kette-rec-bname start-rec)
(rtos (car (vfl-kette-rec-aus start-rec)) 2 1)
(rtos (cadr (vfl-kette-rec-aus start-rec)) 2 1)
(rtos (caddr (vfl-kette-rec-aus start-rec)) 2 1))))
(if naechster-fund
(princ (ssg-textf "vfl-kette-diag-naechster-kandidat"
(list (vfl-kette-rec-bname (car naechster-fund))
(rtos (cdr naechster-fund) 2 1)
(rtos *vfl-kette-tol-eng* 2 1)
(rtos *vfl-kette-tol-weit* 2 1))))
(princ (ssg-textf "vfl-kette-diag-kein-anderer" (list (itoa (length alle-records))))))
(princ (ssg-text "vfl-kette-nur-ein-baustein")) (ssg-end) (exit)))
(princ (ssg-textf "vfl-kette-gefunden" (list (itoa (length kette)))))
(foreach rec kette (princ (strcat "\n " (vfl-kette-rec-bname rec))))
(if warnung
(princ (ssg-textf "vfl-kette-luecke-warnung"
(list (car warnung) (cadr warnung) (rtos (caddr warnung) 2 1)))))
;; DIAGNOSE: Anschluesse mit spuerbarem (>0.5mm), aber noch innerhalb
;; tol-eng liegendem Abstand - Verdacht auf zufaellig nahe, aber nicht
;; wirklich zusammengehoerige Bauteile (z.B. zwei unabhaengige Linien, die
;; im Layout nahe beieinander liegen).
(if verdaechtig
(foreach v verdaechtig
(princ (ssg-textf "vfl-kette-diag-verdaechtig"
(list (car v) (cadr v) (rtos (caddr v) 2 3)))))
)
;; Attribute aus der Bausteinfolge herleiten, bevor irgendetwas an der
;; Zeichnung veraendert wird (chain-start/chain-end kommen aus dem ersten/
;; letzten Datensatz in kette).
(setq neuer-bname (strcat "VF_" (itoa (vf-next-number))))
(setq chain-start (vfl-kette-rec-ein (car kette)))
(setq chain-end (vfl-kette-rec-aus (car (reverse kette))))
(setq erg (vfl-kette-baue-attribute kette neuer-bname chain-start chain-end))
(setq aggregiert (car erg))
(setq typ-str (cadr erg))
;; Aufgeloeste Wrapper-Sub-Elemente: der ORIGINAL-Wrapper wird (einmal je
;; distinktem wrapper-ename, da er i.d.R. mehrere Sub-Element-Datensaetze
;; in kette beisteuert) jetzt fuer REAL explodiert - Sub-Elemente bleiben
;; als Bloecke erhalten, ATTRIB-Textreste werden verworfen, Original
;; geloescht. Lose Einzel-Bausteine werden unveraendert direkt uebernommen (_.-BLOCK
;; unten SOLLTE sie beim Wickeln konsumieren, wie bei frisch gebauter
;; Geometrie - leaf-enames wird trotzdem mitgefuehrt, um sie nach dem
;; Wickeln sicherheitshalber explizit zu entfernen, falls _.-BLOCK sie aus
;; irgendeinem Grund NICHT aus dem Modellraum nimmt (doppelte/ueberlappende
;; Geometrie waere sonst die Folge).
(setq merge-ss (ssadd))
(setq leaf-enames '())
(setq aufgeloeste-wrapper '())
(foreach rec kette
(if (vfl-kette-rec-wrapper rec)
(if (not (member (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
(progn
(setq aufgeloeste-wrapper (cons (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
(setq kinder (vlax-invoke (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)) 'Explode))
(foreach kind kinder
(if (not (vlax-erased-p kind))
(if (= (vla-get-ObjectName kind) "AcDbBlockReference")
(ssadd (vlax-vla-object->ename kind) merge-ss)
(vla-Delete kind)
)
)
)
(vla-Delete (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)))
)
)
(progn
(setq leaf-enames (cons (vfl-kette-rec-ename rec) leaf-enames))
(ssadd (vfl-kette-rec-ename rec) merge-ss)
)
)
)
;; Frische ATTDEFs am Kettenanfang (wie vfl-block-erstellen), neu wickeln.
(foreach def (ssg-strecke-attrib-defs typ-str)
(entmake
(list '(0 . "ATTDEF")
(cons 10 chain-start)
(cons 11 chain-start)
'(40 . 50.0)
(cons 1 (cadr def))
(cons 2 (car def))
(cons 3 (car def))
'(70 . 1)
'(72 . 0)
'(74 . 0)))
(ssadd (entlast) merge-ss)
)
(setq neuer-insert (ssg-block-wrap-welt neuer-bname chain-start merge-ss))
;; Ziel-Layer der Baugruppe aus cfg/layer.cfg (ohne Eintrag bleibt die
;; Referenz auf dem aktuellen Layer, wie vor der Umstellung).
(ssg-layer-setzen neuer-insert "variofoerderer")
(ssg-attrib-set-on neuer-insert aggregiert)
;; SEITE_AS/SEITE_ES explizit leeren, wenn die Kette (Ausnahmefall) ohne
;; eigenes AS-/ES-Element beginnt/endet - ssg-attrib-set-on wuerde einen
;; leeren Wert sonst als "keine Ueberschreibung" behandeln und den
;; ATTDEF-Default "rechts" faelschlich stehen lassen.
(if (= (cdr (assoc "SEITE_AS" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_AS"))
(if (= (cdr (assoc "SEITE_ES" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_ES"))
(if (car (atoms-family 1 '("SSG-ID-GENERATE"))) (ssg-id-generate neuer-insert))
;; Sicherheitsnetz: lose Einzelteile, die _.-BLOCK aus irgendeinem Grund NICHT
;; aus dem Modellraum entfernt hat, jetzt explizit loeschen - verhindert
;; doppelte/ueberlappende Geometrie (altes Original + neuer Gesamt-Block).
(setq leaf-noch-da 0)
(foreach leaf-ename leaf-enames
(setq leaf-obj (vl-catch-all-apply 'vlax-ename->vla-object (list leaf-ename)))
(if (and (not (vl-catch-all-error-p leaf-obj)) leaf-obj (not (vlax-erased-p leaf-obj)))
(progn
(setq leaf-noch-da (1+ leaf-noch-da))
(vla-Delete leaf-obj)
)
)
)
(if (> leaf-noch-da 0)
(princ (strcat "\n [Diagnose] " (itoa leaf-noch-da)
" lose Einzelteil(e) waren nach _.-BLOCK noch im Modellraum vorhanden - jetzt nachtraeglich entfernt.")))
(princ (ssg-textf "vfl-kette-fertig" (list neuer-bname (itoa (length kette)))))
(ssg-end)
(princ)
)
(vf-typ-registrieren
"linienzug"
'vfl-berechne-platzhalter
'vfl-einfuege-platzhalter
(ssg-text "vfc-typ-linienzug-beschreibung"))
(princ "\n>>> vf_linienzug.lsp geladen - Typ 'linienzug' registriert")
(princ)
Reference in New Issue View Git Blame Copy Permalink