Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
e76e24e1f362a5d0547c18736021c2e96d676564
dxfmakros/Lisp/vf_linienzug.lsp
T
y.wang e76e24e1f3 feat: VF-Linienzug Modus 1 - steigende Gefaellestrecke (Sonderfall, bis 3 Grad) mit automatischen Uebergangsboegen 
Neue dritte Option "Steigend" im Dialog "Wie soll die Laenge dieser
Gefaellestrecke bestimmt werden?": erlaubt eine GF, die statt zu fallen bis
zu 3 Grad steigt (Neigungswinkel 0..3 statt bisher nur 0..3 fallend). Neuer
Helfer vfl-bogen-uebergang erkennt anhand der tatsaechlichen Frame-Neigung,
ob 0/1/2 Uebergangsboegen (Vario_Bogen_auf_3/ab_3) noetig sind, und baut sie
automatisch - fuer den Normalfall (fallend->fallend) bleibt das ein No-Op.

Ausserdem in dieser Sitzung:
- Modus 2: Separator VOR/NACH bei GF-Segmenten, Wahlfreiheit am
  Lauf-Anfang/-Ende (Umlenkstation/Motorstation optional), Stufe-1/2-
  Vereinheitlichung wie in Modus 1.
- Stufe-1/Stufe-2-Entscheidungslogik (vfl-winkel-stufe-entscheidung):
  fehlenden Stufe-2-Fallback fuer "Auf" und "Ab, steiler als 3 Grad"
  ergaenzt; ungenauen "~3 Grad reine GF"-Kurzschluss in zwei Funktionen
  durch praezise Berechnung ersetzt (behebt reale Hoehenfehler).
- Wizard-Dialoge: DCL-Text-Umbruch fuer lange Hinweise (vflw-umbruch-zeilen,
  3 Groessenvarianten statt fester Zeilenzahl), Konsolen-Echo der
  Wizard-Antworten fuer Debug-Logs.
- Neuer Regressionstest TEST_LINIENZUG_STUFE2 (linienzug_tests_stufe2.json)
  reproduziert den behobenen Stufe-2-Kettenende-Bug; bestehender
  LZ_Standard-Test an aktuelle Menue-Nummerierung angepasst (Kettenanfang-
  Menue ist inzwischen 6 statt 4 Optionen gross).
- Neue Anleitung doc/vf_linienzug_modus1_anleitung.md: Modus 1 anhand des
  obigen Testfalls erklaert (Fragen-Bedeutung, Stufe-1/2-Logik, typische
  Stolperfallen: GF laengenhungrig bei 3 Grad, fester Motor+Separator+ES-
  Fussabdruck, 90-Grad-Element-Versatz).

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-11 09:59:27 +02:00

8398 lines
439 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"))
;; 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 (alert (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).
(defun vfl-journal-reset ()
(setq *vfl-journal* '() *vfl-replay-queue* nil)
(if (boundp '*vflw-pending*) (setq *vflw-pending* nil)))
;; 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".
;; winkel-werte enthaelt entweder (30 60 90) als ZAHLEN [GF-Bogen, INT-
;; Journal] oder ("90" "30") als STRINGS [ES, STR-Journal] - das bestimmt
;; sowohl welche Radio-Buttons waehlbar sind (nicht enthaltene Winkel werden
;; per mode_tile gesperrt), den Default (erster Eintrag der Liste, wie
;; bisher Index 0) ALS AUCH den TYP des in die Pending-Queue geschriebenen
;; Werts - der muss exakt zu winkel-werte passen, sonst schlaegt der
;; nachgelagerte Typ-Check (vfl-in-value "INT" bzw. "STR") fehl.
(defun vflw-gruppe-winkel-seite-impl (kopf-key winkel-optionen winkel-werte /
dat dcl-pfad ergebnis gwinkel-grad gseite)
(setq dat (load_dialog (vflw-dcl-pfad)))
(if (not (new_dialog "vflw_winkel_seite" dat))
(if (and dat (>= dat 0)) (unload_dialog dat))
(progn
(set_tile "kopf" (vflw-clean (ssg-text kopf-key)))
(if (not (vfl-winkel-in-liste-p 30 winkel-werte)) (mode_tile "winkel_30" 1))
(if (not (vfl-winkel-in-liste-p 60 winkel-werte)) (mode_tile "winkel_60" 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"
"(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)")
(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))
;; Hilfsfunktionen fuer winkel-werte-Listen, die je nach Aufrufer Zahlen
;; (GF-Bogen) oder Strings (ES) enthalten koennen (siehe oben).
(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))
;; ------------------------------------------------------------
;; 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. Konsumiert an der Aufrufstelle in diesem Fall NUR per
;; vfl-in-real (kein vorheriges vfl-in-string fuer den Modus mehr noetig) -
;; es wird daher auch nur der Winkelwert gepusht, kein Modus-String.
(defun vflw-gruppe-gefaelle-impl (hoehe-default nur-winkel / 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")))
(set_tile "modus_winkel" "1")
(set_tile "wlabel" "Neigungswinkel (Grad):")
(set_tile "wert" (rtos (float winkel-default) 2 1))
(if nur-winkel
(progn
(mode_tile "modus_hoehe" 1)
(set_tile "hinweis" (ssg-text "vfl-gf-hinweis-laenge-berechnet"))
)
)
;; 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"
;; Winkel ist jetzt Option 1 (Default), Hoehe Option 2 - siehe
;; wahl=\"Linie-GF\" in vf-linienzug-modus.
"(setq gmodus (if (= (get_tile \"modus_hoehe\") \"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))
;; ------------------------------------------------------------
;; "Wie soll die Laenge dieser Gefaellestrecke bestimmt werden?" (Neue Linie:
;; GF) - Endpunkt waehlen (Laenge ergibt sich, heutiges Verhalten) ODER
;; Zielhoehe zuerst festlegen (Laenge wird aus Zielhoehe+Winkel berechnet).
;; Nur an der Aufrufstelle gezeigt, wenn bereits ein Frame existiert (siehe
;; vf-linienzug-modus, wahl="Linie-GF"). Pusht "1" (Endpunkt), "2"
;; (Zielhoehe) oder "3" (steigende GF, Sonderfall).
(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\")
(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))
;; ------------------------------------------------------------
;; 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) mit zwei baubaren Vorschlaegen (siehe
;; vfl-vf-hoehe-vorschlaege/vfl-segment-hoehe-vorschlaege) - dann zeigt der
;; Kopftext beide Richtungen, vorbelegt wird die Ab-Variante (haeufigerer
;; Fall, siehe vfl-segment-entscheidung). Ist hoehe-ab nil (kein baubarer
;; Wert in der sondierten Zone gefunden), 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 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))
(setq vorbelegt (if hoehe-ab hoehe-ab 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
(if (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)))
(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))
;; ------------------------------------------------------------
;; Gruppe "Separator VOR/NACH bei GF" (Neue Linie: GF): beide Ja/Nein-Fragen
;; in einem Bildschirm. Reihenfolge/Journal: vfl-in-string (Sep-VOR), dann
;; vfl-in-string (Sep-NACH) - siehe wahl="Linie-GF" in vf-linienzug-modus.
(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" "Separator an dieser Gefaellestrecke")
(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))
;; 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)))
(set_tile "wahl_ja" "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 (siehe Fehlerbericht 2026-09-11).
(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 Punkt 7 (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))
;; 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")))
;; Punkt-7-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).
(defun vflw-gruppe-naechstes-element-impl (kettenanfang / 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))
(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).
;; Dritter Zustand 'ERZWUNGEN (Modus 2: Bogen folgt direkt auf eine als VF
;; klassifizierte Gerade - die VF-Einheit MUSS mit einer Vario-Kurve
;; weitergehen, siehe nach-vf in vf-linienzug-modus2): GF-Bogen-Option
;; deaktiviert, Vario-Kurve vorbelegt+aktiv, nur noch Aussen/Innen waehlbar.
(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))
;; --- 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.
(defun vflw-m2-lauf-abschluss-impl (kopf-txt / 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")
(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))
;; ============================================================
;; 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)
(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)
(alert (ssg-textf "vfl-m3-alert-objekte-fehlen" (list (itoa fehlt))))))
(progn
(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.
(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))
(if popped (setq v (car popped)) (setq v (apply livefn nil)))))
(vfl-journal-record (if v kind "NIL") 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 popped (setq v (car popped)) (setq v (apply livefn nil)))))
(vfl-journal-record (if (apply gueltig-p (list v)) kind "NIL") 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)))
;; --- 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.
(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 ",")))
(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)))
(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) ",") "]"))
(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")))
(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))
;; 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-journal e cnt slice-label)
(setq forward-journal (reverse *vfl-journal*))
(setq seg-idx (length (vfl-journal-glieder forward-journal)))
(setq cnt 0)
(if (> seg-idx 0)
(progn
(setq seg-journal (vfl-journal-slice forward-journal seg-idx))
;; 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 seg-journal (= (car (car seg-journal)) "STEP"))
(cdr (car seg-journal)) wahl))
(setq e (if seg-lastEnt (entnext seg-lastEnt) (entnext)))
(while e
(vfl-journal-xdata-schreiben-seg e seg-idx seg-journal)
(setq cnt (1+ cnt))
(setq e (entnext e))
)
;; 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-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.
(if (vfl-schema-felder slice-label)
(vfl-schema-log-slice slice-label seg-journal)
(if (member slice-label '("Linie-VF" "Horizontal-VF"))
(vfl-schema-log-vf slice-label seg-journal)))
)
(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.
(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* '())
(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 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)
;; ============================================================
;; Punkt 7: Kletter-Teilstrecke OHNE Zielhoehe (kommt die Kette bereits flach
;; an, gibt es keinen sinnvollen Zielpunkt zum Anpeilen). Fuer jeden
;; konfigurierten Bogenwinkel wird L_VF direkt aus deltaL geloest (reiner
;; VF-Koerper, kein GF-Anteil) und die daraus folgende Hoehenaenderung
;; mitberechnet. Rotationskonvention 1:1 aus vfs-vf-koerper/berechne-alle-
;; winkel uebernommen (Eintritt immer @3 Grad, Austritt @(3-w) Auf / @(w+3)
;; Ab) - hier OHNE Uebergangs-Kompensation fuer "schon-flach", weil deltaL an
;; dieser Aufrufstelle bereits NACH einer evtl. noetigen vfl-nach-3grad-
;; Wandlung gemessen wird (die Kette steht zu diesem Zeitpunkt also schon auf
;; der 3-Grad-Basis). WICHTIG: "ungueltig" bedeutet hier NICHT wie bei
;; berechne-alle-winkel "trifft die vorgegebene Zielhoehe nicht" (es gibt hier
;; gar keine Zielhoehe - die Hoehe folgt erst aus dem gewaehlten Winkel!),
;; sondern reinen Platzbedarf: der Bogen-Fussabdruck (waechst mit dem Winkel)
;; allein passt schon nicht in die gewaehlte Strecke deltaL, es bliebe kein
;; oder ein negatives L_VF fuer die Geradstrecke uebrig. Rueckgabe: Liste von
;; (winkel deltaH-oder-nil L_VF-oder-nil gueltig), aufsteigend nach winkel,
;; EIN Eintrag pro konfiguriertem Winkel (auch ungueltige, fuer die
;; Diagnose-Tabelle in vfl-waehle-winkel-hoehen-tabelle).
(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" - analog zur GUELTIG/
;; UNGUELTIG-Diagnose von berechne-alle-winkel), 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))))
;; 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.
(defun vfl-waehle-winkel (ergebnis-liste / gueltige idx antwort e labels)
(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)))))
(cond
((null gueltige) nil)
((= (length gueltige) 1)
(setq e (car gueltige)) (list (nth 0 e) (nth 1 e) (nth 2 e)))
(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"))
(if (or (null antwort) (< antwort 1) (> antwort (length gueltige))) (setq antwort 1))
(setq e (nth (1- antwort) gueltige))
(list (nth 0 e) (nth 1 e) (nth 2 e)))))
;; 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 um die mit vfl-body-zerlegung geteilte Stufe-1/Stufe-2-
;; Entscheidung (vfl-winkel-stufe-entscheidung) - eigene Mindestlaenge
;; (*vfk-vf-mindestlaenge*=1000, Umlenkstation+Motorstation), Budget
;; *vfl-feste-horizontal*=1300 (Umlenkstation+Separator+Motorstation, 1
;; Separator/Einlaufseite - der Eingang dieser FRISCHEN VF-Einheit ist hier
;; noch nicht gebaut, im Gegensatz zum Kettenende-Fall). schon-flach immer
;; nil: der Frame kommt hier immer frisch von der Umlenkstation bei 3 Grad.
;; deltaH<1.0 wird NICHT mehr sofort abgelehnt (das war die alte Luecke -
;; vfl-winkel-stufe-entscheidung versucht dafuer jetzt auch Stufe 2 rein
;; horizontal, wie beim Kettenende-Fall).
(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 /
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)
(if (null feste-hz) (setq feste-hz FESTE_HORIZONTAL))
(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)))
(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 (- bogen-z1) (- bogen-z2)
(* feste-hz sin3)))
(setq B (+ (- deltaH abs-dz-AUS abs-dz-EIN (* 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-winkel-stufe-entscheidung) 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*))
(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*))
(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)
)
;; 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.
(defun vfl-body-machbar-p (deltaL deltaH richtung / horizontal-info save-ausdx save-ausdz ergebnis)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(setq save-ausdx aus-dx save-ausdz aus-dz)
(setq aus-dx 0.0 aus-dz 0.0)
(setq ergebnis
(cond
((< deltaL *vfk-kettenende-mindestlaenge*) nil)
((< deltaH 1.0)
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" nil))
(and horizontal-info (caddr horizontal-info) t))
((= richtung "Auf")
(vfl-winkel-machbar-p deltaL deltaH "Auf" *vfk-feste-horizontal-kettenende*))
(t
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" nil))
(if (and horizontal-info (caddr horizontal-info))
t
(vfl-winkel-machbar-p deltaL deltaH "Ab" *vfk-feste-horizontal-kettenende*)))
)
)
(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 / 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)
(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) 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 / min-ab min-auf)
(setq min-ab (vfl-body-min-deltah deltaL "Ab"))
(setq min-auf (vfl-body-min-deltah deltaL "Auf"))
(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.
((= 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 ( / )
(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)
(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))
(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)))
(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))
;; NUR die Fahrtrichtung picken (kein deltaL) - fuer "Linie-GF"/Zweig B
;; ("Zielhoehe zuerst festlegen") am ECHTEN Kettenanfang, wo noch kein
;; Vorgaenger-Frame existiert, aus dem die Richtung uebernommen werden
;; koennte. Der Klick-ABSTAND wird bewusst ignoriert (die Laenge kommt dort
;; aus Zielhoehe+Winkel, nicht aus dem Klick) - nur die gesnappte Richtung
;; wird verwendet. Laeuft ueber vfl-in-value (wie alle anderen vfl-in-*-
;; Wrapper): Replay/Pending-Queue/Abbruch-Trigger/Journal (als "REAL")
;; funktionieren dadurch automatisch mit.
(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)))))
;; 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.
(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))))
;; 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). Die 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-baue-
;; horizontal-koerper, 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)
)
;; 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 wird
;; "Ist der Endpunkt der Foerderer?" VOR der Laengenberechnung gestellt -
;; erst wenn die Antwort feststeht, 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 eine
;; Motorstation dazukommt.
;; KEIN Separator VOR/NACH mehr innerhalb dieses Sub-Segments: ein
;; Separator ist mechanisch nur zwischen zwei GF-Segmenten, zwischen GF und
;; Umlenkstation, oder zwischen Motorstation und GF gueltig - NICHT
;; innerhalb einer laufenden, angetriebenen VF-Einheit (die Sub-Segmente
;; haengen nur ueber Vertikalboegen zusammen, keine echte Trennstelle). Der
;; Separator an der Motorstation wird stattdessen dort gefragt/gebaut, wo er
;; hingehoert: vfl-sep-an-stelle-frage in vfl-vf-einheit-abschluss beim
;; Weiterbauen, automatisch vor dem ES-Element beim Kettenende.
;; 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.
;; 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))
)
;; Frage "Ist der Endpunkt der Foerderer?" - eigene Funktion, weil
;; vfl-baue-horizontal-koerper sie unter Umstaenden zweimal stellen muss
;; (Erstfrage + Nachfrage, wenn die Reststrecke sich nachtraeglich als zu
;; kurz herausstellt und die Erstantwort dadurch ungueltig werden kann). Im
;; Wizard-Modus zeigt sie SELBST den Dialog (vflw_horizontal, radio-basiert)
;; und legt die Antwort in die Pending-Queue - so bekommt auch die Nachfrage
;; (kein separater Gruppen-Dialog-Aufruf an der Aufrufstelle) ein echtes
;; Auswahlfenster statt des generischen Dropdowns.
(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)
(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"))
)
)
)
)
)
(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"))
;; checkpoint: (entlast) von VOR dem Eingangsaufbau (GF1+Separator+
;; Umlenkstation) der aufrufenden VF-Einheit, oder nil bei einer Fortsetzung
;; einer bereits laufenden VF-Einheit (dort bleibt bei Abbruch die bisherige
;; Kette stehen). Bei checkpoint<>nil wird vor jedem (exit) dieser Funktion
;; der seither eingefuegte Eingang wieder geloescht (vfl-loesche-seit) - eine
;; VF-Einheit mit nur einer Umlenkstation und nichts dahinter ist kein
;; sinnvolles Teilergebnis.
(defun vfl-baue-horizontal-koerper (frame hz dL ziel-modus gf2-laenge checkpoint /
pt m1 pt-vor-bogen ist-ende-antwort dL-neu
antwort-zu-kurz)
(setq pt (car frame))
;; Im Ziel-Modus: "Ist der Endpunkt der Foerderer?" abfragen, BEVOR die
;; endgueltige Laenge feststeht (Dialog wird bei Bedarf von
;; vfl-frage-ist-endpunkt selbst gezeigt).
(if ziel-modus (setq ist-ende-antwort (vfl-frage-ist-endpunkt)))
;; 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-neu (- dL (vfl-projiziere-distanz pt-vor-bogen pt hz)))
(if (< dL-neu *vfk-restlaenge-min-clamp*)
(progn
;; Nicht sofort abbrechen: Hinweis mit den echten Zahlen zeigen und
;; fragen, ob mit der Mindestlaenge trotzdem weitergebaut werden
;; soll (gleiches Bauteil "Staustrecke_SP_1000_mm" wie im Normalfall,
;; nur auf *vfk-restlaenge-min-clamp* geklemmt statt geplant lang -
;; der Kettenpunkt landet dann entsprechend weiter als angeklickt).
(princ (ssg-textf "vfl-hinweis-horizontal-fussabdruck-zu-kurz"
(list (rtos dL 2 0) (rtos dL-neu 2 0) (rtos *vfk-restlaenge-min-clamp* 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-hinweis-horizontal-fussabdruck-zu-kurz"
(list (rtos dL 2 0) (rtos dL-neu 2 0) (rtos *vfk-restlaenge-min-clamp* 2 0))))))
(setq antwort-zu-kurz (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
"vfl-hinweis-horizontal-fussabdruck-zu-kurz"))
(if (= antwort-zu-kurz "1")
(progn
(setq dL-neu *vfk-restlaenge-min-clamp*)
;; Die Erstantwort auf "Ist der Endpunkt der Foerderer?" bezog
;; sich auf die urspruenglich geplante (laengere) Reststrecke -
;; nach dem Klemmen auf das Minimum ggf. nicht mehr sinnvoll
;; (z.B. reicht es dann erst recht nicht mehr fuer Motorstation
;; +Bogen) - deshalb hier neu erfragen.
(if ziel-modus (setq ist-ende-antwort (vfl-frage-ist-endpunkt)))
)
(progn
(if checkpoint (vfl-loesche-seit checkpoint))
(princ (ssg-textf "vfl-fehler-horizontal-fussabdruck-zu-kurz" (list (rtos dL-neu 2 0))))
(exit)
)
)
)
)
(setq dL dL-neu)))
;; Ausgangs-Fussabdruck (Vario_Bogen_ab_3 + Motorstation [+ GF2]) nur
;; reservieren, wenn tatsaechlich sofort mit Motorstation geschlossen wird
;; (Antwort 1 oder 3) - die Frage selbst ist oben schon beantwortet.
(if ziel-modus
(cond
((= ist-ende-antwort "1")
(setq dL-neu (- 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))))))
(if (< dL-neu *vfk-restlaenge-min-clamp*)
(progn
(if checkpoint (vfl-loesche-seit checkpoint))
(princ (ssg-textf "vfl-fehler-horizontal-fussabdruck-zu-kurz" (list (rtos dL-neu 2 0))))
(exit)))
(setq dL dL-neu))
((= ist-ende-antwort "3")
(setq dL-neu (- dL (car (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*))) *vfk-stations-laenge*))
(if (< dL-neu *vfk-restlaenge-min-clamp*)
(progn
(if checkpoint (vfl-loesche-seit checkpoint))
(princ (ssg-textf "vfl-fehler-horizontal-fussabdruck-zu-kurz" (list (rtos dL-neu 2 0))))
(exit)))
(setq dL dL-neu))
)
)
;; horizontale Zwischenstrecke (0 Grad) - KEIN Separator mehr davor/danach.
(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)
;; KEIN ab_3 mehr -> das Stueck ENDET FLACH (0 Grad)
(setq frame (make-frame-from-dir pt (hz-winkel->xu hz 0.0)))
(if ziel-modus (list frame ist-ende-antwort) frame)
)
;; ============================================================
;; 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.
;; schon-flach: T => die Kette kommt bereits flach (0 Grad) an (letztes
;; Sub-Segment war horizontal, kein ab_3 wurde dafuer gebraucht) - wird an
;; berechne-horizontale-mitte weitergereicht, damit ein evtl. dort
;; entschiedenes horizontales Mittelstueck OHNE ueberfluessigen Eintritts-
;; bogen (auf_3) budgetiert wird. Der Aufrufer (vfl-body-abschluss) baut in
;; diesem Fall das Mittelstueck dann auch tatsaechlich ohne auf_3.
;; Rueckgabe: (typ winkel L_GF2 L_VF) - typ "GF"/"VF"/nil (wie
;; vfl-segment-entscheidung; L_GF2 varriert, Mindestwert siehe vfl-body-abschluss).
;;
;; Diagnose-Ausgabe fuer den Stufe-2-Versuch (horizontales VF + GF, siehe
;; berechne-horizontale-mitte): zeigt GF_total/L_VF auch dann, wenn das
;; Ergebnis ungueltig ist (negativ) - hilft zu erkennen, WARUM Stufe 2
;; scheitert (z.B. wenn die feste 3-Grad-Neigung der Motor-/Separator-/ES-
;; Stationen allein schon mehr Hoehe abbaut, als das Ziel verlangt - dann
;; wuerde GF_total negativ, was physisch nicht baubar ist).
;; schon-flach: derselbe Wert, der auch an berechne-horizontale-mitte
;; uebergeben wurde - bestimmt hier NUR die Anzeige (ob bogen-x1/z1 als 0
;; oder als tatsaechlicher Eintrittsbogen-Fussabdruck gezeigt werden), damit
;; sichtbar wird, dass im Kettenende-Fall (Aufrufer vfl-body-zerlegung) NUR
;; der Austrittsbogen (bogen-x2/z2, 0->3 Grad vor Motorstation) zwingend
;; gebraucht wird, waehrend aus-dx/aus-dz (Einlauf-AS-Element) bereits vom
;; Aufrufer auf 0 gesetzt sind (siehe dortiger Kommentar). Rekonstruiert die
;; Bogen-Fussabdruecke separat (dupliziert bewusst die paar Zeilen aus
;; berechne-horizontale-mitte statt deren Rueckgabe zu erweitern - die
;; Funktion ist Standard/Etage-uebergreifend, eine Signaturaenderung dort
;; haette einen groesseren Blast-Radius als hier lokal in vf_linienzug.lsp
;; nochmal auszurechnen).
;; Zeigt ZUSAETZLICH, sobald das Ergebnis ungueltig ist, zwei Mindestwerte,
;; die die beiden moeglichen Ursachen trennen (siehe Nutzer-Anfrage):
;; Variante 1 (kein gerader VF-Anteil, L_VF=0): GF wird exakt auf die
;; VERLANGTE Zielhoehe dimensioniert (GF_total aus horizontal-info) - die
;; dafuer noetige Mindest-Streckenlaenge ist fixed-x + GF_total*cos(rad3).
;; Ist GF_total selbst schon negativ, ist diese Variante gar NICHT ueber die
;; Laenge loesbar (auch bei unendlich viel Laenge nicht) - dann wird
;; stattdessen die Hoehen-Diskrepanz gemeldet: schon OHNE GF-Bogen aendert
;; sich die Hoehe um mindestens minh mm.
;; Variante 2 (kein GF-Bogen, GF_total=0, Rest als gerader VF-Anteil - VF
;; aendert die Hoehe nicht): die resultierende Hoehenaenderung ist dann fix
;; minh mm, UNABHAENGIG von der Streckenlaenge. Ist aber selbst der reine
;; feste Fussabdruck (fixed-x, ohne VF UND ohne GF) schon laenger als die
;; verfuegbare Strecke, ist auch diese Variante nicht ueber die Hoehe
;; loesbar - dann wird stattdessen die Laengen-Diskrepanz gemeldet.
;; Ausgabe wird NICHT sofort geprinct, sondern in *vfl-stufe2-diagnose-text*
;; gesammelt: der Aufrufer (vfl-body-zerlegung) leert die Variable bei jedem
;; Aufruf zuerst, vfl-body-abschluss haengt den gesammelten Text (falls
;; vorhanden) 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-Winkel-
;; tabelle 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 Zwischen-
;; versuchs 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))
;; 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):
;; feste-hz=*vfk-feste-horizontal-kettenende* (800, nur Motor+Separator -
;; der Eingang ist zu diesem Zeitpunkt schon gebaut).
;; - vfl-vf-entscheidung ("Neue Linie: Ab/Auf VF"/"BIS Kettenende", 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), typ="GF"/"VF"/nil (winkel=0 bei "VF"
;; heisst horizontales Stufe-2-Ergebnis). 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 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))))
(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))
(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))))
(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))))
(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 Motor+Separator = kein
;; Abschluss baubar), sonst delegiert an vfl-winkel-stufe-entscheidung mit dem
;; Kettenende-Budget.
(defun vfl-body-zerlegung (deltaL deltaH richtung schon-flach)
(if (< deltaL *vfk-kettenende-mindestlaenge*)
(list nil nil nil nil)
(vfl-winkel-stufe-entscheidung deltaL deltaH richtung schon-flach *vfk-feste-horizontal-kettenende*)))
;; 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.
(defun vfl-body-abschluss (frame letzt-hz p-umlenk /
linie-mess dL hzn hn dH richtn rad3 dec typ w lgf lvf
gf2 cnt p0 tx ty schon-flach antwort-gf2
hoehe-vorschlaege hoehe-ab hoehe-auf hoehe-fallback)
;; 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-body-zerlegung). Die
;; Positions-Messung selbst funktioniert unabhaengig von der Neigung.
(setq schon-flach (vfl-frame-flach-p frame))
(setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz))
(if (null linie-mess)
(progn (princ (ssg-text "vfl-abgebrochen-kein-ziel")) 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))
(setq hoehe-ab (nth 0 hoehe-vorschlaege) hoehe-auf (nth 1 hoehe-vorschlaege))
(setq hoehe-fallback (if hoehe-ab hoehe-ab (caddr (car frame))))
(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 (caddr (car frame))))))
(setq hn (vfl-in-real
(if (and hoehe-ab hoehe-auf)
(ssg-textf "vfl-prompt-hoehe-kettenende-2"
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1)))
(ssg-textf "vfl-prompt-hoehe-kettenende" (list (rtos hoehe-fallback 2 1))))))
(if (null hn) (setq hn hoehe-fallback))
(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))
(setq typ (nth 0 dec) w (nth 1 dec) lgf (nth 2 dec) lvf (nth 3 dec))
(if (null typ)
(progn
;; Klare Rueckmeldung statt nur "nicht baubar": die tatsaechlich
;; gewaehlte Zielhoehe + Strecke nennen, UND (falls vorhanden) die
;; bereits VOR der Hoehe-Abfrage berechneten baubaren Vorschlaege
;; (hoehe-ab/hoehe-auf, siehe vfl-body-hoehe-vorschlaege oben)
;; hier NOCHMAL zeigen - der Nutzer sieht sie sonst nur einmal vor
;; der Eingabe und muss beim Fehler wieder hochscrollen.
(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))))
;; 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, und
;; wuerde weiter oben (vor der Stufe-1-Tabelle) den Lesefluss stoeren.
(if *vfl-stufe2-diagnose-text* (princ *vfl-stufe2-diagnose-text*))
;; Kurze 2-Punkte-Zusammenfassung zusaetzlich als Alert-Popup (nicht
;; nur im Konsolen-Log) - Punkt 2 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 ""))))
(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 weiter unten 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 (bracktet
;; selbst korrekt mit auf_3/ab_3 bzw. den Winkel-Boegen). 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.
((and (= typ "VF") lvf (> lvf 1.0))
(setq frame (vfl-nach-3grad frame))
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn w lvf hzn) hzn))
(vfl-acc-vf-seg richtn w lvf)
(setq cnt (1+ cnt)))
)
(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). Ein
;; berechneter Wert unter 400mm ist geometrisch genauso baubar wie
;; jeder andere (vfs-vf-exit skaliert den Block auf jede Laenge >0).
(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)
)
)
)
)
)
;; eingang-modus steuert den VF-Eingang je nach VORHERIGEM Kettenglied
;; (letzter-typ in vf-linienzug-modus) - keine blinde GF1+Separator-Zugabe
;; mehr, wenn das vorherige Glied das schon erledigt hat:
;; nil => Standard: GF1 (mind. *vfl-gf-min-laenge*) + Separator +
;; Umlenkstation (Kettenanfang/AS, oder vorheriges Glied VF).
;; "gf" => vorheriges Glied ist ein GF-Segment OHNE eigenen
;; Separator: kein GF1-Stumpf, nur Separator + Umlenkstation.
;; "separator" => vorheriges Glied ist bereits ein Separator: nur noch
;; Umlenkstation (weder GF1 noch ein zweiter Separator).
;; "keine" => vorheriges Glied ist bereits Teil einer virtuellen VF-Kette
;; OHNE eigene Umlenkstation (z.B. Vario-Kurve als allererstes
;; Kettenglied) - eine zweite Umlenkstation waere mechanisch
;; sinnlos: KEIN GF1, KEIN Separator, KEINE Umlenkstation, der
;; Koerper knuepft direkt am uebergebenen frame an.
;; Rueckgabe: (frame anzahl-koerper ziel-ende)
(defun vfl-vf-einheit (frame hz1 richtung1 winkel1 L_GF1 L_VF1 gf-am-ausgang eingang-modus /
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
letzt-hz fertig ziel-ende ziel-gf2 res3 gf2-eff entry-start
res-h vor-antwort es-gewuenscht es-antwort save-eindx save-eindz
hoehe-vorschlaege hoehe-ab hoehe-auf hoehe-fallback restlaenge
schon-flach winkel-hoehen-erg entry-checkpoint 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": dort ist kein
;; GF1-Stumpf noetig (siehe Kommentar oben).
(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 ---
;; Checkpoint VOR dem Eingangs-Aufbau: falls die horizontale Zwischenstrecke
;; (unten, winkel1=0) sich als zu kurz erweist und der Nutzer "trotzdem
;; bauen?" verneint, soll NICHT nur die Fehlermeldung kommen, sondern auch
;; der bereits eingefuegte Eingang (GF1+Separator+Umlenkstation+ggf.
;; Uebergangsbogen) wieder entfernt werden - eine VF-Einheit mit nur einer
;; Umlenkstation und nichts dahinter ist kein sinnvolles Teilergebnis (siehe
;; vfl-loesche-seit, uebergeben an vfl-baue-horizontal-koerper).
(setq entry-checkpoint (entlast))
(setq entry-start (car frame))
(if (equal eingang-modus "keine")
(setq p-umlenk (car frame))
(progn
(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)
(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).
;; Dieser Ausgangs-Fussabdruck wird NUR reserviert, wenn "Ist der
;; Endpunkt der Foerderer?" (in vfl-baue-horizontal-koerper) mit
;; "Ja" beantwortet wird - beim Weiterbauen faellt er weg, siehe dort.
(if (= (fix winkel1) 0)
(progn
;; Reale (gemessene) Restlaenge nach Abzug des Eingangs (GF1+Separator+
;; Umlenkstation) - NICHT hier schon auf *vfk-restlaenge-min-clamp*
;; pruefen: das Umlenkstation-Austritts-Frame ist 3 Grad geneigt, der
;; noch fehlende 3-Grad-Uebergangsbogen (Vario_Bogen_auf_3) frisst
;; hiervon nochmal etwas ab - die verlaessliche Pruefung (inkl. Hinweis+
;; Nachfrage bei zu kurzer Reststrecke) passiert bereits INNERHALB von
;; vfl-baue-horizontal-koerper, direkt nach dem Bogen-Einbau. Eine
;; Pruefung hier waere zu frueh (Bogen-Fussabdruck noch nicht
;; beruecksichtigt) und wuerde genau diese Nachfrage verhindern.
(setq restlaenge (- L_VF1 (vfl-projiziere-distanz entry-start p-umlenk hz1)))
;; 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 restlaenge t L_GF2-bau entry-checkpoint))
(setq frame (car res-h) vor-antwort (cadr res-h))
)
(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 frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtung1 winkel1 L_VF1 hz1) hz1))
(vfl-acc-vf-seg richtung1 winkel1 L_VF1)
)
)
(setq vf-count 1 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, dieselbe Mechanik wie in
;; vf-linienzug-modus2). Winkel/Seite werden JETZT (nicht erst spaeter
;; in vfl-vf-einheit-abschluss) erfragt, weil sie den tatsaechlichen
;; ES-Fussabdruck (ein-dx/ein-dz, per vf-set-es-masse 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.
(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
;; dialog-schon-gezeigt=T: Winkel+Seite kamen bereits aus dem
;; kombinierten vflw-gruppe-as-impl-Dialog oben (mit).
(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 letzt-hz p-umlenk))
(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))
;; Punkt-Pick abgebrochen (ESC): bisher fiel dies still durch (kein
;; (exit)) und die Schleife fragte einfach erneut "Naechstes
;; Element" - vom Nutzer als "Abbrechen wirkt nicht" gemeldet.
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(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.
;; kein Checkpoint (nil): dies ist eine Fortsetzung einer
;; bereits laufenden VF-Einheit, nicht deren Eingang - bei
;; "trotzdem bauen?"=Nein bleibt die bisherige Kette stehen
;; (normaler Abbruch/Wickeln, kein Rueckbau).
(setq res-h (vfl-baue-horizontal-koerper frame hzn dL t L_GF2-bau nil))
(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))
;; Punkt-Pick abgebrochen (ESC): bisher fiel dies still durch (kein
;; (exit)) und die Schleife fragte einfach erneut "Naechstes
;; Element" - vom Nutzer als "Abbrechen wirkt nicht" gemeldet.
(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 "vfl-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 hoehe-fallback (if hoehe-ab hoehe-ab (caddr (car frame))))
(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 (caddr (car frame))))))
(setq hn (vfl-in-real
(if (and hoehe-ab hoehe-auf)
(ssg-textf "vfl-prompt-hoehe-endpunkt-2"
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1)))
(ssg-textf "vfl-prompt-hoehe-endpunkt"
(list (rtos hoehe-fallback 2 1))))))
(if (null hn) (setq hn hoehe-fallback))
(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))
(if (and typ (= typ "VF"))
(progn
(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))
)
(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).
(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))
;; Auslauf-GF2: im Kettenende-Modus (Option 3) neu berechnet (ziel-gf2),
;; sonst aus der GF-Verteilungs-Frage (L_GF2-bau).
(setq gf2-eff (if ziel-ende ziel-gf2 L_GF2-bau))
(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)))
(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). Ist der
;; Frame bereits flach (z.B. direkt nach einem AS-Element oder GF-Bogen als
;; allererstem Kettenglied), wird NICHT per make-frame-from-dir neu
;; aufgebaut - das wuerde die REALE (aus dem Vorgaenger-Block gemessene)
;; yu/zu-Rollung verwerfen und durch die rein rechnerische Konvention
;; ersetzen, was bei realen Bloecken zu einem KS-Versatz/Drehfehler fuehren
;; kann (dieselbe Fehlerklasse, die weiter unten fuer die AUSGANGS-Korrektur
;; bereits empirisch gefunden und dort durch die rollungserhaltende
;; vfl-frame-um-z-drehen ersetzt wurde - hier war die Eingangsseite noch
;; nicht angepasst). Nur bei einer TATSAECHLICH geneigten 3-Grad-Basis
;; (mitten in einer VF-Einheit) wird abgeflacht - dort gibt es keine reale
;; Rollung zu erhalten, die Rekonstruktion ist unbedenklich.
(if (vfl-frame-flach-p frame)
(setq flach-frame frame)
(progn
(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")
)
;; 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")) "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).
;; Bewusst NICHT verschachtelt (erst VF/GF, dann ggf. nachfragen) - ist
;; der Vorgaenger bereits SICHER bekannt (Fall 1/letzter-typ), gibt es
;; ohnehin keine Frage; hier ist die Lage grundsaetzlich unklar, daher
;; gleich alle drei Ergebnisse gleichwertig anbieten.
;; Fall 4 - sonst voller Eingang (GF1+Separator+Umlenkstation).
;; WICHTIG fuer den Aufrufer: bei ALLEN reduzierten Faellen (Separator/GF/
;; Vario-Kurve/keine) ist L_GF danach 0.0 (vfl-vf-einheit zerlegt L_GF-eff
;; dann ohnehin auf 0.0) - es gibt also KEINE frei waehlbare GF-Laenge mehr,
;; mit der ein 2-Unbekannten-Solve (Zielhoehe -> L_GF+L_VF, wie
;; vfl-vf-entscheidung) eine beliebige Zielhoehe treffen koennte. In allen
;; reduzierten Faellen muss der Aufrufer daher die Punkt-7-Winkel/Hoehen-
;; Tabelle (vfl-waehle-winkel-hoehen-tabelle) statt einer Zielhoehe-Abfrage
;; nutzen - nur bei vollem Eingang (nil) bleibt die klassische Zielhoehe-
;; Abfrage sinnvoll (L_GF dort frei, kann exakt auf die Zielhoehe hinsolvet
;; werden). 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.
;; 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"))
(vf-set-es-masse *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-ss ent 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)))
;; ATTDEFs nach gemeinsamem Strecken-Schema (Reihenfolge!)
(foreach def (ssg-strecke-attrib-defs typ-str)
(entmake
(list '(0 . "ATTDEF")
(cons 10 startpunkt)
(cons 11 startpunkt)
'(40 . 50.0)
(cons 1 (cadr def))
(cons 2 (car def))
(cons 3 (car def))
'(70 . 1)
'(72 . 0)
'(74 . 0)))
)
(setq vfl-ss (ssadd))
(setq ent (if lastEnt (entnext lastEnt) (entnext)))
(while ent
(ssadd ent vfl-ss)
(setq ent (entnext ent))
)
;; Block definieren und einfuegen mit garantiert weltparallelem BKS.
;; startpunkt ist ein Welt-Punkt; ssg-block-wrap-welt setzt das BKS
;; temporaer auf Welt (verhindert den 31.95mm-Z-Versatz bei abweichendem
;; BKS, siehe Kommentar dort) und stellt es danach wieder her.
(setq vfl-insert (ssg-block-wrap-welt vfl-bname startpunkt vfl-ss))
;; Werte (volle Liste; nicht vorhandene Tags ignoriert ssg-attrib-set-on)
(ssg-attrib-set-on vfl-insert
(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*))
)
)
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
(ssg-id-generate vfl-insert))
;; Dimension (2D/3D), in der gebaut wurde, als eigenes SSG_DIM-XDATA merken
;; (analog vf-block-erstellen). Deckt alle Bau-Pfade ab, da Modus 1/2/3 UND
;; die Abbruch-Sicherung ueber vfl-block-erstellen laufen. Erst dadurch kann
;; die Batch-Umschaltung (ssg-dim-alle-umwandeln) Linienzug-Bloecke korrekt
;; als 2D bzw. 3D erkennen statt sie pauschal als "3D" zu behandeln.
(if (and vfl-insert (car (atoms-family 1 '("SSG-DIM-XDATA-SCHREIBEN"))))
(ssg-dim-xdata-schreiben vfl-insert (ssg-ils-dim-aktuell)))
(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").
;; gf-verteilung-fest: nil => Verteilung wie bisher interaktiv erfragen.
;; "1"/"2" => Frage UEBERSPRINGEN, direkt mit dieser Antwort weiterbauen -
;; fuer den horizontalen Anfangs-Koerper: L_GF ist dort nur der
;; strukturelle Mindest-Eingang (kein frei waehlbarer Staustrecke-Puffer),
;; die Frage waere fuer den Nutzer bedeutungslos. Das Ausgangs-Ende regelt
;; dort stattdessen ausschliesslich die mit/ohne-Motorstation-Frage in
;; vfl-baue-horizontal-koerper.
;; eingang-modus: nil/"gf"/"separator" - siehe vfl-vf-einheit, wird nur
;; durchgereicht (vom Aufrufer aus letzter-typ abgeleitet).
;; Rueckgabe: (frame anzahl-koerper ende-flag es-seite-oder-nil).
(defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF auto-ende gf-verteilung-fest eingang-modus /
antwort res es-s ende es-gewuenscht es-seite-vorab)
;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf.
(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 (= antwort "1") eingang-modus))
(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).
(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)
)
)
)
((= 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.
(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)
)
)
)
(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 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 gf-laenge-modus
as-vorhanden erg old-error vfl-ins dbg-an
hoehe-vorschlaege hoehe-ab hoehe-auf hoehe-fallback
sep-vor-gf sep-nach-gf sep-anzahl
vf-eingang-lgf vf-eingang-modus winkel-hoehen-erg eingang-laenge
bogen-mass fest-drop fest-laenge eingang-fertig
gf-steigend-modus erg-bogen)
;; "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)
(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 (dbg-schalter-open "vfl-modus1" "vfl_modus1.dbg" "DXFM_LOG"))
(if dbg-an
(progn
(dbgf "vf-linienzug-modus")
(dbgmsg "=== SESSION Modus 1 (Manuelle Eingabe) START ===")
;; Diagnose: 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.
(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*)
;; Abbruch-Handler: zuerst *error* zuruecksetzen (kein rekursiver
;; Wiedereintritt bei einem Fehler waehrend des Wickelns), dann wickeln.
;; Laeuft der Aufruf innerhalb einer ssg-start-Sitzung (Editier-Pfad via
;; c:VARIOFOERDERER_EDIT -> vfl-edit-ent), wird diese mit ssg-end sauber
;; geschlossen (Undo-Gruppe, gesicherte Systemvariablen, *error* aus dem
;; Sitzungs-Frame) - sonst bliebe die von ssg-start geoeffnete Undo-Gruppe
;; offen.
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite "linienzug")
(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))))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
(list "vfl-prompt-startpunkt-kette" "Starthoehe (Z, mm):")))
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-prompt-startpunkt-kette")))
(if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
;; Hoehe (Z) des Startpunkts abfragen und in die Z-Koordinate uebernehmen.
(setq start-hoehe
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt-kette" (list (rtos (caddr startpunkt) 2 1)))))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(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
(progn
(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 "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-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
)
)
;; 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)
(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).
(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 "?")
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-naechstes-element-impl (list (null frame))))
(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
(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
)
)
;; Segmenttyp steht fest -> Glied-Label nachtragen (fuer die Edit-Liste).
(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 (im Dialog von
;; vfl-insert-gf-bogen abgefragt) 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" darf daher keine zweite Umlenkstation bauen
;; (siehe Sonderfall in wahl="Linie-VF" unten).
(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", Punkt 5).
(setq erg (vfl-eingang-modus-bestimmen letzter-typ kettenanfang as-vorhanden p-aktuell))
(setq vf-eingang-lgf (car erg) vf-eingang-modus (cdr erg))
;; NEU: bei einem vollen Neuaufbau des Eingangs (modus=nil, GF1 wird
;; frisch gebaut) wird GF1 nicht mehr 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)
(alert (ssg-text "vfl-alert-eingang-kann-nicht-steigen"))
(setq vf-eingang-lgf nil))
((< deltaH fest-drop)
(alert (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
(alert (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 "2" vf-eingang-modus))
(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)))
;; NEU: Vorfrage "Wie soll die Laenge bestimmt werden?" - IMMER gezeigt
;; (auch am Kettenanfang: dort wird bei "Zielhoehe festlegen" die
;; Richtung ueber einen eigenen, reinen Richtungs-Pick bestimmt statt
;; ueber den sonst richtungsbestimmenden Endpunkt-Klick - siehe unten).
;; gf-laenge-modus="2" => Zielhoehe zuerst (Zweig B unten), "3" =>
;; steigende GF (Sonderfall, Zweig C unten, eigenstaendig, KEIN
;; Separator), sonst (Default "1") Endpunkt waehlen (Zweig A,
;; unveraendertes heutiges Verhalten).
(setq gf-laenge-modus "1")
(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"))
(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")) 1
"vfl-gf-laenge-modus-header"))
(setq gf-ok nil)
(cond
((= gf-laenge-modus "3")
(progn
;; --- Zweig C: Steigende GF (Sonderfall, bis 3 Grad) - eigene,
;; von Zweig A/B unabhaengige Kopie: KEIN Separator (gilt laut
;; Vorgabe nur fuer die normale fallende 3-Grad-GF), dafuer
;; 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.
(setq sep-vor-gf nil sep-nach-gf nil)
;; KEIN vflw-gruppe-gf-laenge-modus-impl hier: dessen Dialog zeigt
;; alle 3 Optionen (inkl. "steigend" erneut) - fuer diese innere
;; Frage sind nur Endpunkt/Zielhoehe gueltig. vfl-menu nutzt im
;; Wizard-Modus automatisch den generischen Auswahl-Fallback.
(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"))
(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)))
(if (< deltaH 0.0)
(progn
(alert (ssg-text "vfl-alert-gf-steigend-falsche-richtung"))
(setq gf-ok nil))
(progn
;; KEIN vflw-gruppe-gefaelle-impl hier (im Gegensatz zu
;; Zweig B): dessen DCL-Dialog ist fest auf den normalen
;; Wortlaut/Wertebereich (0 < Winkel) zugeschnitten. Der
;; generische vfl-in-real-Fallback (vflw_zahl) zeigt den
;; hier uebergebenen Steigend-Prompt korrekt an.
(princ (ssg-text "vfl-gefaelle-festlegen-header"))
(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
(alert (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
(alert (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))
)
)
(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
(alert (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")
(progn
;; --- Zweig B: Zielhoehe zuerst festlegen, Laenge wird berechnet ---
(if kettenanfang
(progn
;; Echter Kettenanfang: keine Vorgaenger-Richtung vorhanden -
;; eigener Richtungs-Pick (Abstand wird ignoriert, siehe
;; vfl-in-richtung), danach AS-Element (falls gewuenscht) SOFORT
;; einfuegen (braucht die jetzt bekannte Richtung). Keine feste
;; Laengen-Budget-Pruefung noetig - Zweig B hat kein deltaL, das
;; hier schon existieren muesste.
(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))
)
;; Sonst: Richtung vom Vorgaenger-Frame uebernehmen - kein Pick.
(setq hz-neu (car (frame->hz-winkel frame)))
)
(setq rad3 (* gf-max-winkel (/ pi 180.0)))
;; Separator VOR/NACH wie in Zweig A abfragen - hier aber NICHT von
;; einer festen Laenge abziehen (die gibt es noch nicht), sondern
;; ihr Hoehenanteil wird unten von der Zielhoehe abgezogen.
(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"))
(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
(alert (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
;; Hoehenanteil der Separatoren vorab abziehen (Reihenfolge
;; hier umgekehrt zu Zweig A: Hoehe zuerst, Winkel/Laenge
;; danach - siehe Kommentar oben).
(if (> sep-anzahl 0)
(setq deltaH (max 0.0 (- deltaH (* sep-anzahl *vfk-separator-laenge* (sin rad3))))))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-gefaelle-impl
(list (vfl-gf-hoehe-vorschlag (caddr p-aktuell)) t)))
(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
(alert (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
(progn
;; --- Zweig A: Endpunkt waehlen (heutiges Verhalten, unveraendert) ---
;; 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
;; (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 Dreh­teller-
;; 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 (das AS-Element allein braucht bereits mehr Platz als bis
;; zum Klickpunkt vorhanden war). Ohne diese zweite Pruefung wuerde
;; vfl-insert-gf-segment mit negativem deltaL "erfolgreich" eine
;; entartete/unsichtbare GF-Strecke bauen (leerer Sprung zwischen AS
;; und dem naechsten Element) statt den Nutzer erneut picken zu
;; lassen - siehe vfl-fehler-linie-zu-kurz oben (dieselbe Meldung).
;; Sofortiger Abbruch DIESES Zweigs (kein Weiterfragen nach Winkel/
;; Hoehe fuer ein Segment, das ohnehin nicht gebaut werden kann) -
;; gf-ok wird unten sonst mehrfach ueberschrieben.
(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,
;; da der tatsaechliche GF-Winkel erst danach feststeht - siehe
;; analoge Naeherung im Kettenende-Modus/wahl="Linie") 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"))
(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)))))
(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)))
(princ (ssg-text "vfl-gefaelle-festlegen-header"))
(princ (ssg-text "vfl-gefaelle-opt-winkel"))
(princ (ssg-text "vfl-gefaelle-opt-hoehe"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "vfl-gefaelle-opt-winkel")
(ssg-text "vfl-gefaelle-opt-hoehe")) 1
"vfl-gefaelle-festlegen-header"))
(if (= antwort "1")
(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
(alert (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 - wie bisher, aber Winkel wird daraus abgeleitet
;; und gegen den GF-Maximalwinkel geprueft (GF kann nicht steigen).
;; p-aktuell ist ab hier immer der reale Referenzpunkt (bei
;; Kettenanfang das echte KS_AUS des AS-Elements). Vorschlag/
;; Enter-Default = vfl-gf-hoehe-vorschlag (siehe dort), NICHT
;; die unveraenderte Ist-Hoehe - sonst waere deltaH=0 und die
;; GF-Pruefung wiese den Wert als "kann nicht steigen" ab.
(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))
;; Hoehenanteil der Separator(en) (genaehert auf rad3,
;; siehe Laengen-Abzug oben) ebenfalls abziehen, sonst
;; wuerde die Kette am Ende leicht unter/ueber die
;; gegebene Zielhoehe hinausschiessen.
(if (> sep-anzahl 0)
(setq deltaH (max 0.0 (- deltaH (* sep-anzahl *vfk-separator-laenge* (sin rad3))))))
(cond
((= richtung "Auf")
(alert (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
(alert (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 BEIDE Zweige/Zweig C (unveraendert bzw.
;; per vfl-bogen-uebergang um den Steigend-Sonderfall erweitert) ---
(if gf-ok
(progn
;; Uebergangsbogen(n) einfuegen, falls die aktuelle Frame-Neigung
;; nicht zur Ziel-Neigung dieser Linie passt: noetig fuer den
;; Steigend-Sonderfall (Zweig C, winkel < 0) UND falls der
;; VORGAENGER eine steigende GF war und jetzt normal (Zweig A/B)
;; weitergebaut wird. Im unveraenderten Normalfall (Vorgaenger-
;; Neigung bereits 0/+3, Ziel +3 wie bisher) ist die Bedingung
;; falsch - kein Verhaltensunterschied zu vorher.
(if (or (< winkel 0.0) (< (cadr (frame->hz-winkel frame)) (- *vfl-gf-winkel-toleranz*)))
(progn
(setq erg-bogen (vfl-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 (analog
;; vfl-insert-es-element bei typ="GF").
(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 (letzter-typ dadurch "Separator", nicht
;; mehr "GF" - relevant fuer den naechsten VF-Einheit-
;; Eingang).
(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))
)
)
(setq antwort (vfl-frage-ist-kettenende))
(cond
((= antwort "1")
(setq es-seite (vfl-frage-es-seite nil))
(setq frame (vfl-insert-es-element "GF" frame hz-neu winkel
(caddr (car frame)) es-seite))
(setq fertig t))
((= antwort "2") (setq fertig t))
)
)
)
)
)
)
;; --- 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", Punkt 5).
(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 wie Punkt 7 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 "vfl-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/Blank-Scan, 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 (laenger/hoeher als tatsaechlich baubar).
(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 "2" vf-eingang-modus))
(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))
;; KEIN Ist-Ziel-Vergleich mehr gegen hoehe-neu hier: hoehe-neu
;; sagt nur das Ergebnis DIESES einen Kletter-Segments voraus,
;; aber vfl-vf-einheit-abschluss kann intern beliebig viele
;; weitere Glieder anhaengen (Vario-Kurve, Kettenende-Zerlegung
;; mit eigener Hoehenaenderung), BEVOR es hier zurueckkehrt -
;; der Vergleich war dadurch nach jedem "weiterbauen" spaeter
;; systematisch falsch (verglich Kletter-Vorhersage mit der
;; Hoehe NACH allen Folgegliedern). Der echte Ist-Ziel-Vergleich
;; (Kettenende-Fall) sitzt bereits korrekt in
;; vfl-vf-einheit-abschluss selbst (*vfl-ziel-punkt*).
(if dbg-an
(dbgmsg (strcat "GEOMETRIE ERFOLG: VF-Einheit reduzierter Eingang gebaut, neue Position="
(dbg-tostring p-aktuell))))
)
)
)
(progn
(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-fallback (if hoehe-ab hoehe-ab (caddr p-aktuell)))
(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 (caddr p-aktuell)))))
(setq hoehe-neu
(vfl-in-real
(if (and hoehe-ab hoehe-auf)
(ssg-textf "vfl-prompt-hoehe-linienendpunkt-2"
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1)))
(ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos hoehe-fallback 2 1))))))
(if (null hoehe-neu) (setq hoehe-neu hoehe-fallback))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
(setq deltaH (abs deltaH))
(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))
(if (null typ)
(progn
(alert (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*))
(alert
(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 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 gebaut, neue Position="
(dbg-tostring p-aktuell))))
)
)
)
)
)
)
)
((= wahl "Linie") ;; --- Neue Linie BIS Kettenende (automatische GF/VF-Entscheidung, unveraendert) ---
;; 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))
(setq kettenanfang (null frame))
(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-fallback (if hoehe-ab hoehe-ab (caddr p-aktuell)))
(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 (caddr p-aktuell)))))
(setq hoehe-neu
(vfl-in-real
(if (and hoehe-ab hoehe-auf)
(ssg-textf "vfl-prompt-hoehe-linienendpunkt-2"
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1)))
(ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos hoehe-fallback 2 1))))))
(if (null hoehe-neu) (setq hoehe-neu hoehe-fallback))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
(setq deltaH (abs deltaH))
;; 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
;; (abgezogen) werden, damit das ES-Element genau am Zielpunkt
;; endet. Naeherung: Separator-Neigung = 3 Grad (Auslauf).
(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 (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))))
)
)
(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))
)
)
(if (null typ)
(progn
(alert (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*))
(alert
(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 4): ohne Frage direkt ES setzen.
;; Sonst nachfragen, ob die Kette hier endet.
(if linie-ende-modus
(setq antwort "1")
(setq antwort (vfl-frage-ist-kettenende))
)
(cond
((= antwort "1")
(setq es-seite (vfl-frage-es-seite nil))
(setq frame (vfl-insert-es-element "GF" frame hz-neu winkel
(caddr (car frame)) es-seite))
(setq fertig t))
((= antwort "2") (setq fertig t))
)
)
(progn
;; --- VarioFoerderer-Einheit (Umlenk..Motor, mehrsegmentig) ---
;; linie-ende-modus=T -> direkt Kettenende (Separator + ES).
(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
linie-ende-modus 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 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))
)
)
(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). 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 - "winkel_60" wird gesperrt), 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" dat))
(progn (if (and dat (>= dat 0)) (unload_dialog dat))
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
(progn
(mode_tile "winkel_60" 1)
(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).
(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"))
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
(if (= marker "linienzug2")
'vf-linienzug-modus2
'vf-linienzug-modus)))
(setq *ssg-ils-dim* nil) ; Override zuruecksetzen
(if (vl-catch-all-error-p 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))
(if (= marker "linienzug2")
(vfl-edit-ent2 ent journal)
(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)
(vl-catch-all-apply 'vf-linienzug-modus)
(setq *ssg-ils-dim* nil)))))
(princ))
;; Modus-2-Block per Doppelklick zuruecksetzen: voller Reset - die komplette
;; gespeicherte Eingabe (inkl. der gewaehlten Pfad-Objekte, siehe
;; vfl-in-selection) wird 1:1 stumm abgespielt, identischer Neuaufbau. Kein
;; Sektions-Dialog; der Nutzer kann den neu entstandenen Block danach ganz
;; normal weiterbearbeiten oder loeschen.
(defun vfl-edit-ent2 (ent journal / 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)
(vl-catch-all-apply 'vf-linienzug-modus2)
(setq *ssg-ils-dim* nil)
(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)
(defun vf-linienzug-modus3 ( / ss obj-liste startpunkt start-hoehe as-seite
es-seite kette segmente 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)
(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*/*vflw-pending* werden dabei nebenbei mitbefuellt, aber von
;; Modus 3 nirgends gelesen/persistiert (kein Replay/XDATA wie bei Modus 1/2
;; - das ist hier bewusst NICHT mit umgebaut, nur das Logging).
;; Der *error*-Handler schliesst die Datei bei Abbruch sauber.
(setq dbg-an (dbg-schalter-open "vfl-modus3" "vfl_modus3.dbg" "DXFM_LOG"))
(if dbg-an
(progn
(dbgf "vf-linienzug-modus3")
(dbgmsg "=== SESSION Modus 3 (Vorwaerts-Nachbau) START ===")
(dbgflush)))
(setq old-error *error*)
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(if dbg-an
(progn
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
(dbgreturn nil)
(dbgclose)))
(if old-error (old-error msg) (princ)))))
(vfl-gf-abhaengigkeit-sicherstellen "vfl-m3-alert-gf-modul")
;; --- 1. Pfad-Objekte waehlen (LINE/ARC) ---
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq ss (vfl-in-selection '((0 . "LINE,ARC"))))
(if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
(setq obj-liste (mapcar 'vlax-ename->vla-object ss))
;; --- 2. Startpunkt (hoehere Seite) + Hoehe + AS-Seite ---
;; Wizard: Startpunkt+Hoehe als EIN Gruppen-Dialog (analog Modus 2). Die
;; unveraenderten vfl-in-point/vfl-in-real-Aufrufe konsumieren die Antworten
;; danach aus *vflw-pending*.
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
(list "vfl-m3-prompt-startpunkt" "Starthoehe (Z, mm):")))
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-startpunkt")))
(if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq start-hoehe (vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt"
(list (rtos (caddr startpunkt) 2 1)))))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
;; 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. Sortieren + Analysieren ---
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
(if (null kette)
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit)))
(setq segmente (gf-analysiere-kette kette))
(if dbg-an
(progn
(dbgmsg (strcat "ANALYSE: " (itoa (length segmente)) " Segment(e) erkannt"))
(dbg 'segmente)
(dbgflush)))
;; --- 4. Eck-Winkel-Vorpruefung (vor dem Bau) ---
(setq ecke-bad (vfl2-pruefe-eckwinkel kette *vfk-eckwinkel-toleranz*))
(if ecke-bad
(progn
(alert (ssg-textf "vfl-vwnb-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
(exit)))
;; --- 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 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 (alert (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))
(setq seg-ent (car (nth i kette))) ; echte LINE/ARC-Entity dieses Segments
;; Wizard: alle Fragen dieses Segments in EINEM Dialog erfassen (die
;; unveraenderten vfl-in-*-Aufrufe unten konsumieren die Antworten aus
;; *vflw-pending*). Segment vorher in der Zeichnung hervorheben. 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 (alert (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 + Ist-Ziel-Report ---
(setq hoehe-bis (caddr (car frame)))
(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)
(setq soll-ende (caddr (last kette))) ; Endpunkt des letzten gezeichneten Segments
(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))
(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))
(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))
;; 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 /
info theta dpx dpy npx npy phi vx vy vwx vwy
along-es perp-es ua na-x na-y cc dp-na np-na ep-na)
(setq info (vf-element-ks-info es-block))
(if (null info)
(- (+ (* (- (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 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))))
(setq along-es (+ (* vwx dpx) (* vwy dpy)))
(setq perp-es (+ (* vwx npx) (* vwy npy)))
(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 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
member carrier-idx kv-variante seg-hz letzt-koerper-hz
vf-first-line vf-last-line climber-span mid-hor
z-aftermotor gf2-drop gf2-planar 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
gf-total br-gf-mode br-gf2-exp filler-A-len filler-a-done
m2-lauf-antwort m2-offenes-ende
m2-front-antwort m2-offener-anfang m2-kein-gf1-vorne entry-fixed
as-vorhanden es-vorhanden dbg-an dbg-old-error)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-m3-titel"))
(princ "\n=========================================")
;; --- 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 (dbg-schalter-open "vfl-modus2" "vfl_modus2.dbg" "DXFM_LOG"))
(if dbg-an
(progn
(dbgf "vf-linienzug-modus2")
(dbgmsg "=== SESSION Modus 2 (3D-Objekte + Ziel-Hoehe) START ===")
(dbgflush)))
(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)))))
(vfl-gf-abhaengigkeit-sicherstellen "vfl-m3-alert-gf-modul")
;; --- 1. Pfad-Objekte waehlen ---
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq ss (vfl-in-selection '((0 . "LINE,ARC"))))
(if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
(setq obj-liste (mapcar 'vlax-ename->vla-object ss))
;; --- 2. Startpunkt + Z + AS-Seite ---
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
(list "vfl-m3-prompt-startpunkt" "Starthoehe (Z, mm):")))
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-startpunkt")))
(if (null startpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit)))
(setq start-hoehe (vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt"
(list (rtos (caddr startpunkt) 2 1)))))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(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
(progn
(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 "gf-seite-aus-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-aus-header"))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
)
)
;; --- 3. Endpunkt + Z + ES-Seite (NEU in Modus 3) ---
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
(list "vfl-m3-prompt-endpunkt" "Zielhoehe (Z, mm):")))
(setq endpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-endpunkt")))
(if (null endpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit)))
(setq end-hoehe (vfl-in-real (ssg-textf "vfl-m3-prompt-zielhoehe"
(list (rtos (caddr endpunkt) 2 1)))))
(if (null end-hoehe) (setq end-hoehe (caddr endpunkt)))
(setq endpunkt (list (car endpunkt) (cadr endpunkt) end-hoehe))
(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
(progn
(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"))
(vf-set-es-masse *vfl-es-winkel* es-seite) ; Masse fuer Variante
)
)
;; --- 4. Sortieren + Analysieren + Eck-Vorpruefung ---
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
(if (null kette)
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit)))
(setq segmente (gf-analysiere-kette kette))
(setq ecke-bad (vfl2-pruefe-eckwinkel kette *vfk-eckwinkel-toleranz*))
(if ecke-bad
(progn
(alert (ssg-textf "vfl-m3-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
(exit)))
;; --- 5. Klassifizierung (Phase A: nur speichern, nichts bauen) ---
;; Plan-Eintrag Gerade: ("Linie" hz laenge klass winkel [sep-vor sep-nach])
;; klass=GF/VF; sep-vor/sep-nach nur bei GF gesetzt (T/nil).
;; Plan-Eintrag Bogen : ("Bogen" hz chord bwinkel bseite klass)
;; nach-vf: T sobald die letzte Gerade als VF klassifiziert wurde - der
;; naechste Bogen MUSS dann Vario-Kurve sein (VF-Einheit kann nicht in
;; einen GF-Bogen auslaufen), siehe vflw-seg-bogen-impl 'ERZWUNGEN.
(setq n (length segmente) i 0 plan '())
(while (< i n)
(setq seg (nth i segmente) typ (car seg) hz (cadr seg) laenge (caddr seg))
(setq seg-ent (car (nth i kette))) ; echte LINE/ARC-Entity dieses Segments
;; Wizard: alle Fragen dieses Segments in EINEM Dialog erfassen (die
;; unveraenderten vfl-menu/vfl-in-*-Aufrufe unten konsumieren die Antworten
;; aus *vflw-pending*). Segment vorher in der Zeichnung hervorheben. Der
;; nach-kurve-Fall stellt keine Frage (auto-VF) -> kein Dialog.
(if (and (vfl-wizard-aktiv) (not (and (= typ "Linie") nach-kurve)))
(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)))
(if nach-vf 'ERZWUNGEN T))) ; nach VF-Gerade: Vario-Kurve Pflicht
(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/vfl3-seg-dz/-dback 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
(setq member (or (and (= (car e) "Linie") (= (nth 3 e) "VF"))
(and (= (car e) "Bogen") (= (nth 5 e) "Vario-Kurve"))))
(if 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
(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"))
(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 "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
(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"))
(princ (ssg-text "vfl-m3-lauf-abschluss-opt-motor-es"))
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-m2-lauf-abschluss-impl (list "vfl-m3-lauf-abschluss-header")))
(setq m2-lauf-antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def2")
(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")))
((= m2-lauf-antwort "3")
(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)
(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)
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite "linienzug2")
(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))))
;; 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 (alert (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): vfl3-dback's Tail-Naeherung
;; (reserviert IMMER einen Separator+ES-Fussabdruck) ist hier falsch - die
;; Zielhoehe fuer den Loeser ist exakt end-hoehe.
(if m2-offenes-ende (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*)
(alert (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*))))
(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
(setq feste-vf (+ entry-fixed (if m2-offenes-ende 0.0 *vfk-stations-laenge*)) dH-adj dH-bruecke))
;; 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))
(setq wahl3 (vfl3-waehle-winkel climber-span 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 (Zeile
;; unten, "kurze VF-Gerade -> horizontaler Fueller"). Die komplette
;; Hoehe wandert in GF1 (reine Kompensation, wie beim reinen-GF-Fall in
;; Modus 1 - darf legitim (nahe) 0 sein, siehe Nutzer-Klarstellung).
(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)))
(alert (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 (ohne GF2)
(setq pt (vfs-vf-exit pt 0.0 letzt-koerper-hz nil))
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
;; GF2 = gemessener exakter Hoehen-Ausgleich (Abstieg bis zur Junction)
(setq z-aftermotor (caddr pt))
(setq gf2-drop (- z-aftermotor z-junction))
(if (< gf2-drop 0.0)
(progn
(alert (ssg-textf "vfl-m3-warnung-gf2-negativ" (list (rtos (- gf2-drop) 2 1))))
(setq gf2-drop 0.0)))
(setq gf2-planar (/ gf2-drop (/ (sin (* *vfk-gefaelle-winkel* (/ pi 180.0))) (cos (* *vfk-gefaelle-winkel* (/ pi 180.0))))))
(if (> gf2-planar 0.1)
(progn
(princ (ssg-textf "vfl-m3-gf2-ausgleich" (list (rtos gf2-planar 2 1))))
(setq frame (vfl-insert-gf-segment pt letzt-koerper-hz gf2-planar (fix *vfk-gefaelle-winkel*)))
(vfl-acc-gf-seg (/ gf2-planar (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.
(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_*") "BOGENAUF")
((wcmatch bname "Vario_Bogen_ab_*") "BOGENAB")
((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)
(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
;; Zweiter Bogen schliesst das Tripel. Neigung/Richtung ueber die
;; ECHTE Geometrie messen (Anfang des ersten bis Ende des zweiten
;; Bogens) - die Blocknamen allein sind fuer den 3-Grad/horizontal-
;; Fall mehrdeutig (beide nutzen "auf_3"/"ab_3", vfs-vf-koerper).
(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))
(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