;; ============================================================ ;; 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) ;; 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__). (defun vfl-as-winkel () (if (boundp '*vfl-as-winkel*) *vfl-as-winkel* "90")) (defun vfl-es-winkel () (if (boundp '*vfl-es-winkel*) *vfl-es-winkel* "90")) ;; ============================================================ ;; TEIL 0a-2: MELDUNGEN (statt alert im Bau-Pfad) ;; ============================================================ ;; Ein (alert ...) im Bau-Pfad blockiert jeden nicht-interaktiven Lauf ;; (Batch-Konvertierung vfl-konvertiere-ent, Testtreiber, Spec-Bau) mit einem ;; modalen Fenster - und der Text ist zugleich die EINZIGE Auskunft darueber, ;; welche Sektion warum abgewiesen wurde. vfl-meldung sammelt ihn deshalb ;; immer ein (*vfl-meldungen*, aelteste zuerst -> Auswertung im Ergebnis- ;; Record), schreibt ihn ins Debug-Log und zeigt ihn nur dann modal, wenn die ;; GUI erlaubt ist (ssg-gui-p, ssg_core.lsp); sonst geht er auf die Konsole. ;; Interaktiv ist das Verhalten damit unveraendert. ;; NUR fuer Meldungen aus dem Bau-Pfad. Die reinen Interaktiv-Alerts (fehlende ;; DCL-Datei, "Glied nicht editierbar", "kein Journal") bleiben alert - sie ;; koennen nur bei echter Benutzerbedienung auftreten. (if (not (boundp '*vfl-meldungen*)) (setq *vfl-meldungen* nil)) (defun vfl-meldung (txt) ;; Ein fehlender i18n-Schluessel liefert nil - dann wuerde strcat ;; hier abbrechen, und zwar in dem Moment, in dem ohnehin schon ;; etwas schiefgelaufen ist. Also abfangen statt nachtraeglich ;; suchen. (if (null txt) (setq txt "(Meldung ohne Text)")) (setq *vfl-meldungen* (append *vfl-meldungen* (list txt))) (dbgmsg (strcat "MELDUNG: " txt)) (dbgflush) (if (ssg-gui-p) (alert txt) (princ (strcat "\n" txt))) txt) ;; ============================================================ ;; TEIL 0a-3: HEADLESS-NOTAUSGANG ;; ============================================================ ;; Bei aktivem *vfl-headless* darf keine Live-Eingabe mehr stattfinden. Eine ;; erschoepfte Replay-Queue heisst dann: die Datenquelle (aufgezeichnetes ;; Journal bzw. Spec) passt nicht zum tatsaechlichen Bau-Ablauf (Desync) - ein ;; getpoint/getreal/ssget an dieser Stelle wuerde den Batch-Lauf still ;; blockieren statt den Fehler zu zeigen. Bisher fielen die Wrapper ;; STILLSCHWEIGEND auf Live-Eingabe zurueck; genau das wird hier zum harten, ;; lokalisierten Abbruch. ;; ;; *vfl-headless-fehler* traegt danach die Fundstelle (welche Art Eingabe, ;; welches Glied, welche Eingabe-Nummer) und wird vom Aufrufer in den ;; Ergebnis-Record uebernommen. Die Texte sind reine Diagnose (kein ;; ssg-text-Key noetig), sie erscheinen im normalen Betrieb nie. ;; ;; *vfl-headless-antwort-fn*: optionaler Hook, der eine nicht vorhersagbare ;; Rueckfrage doch noch beantworten darf (Beispiel: vfl-waehle-winkel fragt ;; nur dann, wenn mehrere Winkel-Kandidaten geometrisch gueltig sind - das ;; laesst sich vorab nicht immer wissen). Der gelieferte Wert wird normal ;; journalisiert; die Ersetzung wird zusaetzlich als Meldung protokolliert, ;; damit ein solcher Lauf nie als "sauber" durchgeht. ;; Aufruf: (fn was ort) -> Wert. (if (not (boundp '*vfl-headless*)) (setq *vfl-headless* nil)) (if (not (boundp '*vfl-headless-fehler*)) (setq *vfl-headless-fehler* nil)) (if (not (boundp '*vfl-headless-antwort-fn*)) (setq *vfl-headless-antwort-fn* nil)) (defun vfl-headless-p () (and (boundp '*vfl-headless*) *vfl-headless*)) ;; Fundstelle als Text: Glied-Nummer (STEP-Marker im bisherigen Journal) und ;; Nummer der Eingabe, die JETZT faellig gewesen waere (STEP-Marker zaehlen ;; nicht mit, die entstehen beim Replay neu). (defun vfl-headless-ort ( / steps) (setq steps (vfl-steps-zaehlen *vfl-journal*)) (strcat "Glied " (itoa steps) ", Eingabe " (itoa (1+ (- (length *vfl-journal*) steps))))) ;; Harter Abbruch ohne Rueckfrage (kehrt NICHT zurueck, (exit) wird vom ;; vl-catch-all-apply des Aufrufers gefangen). Fuer Eingaben, bei denen ein ;; nachgelieferter Wert nicht sinnvoll waere - z.B. eine Objektauswahl: eine ;; Teilauswahl wuerde die Fragenzahl des ganzen Modus-2-Ablaufs still ;; verschieben. (defun vfl-headless-abbruch (was / ort steps) (setq steps (vfl-steps-zaehlen *vfl-journal*)) (setq ort (vfl-headless-ort)) (setq *vfl-headless-fehler* (list (cons "was" was) (cons "glied" steps) (cons "eingabe" (1+ (- (length *vfl-journal*) steps))) (cons "ort" ort))) (vfl-meldung (strcat "HEADLESS-ABBRUCH: keine Eingabedaten mehr fuer [" was "] - " ort)) (exit)) ;; Wie vfl-headless-abbruch, aber der Antwort-Hook darf zuerst uebernehmen. ;; Rueckgabe dann (wert) als 1-elementige Liste - dieselbe Form wie ;; vfl-replay-pop, damit die Aufrufstelle sie unveraendert weiterverwendet. (defun vfl-headless-notausgang (was / ort v) (if *vfl-headless-antwort-fn* (progn (setq ort (vfl-headless-ort)) (setq v (vl-catch-all-apply *vfl-headless-antwort-fn* (list was ort))) (if (vl-catch-all-error-p v) (setq v nil)) (vfl-meldung (strcat "HEADLESS: Ersatzantwort fuer [" was "] - " ort)) (list v)) (vfl-headless-abbruch was))) ;; Gemeinsame Vorbedingung aller drei Linienzug-Modi: die GF-Segmente/-Boegen ;; nutzen Funktionen aus Gefaellestrecke.lsp (gf-insert-hz-incl-scaled, ;; gf-bogen-blockname, ...). Bei reiner VarioFoerderer-Ladung ohne ;; Gefaellestrecke wuerde der GF-Zweig fehlschlagen - deshalb hier pruefen und ;; danach die AS/ES-/Bogen-Bibliothek initialisieren (init-bibliothek), falls ;; noch nicht geschehen. alert-key: modusspezifischer i18n-Text (Modus 1 ist ;; ausfuehrlicher als 2/3, daher als Parameter statt vereinheitlicht). (defun vfl-gf-abhaengigkeit-sicherstellen (alert-key) (if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED")))) (progn (vfl-meldung (ssg-text alert-key)) (exit))) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))) ;; ============================================================ ;; TEIL 0b: EINGABE-JOURNAL (RECORD & REPLAY) ;; ============================================================ ;; Jede interaktive Eingabe im Modus-1-Aufrufbaum laeuft ueber die Wrapper ;; vfl-in-point/-string/-real/-int. Diese arbeiten in zwei Modi: ;; Record (*vfl-replay-queue* = nil): normal fragen + in *vfl-journal* anhaengen. ;; Replay (*vfl-replay-queue* gesetzt): naechsten gespeicherten Wert liefern ;; (nicht fragen) und ebenfalls in *vfl-journal* anhaengen. Laeuft die ;; Queue leer, wird ab hier wieder live gefragt (nahtloser Uebergang). ;; Weil der Builder deterministisch bzgl. seiner Eingaben ist, reproduziert das ;; Abspielen desselben Journals exakt dieselbe Kette. *vfl-journal* wird beim ;; Replay komplett neu aufgebaut (durch die erneute Ausfuehrung), die Queue ist ;; nur Lesequelle. ;; ;; Journal-Eintrag: (kind . value) mit kind aus ;; "PT" Punkt (Liste x y z) "STR" String (auch "") ;; "REAL" Realzahl "INT" Ganzzahl ;; "NIL" Abbruch/Default (value nil) "STEP" Glied-Checkpoint (value = Label) ;; *vfl-journal* wird in UMGEKEHRTER Reihenfolge gehalten (neuestes zuerst, cons). ;; *vfl-seg-glied-letzte* = Glied-Stand nach der vorherigen Iteration der ;; Bau-Hauptschleife (fuer die Segment-XDATA, siehe vfl-segment-xdata-sichern). ;; MUSS bei jedem Journal-Start auf 0 stehen, sonst bekaeme das erste Glied ;; eines neuen Baus einen zu hohen Index und die Praeambel wuerde nicht ;; geschrieben. (if (not (boundp '*vfl-seg-glied-letzte*)) (setq *vfl-seg-glied-letzte* 0)) ;; Journal und Replay-Queue muessen auch VOR dem ersten ;; vfl-journal-reset lesbar sein: die vfl-in-*-Wrapper und die ;; Headless-Diagnose lesen sie ungeschuetzt. (if (not (boundp '*vfl-journal*)) (setq *vfl-journal* nil)) (if (not (boundp '*vfl-replay-queue*)) (setq *vfl-replay-queue* nil)) (defun vfl-journal-reset () ;; Sammel-Meldungen und Headless-Diagnose gehoeren zum LAUF, nicht zur ;; Sitzung - sonst tragen sie in einen neuen Bau die Befunde des alten. (setq *vfl-meldungen* nil *vfl-headless-fehler* nil) (setq *vfl-journal* '() *vfl-replay-queue* nil *vfl-seg-glied-letzte* 0) (if (boundp '*vflw-pending*) (setq *vflw-pending* nil))) ;; 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 " 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 " (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)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (and (= ergebnis 1) dlg-wert (> (strlen dlg-wert) 0)) (atof dlg-wert) 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)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (itoa (1+ (atoi dlg-opt))) "")))) (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)") (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))))) (t (setq fertig t))) ) ) ) (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") (start_list "winkel") (add_list (vflw-clean (ssg-text "vf-winkel-90"))) (add_list (vflw-clean (ssg-text "vf-winkel-30"))) (end_list) (set_tile "winkel" "0") (start_list "seite") (add_list (vflw-clean (ssg-text "gf-seite-links"))) (add_list (vflw-clean (ssg-text "gf-seite-rechts"))) (end_list) (set_tile "seite" "0") (action_tile "setzen" "(mode_tile \"winkel\" (if (= (get_tile \"setzen\") \"1\") 0 1)) (mode_tile \"seite\" (if (= (get_tile \"setzen\") \"1\") 0 1))") (action_tile "accept" "(setq gsetzen (get_tile \"setzen\")) (setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= 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" (if (= gwinkel "1") "30" "90") (if (= gseite "1") "2" "1"))) (vflw-pending-push-all (list "2")))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Winkel+Seite": GF-Bogen (3 Winkel-Optionen) ODER ES-Element am ;; Kettenende (2 Winkel-Optionen). Original-Reihenfolge/-Journal: ;; vfl-menu-winkel/vfl-in-value (Winkel), dann vfl-in-string (Seite). ;; winkel-werte: Liste der zu den Optionen gehoerenden WINKELWERTE, in der ;; Reihenfolge der Labels - GF-Bogen (30 60 90), ES ("90" "30"). Der Winkel ;; wird IMMER als echter Wert in die Pending-Queue geschrieben (nie als Index), ;; damit Journal/Log selbsterklaerend sind. GF-Bogen legt Zahlen ab (vom ;; vfl-menu-winkel/vfl-in-value als "INT" journalisiert), ES Strings "90"/"30". (defun vflw-gruppe-winkel-seite-impl (kopf-key winkel-optionen winkel-werte / dat dcl-pfad ergebnis gwinkel 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))) (start_list "winkel") (foreach o winkel-optionen (add_list (vflw-clean o))) (end_list) (set_tile "winkel" "0") (start_list "seite") (add_list (vflw-clean (ssg-text "gf-seite-links"))) (add_list (vflw-clean (ssg-text "gf-seite-rechts"))) (end_list) (set_tile "seite" "0") (action_tile "accept" "(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (list (nth (atoi gwinkel) winkel-werte) (if (= gseite "1") "2" "1")))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Vario-Kurve": Winkel(90/60/30) + Seite + Variante(aussen/innen). ;; Reihenfolge/Journal: vfl-menu-winkel (Winkel als ECHTER Wert 90/60/30, als ;; INT journalisiert - kein Index mehr), vfl-in-string (Seite), vfl-in-string ;; (Variante). (defun vflw-gruppe-variokurve-impl ( / dat dcl-pfad ergebnis gwinkel gseite gvariante) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_variokurve" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean (ssg-text "vfl-variokurve-winkel-header"))) ;; Winkel-Reihenfolge vereinheitlicht auf 30/60/90 (wie GF-Bogen); ;; Default 90 -> Listenposition 2. (start_list "winkel") (add_list (vflw-clean (ssg-text "vfl-opt3-30grad"))) (add_list (vflw-clean (ssg-text "vfl-opt2-60grad"))) (add_list (vflw-clean (ssg-text "vfl-opt1-90grad"))) (end_list) (set_tile "winkel" "2") (start_list "seite") (add_list (vflw-clean (ssg-text "gf-seite-links"))) (add_list (vflw-clean (ssg-text "gf-seite-rechts"))) (end_list) (set_tile "seite" "0") (start_list "variante") (add_list (vflw-clean (ssg-text "vfl-variante-aussen"))) (add_list (vflw-clean (ssg-text "vfl-variante-innen"))) (end_list) (set_tile "variante" "1") (action_tile "accept" "(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (setq gvariante (get_tile \"variante\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (list (nth (atoi gwinkel) *vfk-gf-bogen-winkel*) (if (= gseite "1") "2" "1") (if (= gvariante "1") "2" "1")))))) (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). (defun vflw-gruppe-gefaelle-impl (hoehe-default / dat dcl-pfad ergebnis gmodus gwert winkel-default) (setq winkel-default (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_gefaelle" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean (ssg-text "vfl-gefaelle-festlegen-header"))) (start_list "modus") (add_list (vflw-clean (ssg-text "vfl-gefaelle-opt-hoehe"))) (add_list (vflw-clean (ssg-text "vfl-gefaelle-opt-winkel"))) (end_list) (set_tile "modus" "0") (set_tile "wlabel" "Zielhoehe (Z, mm):") (set_tile "wert" (rtos hoehe-default 2 1)) ;; Wertfeld MUSS beim Moduswechsel mit umschalten - sonst steht dort ;; nach dem Wechsel noch der Wert des vorherigen Modus (Hoehe/Winkel ;; sind nicht dieselbe Groesse, ein stehengebliebener Hoehenwert waere ;; als Neigungswinkel unsinnig). (action_tile "modus" "(if (= (get_tile \"modus\") \"0\") (progn (set_tile \"wlabel\" \"Zielhoehe (Z, mm):\") (set_tile \"wert\" (rtos hoehe-default 2 1))) (progn (set_tile \"wlabel\" \"Neigungswinkel (Grad):\") (set_tile \"wert\" (rtos (float winkel-default) 2 1))))") (action_tile "accept" "(setq gmodus (get_tile \"modus\")) (setq gwert (get_tile \"wert\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (list (if (= gmodus "1") "2" "1") (atof gwert)))))) (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)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (and (= ergebnis 1) dlg-wert (> (strlen dlg-wert) 0)) (vflw-pending-push-all (list (atof dlg-wert)))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Horizontales Stueck": Separator VOR + Separator NACH + ;; Foerderer-Ende (3 Optionen). Original-Reihenfolge/-Journal (alle in ;; vfl-baue-horizontal-koerper): vfl-in-string (Sep-vor), vfl-in-string ;; (Sep-nach), [nur im Ziel-Modus] vfl-in-string (Ist-Ende). Der Endpunkt ;; wird an der Aufrufstelle bereits separat ueber vfl-neue-linie-messen ;; gemessen - kein Punkt-Button hier (analog Gefaelle-/Ziel-Hoehe-Gruppe). ;; mit-ende: T, wenn (im Ziel-Modus) zusaetzlich die Ist-Ende-Frage ;; mitgestellt werden soll (siehe vfl-baue-horizontal-koerper). (defun vflw-gruppe-horizontal-impl (mit-ende / dat dcl-pfad ergebnis gsepvor gsepnach gende) (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" "Horizontales Stueck") (set_tile "sepvor" "0") (set_tile "sepnach" "0") (start_list "istende") (add_list (vflw-clean (ssg-text "vfl-ja-nur-motorstation"))) (add_list (vflw-clean (ssg-text "vfl-nein-weiterbauen"))) (add_list (vflw-clean (ssg-text "vfl-ja-motorstation-kettenende"))) (end_list) (set_tile "istende" "1") (mode_tile "istende" (if mit-ende 0 1)) (action_tile "accept" "(setq gsepvor (get_tile \"sepvor\")) (setq gsepnach (get_tile \"sepnach\")) (setq gende (get_tile \"istende\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (append (list (if (= gsepvor "1") "1" "2") (if (= gsepnach "1") "1" "2")) (if mit-ende (list (itoa (1+ (atoi gende)))) nil)))))) (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: " 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) (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)) (start_list "typ") (add_list (vflw-clean "GF (Neigungswinkel)")) (add_list (vflw-clean "VF (Bruecke)")) (end_list) (set_tile "typ" "0") (set_tile "wert" (rtos (float neigung-default) 2 1)) ;; Neigungsfeld nur bei GF (Index 0) aktiv. (action_tile "typ" "(mode_tile \"wert\" (if (= (get_tile \"typ\") \"0\") 0 1))") (action_tile "accept" "(setq gtyp (get_tile \"typ\")) (setq gwert (get_tile \"wert\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (if (= gtyp "0") (vflw-pending-push-all (list "1" (atof gwert))) ; GF + Neigung (vflw-pending-push-all (list "2")))))) ; VF (keine Neigung) (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)) (start_list "typ") (add_list (vflw-clean "GF (Neigungswinkel)")) (add_list (vflw-clean "VF-Ab")) (add_list (vflw-clean "VF-Auf")) (add_list (vflw-clean "VF-Horizontal")) (end_list) (set_tile "typ" "0") (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" "(cond ((= (get_tile \"typ\") \"0\") (set_tile \"wlabel\" \"GF-Neigung (Grad):\") (set_tile \"wert\" (rtos (float neigung-default) 2 1)) (mode_tile \"wert\" 0)) ((= (get_tile \"typ\") \"3\") (set_tile \"wlabel\" \"(kein Wert)\") (mode_tile \"wert\" 1)) (t (set_tile \"wlabel\" \"Vario-Winkel (Grad):\") (set_tile \"wert\" (rtos (float vario-default) 2 1)) (mode_tile \"wert\" 0)))") (action_tile "accept" "(setq gtyp (get_tile \"typ\")) (setq gwert (get_tile \"wert\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (cond ;; typ 0 = GF -> "1" + Neigung(real) ((= gtyp "0") (vflw-pending-push-all (list "1" (atof gwert)))) ;; typ 1 = VF-Ab -> "2" + Vario-Winkel(int) ((= gtyp "1") (vflw-pending-push-all (list "2" (fix (atof gwert))))) ;; typ 2 = VF-Auf -> "3" + Vario-Winkel(int) ((= gtyp "2") (vflw-pending-push-all (list "3" (fix (atof gwert))))) ;; typ 3 = VF-Hor -> "4" (kein Wert) (t (vflw-pending-push-all (list "4"))))))) (princ)) ;; --- Segment "Eck/Bogen" (Modus 2 + Modus 3): Typ + [bei Vario] Variante --- ;; Original-Reihenfolge/-Journal: vfl-in-string/vfl-menu (Typ "1"/"2"), dann ;; bei Vario-Kurve vfl-in-string/vfl-menu (Variante "1"/"2"). Bei GF-Bogen ;; wird KEINE Variante gefragt -> nur "1" in die Pending-Queue. ;; vario-erlaubt: T, wenn Vario-Kurve hier zulaessig ist (Modus 2 immer T; ;; Modus 3 nur im offenen VF-Lauf - sonst konsumiert der Aufrufer die ;; Variante-Antwort nicht und sie wuerde ins naechste Segment lecken). Bei ;; nil wird die Vario-Kurve-Option deaktiviert und bei versehentlicher Wahl ;; als GF-Bogen ("1") behandelt (der Aufrufer weist Vario dort ohnehin ab). (defun vflw-seg-bogen-impl (kopf-txt vario-erlaubt / dat ergebnis gtyp gvariante) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_seg_bogen" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean kopf-txt)) (start_list "typ") (add_list (vflw-clean "GF-Bogen")) (add_list (vflw-clean (if vario-erlaubt "Vario-Kurve" "Vario-Kurve (nur im VF-Lauf)"))) (end_list) (set_tile "typ" "0") (start_list "variante") (add_list (vflw-clean (ssg-text "vfl-variante-aussen"))) (add_list (vflw-clean (ssg-text "vfl-variante-innen"))) (end_list) (set_tile "variante" "0") (mode_tile "variante" 1) ; Variante erst bei Vario-Kurve aktiv ;; Variante-Feld nur aktivieren, wenn Vario gewaehlt UND erlaubt. (if vario-erlaubt (action_tile "typ" "(mode_tile \"variante\" (if (= (get_tile \"typ\") \"1\") 0 1))")) (action_tile "accept" "(setq gtyp (get_tile \"typ\")) (setq gvariante (get_tile \"variante\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (if (and (= gtyp "1") vario-erlaubt) ;; Vario-Kurve: "2" + Variante ("1"=aussen / "2"=innen; Index+1) (vflw-pending-push-all (list "2" (itoa (1+ (atoi gvariante))))) ;; GF-Bogen (oder Vario unzulaessig): "1" (keine Variante) (vflw-pending-push-all (list "1")))))) (princ)) ;; ============================================================ ;; TEIL 0b-3: GRUPPEN-DIALOGE (PENDING-QUEUE) ;; ============================================================ ;; Mehrere Fragen, die im Ablauf IMMER unmittelbar hintereinander kommen ;; (kein Zwischenschritt, keine Verzweigung dazwischen), werden im Wizard in ;; EINEM Dialog gemeinsam erfasst (siehe vflw-gruppe-* unten). Die ;; darunterliegende Aufruf-Reihenfolge in vf-linienzug-modus/vfl-* bleibt ;; dabei WOERTLICH UNVERAENDERT (weiterhin ein vfl-in-point/-string/-real/ ;; -int/-value-Aufruf pro Wert, in derselben Reihenfolge) - nur die HERKUNFT ;; des Werts aendert sich: statt live zu fragen (oder einen Einzel-Dialog zu ;; zeigen) wird der naechste Wert aus *vflw-pending* entnommen, den der ;; Gruppen-Dialog vorher dort abgelegt hat. Journal-Aufzeichnung passiert ;; weiterhin in JEDEM einzelnen vfl-in-*-Aufruf selbst - Editieren/Replay ;; bestehender Ketten ist dadurch unveraendert (siehe TEIL 0b-2). ;; Bricht der Nutzer den Gruppen-Dialog ab, bleibt *vflw-pending* leer - ;; die nachfolgenden vfl-in-*-Aufrufe fallen dann automatisch auf ihre ;; EINZEL-Dialoge zurueck (kein Sonderfall noetig). (if (not (boundp '*vflw-pending*)) (setq *vflw-pending* nil)) (defun vflw-pending-pop ( / v) (if *vflw-pending* (progn (setq v (car *vflw-pending*)) (setq *vflw-pending* (cdr *vflw-pending*)) (list v)) nil)) (defun vflw-pending-push-all (vals) (setq *vflw-pending* (append *vflw-pending* vals)) nil) ;; --- Eingabe-Wrapper --- ;; kind steuert nur, wie ein FRISCH live erfasster Wert typisiert wird; beim ;; Replay wird der gespeicherte Wert unveraendert durchgereicht. ;; ;; Alle Basis-Wrapper teilen dasselbe 3-Zweig-Muster (Replay-Queue -> ;; Pending-Queue -> Live-Eingabe) plus Journal-Aufzeichnung. Dieses Skelett ;; ist EINMAL in vfl-in-value (weiter unten) implementiert; die folgenden ;; Wrapper liefern nur ihre Live-Eingabe-Funktion (livefn) und ihr kind-Tag. ;; Journal-Format und Signaturen bleiben damit unveraendert (63 Aufrufstellen). ;; Ausnahme: vfl-in-selection (OBJS/Handles) hat abweichende Replay-/Journal- ;; Logik und bleibt eigenstaendig. (defun vfl-in-point (base prompt) (vfl-in-value "PT" (function (lambda () (vfl-getpoint base prompt))))) ;; Objektauswahl (Modus 2: Pfad-Objekte). Wie die anderen Wrapper repliziert ;; bzw. journalisiert - aber KEIN Wizard-Dialog (Objektwahl braucht wie ;; Punktwahl die Zeichnung, kein DCL-Fenster wuerde hier helfen). Beim Replay ;; werden die gespeicherten Handles zurueck in Enames aufgeloest; Handles ;; sind - anders als Enames - ueber Sitzungen hinweg stabil und damit fuer ;; die XDATA-Persistenz geeignet. Loest sich ein Handle nicht mehr auf (z.B. ;; weil der Nutzer die urspruengliche Pfad-Geometrie zwischenzeitlich ;; geloescht hat), wird das klar gemeldet statt eine unvollstaendige Auswahl ;; stillschweigend weiterzureichen. (defun vfl-in-selection (filter / popped v handles h en k ss fehlt) (setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil)) (if popped (progn (setq handles (car popped) v nil fehlt 0) (foreach h handles (setq en (vl-catch-all-apply 'handent (list h))) (if (or (vl-catch-all-error-p en) (null en)) (setq fehlt (1+ fehlt)) (setq v (cons en v)))) (setq v (reverse v)) (if (> fehlt 0) (progn (vfl-meldung (ssg-textf "vfl-m3-alert-objekte-fehlen" (list (itoa fehlt)))) ;; Headless NICHT mit einer Teilauswahl weiterbauen: die Segmentzahl ;; bestimmt die gesamte Fragenfolge des Modus-2-Ablaufs, ein ;; fehlendes Pfad-Objekt verschiebt sie still. Ein nachgelieferter ;; Wert waere hier sinnlos, darum -abbruch statt -notausgang. (if (vfl-headless-p) (vfl-headless-abbruch "OBJS-unvollstaendig"))))) (progn ;; Ohne Replay-Daten gibt es headless keine Objektauswahl. (if (vfl-headless-p) (vfl-headless-abbruch "OBJS")) (setq ss (ssget filter)) (setq v nil) (if ss (progn (setq k 0) (while (< k (sslength ss)) (setq v (cons (ssname ss k) v)) (setq k (1+ k))) (setq v (reverse v)))))) (setq handles (mapcar (function (lambda (e) (cdr (assoc 5 (entget e))))) v)) (vfl-journal-record (if v "OBJS" "NIL") handles) v) ;; String: "" (Enter) ist ein GUELTIGER String (kein Abbruch) -> "STR". Daher ;; das strikte STR-Praedikat statt der Default-non-nil-Pruefung. (defun vfl-in-string (prompt) (vfl-in-value-p "STR" (function (lambda (v) (eq (type v) 'STR))) (function (lambda () (if (and (vfl-wizard-mode-p) *vflw-menu-optionen*) (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt) *vflw-menu-optionen* *vflw-menu-default*) (getstring prompt)))))) (defun vfl-in-real (prompt) (vfl-in-value "REAL" (function (lambda () (if (vfl-wizard-mode-p) (vflw-zahl prompt) (getreal prompt)))))) (defun vfl-in-int (prompt) (vfl-in-value "INT" (function (lambda ( / vs) (if (and (vfl-wizard-mode-p) *vflw-menu-optionen*) (progn (setq vs (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt) *vflw-menu-optionen* *vflw-menu-default*)) (if (and vs (> (strlen vs) 0)) (atoi vs) nil)) (getint prompt)))))) ;; Menue-Wrapper: princ-Ausgabe der Optionen bleibt beim Aufrufer unveraendert ;; stehen (Konsolen-Fallback, de/en via ssg-text) - hier wird nur die ;; ABSCHLIESSENDE Eingabe-Zeile ersetzt. frage-key: ssg-text-Schluessel der ;; eigentlichen Frage (die Kopfzeile, die vorher separat per princ ausgegeben ;; wurde, z.B. "vfl-ist-endpunkt-frage") - OHNE das wuerde der Wizard-Dialog ;; nur die generische "Ihre Wahl (1/2/3)..."-Zeile zeigen und die eigentliche ;; Frage bliebe unsichtbar (nur auf der Konsole hinter dem Dialog). Die ;; Lokalvariablen sind ueber die '/'-Deklaration dynamisch nur waehrend ;; dieses Aufrufs sichtbar (AutoLISP dynamic scoping) und wirken daher ;; ausschliesslich auf den EINEN vfl-in-string/-int-Aufruf im Rumpf. (defun vfl-menu (prompt option-labels default-idx frage-key / *vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*) (setq *vflw-menu-optionen* option-labels) (setq *vflw-menu-default* default-idx) (setq *vflw-menu-frage* frage-key) (vfl-in-string prompt)) (defun vfl-menu-int (prompt option-labels default-idx frage-key / *vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*) (setq *vflw-menu-optionen* option-labels) (setq *vflw-menu-default* default-idx) (setq *vflw-menu-frage* frage-key) (vfl-in-int prompt)) ;; Winkel-Menue: fragt einen WINKELWERT (30/60/90) ab und journalisiert ihn ;; als echten Winkel (INT-Eintrag = 30/60/90), NICHT als Auswahl-Index 1/2/3. ;; Damit ist jedes Journal/Log selbsterklaerend und alle GF-Bogen-/Vario-Kurve- ;; Stellen (Live-Bau, Slice, Edit) teilen denselben Wert. winkel-werte ist die ;; Liste der zur Optionsreihenfolge gehoerenden Winkel (einheitlich (30 60 90) ;; fuer GF-Bogen UND Vario-Kurve); default-winkel der vorbelegte Winkelwert. Bei Konsolen-Eingabe ;; tippt der Nutzer den Winkel direkt (30/60/90); ungueltige Eingaben fallen auf ;; den naechstliegenden gueltigen Wert bzw. den Default. Rueckgabe: Winkel (Int). (defun vfl-menu-winkel (prompt option-labels winkel-werte default-winkel frage-key / *vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage* v) (setq *vflw-menu-optionen* option-labels) (setq *vflw-menu-frage* frage-key) ;; Default-Index = Position des Default-Winkels in winkel-werte (1-basiert). (setq *vflw-menu-default* (+ 1 (- (length winkel-werte) (length (member default-winkel winkel-werte))))) (setq v (vfl-in-value "INT" (function (lambda () (vfl-winkel-live prompt winkel-werte default-winkel))))) ;; Absicherung: nur gueltige Winkel zulassen (auch bei Alt-Journals mit Index). (vfl-winkel-normieren v winkel-werte default-winkel)) ;; Live-Abfrage eines Winkelwerts. Wizard: Auswahl aus den Labels, Position -> ;; winkel-werte. Konsole: direkte Zahleneingabe (ENTER = Default). (defun vfl-winkel-live (prompt winkel-werte default-winkel / vs idx r) (if (and (vfl-wizard-mode-p) *vflw-menu-optionen*) (progn (setq vs (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt) *vflw-menu-optionen* *vflw-menu-default*)) (setq idx (if (and vs (> (strlen vs) 0)) (atoi vs) 0)) (if (and (>= idx 1) (<= idx (length winkel-werte))) (nth (1- idx) winkel-werte) default-winkel)) (progn (setq r (getint prompt)) (if r r default-winkel)))) ;; Normiert einen (moeglicherweise aus Alt-Journals stammenden Index oder einen ;; frei getippten Wert) auf einen gueltigen Winkel aus winkel-werte. Ein Wert, ;; der bereits gueltig ist, bleibt unveraendert. Ansonsten Default. (defun vfl-winkel-normieren (v winkel-werte default-winkel / n) (setq n (cond ((null v) default-winkel) ((= (type v) 'STR) (atoi v)) (T v))) (if (member n winkel-werte) n default-winkel)) ;; Generisches Eingabe-Skelett: der gemeinsame 3-Zweig-Ablauf (Replay-Queue -> ;; Pending-Queue -> Live-Eingabe) plus Journal-Aufzeichnung, den alle Basis- ;; Wrapper (vfl-in-point/-string/-real/-int) teilen. livefn ist ein aufrufbares ;; Objekt ohne Argumente (die eigentliche Live-Eingabe, z.B. getpoint/getreal ;; oder eine fragende Hilfsfunktion wie vf-frage-element-winkel); es wird NUR ;; aufgerufen, wenn weder Replay- noch Pending-Wert vorliegt. ;; kind: Journal-Typ eines frisch/gueltig erfassten Werts. Ein non-nil v gilt ;; als gueltig (-> kind), nil als Abbruch (-> "NIL"). Fuer Faelle, in denen die ;; Gueltigkeit strenger geprueft werden muss (z.B. vfl-in-string: "" ist ein ;; gueltiger String), siehe vfl-in-value-p. (defun vfl-in-value (kind livefn / popped v) (setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil)) (if popped (setq v (car popped)) (progn (setq popped (vflw-pending-pop)) ;; Headless: statt still live zu fragen (Batch-Haenger, und der Grund ;; des Desyncs waere verloren) abbrechen bzw. den Antwort-Hook fragen. (if (and (null popped) (vfl-headless-p)) (setq popped (vfl-headless-notausgang kind))) (if popped (setq v (car popped)) (setq v (apply livefn nil))))) (vfl-journal-record (if v kind "NIL") v) v) ;; Variante mit explizitem Gueltig-Praedikat (fuer vfl-in-string: "" ist gueltig). (defun vfl-in-value-p (kind gueltig-p livefn / popped v) (setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil)) (if popped (setq v (car popped)) (progn (setq popped (vflw-pending-pop)) (if (and (null popped) (vfl-headless-p)) ; siehe vfl-in-value (setq popped (vfl-headless-notausgang kind))) (if popped (setq v (car popped)) (setq v (apply livefn nil))))) (vfl-journal-record (if (apply gueltig-p (list v)) kind "NIL") v) 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)) ;; --- Praeambel-XDATA (eigene App "SSG_VF_EDIT_PRE") ----------------------- ;; Die Segment-XDATA (SSG_VF_EDIT_SEG) deckt nur die GLIEDER ab - alles vor ;; dem ersten STEP (Startpunkt, Starthoehe, AS ja/nein + AS-Winkel/-Seite) ;; steht in keiner Slice. Fuer eine vollstaendige Wiederherstellung aus der ;; Zeichnung allein (c:VF_SEKTION_RESTORE) fehlt damit genau der Kopf des ;; Journals. Deshalb wird die Praeambel zusaetzlich als eigene XDATA-App auf ;; die Entities des ERSTEN Gliedes geschrieben - eigene App, weil pro Entity ;; nur ein SSG_VF_EDIT_SEG-Record Platz hat (der gehoert dem Glied). ;; Layout: [0]="linienzug-pre" (Marker), [1..]=Journal-String in 250-Byte-Chunks. ;; ;; Praeambel = alle Journal-Eintraege VOR dem ersten STEP. (defun vfl-journal-praeambel (forward-journal / out fertig) (setq out '() fertig nil) (foreach e forward-journal (if (and (not fertig) (= (car e) "STEP")) (setq fertig t)) (if (not fertig) (setq out (cons e out)))) (reverse out)) (defun vfl-journal-xdata-schreiben-pre (ent pre-journal / chunks appentry) (regapp "SSG_VF_EDIT_PRE") (setq chunks (vfl-chunk-string (vfl-journal-list->string pre-journal) 250)) (setq appentry (cons "SSG_VF_EDIT_PRE" (cons (cons 1000 "linienzug-pre") (mapcar (function (lambda (c) (cons 1000 c))) chunks)))) (entmod (append (entget ent) (list (list -3 appentry)))) ent) ;; Rueckgabe: Praeambel-Journal oder nil (keine/unbekannte Praeambel-XDATA). (defun vfl-journal-xdata-lesen-pre (ent / xd app-data werte) (setq xd (entget ent '("SSG_VF_EDIT_PRE"))) (setq app-data (cdr (assoc -3 xd))) (if app-data (progn (setq werte (mapcar 'cdr (cdr (car app-data)))) (if (and werte (= (car werte) "linienzug-pre")) (vfl-string->journal (apply 'strcat (cdr werte))) nil)) nil)) ;; Wird direkt nach dem Segment-Dispatch-cond in vf-linienzug-modus aufgerufen ;; (per vl-catch-all-apply abgesichert - ein Fehler hier darf den Hauptbau nie ;; abbrechen, rein additive Zusatz-XDATA). seg-lastEnt = Schnappschuss VOR ;; diesem Glied (vf-lastent-ohne-attribute, siehe Aufruf). wahl wird hier ;; nicht mehr gebraucht (das Label steckt schon im STEP-Eintrag des Journals ;; via vfl-journal-steplabel) - Parameter bleibt fuer eine spaetere dbgmsg- ;; Diagnose nuetzlich, daher weiterhin uebergeben. ;; Ermittelt Glied-Index + Journal-Teilsequenz selbst aus dem aktuellen ;; *vfl-journal* (zu diesem Zeitpunkt bereits um dieses Glied vollstaendig ;; ergaenzt) und schreibt sie auf JEDES seit seg-lastEnt neu erzeugte Entity ;; (entnext-Wanderung, gleiches Muster wie vfl-block-erstellen/ ;; vfl-modus-abbruch-sichern). (defun vfl-segment-xdata-sichern (seg-lastEnt wahl / forward-journal seg-idx seg-von seg-journal log-slice e cnt slice-label pre-journal) (setq forward-journal (reverse *vfl-journal*)) (setq seg-idx (length (vfl-journal-glieder forward-journal))) ;; Erstes Glied DIESER Iteration: eine Iteration kann mehrere Glieder ;; erzeugen (VF-Einheit + eingebettete Vario-Kurven). *vfl-seg-glied-letzte* ;; haelt den Glied-Stand der vorherigen Iteration. (if (null *vfl-seg-glied-letzte*) (setq *vfl-seg-glied-letzte* 0)) (setq seg-von (1+ *vfl-seg-glied-letzte*)) (setq cnt 0) (if (and (> seg-idx 0) (>= seg-idx seg-von)) (progn ;; XDATA: der KOMPLETTE in dieser Iteration entstandene Journal-Abschnitt ;; (Glieder seg-von .. seg-idx), indiziert mit dem ERSTEN Glied-Index. ;; Nur so ist die Kette spaeter luecken- und desync-frei aus der ;; Zeichnung rekonstruierbar (c:VF_SEKTION_RESTORE). (setq seg-journal (vfl-journal-ab-glied forward-journal seg-von)) ;; Fuers Log/die Schema-Validierung weiterhin die Slice des LETZTEN ;; Glieds (unveraendertes Verhalten, siehe Kommentar unten). (setq log-slice (vfl-journal-slice forward-journal seg-idx)) ;; Praeambel (Startpunkt/Starthoehe/AS) bei der ERSTEN Iteration ;; mitschreiben - ohne sie waere die Kette aus der Zeichnung nicht ;; vollstaendig rekonstruierbar (vfl-journal-xdata-schreiben-pre). ;; Danach aendert sich die Praeambel nicht mehr. (setq pre-journal (if (= seg-von 1) (vfl-journal-praeambel forward-journal) nil)) ;; Tatsaechliches Label der geschnittenen Slice (der STEP-Wert am Anfang). ;; Kann von wahl (dem Hauptschleifen-Label) ABWEICHEN: enthaelt die ;; VF-Einheit eine Vario-Kurve, ist DEREN STEP das letzte Glied, seg-idx ;; zeigt darauf, und die Slice ist die Vario-Kurve-Slice - waehrend wahl ;; noch "Horizontal-VF"/"Linie-VF" ist. Fuers Log/die Validierung zaehlt ;; das echte Slice-Label, nicht wahl (sonst falsch etikettiert). (setq slice-label (if (and log-slice (= (car (car log-slice)) "STEP")) (cdr (car log-slice)) wahl)) (setq e (if seg-lastEnt (entnext seg-lastEnt) (entnext))) (while e (vfl-journal-xdata-schreiben-seg e seg-von seg-journal) (if pre-journal (vfl-journal-xdata-schreiben-pre e pre-journal)) (setq cnt (1+ cnt)) (setq e (entnext e)) ) ;; Glied-Stand NUR fortschreiben, wenn wirklich Entities beschrieben ;; wurden. Ein Glied ohne Geometrie (z.B. "VF-Einheit nicht baubar" - ;; Menue-Antwort und Laenge sind journalisiert, gebaut wurde nichts) hat ;; keinen Traeger fuer seine XDATA. Bliebe der Stand trotzdem stehen, ;; waere sein Journal-Abschnitt unauffindbar und die Kette waere ab dort ;; nur noch mit Luecke wiederherstellbar. So wandert der Abschnitt ;; stattdessen in den naechsten Record, der Entities bekommt. (if (> cnt 0) (setq *vfl-seg-glied-letzte* seg-idx)) ;; Diagnose: den tatsaechlichen Segment-Journal-Inhalt als JSON loggen ;; (analog zum Ketten-XDATA-JOURNAL-JSON in vfl-journal-xdata-schreiben) ;; plus die Anzahl der beschriebenen Entities. No-Op ohne offene .dbg. (dbgmsg (strcat "SEGMENT-XDATA-JSON Glied " (itoa seg-von) (if (> seg-idx seg-von) (strcat ".." (itoa seg-idx)) "") " (" (if slice-label slice-label "?") ") auf " (itoa cnt) " Entity(s): " (vfl-journal->json seg-journal))) ;; Zusaetzlich benannt loggen (statt roher [INT]/[STR]-Zeilen). Feste ;; Glieder (AS/ES/GF-Bogen/Vario-Kurve) ueber ihr Feld-Schema ;; (GF-Bogen.winkel = 90), die VF-Einheit (Linie-VF/Horizontal-VF, variable ;; Laenge) ueber den Sub-Step-Logger (VF.menue = 4, VF.laenge = ...). Beide ;; validieren, was validierbar ist, und markieren Abweichungen (). ;; Ueber slice-label (echtes Glied), nicht wahl. ;; Bewusst log-slice (genau EIN Glied) - die Schema-Logger erwarten die ;; Slice eines einzelnen Glieds, nicht den Iterations-Abschnitt. (if (vfl-schema-felder slice-label) (vfl-schema-log-slice slice-label log-slice) (if (member slice-label '("Linie-VF" "Horizontal-VF")) (vfl-schema-log-vf slice-label log-slice))) ) (dbgmsg (strcat "SEGMENT-XDATA: kein Glied vorhanden (" (if wahl wahl "?") ")")) ) (dbgflush) (princ)) ;; --- Abbruch-Sicherung --- ;; Alle nach lastEnt erzeugten Entities werden NICHT geloescht, sondern ;; GENAUSO wie beim erfolgreichen Abschluss (vfl-block-erstellen) zu einem ;; neuen VF_n-Block gewickelt, mit dem VOLLEN aktuellen Eingabe-Journal ;; (inkl. des angefangenen, noch unfertigen letzten Gliedes) als XDATA. Die ;; Geometrie bleibt in der Zeichnung stehen und ist sofort per Doppelklick ;; weiter editierbar/fortsetzbar (vfl-edit-ent) - unabhaengig davon, ob es ;; sich um einen frischen Bau oder einen Editier-Neuaufbau handelte (kein ;; Sonderfall mehr noetig). Aufgerufen aus dem *error*-Handler von ;; vf-linienzug-modus. (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) (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"))) (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)))) (princ (ssg-textf "vfl-abbruch-gesichert" (list (itoa cnt))))) ) ) (princ)) ;; Replay-Modus scharf schalten: die uebergebene (Vorwaerts-)Journalliste wird ;; zur Lesequelle, *vfl-journal* startet leer und wird bei der erneuten ;; Ausfuehrung neu aufgebaut. Genutzt von vfl-edit-ent und der Wiederaufnahme. (defun vfl-journal-replay-start (forward-journal) (setq *vfl-replay-queue* forward-journal *vfl-journal* '() *vfl-seg-glied-letzte* 0) (if (boundp '*vflw-pending*) (setq *vflw-pending* nil))) ;; --- Glied-Zerlegung fuer den Editier-Dialog --- ;; Labels der Glieder (STEP-Marker) in Bau-Reihenfolge. (defun vfl-journal-glieder (forward-journal / out) (setq out '()) (foreach e forward-journal (if (= (car e) "STEP") (setq out (cons (cdr e) out)))) (reverse out)) ;; Journal auf die ersten (keep) Glieder kuerzen: Praeambel (vor dem 1. STEP) ;; bleibt immer erhalten; ab dem (keep+1)-ten STEP wird alles verworfen. (defun vfl-journal-truncate (forward-journal keep / seen out done) (setq seen 0 out '() done nil) (foreach e forward-journal (if (not done) (if (= (car e) "STEP") (if (< seen keep) (progn (setq seen (1+ seen)) (setq out (cons e out))) (setq done t)) (setq out (cons e out))))) (reverse out)) ;; Journal-Eintraege GENAU eines Glieds liefern: der (from-step-idx)-te STEP ;; (1-basiert, in Bau-Reihenfolge) bis ausschliesslich dem naechsten STEP. ;; Praeambel-Eintraege vor dem 1. STEP gehoeren zu keinem Glied und werden ;; hier nie zurueckgegeben (anders als vfl-journal-truncate, das sie immer ;; mitnimmt). Genutzt fuer die Segment-XDATA (vfl-segment-xdata-sichern) und ;; das Ersetzen eines einzelnen Glieds (vfl-journal-splice). (defun vfl-journal-slice (forward-journal from-step-idx / seen out started done) (setq seen 0 out '() started nil done nil) (foreach e forward-journal (if (not done) (cond ((and (= (car e) "STEP") started) (setq done t)) ((= (car e) "STEP") (setq seen (1+ seen)) (if (= seen from-step-idx) (progn (setq started t) (setq out (cons e out))))) (started (setq out (cons e out)))))) (reverse out)) ;; Journal-Eintraege AB dem (from-step-idx)-ten Glied bis zum ENDE des ;; Journals (alle folgenden STEPs inklusive). Gegenstueck zu ;; vfl-journal-slice, das bei genau einem Glied stoppt. ;; Gebraucht fuer die Segment-XDATA: eine Iteration der Bau-Hauptschleife kann ;; MEHRERE Glieder erzeugen (eine VF-Einheit mit eingebetteten Vario-Kurven ;; legt Horizontal-VF/Linie-VF + je Kurve ein eigenes STEP ab). Auf die ;; Entities dieser Iteration muss deshalb der GESAMTE in ihr entstandene ;; Journal-Abschnitt, nicht nur die Slice des letzten Glieds - sonst fehlen ;; die Eingaben der Einheit selbst und die Kette ist aus der Zeichnung nicht ;; mehr vollstaendig rekonstruierbar (c:VF_SEKTION_RESTORE). (defun vfl-journal-ab-glied (forward-journal from-step-idx / seen out started) (setq seen 0 out '() started nil) (foreach e forward-journal (if started (setq out (cons e out)) (if (= (car e) "STEP") (progn (setq seen (1+ seen)) (if (= seen from-step-idx) (progn (setq started t) (setq out (cons e out)))))))) (reverse out)) ;; Anzahl der Glieder (STEP-Eintraege) in einem Journal-Abschnitt. (defun vfl-steps-zaehlen (journal / n) (setq n 0) (foreach e journal (if (= (car e) "STEP") (setq n (1+ n)))) n) ;; Journal-Eintraege des Glieds (seg-idx) durch (new-seg-journal) ersetzen - ;; alle anderen Glieder (davor UND danach) sowie die Praeambel bleiben ;; unveraendert. Gegenstueck zu vfl-journal-slice (welches genau dieses Glied ;; ISOLIERT liefert). Genutzt von der Einzelsegment-Bearbeitung (vfl-edit-glied). (defun vfl-journal-splice (forward-journal seg-idx new-seg-journal / seen out) (setq seen 0 out '()) (foreach e forward-journal (progn (if (= (car e) "STEP") (setq seen (1+ seen))) (cond ((< seen seg-idx) (setq out (cons e out))) ; vor dem Ziel-Glied: unveraendert ((> seen seg-idx) (setq out (cons e out))) ; nach dem Ziel-Glied: unveraendert ((and (= seen seg-idx) (= (car e) "STEP")) ; Ziel-Glied: einmalig durch (setq out (append (reverse new-seg-journal) out)))))) ; new-seg-journal ersetzen, (reverse out)) ; alle uebrigen Eintraege verwerfen ;; Internes (sprachneutrales) Glied-Token in lesbaren Text der AKTUELLEN Sprache ;; uebersetzen. Da im Journal nur das Token steht, folgt die Anzeige immer der ;; aktiven Sprache - ein in Deutsch aufgezeichnetes Journal zeigt in englischer ;; UI englische Labels (und umgekehrt). (defun vfl-glied-label-text (w) (cond ((= w "GF-Bogen") (ssg-text "vfl-glied-gf-bogen")) ((= w "Linie-GF") (ssg-text "vfl-glied-gf")) ((= w "Linie-VF") (ssg-text "vfl-glied-vf")) ((= w "Horizontal-VF") (ssg-text "vfl-glied-horizontal-vf")) ((= w "Linie") (ssg-text "vfl-glied-linie")) ((= w "AS") (ssg-text "vfl-glied-as")) ((= w "ES") (ssg-text "vfl-glied-es")) ((= w "Vario-Kurve") (ssg-text "vfl-glied-vario")) ((= w "?") (ssg-text "vfl-glied-offen")) (t w))) ;; ============================================================ ;; TEIL 1: SEGMENT-ENTSCHEIDUNG (GF oder VF) ;; ============================================================ ;; Aus der Ergebnisliste von berechne-alle-winkel die GUELTIGEN Winkel filtern ;; und - bei mehreren - den Nutzer waehlen lassen. Rueckgabe: (winkel L_GF L_VF) ;; oder nil, wenn kein gueltiger Winkel existiert. ;; --- Winkelwahl: reine Teile + Frage-Schale --- ;; Die gueltigen Kandidaten aus einer berechne-alle-winkel-Ergebnisliste ;; filtern. Gueltig heisst: baubar (cadddr) UND beide Laengen positiv. ;; Reine Funktion, keine Frage, keine Globals. (defun vfl-winkel-gueltige (ergebnis-liste / gueltige) (setq gueltige '()) (foreach e ergebnis-liste (if (and (cadddr e) (numberp (cadr e)) (numberp (caddr e)) (> (cadr e) 0) (> (caddr e) 0)) (setq gueltige (append gueltige (list e))))) gueltige) ;; Kandidat Nummer idx (1-basiert) als (winkel L_GF L_VF). Ein Index ;; ausserhalb der Liste faellt auf den ersten Kandidaten zurueck - so ;; verhielt sich die Frage-Schale schon immer bei ungueltiger Eingabe. (defun vfl-winkel-nach-index (gueltige idx / e) (if (or (null idx) (< idx 1) (> idx (length gueltige))) (setq idx 1)) (setq e (nth (1- idx) gueltige)) (if e (list (nth 0 e) (nth 1 e) (nth 2 e)) nil)) ;; Vorgabe-Kanal: ist *vfl-winkel-idx-vorgabe* gesetzt, wird NICHT gefragt, ;; sondern dieser Kandidat genommen. Derselbe Mechanismus, den die Datei ;; schon fuer die Wizard-Menues nutzt (dynamisch gebundene *vflw-menu-*). ;; Warum ein Kanal und kein Parameter: vfl-waehle-winkel wird aus vier ;; Solvern gerufen (vfl-vf-winkel, vfl-vf-entscheidung, vfl-body-zerlegung, ;; vfl-segment-entscheidung) - ein zusaetzlicher Parameter wuerde vier ;; Signaturen und alle deren Aufrufer aendern. ;; ACHTUNG: die Vorgabe gilt fuer JEDE folgende Winkelfrage, bis sie ;; zurueckgesetzt wird. Setzer muessen sie darum wieder auf nil stellen. (if (not (boundp '*vfl-winkel-idx-vorgabe*)) (setq *vfl-winkel-idx-vorgabe* nil)) ;; Frage-Schale (Name unveraendert, alle Aufrufstellen bleiben): gueltige ;; Kandidaten bestimmen, bei genau einem ohne Frage nehmen, sonst fragen - ;; bzw. die Vorgabe verwenden. (defun vfl-waehle-winkel (ergebnis-liste / gueltige idx antwort e labels) (setq gueltige (vfl-winkel-gueltige ergebnis-liste)) (cond ((null gueltige) nil) ((= (length gueltige) 1) (vfl-winkel-nach-index gueltige 1)) (*vfl-winkel-idx-vorgabe* (vfl-winkel-nach-index gueltige *vfl-winkel-idx-vorgabe*)) (t (princ (ssg-text "vfl-mehrere-winkel-header")) (setq idx 1 labels '()) (foreach e gueltige (princ (ssg-textf "vfl-winkel-option" (list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1)))) (setq labels (append labels (list (ssg-textf "vfl-winkel-option" (list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1)))))) (setq idx (1+ idx))) (setq antwort (vfl-menu-int (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige))) labels 1 "vfl-mehrere-winkel-header")) (vfl-winkel-nach-index gueltige antwort)))) ;; berechne-alle-winkel ausfuehren (mit Linienzug-FESTE_HORIZONTAL = 1300) und ;; den Winkel waehlen lassen. Rueckgabe: (winkel L_GF L_VF) oder nil. ;; aus-dx/aus-dz temporaer nullen: an jeder Aufrufstelle (ueber vfl-vf- ;; entscheidung) ist ein evtl. vorhandenes AS-Element bereits real eingefuegt ;; und deltaL bereits aus dessen echtem KS_AUS neu berechnet (vfl-projiziere- ;; distanz) - der Platzbedarf ist also schon "verbraucht" und darf nicht ;; nochmal in berechne-alle-winkel abgezogen werden (sonst fehlt am Ende ;; systematisch genau dieser Betrag, aus-dx typischerweise mehrere hundert mm). ;; ein-dx/ein-dz bleiben unangetastet: das ES-Element ist an dieser Stelle noch ;; nicht gebaut (folgt erst nach der "Kettenende?"-Frage) - konsistent mit ;; vfl-body-zerlegung, die ebenfalls nur aus-dx/aus-dz nullt. (defun vfl-vf-winkel (deltaL deltaH richtung / save-ausdx save-ausdz res) (setq save-ausdx aus-dx save-ausdz aus-dz) (setq aus-dx 0.0 aus-dz 0.0) (setq res (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH richtung *vfl-feste-horizontal*)))) (setq aus-dx save-ausdx aus-dz save-ausdz) res) ;; Rueckgabe: (typ winkel L_GF L_VF) - erzwingt IMMER eine VF-Einheit (nie GF), ;; genutzt sowohl von vfl-segment-entscheidung (automatische Zweig-Auswahl) als ;; auch direkt vom expliziten "Ab/Auf VF"-Menuepunkt in Modus 1 (vf-linienzug-modus). ;; typ="VF": winkel = best-winkel (0 = Horizontale Mitte), L_GF/L_VF wie ;; berechne-alle-winkel bzw. berechne-horizontale-mitte ;; typ=nil : keine VF-Einheit fuer dieses deltaL/deltaH geometrisch moeglich (defun vfl-vf-entscheidung (deltaL deltaH richtung / winkel-natuerlich wahl horizontal-info) (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. ((< deltaL *vfk-vf-mindestlaenge*) (list nil nil nil nil)) ;; Segment ohne messbare Hoehenaenderung: kein sinnvolles VF ((< deltaH 1.0) (list nil nil nil nil)) ;; Steigend: bei mehreren gueltigen Winkeln waehlt der Nutzer (vfl-vf-winkel). ((= richtung "Auf") (setq wahl (vfl-vf-winkel deltaL deltaH "Auf")) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))) ;; Fallend: natuerlichen Neigungswinkel bestimmen (atan der Schraege). ;; steiler als 3 Grad -> absteigender VarioFoerderer (VF-ab) ;; sonst -> VF (Horizontale Mitte oder diskreter Winkel) (t (setq winkel-natuerlich (* (atan (/ deltaH deltaL)) (/ 180.0 pi))) (if (> winkel-natuerlich *vfk-gefaelle-winkel*) (progn (setq wahl (vfl-vf-winkel deltaL deltaH "Ab")) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))) (progn (setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab")) (if (and horizontal-info (caddr horizontal-info)) (list "VF" 0 (car horizontal-info) (cadr horizontal-info)) (progn (setq wahl (vfl-vf-winkel deltaL deltaH "Ab")) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))))) ) ) ) ) ;; 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-vf-winkel ;; temporaer genullt (AS-Footprint an dieser Stelle bereits verbraucht) - ;; sonst wuerde die Sondierung ein zu kleines Budget sehen und einen ;; eigentlich baubaren Wert faelschlich als "nicht baubar" verwerfen. (defun vfl-vf-machbar-p (deltaL deltaH richtung / horizontal-info save-ausdx save-ausdz ergebnis) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) (cond ((< deltaL *vfk-vf-mindestlaenge*) nil) ((< deltaH 1.0) nil) ((= richtung "Auf") (setq save-ausdx aus-dx save-ausdz aus-dz) (setq aus-dx 0.0 aus-dz 0.0) (setq ergebnis (vfl-winkel-machbar-p deltaL deltaH "Auf" *vfl-feste-horizontal*)) (setq aus-dx save-ausdx aus-dz save-ausdz) ergebnis) (t (setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab")) (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")) (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")) (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))) ;; Segment ohne messbare Hoehenaenderung: weder Gefaelle noch sinnvolles VF ((< deltaH 1.0) (list nil nil 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 (fest 3 Grad) ;; sonst -> VF (vfl-vf-entscheidung) (t (setq winkel-natuerlich (* (atan (/ deltaH deltaL)) (/ 180.0 pi))) (if (<= (abs (- winkel-natuerlich *vfk-gefaelle-winkel*)) *vfl-gf-winkel-toleranz*) (list "GF" *vfk-gefaelle-winkel* nil nil) (vfl-vf-entscheidung deltaL deltaH richtung)) ) ) ) ;; ============================================================ ;; TEIL 2: SEGMENT-EINFUEGUNG (ohne AS/ES - reine Kettenmitte) ;; ============================================================ ;; Reine, kontinuierlich skalierte Gefaelleschraege (kein AS/ES, kein Bogen). ;; punkt: Startpunkt (3D), hz: Horizontalrichtung, deltaL: horizontaler ;; Fussabdruck, winkel: Neigungswinkel (aus vfl-segment-entscheidung). ;; Die Schraeglaenge wird aus deltaL/cos(winkel) abgeleitet, damit der ;; horizontale Fussabdruck exakt deltaL entspricht (deltaH = deltaL*tan(winkel) ;; ergibt sich damit konsistent). Rueckgabe: neuer Frame am Segmentende. (defun vfl-insert-gf-segment (punkt hz deltaL winkel / l-schraeg endpunkt) (setq l-schraeg (/ deltaL (cos (* (float winkel) (/ pi 180.0))))) (setq endpunkt (gf-insert-hz-incl-scaled "Staustrecke_SP_1000_mm" punkt l-schraeg hz winkel)) (make-frame-from-dir endpunkt (hz-winkel->xu hz winkel)) ) ;; Ansicht auf Grundriss (Draufsicht, Welt-UCS) zoomen: nach jedem ;; Kettenglied mit Geometrieerzeugung wird die neu entstandene Strecke sonst ;; leicht aus dem sichtbaren Bereich oder in eine schraege 3D-Ansicht ;; hinauslaufen - der naechste Punkt (vfl-neue-linie-messen, siehe unten) ;; waere dann schwer/ungenau anzuwaehlen. _PLAN "_World" aendert nur die ;; ANSICHT, nicht das aktuell aktive BKS. Rein kosmetisch (per ;; vl-catch-all-apply abgesichert) - ein Fehler hier darf den eigentlichen ;; Kettenbau nie unterbrechen. (defun vfl-view-refresh ( / ) ;; Headless nur Kosten: die Ansicht sieht niemand, _PLAN/_ZOOM laufen aber ;; vor JEDER Laengeneingabe (vfl-neue-linie-messen) - im Batch reine Zeit. (if (not (vfl-headless-p)) (vl-catch-all-apply (function (lambda () (command "_.PLAN" "_World") (command "_.ZOOM" "_Extents"))) nil)) (princ)) ;; --- Hilfsfunktionen fuer die VF-Einheit --- ;; Planare (XY-)Distanz und Richtung zwischen zwei Punkten. (defun vfl-planar-dist (p1 p2) (sqrt (+ (expt (- (car p2) (car p1)) 2) (expt (- (cadr p2) (cadr p1)) 2)))) (defun vfl-planar-hz (p1 p2) (* (atan (- (cadr p2) (cadr p1)) (- (car p2) (car p1))) (/ 180.0 pi))) ;; Neue Linie ausmessen: Laenge (deltaL) und Fahrtrichtung (hz) bestimmen. ;; Ist hz-vorgabe gesetzt (Fahrtrichtung durch das vorherige Element - z.B. ;; einen GF-Bogen oder eine Vario-Kurve - bereits festgelegt), wird der ;; gewaehlte Punkt auf diese Richtung PROJIZIERT: die Linie folgt exakt der ;; Fahrtrichtung, der Nutzer gibt praktisch nur die Laenge vor (eine gerade ;; Foerderstrecke kann die Richtung nicht aendern). Nur beim allerersten ;; Segment (hz-vorgabe=nil) definiert der gewaehlte Punkt die Richtung frei. ;; Punkt-Abfrage mit FESTER 2-Arity (Basispunkt + Prompt). Verhaltensneutraler ;; Wrapper um das variadische Built-in getpoint: mit Basispunkt (base) wird die ;; 2-Argument-Form genutzt (Gummiband), ohne (base=nil) die reine Prompt-Form. ;; Zweck: ein Testmock kann diese feste Signatur ersetzen (getpoint selbst kann ;; als defun nicht 1- UND 2-argumentig gemockt werden). ;; DYNMODE waehrend des Picks auf 3 (Pointer- + Dimensions-Input) setzen, damit ;; BricsCAD Distanz/Winkel dynamisch am Cursor anzeigt (Laengen-Feedback beim ;; Picken) - danach den Nutzer-Wert wiederherstellen. (defun vfl-getpoint (base prompt / old-dynmode pt) (setq old-dynmode (vl-catch-all-apply 'getvar (list "DYNMODE"))) (if (vl-catch-all-error-p old-dynmode) (setq old-dynmode nil)) (if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" 3))) (setq pt (if base (getpoint base prompt) (getpoint prompt))) (if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" old-dynmode))) pt ) ;; Vorschlagswert fuer die GF-Zielhoehe: die aktuelle Kettenhoehe (ist-hoehe) ;; UNVERAENDERT als Default anzubieten fuehrt in eine Falle - ein GF-Segment ;; MUSS fallen (0 Grad Gefaelle gibt es nicht), ein direkt uebernommener ;; Vorschlag mit deltaH=0 wird also immer als "kann nicht steigen" abgelehnt. ;; Deshalb hier auf volle mm ABGERUNDET (truncate, nicht rtos-Rundung - die ;; koennte sonst aufrunden und ueber die Ist-Hoehe hinausgehen) und bei ;; bereits ganzzahligen Werten zusaetzlich 1mm abgezogen, damit der Vorschlag ;; immer echt unterhalb der Ist-Hoehe liegt und direkt uebernehmbar ist. (defun vfl-gf-hoehe-vorschlag (ist-hoehe / gekappt) (setq gekappt (float (fix ist-hoehe))) (if (>= gekappt ist-hoehe) (- gekappt 1.0) gekappt)) ;; Punkt+Prompt-Eingabe fuer eine neue Linie journalfrei in (deltaL . hz) ;; uebersetzen: LIVE wird ganz normal ein Punkt gepickt (Gummiband), aber ;; NICHT der Punkt selbst journalisiert, sondern nur die daraus berechnete ;; Distanz (immer) und - NUR wenn hz-vorgabe nil war (freie Richtung, gilt ;; ausschliesslich fuer das allererste Segment der Kette) - zusaetzlich die ;; gesnappte Richtung. Ist hz-vorgabe bereits gesetzt (jedes Nicht-Start- ;; Segment), journalisiert diese Funktion NUR deltaL - die Richtung ist ja ;; ohnehin immer die des Vorgaengers, ein Journal-Eintrag dafuer waere ;; redundant. Rueckgabe: (deltaL . hz) oder nil bei Abbruch/leerer Eingabe. (defun vfl-in-abstand (p-akt hz-vorgabe prompt / p2 rad ux uy deltaL hz-aktuell popped) ;; Eigene Replay-Logik (zwei Eintraege pro Aufruf), darum ein eigener ;; Headless-Riegel: leere Queue = Desync, nicht "Nutzer soll picken". (if (and (null *vfl-replay-queue*) (vfl-headless-p)) (vfl-headless-abbruch "DL")) (if *vfl-replay-queue* (progn ;; Replay: IMMER nur deltaL aus der Queue lesen (nie einen Punkt). Bei ;; freier Richtung (hz-vorgabe nil) steht direkt DANACH noch die ;; gesnappte Richtung als zweiter Eintrag im Journal (siehe ;; Live-Zweig unten) - Reihenfolge: deltaL, dann optional hz. (setq popped (vfl-replay-pop)) (if (null popped) (setq deltaL nil) (setq deltaL (car popped))) (if (and deltaL (null hz-vorgabe)) (progn (setq popped (vfl-replay-pop)) ;; Queue endet zwischen DL und Richtung: headless ein Desync, nicht ;; stillschweigend 0 Grad (das wuerde die ganze Kette verdrehen). (if (and (null popped) (vfl-headless-p)) (vfl-headless-abbruch "REAL-hz")) (setq hz-aktuell (if popped (car popped) 0.0))) (setq hz-aktuell hz-vorgabe))) (progn ;; Live/Wizard: Pending-Queue zuerst pruefen (Konsistenz mit den ;; anderen vfl-in-*-Wrappern/Sicherheitsnetz, siehe vfl-wizard-aktiv- ;; Kommentar oben) - aktuell legt kein Gruppen-Dialog hier einen Punkt ;; ab, dieser Zweig bleibt also praktisch immer leer. Sonst normal ;; picken (Gummiband). Der Punkt lebt nur hier lokal, er wird nie ;; journalisiert. (setq popped (vflw-pending-pop)) (setq p2 (if popped (car popped) (vfl-getpoint p-akt prompt))) (if (null p2) (setq deltaL nil) (progn (setq hz-aktuell (if hz-vorgabe hz-vorgabe (vfl-hz-snappen-absolut (vfl-planar-hz p-akt p2)))) (setq rad (* (float hz-aktuell) (/ pi 180.0)) ux (cos rad) uy (sin rad)) (setq deltaL (+ (* (- (car p2) (car p-akt)) ux) (* (- (cadr p2) (cadr p-akt)) uy))))))) ;; Journalisieren fuer BEIDE Zweige (Replay UND Live) - wie alle anderen ;; vfl-in-*-Wrapper (siehe vfl-in-point/-real/-int): ein beim Replay aus der ;; alten Queue gelesener Wert MUSS ins neue *vfl-journal* uebernommen werden, ;; sonst fehlt er beim erneuten Speichern (vfl-journal-xdata-schreiben nach ;; einem Edit) - genau das fuehrte beim ZWEITEN Edit einer Kette zum ;; deltaL-Desync (die replizierten DL/Richtungs-Eintraege waren im nach dem ;; ersten Edit gespeicherten Journal verschwunden). Reihenfolge identisch zur ;; Lese-Reihenfolge oben: erst DL, dann - nur beim ersten Segment ;; (hz-vorgabe nil) - die gesnappte Richtung als REAL. (vfl-journal-record (if deltaL "DL" "NIL") deltaL) (if (and deltaL (null hz-vorgabe)) (vfl-journal-record "REAL" hz-aktuell)) (if deltaL (cons deltaL hz-aktuell) nil)) ;; Rueckgabe: (deltaL hz) oder nil bei Abbruch. Foerderer-Maximallaenge 25 m: ;; bei Ueberschreitung wird die Eingabe abgelehnt und der Endpunkt erneut ;; abgefragt. ;; ;; WICHTIG (siehe vfl-in-abstand): journalisiert wird NUR deltaL (+ ggf. die ;; gesnappte Richtung beim allerersten Segment), niemals ein absoluter Punkt. ;; deltaL ist eine reine Distanz relativ zum AKTUELLEN Frame (p-akt) entlang ;; der (ggf. vom Vorgaenger geerbten) Fahrtrichtung - eine absolute ;; Weltkoordinate wuerde dagegen nur zur URSPRUENGLICHEN Frame-Position ;; passen. Wird nach einem Einzelsegment-Edit (vfl-edit-glied, z.B. GF-Bogen ;; Seite/Winkel aendern) die Kette AB einem anderen Frame neu verkettet, ist ;; eine gespeicherte Distanz+Richtung sofort und ohne jede Umrechnung wieder ;; korrekt - ein gespeicherter absoluter Punkt waere es nicht (siehe Bug: ;; Neuprojektion des alten Punkts gegen den neuen Frame ergab eine falsche, ;; teils negative Laenge und in der Folge einen Queue-Desync-Absturz). ;; Einzige Ausnahme im ganzen Modus 1: der Kettenstartpunkt (vf-linienzug- ;; modus, vfl-in-point auf den allerersten Klick) - er bleibt ein echter ;; absoluter Punkt, weil er den einzigen Anker der ganzen Kette markiert und ;; von keiner Bogen-Aenderung betroffen sein kann. (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)) ;; Horizontales Sub-Segment bauen. Die flache Zone (0 Grad) wird NICHT mehr ;; automatisch mit ab_3 auf die 3-Grad-Basis zurueckgefuehrt - das Stueck ENDET ;; FLACH. Der ab_3-Uebergang kommt erst, wenn ein 3-Grad-Element folgt ;; (vfl-nach-3grad). Der auf_3-Eintritt wird nur gesetzt, wenn der Frame noch ;; NICHT flach ist (sonst bleibt die laufende flache Zone erhalten). Separatoren ;; VOR/NACH liegen in der 0-Grad-Ebene. Rueckgabe: neuer Frame (flach, 0 Grad). ;; ziel-modus=T: dL ist die GESAMT-Zielstrecke ab pt (der Nutzer hat einen ;; Endpunkt gepickt, den die Kette exakt treffen soll). In diesem Fall werden ;; ALLE Fragen, die die spaeter tatsaechlich gebaute Laenge beeinflussen ;; (Separator VOR/NACH, UND "Ist der Endpunkt der Foerderer?"), VOR der ;; Laengenberechnung gestellt - erst wenn wirklich alle Informationen da sind, ;; wird dL final berechnet und die horizontale Strecke gebaut. Das verhindert, ;; dass die Kette am Ende ueber den gepickten Punkt hinausragt, nur weil ;; nachtraeglich noch ein Separator oder eine Motorstation dazukommt. ;; gf2-laenge: die (schon feststehende) GF2-Laenge aus der GF-Verteilungs- ;; Frage (L_GF2-bau in vfl-vf-einheit) - wird bei Antwort "1" (nur Motor- ;; station) MIT reserviert, da vfs-vf-exit sie direkt danach anbaut. Bei ;; Antwort "3" (Kettenende definieren) NICHT reservieren: dort berechnet ;; vfl-body-abschluss ein eigenes, unabhaengiges ziel-gf2 (siehe dort) - hier ;; unbekannt und irrelevant. ;; Rueckgabe bei ziel-modus=T: (frame ist-endpunkt-antwort) - der Aufrufer ;; (vfl-vf-einheit) muss die Frage dann NICHT erneut stellen. Bei ziel-modus= ;; nil (Default/mid-chain-Fortsetzung): unveraendertes Verhalten, Rueckgabe ;; nur frame. ;; --- Horizontaler Koerper: reiner Bauteil --- ;; Baut das horizontale Stueck aus FERTIGEN Antworten - keine Frage, kein ;; Dialog. Rueckgabe: neuer Frame (das Stueck endet flach, 0 Grad). ;; ;; ziel-modus bleibt ein EIGENER Parameter neben ende-code (der Fahrplan ;; wollte ihn ersetzen): die Separator-Subtraktionen haengen allein am ;; Ziel-Modus, nicht an der Endpunkt-Antwort - und ende-code darf nil sein ;; (abgebrochene Menuefrage). Mit nur einem Parameter waere genau dieser Fall ;; eine stille Verhaltensaenderung. ;; ;; REIHENFOLGE IST GEOMETRIE: jede dL-Subtraktion ist mit ;; (max *vfk-restlaenge-min-clamp* ...) geklammert, also nicht kommutativ, ;; und der auf_3-Insert sitzt BEWUSST zwischen Subtraktion 1 und 2 - sein ;; Fussabdruck wird GEMESSEN (vfl-projiziere-distanz), nicht geschaetzt. ;; Hier darf nichts umsortiert werden. (defun vfl-hor-koerper-bauen (frame hz dL ziel-modus ende-code sep-vor sep-nach gf2-laenge / pt m1 pt-vor-bogen) (setq pt (car frame)) (if (and ziel-modus sep-vor) (setq dL (max *vfk-restlaenge-min-clamp* (- dL *vfk-separator-laenge*)))) ;; auf_3-Eintritt nur, wenn noch NICHT flach (sonst flache Zone fortsetzen). ;; dL ist die gewuenschte Reststrecke AB HIER (pt) - der reale Bogen- ;; Fussabdruck (gemessen, nicht aus der Tabellen-Masse geschaetzt - die ;; stimmt nach der Rotation nicht mehr exakt) wird von dL abgezogen, damit ;; das horizontale Stueck am gewuenschten Zielpunkt endet. (if (not (vfl-frame-flach-p frame)) (progn (setq pt-vor-bogen pt) (setq m1 (get-bogen-mass bogen-auf 3)) (princ (ssg-text "vfl-bogen-auf3-uebergang")) (setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt (ssg-cfg-or "vario" "gefaelle_winkel" 3) (car m1) (caddr m1) hz)) (setq dL (max *vfk-restlaenge-min-clamp* (- dL (vfl-projiziere-distanz pt-vor-bogen pt hz)))))) (if (and ziel-modus sep-nach) (setq dL (max *vfk-restlaenge-min-clamp* (- dL *vfk-separator-laenge*)))) ;; Ausgangs-Fussabdruck (Vario_Bogen_ab_3 + Motorstation) nur reservieren, ;; wenn die Einheit tatsaechlich sofort schliesst (Antwort 1 oder 3); bei ;; Antwort 1 zusaetzlich die GF2 hinter dem Motor. (if ziel-modus (cond ((= ende-code "1") (setq dL (max *vfk-restlaenge-min-clamp* (- dL (car (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*))) *vfk-stations-laenge* (* (if gf2-laenge gf2-laenge 0.0) (cos (* *vfk-gefaelle-winkel* (/ pi 180.0)))))))) ((= ende-code "3") (setq dL (max *vfk-restlaenge-min-clamp* (- dL (car (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*))) *vfk-stations-laenge*)))))) ;; optionaler Separator VOR - in der horizontalen Ebene (0 Grad) (if sep-vor (setq pt (vfl-sep-hz pt hz))) ;; horizontale Zwischenstrecke (0 Grad) (princ (ssg-textf "vfl-horizontale-zwischenstrecke" (list (rtos dL 2 2)))) (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt dL 0 hz)) (vfl-acc-vf-seg "horizontal" 0 dL) ;; optionaler Separator NACH (jetzt tatsaechlich bauen) (if sep-nach (setq pt (vfl-sep-hz pt hz))) ;; KEIN ab_3 mehr -> das Stueck ENDET FLACH (0 Grad) (make-frame-from-dir pt (hz-winkel->xu hz 0.0)) ) ;; --- Horizontaler Koerper: Frage-Schale (Name unveraendert) --- ;; Fragt Separator vor/nach und - im Ziel-Modus - "Ist der Endpunkt der ;; Foerderer?", danach baut vfl-hor-koerper-bauen. Keine der drei Fragen ;; haengt an einem berechneten Wert, sie stehen darum alle vor dem Bau; die ;; Journal-Reihenfolge ist dieselbe wie zuvor. ;; Die Endpunkt-Antwort wird im Ziel-Modus mit zurueckgegeben (vor-antwort), ;; damit die Fortsetzungsschleife des Aufrufers sie nicht erneut erfragt. (defun vfl-baue-horizontal-koerper (frame hz dL ziel-modus gf2-laenge / sep-vor sep-nach ist-ende-antwort neu) (if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-horizontal-impl (list ziel-modus))) (princ (ssg-text "vfl-sep-vor-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-nein")) (setq sep-vor (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2 "vfl-sep-vor-frage") "1")) ;; Separator NACH abfragen (noch nicht bauen) - im Ziel-Modus muss der ;; Fussabdruck vor der Laengenberechnung feststehen. (princ (ssg-text "vfl-sep-nach-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-nein")) (setq sep-nach (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2 "vfl-sep-nach-frage") "1")) (if ziel-modus (progn (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")) (setq ist-ende-antwort (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")))) (setq neu (vfl-hor-koerper-bauen frame hz dL ziel-modus ist-ende-antwort sep-vor sep-nach gf2-laenge)) (if ziel-modus (list neu ist-ende-antwort) neu) ) ;; ============================================================ ;; OPTION 3: KETTENENDE AUS LAUFENDER VF-EINHEIT (ein Motor) ;; ============================================================ ;; Zerlegt den verbleibenden GERADEN Lauf bis zum Ziel-ES mit der bewaehrten ;; STANDARD-Logik (wie aussen), aber fuer den Mid-Body-Fall: ;; - Der Einlauf (AS + GF1 + Separator + Umlenk) ist bereits gebaut und wird ;; NICHT beruecksichtigt -> aus-dx/aus-dz = 0. ;; - Fest vor dem ES stehen nur Motor(500) + Auslauf-Separator(300) ;; -> FESTE_HORIZONTAL = 800. ;; Ergebnis der Standard-Logik (GF2 = GF, VARIIERT mit dem Winkel): ;; steiler als 3 Grad / steigend -> gewinkeltes VF + GF2 (Winkeltabelle), ;; flacher als 3 Grad -> horizontales VF + GF2 (Rest-Laenge ueber ;; das horizontale Stueck ausgeglichen). ;; Die Hoehe kommt also aus VF-Winkel/horizontal + GF2, die ueberschuessige ;; Laenge aus dem horizontalen VF - genau die zweistufige Logik. ;; Rueckgabe: (typ winkel L_GF2 L_VF) - typ "GF"/"VF"/nil (wie ;; vfl-segment-entscheidung; L_GF2 varriert, Mindestwert siehe vfl-body-abschluss). (defun vfl-body-zerlegung (deltaL deltaH richtung / save-ausdx save-ausdz save-feste winkel-natuerlich wahl horizontal-info res) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) ;; Budget-Globals temporaer auf den Mid-Body-Fall 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 *vfk-feste-horizontal-kettenende*) (setq res (cond ;; kuerzer als Motor(500)+Separator(300): kein Abschluss baubar ((< deltaL *vfk-kettenende-mindestlaenge*) (list nil nil nil nil)) ;; praktisch flach: horizontales VF + GF2 ((< deltaH 1.0) (setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab")) (if (and horizontal-info (caddr horizontal-info)) (list "VF" 0 (car horizontal-info) (cadr horizontal-info)) (list nil nil nil nil))) ;; steigend: nur gewinkeltes VF + GF2 moeglich ((= richtung "Auf") (setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Auf" *vfk-feste-horizontal-kettenende*)))) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (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 ;; ~3 Grad -> reine GF2 (kein Koerper, GF2 traegt Laenge + 3-Grad-Absenkung) ((<= (abs (- winkel-natuerlich *vfk-gefaelle-winkel*)) *vfl-gf-winkel-toleranz*) (list "GF" *vfk-gefaelle-winkel* nil nil)) ;; steiler als 3 Grad -> Stufe 1: gewinkeltes VF + GF2 (GF2 variiert mit Winkel) ((> winkel-natuerlich *vfk-gefaelle-winkel*) (setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Ab" *vfk-feste-horizontal-kettenende*)))) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))) ;; flacher als 3 Grad -> Stufe 2: horizontales VF + GF2 (t (setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab")) (if (and horizontal-info (caddr horizontal-info)) (list "VF" 0 (car horizontal-info) (cadr horizontal-info)) (progn (setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Ab" *vfk-feste-horizontal-kettenende*)))) (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) ;; Fragt Zielpunkt (XY) + Zielhoehe (Z) ab, zerlegt den Rest (vfl-body- ;; zerlegung, Standard-Logik) und baut den Koerper VOR dem Motor: gewinkeltes ;; VF (winkel>0) oder horizontales VF (winkel=0). GF2 (variiert mit dem Winkel, ;; Mindestwert *vfl-gf-min-laenge*=400) sitzt hinter dem Motor und wird als ;; Laenge zurueckgegeben (der Aufrufer setzt sie beim Auslauf ein und schliesst ;; mit Motor -> GF2 -> Separator -> ES ab). Speichert den Soll-Zielpunkt in ;; *vfl-ziel-punkt* fuer den Ist-Ziel-Report. ;; Rueckgabe: (frame anzahl-koerper letzt-hz gf2-laenge) oder nil. ;; --- Kettenende-Abschluss: reiner Bauteil --- ;; Zerlegt die Reststrecke und baut Koerper + Motor-Vorbereitung. Fragt ;; nichts mehr - die einzige Rueckfrage steckt in vfl-body-zerlegung ;; (vfl-waehle-winkel, nur wenn mehrere Winkel gueltig sind) und ist ueber ;; *vfl-winkel-idx-vorgabe* vorab beantwortbar. ;; Rueckgabe: (frame anzahl-koerper hz gf2-laenge) oder nil, wenn der Rest ;; nicht baubar ist. ;; ;; Signatur schlanker als im Fahrplan skizziert: letzt-hz und es-gewuenscht ;; werden hier nicht gebraucht. es-gewuenscht wirkt beim Aufrufer, der ;; ein-dx/ein-dz um den Aufruf herum nullt (kein ES-Fussabdruck reservieren); ;; letzt-hz wurde nur einer wirkungslosen Zuweisung zugefuehrt (siehe unten). (defun vfl-body-abschluss-bauen (frame p-umlenk dL hzn hn / dH richtn rad3 dec typ w lgf lvf gf2 cnt p0 tx ty letzt-hz) (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)) (setq typ (nth 0 dec) w (nth 1 dec) lgf (nth 2 dec) lvf (nth 3 dec)) (if (null typ) (progn (princ (ssg-text "vfl-fehler-rest-nicht-baubar")) (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). (if (and (= typ "VF") lvf (> lvf 1.0)) (progn (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)))) ;; ohne Wirkung: letzt-hz ist lokal und wird nicht mehr gelesen - ;; die Fahrtrichtung verlaesst die Funktion ueber die Rueckgabe. ;; Beim Umzug bewusst wortwoertlich uebernommen. (setq letzt-hz hzn) (vfl-20m-check p-umlenk (car frame)) ;; GF2-Laenge (hinter dem Motor): aus der Zerlegung (variiert mit Winkel), ;; sonst (typ "GF") aus der 3-Grad-Geometrie abgeleitet. Mindestwert 400. (setq gf2 (cond ((and lgf (> lgf 0.0)) lgf) ((= typ "GF") (max 0.0 (- (/ (- dL (abs (if ein-dx ein-dx *vfk-as-es-fallback-dx*))) (cos rad3)) *vfk-feste-horizontal-kettenende*))) (t 0.0))) (if (and (> gf2 0.0) (< gf2 *vfl-gf-min-laenge*)) (progn (princ (ssg-textf "vfl-hinweis-gf2-minimum" (list (rtos gf2 2 0) (rtos *vfl-gf-min-laenge* 2 0)))) (setq gf2 *vfl-gf-min-laenge*))) (dbgmsg (strcat "GEOMETRIE ERFOLG: Kettenende-Abschluss gebaut (cnt=" (itoa cnt) " gf2=" (rtos gf2 2 0) "), neue Position=" (dbg-tostring (car frame)))) (list frame cnt hzn gf2) ) ) ) ;; --- Kettenende-Abschluss: Frage-Schale (Name unveraendert) --- ;; "Alles fragen, dann alles bauen" geht hier NICHT: vfl-neue-linie-messen ;; braucht den Frame NACH vfl-nach-3grad, und die Hoehenvorschlaege brauchen ;; die gemessene Laenge und die aktuelle Kettenhoehe. Darum in dieser ;; Reihenfolge: flache Zone abschliessen -> Laenge messen -> Vorschlaege ;; berechnen -> Zielhoehe fragen -> bauen. (defun vfl-body-abschluss (frame letzt-hz p-umlenk / linie-mess dL hzn hn hoehe-vorschlaege hoehe-ab hoehe-auf hoehe-fallback) ;; Der Abschluss-Koerper (vfs-vf-koerper) und der Motor gehen von 3-Grad-Basis ;; aus - eine gerade laufende flache Zone hier mit ab_3 abschliessen. (setq frame (vfl-nach-3grad frame)) (setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz)) (if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen-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)) (vfl-body-abschluss-bauen frame p-umlenk dL hzn hn) ) ) ) ;; --- VF-Einheit: Eingang (reiner Bauteil) --- ;; GF1 + Einlauf-Separator + Umlenkstation. Keine Frage, kein Dialog. ;; Rueckgabe: neuer Frame (Ausgang der Umlenkstation, 3-Grad-Basis). ;; Der Separator-Zaehler wird hier erhoeht, weil vfs-vf-entry den Separator ;; mitbaut - die *vfl-acc-*-Aufrufe muessen an derselben Stelle in derselben ;; Reihenfolge bleiben, sonst vertauschen sich die Komma-Listen L_VF_m/L_GF_m ;; im Sivas-Export (in der Zeichnung unsichtbar). (defun vfl-vf-eingang-bauen (frame hz1 L_GF1-bau) (setq frame (vfl-frame-3grad (vfs-vf-entry (car frame) L_GF1-bau hz1) hz1)) (if (> L_GF1-bau 0.1) (vfl-acc-gf-seg L_GF1-bau (ssg-cfg-or "vario" "gefaelle_winkel" 3))) (setq *vfl-acc-separator* (1+ *vfl-acc-separator*)) ; Einlauf-Separator (in vfs-vf-entry) frame) ;; --- VF-Einheit: Ausgang (reiner Bauteil) --- ;; Motorstation [+ GF2], KEIN Separator - der sitzt erst vor dem ES-Element ;; bzw. optional zwischen zwei Foerderern. ;; gf2-eff kommt FERTIG herein (siehe Aufrufstelle). (defun vfl-vf-ausgang-bauen (frame letzt-hz gf2-eff) ;; Motorseite erfassen: derzeit immer "rechts" (nur diese DWG vorhanden; ;; die "links"-Einzel-DWG wird spaeter ergaenzt). (setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts"))) ;; Motorstation braucht 3-Grad-Basis: falls die Kette gerade flach endet ;; (horizontales Stueck ohne ab_3), hier den ab_3-Uebergang nachholen. (setq frame (vfl-nach-3grad frame)) (setq frame (vfl-frame-3grad (vfs-vf-exit (car frame) gf2-eff letzt-hz nil) letzt-hz)) (if (> gf2-eff 0.1) (vfl-acc-gf-seg gf2-eff (ssg-cfg-or "vario" "gefaelle_winkel" 3))) frame) ;; Rueckgabe: (frame anzahl-koerper ziel-ende) (defun vfl-vf-einheit (frame hz1 richtung1 winkel1 L_GF1 L_VF1 gf-am-ausgang / 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) ;; 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. (setq L_GF-eff (max L_GF1 *vfl-gf-min-laenge*)) (if gf-am-ausgang (setq L_GF1-bau (/ L_GF-eff 2.0) L_GF2-bau (/ L_GF-eff 2.0)) ; halbe/halbe (setq L_GF1-bau L_GF-eff L_GF2-bau 0.0)) ; alles am Einlauf ;; --- Eingang: GF1 + Separator + Umlenkstation --- ;; entry-start/p-umlenk sind der Stand VOR bzw. NACH dem Eingang - die ;; horizontale Erstkoerper-Rechnung braucht beide (gemessener Fussabdruck). (setq entry-start (car frame)) (setq frame (vfl-vf-eingang-bauen frame hz1 L_GF1-bau)) (setq p-umlenk (car frame)) ;; --- Erstes Koerper-Sub-Segment --- ;; winkel1=0 => horizontaler Anfang (Option 3): mit Separator-vor/nach-Abfrage. ;; L_VF1 wird bei winkel1=0 vom Aufrufer (Modus 1, Option 3) als GESAMT- ;; Zielstrecke ab entry-start (dem gepickten Endpunkt) verstanden - abgezogen ;; werden daher: ;; 1) der reale Eingang-Fussabdruck (GF1+Separator+Umlenkstation, GEMESSEN ;; statt geschaetzt, ueber entry-start/p-umlenk) ;; 2) der Fussabdruck fuer einen MOEGLICHEN sofortigen Abschluss direkt ;; nach diesem Stueck: Vario_Bogen_ab_3 (Ausgangs-Uebergang zurueck auf ;; 3 Grad, Tabellen-Mass wie in vfl-nach-3grad) + Motorstation (500mm). ;; Falls die Kette hier NICHT sofort endet, wird dieser Fussabdruck ;; trotzdem reserviert - konsistent mit dem "Kettenende"-Verhalten an ;; anderer Stelle (lieber vorsichtig reservieren als ueberschiessen). (if (= (fix winkel1) 0) (progn ;; ziel-modus=T: Separator VOR/NACH + "Ist der Endpunkt der Foerderer?" ;; werden INNERHALB von vfl-baue-horizontal-koerper VOR der Laengen- ;; berechnung gestellt (siehe dortiger Kommentar) - die Antwort kommt ;; hier zurueck, damit die Schleife unten sie nicht nochmal erfragt. (setq res-h (vfl-baue-horizontal-koerper frame hz1 (max *vfk-restlaenge-min-clamp* (- L_VF1 (vfl-projiziere-distanz entry-start p-umlenk hz1))) t L_GF2-bau)) (setq frame (car res-h) vor-antwort (cadr res-h)) ) (progn (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) (progn (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")) (setq antwort (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")) ) ) (if (= antwort "1") (setq fertig t) (if (= antwort "3") ;; --- Option 3: Kettenende exakt am Zielpunkt (nur EIN Motor) --- (progn ;; ES-Element hier gewuenscht? Falls nein, ein-dx/ein-dz waehrend der ;; Zerlegung (vfl-body-abschluss -> vfl-body-zerlegung -> berechne- ;; alle-winkel) 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")) (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 (not es-gewuenscht) (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")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3") (list (ssg-text "vfl-opt-horizontaler-foerderer") (ssg-text "vfl-opt-vario-kurve") (ssg-text "vfl-opt-auf-ab-foerderer")) 3 "vfl-naechstes-element-vf")) (cond ;; --- Vario-Kurve (aendert hz) --- ((= antwort "2") (setq frame (vfl-insert-vario-kurve frame)) (setq letzt-hz (car (frame->hz-winkel frame))) ) ;; --- Horizontaler Foerderer (folgt der aktuellen Fahrtrichtung) --- ((= antwort "1") (setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz)) (if linie-mess (progn (setq dL (car linie-mess) hzn (cadr linie-mess)) (if (> dL 1.0) (progn ;; ziel-modus=T: Separator VOR/NACH + "Ist der Endpunkt der ;; Foerderer?" werden VOR der Laengenberechnung gestellt ;; (siehe vfl-baue-horizontal-koerper) - Antwort kommt hier ;; zurueck und wird in der naechsten Schleifen-Runde ;; verwendet, statt erneut zu fragen. (setq res-h (vfl-baue-horizontal-koerper frame hzn dL t L_GF2-bau)) (setq frame (car res-h) vor-antwort (cadr res-h)) (setq vf-count (1+ vf-count) letzt-hz hzn) (vfl-20m-check p-umlenk (car frame)) ) (princ (ssg-text "vfl-linie-zu-kurz-uebersprungen")) ) ) ) ) ;; --- Auf/Ab-Foerderer (folgt der aktuellen Fahrtrichtung) --- (t ;; gewinkeltes VF braucht 3-Grad-Basis -> flache Zone ggf. mit ab_3 beenden (setq frame (vfl-nach-3grad frame)) (setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz)) (if linie-mess (progn (setq dL (car linie-mess) hzn (cadr linie-mess)) (if (> dL 1.0) (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). ;; Auslauf-GF2: im Kettenende-Modus (Option 3) neu berechnet (ziel-gf2), ;; sonst aus der GF-Verteilungs-Frage (L_GF2-bau). Die Auswahl steht ;; BEWUSST hier und nicht im Bauteil - sie ist die Stelle, an der sonst ;; still die falsche GF2 hinter dem Motor entsteht. (setq gf2-eff (if ziel-ende ziel-gf2 L_GF2-bau)) (setq frame (vfl-vf-ausgang-bauen frame letzt-hz gf2-eff)) (list frame vf-count ziel-ende es-gewuenscht) ) ;; Rundet einen Winkel (Grad) auf das naechste 30-Grad-Vielfache DES WELT- ;; KOORDINATENSYSTEMS (absolut, nicht relativ zu einer Vorgaenger-Richtung). ;; Im System sind Fahrtrichtungen immer 30/60/90-Grad-Vielfache relativ zur ;; Zeichnung selbst - jede Abweichung (freier erster Klick, Bogen-Block- ;; Zeichnungsungenauigkeit) wird damit auf den naechsten gueltigen absoluten ;; Wert korrigiert, statt sich ueber die Kette aufzusummieren. (defun vfl-hz-snappen-absolut (hz / n) (setq n (/ hz 30.0)) (setq n (if (>= n 0.0) (fix (+ n 0.5)) (fix (- n 0.5)))) (* n 30.0) ) ;; Rotiert einen kompletten Frame (P xu yu zu) um die WELT-Z-Achse um delta ;; Grad - im Gegensatz zu (make-frame-from-dir P neue-xu) bleibt dabei die ;; urspruengliche Rollung (yu/zu, aus der echten Blockgeometrie gemessen) ;; erhalten. WICHTIG: make-frame-from-dir erzeugt yu/zu nach einer generischen ;; Konvention, die bei Bloecken mit eigener, nicht-generischer Ausrichtung ;; (z.B. Vario-Kurve) NICHT zur tatsaechlichen Verkettung passt - das fuehrte ;; empirisch zu einer um 90 Grad verdrehten Motorstation nach einem gesnappten ;; horizontalen Bogen. Eine reine Z-Drehung (nur X/Y von xu/yu/zu betroffen, ;; Z-Komponente unveraendert) behebt die winzige Snapping-Abweichung, ohne die ;; Rollung anzutasten. (defun vfl-vec-um-z-drehen (v c s) (list (- (* (car v) c) (* (cadr v) s)) (+ (* (car v) s) (* (cadr v) c)) (caddr v)) ) (defun vfl-frame-um-z-drehen (frame delta / rad c s) (setq rad (* (float delta) (/ pi 180.0))) (setq c (cos rad) s (sin rad)) (list (car frame) (vfl-vec-um-z-drehen (cadr frame) c s) (vfl-vec-um-z-drehen (caddr frame) c s) (vfl-vec-um-z-drehen (cadddr frame) c s)) ) ;; GF-Bogen (horizontale Kurve, Neigung bleibt wie im aktuellen Frame). ;; Fragt Winkel (30/60/90) und Seite interaktiv ab. ;; Nicht-interaktiver Kern: GF-Bogen mit gegebenem Winkel/Seite einfuegen. ;; Genutzt von der interaktiven Abfrage UND von den Pfad-Modi (Winkel/Seite ;; aus der Geometrie). Rueckgabe: neuer Frame. (defun vfl-insert-gf-bogen-block (frame bwinkel bseite / blockname neuer-frame hz-gemessen hz-gesnappt) (setq blockname (gf-bogen-blockname bwinkel bseite)) (princ (ssg-textf "vfl-fuege-block-ein" (list blockname))) (dbgmsg (strcat "GEOMETRIE: vfl-insert-gf-bogen-block (block=" blockname " bwinkel=" (itoa bwinkel) " bseite=" bseite ")")) ;; GF-Bogen zaehlen (Seite L/R + Winkel) -> Attribut GF_Bogen_L/R_xx (setq *vfl-acc-gfbogen* (vfl-inc-count *vfl-acc-gfbogen* (strcat (if (= bseite "rechts") "R" "L") "_" (itoa bwinkel)))) (setq neuer-frame (insert-block-ks-to-ks blockname frame)) (if (null neuer-frame) (dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Block " blockname " nicht eingefuegt")) (progn (setq hz-gemessen (car (frame->hz-winkel neuer-frame))) (setq hz-gesnappt (vfl-hz-snappen-absolut hz-gemessen)) ;; Reine Z-Drehung statt make-frame-from-dir-Neuaufbau: erhaelt die aus dem ;; Block gemessene Rollung (yu/zu) - siehe Kommentar bei vfl-frame-um-z-drehen. (if (> (abs (- hz-gemessen hz-gesnappt)) 0.0001) (setq neuer-frame (vfl-frame-um-z-drehen neuer-frame (- hz-gesnappt hz-gemessen)))) (dbgmsg (strcat "GEOMETRIE ERFOLG: GF-Bogen gebaut, neue Position=" (dbg-tostring (car neuer-frame)))) ) ) neuer-frame ) ;; Interaktiv (i18n): GF-Bogen-Winkel + Seite abfragen, dann Kern aufrufen. (defun vfl-insert-gf-bogen (frame / bwinkel bseite antwort) (if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-winkel-seite-impl (list "vfl-gf-bogen-winkel-header" (list (ssg-text "vfl-winkel-30") (ssg-text "vfl-winkel-60") (ssg-text "vfl-winkel-90")) *vfk-gf-bogen-winkel*))) (princ (ssg-text "vfl-gf-bogen-winkel-header")) (princ (ssg-text "vfl-winkel-30")) (princ (ssg-text "vfl-winkel-60")) (princ (ssg-text "vfl-winkel-90")) (setq bwinkel (vfl-menu-winkel (ssg-text "vfl-prompt-wahl-winkel-30-60-90") (list (ssg-text "vfl-winkel-30") (ssg-text "vfl-winkel-60") (ssg-text "vfl-winkel-90")) *vfk-gf-bogen-winkel* 90 "vfl-gf-bogen-winkel-header")) (princ (ssg-text "vfl-gf-bogen-seite-header")) (princ (ssg-text "gf-seite-links")) (princ (ssg-text "gf-seite-rechts")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "vfl-gf-bogen-seite-header")) (setq bseite (if (= antwort "2") "rechts" "links")) (vfl-insert-gf-bogen-block frame bwinkel bseite) ) ;; Vario-Kurve-Blockname (links/rechts x 30/60/90 x TEF aussen/innen). (defun vfl-kurve-blockname (kwinkel kseite kvariante) (strcat "Vario_Kurve_" kseite "_" (itoa kwinkel) "_TEF_" kvariante) ) ;; Nicht-interaktiver Kern: Vario-Kurve mit gegebenem Winkel/Seite/Variante ;; einfuegen. Genutzt von der interaktiven Abfrage UND von den Pfad-Modi ;; (Winkel/Seite aus der Geometrie, Variante abgefragt). Rueckgabe: neuer Frame. ;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch ;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das ;; (siehe ks-normalize-name). (defun vfl-insert-vario-kurve-block (frame kwinkel kseite kvariante / blockname hz flach-frame neuer-frame hz-gemessen hz-gesnappt) (setq blockname (vfl-kurve-blockname kwinkel kseite kvariante)) (princ (ssg-textf "vfl-fuege-block-ein" (list blockname))) ;; Vario-Kurve zaehlen (Variante A=aussen/I=innen + Winkel) -> VF_Bogen_A/I_xx (setq *vfl-acc-variokurve* (vfl-inc-count *vfl-acc-variokurve* (strcat (if (= kvariante "aussen") "A" "I") "_" (itoa kwinkel)))) ;; Vario-Kurve ist ein HORIZONTALER Richtungswechsel (KEINE Neigung). ;; Der aktuelle Frame traegt die 3-Grad-Basisneigung - fuer die Kurve wird er ;; daher auf 0 Grad abgeflacht (Position + Fahrtrichtung bleiben erhalten). (setq hz (car (frame->hz-winkel frame))) (setq flach-frame (make-frame-from-dir (car frame) (hz-winkel->xu hz 0.0))) (setq neuer-frame (insert-block-ks-to-ks blockname flach-frame)) ;; Auf den absoluten 30-Grad-Raster snappen (siehe vfl-hz-snappen-absolut) - ;; gleiche Zeichnungsungenauigkeit wie bei GF-Bogen moeglich. Reine Z-Drehung ;; statt make-frame-from-dir-Neuaufbau: erhaelt die aus dem Block gemessene ;; Rollung (yu/zu) - siehe Kommentar bei vfl-frame-um-z-drehen. Ein Neuaufbau ;; ueber make-frame-from-dir fuehrte hier empirisch zu einer um 90 Grad ;; verdrehten Motorstation NACH der Vario-Kurve. (setq hz-gemessen (car (frame->hz-winkel neuer-frame))) (setq hz-gesnappt (vfl-hz-snappen-absolut hz-gemessen)) (if (> (abs (- hz-gemessen hz-gesnappt)) 0.0001) (setq neuer-frame (vfl-frame-um-z-drehen neuer-frame (- hz-gesnappt hz-gemessen)))) neuer-frame ) ;; Vario-Kurve (horizontale Kurve, Neigung bleibt wie im aktuellen Frame). ;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch ;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das ;; (siehe ks-normalize-name). ;; Interaktiv (i18n): Vario-Kurve-Winkel + Seite + Variante abfragen, dann Kern. ;; Die Vario-Kurve bekommt - wie das ES-Element (vfl-frage-es-seite) - einen ;; EIGENEN STEP-Marker "Vario-Kurve", obwohl sie INNERHALB der VF-Einheit- ;; Schleife gebaut wird und keinen eigenen Hauptschleifen-Durchlauf hat. Damit ;; wird sie zu einem regulaeren, waehlbaren Glied und ist ueber die bestehende ;; Glied-Maschinerie (vfl-journal-glieder/-slice/-splice) editierbar. Der Marker ;; steht VOR den drei Eingaben (Winkel INT, Seite STR, Variante STR), sodass ;; diese als Glied-Inhalt darauf folgen. Beim Replay ueberspringt vfl-replay-pop ;; den Marker automatisch; die drei Werte poppen danach regulaer. Der Glied-Edit ;; liest allein aus dem Ketten-Journal (Segment-XDATA ist nur additive Deko), ;; daher ist KEIN Umbau der Segment-XDATA-Sicherung noetig. (defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort) (vfl-journal-mark "Vario-Kurve") (if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-variokurve-impl nil)) (princ (ssg-text "vfl-variokurve-winkel-header")) (princ (ssg-text "vfl-opt3-30grad")) (princ (ssg-text "vfl-opt2-60grad")) (princ (ssg-text "vfl-opt1-90grad")) (setq kwinkel (vfl-menu-winkel (ssg-text "vfl-prompt-wahl-winkel-30-60-90") (list (ssg-text "vfl-opt3-30grad") (ssg-text "vfl-opt2-60grad") (ssg-text "vfl-opt1-90grad")) *vfk-gf-bogen-winkel* 90 "vfl-variokurve-winkel-header")) (princ (ssg-text "vfl-variokurve-seite-header")) (princ (ssg-text "gf-seite-links")) (princ (ssg-text "gf-seite-rechts")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "vfl-variokurve-seite-header")) (setq kseite (if (= antwort "2") "rechts" "links")) (princ (ssg-text "vfl-variokurve-variante-header")) (princ (ssg-text "vfl-variante-aussen")) (princ (ssg-text "vfl-variante-innen")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-variante-aussen") (ssg-text "vfl-variante-innen")) 2 "vfl-variokurve-variante-header")) (setq kvariante (if (= antwort "1") "aussen" "innen")) (vfl-insert-vario-kurve-block frame kwinkel kseite kvariante) ) ;; ============================================================ ;; TEIL 3: KETTENANFANG (AS) / KETTENENDE (ES) ;; ============================================================ ;; AS-Element am Kettenanfang. Wird IMMER FLACH eingefuegt (KS_EIN ohne ;; Neigung) - per Einzel-Insert-Test in BricsCAD bestaetigt (2026-07-24): ;; das AS-Element selbst hat keine Neigung, die Neigung beginnt erst im ;; nachfolgenden GF-Koerper (vfl-insert-gf-segment). typ/winkel sind aus ;; Call-Kompatibilitaet weiterhin Parameter, werden aber fuer die AS-eigene ;; Ausrichtung nicht mehr verwendet (KEIN vertikaler Tilt mehr, unabhaengig ;; vom folgenden Segmenttyp). ;; Rueckgabe: Frame am AS-Ausgang (KS_AUS). (defun vfl-insert-as-element (typ startpunkt hz winkel as-seite / ein-hz-as rad-h xu-ein as-turn) ;; Schwenk aus dem Block messen -> KS_EIN so drehen, dass KS_AUS entlang hz ;; zeigt (Grundriss-Versatz des 30-Grad-Elements bleibt beruecksichtigt). (setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite))) (setq ein-hz-as (- hz as-turn)) (setq rad-h (* (float ein-hz-as) (/ pi 180.0))) (setq xu-ein (list (cos rad-h) (sin rad-h) 0.0)) (insert-block-mixed-to-ks (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite) (make-frame-from-dir startpunkt xu-ein) (caddr startpunkt) nil "KS_EIN") ) ;; Kettenanfang-Baustein: falls as-vorhanden, AS-Element einfuegen und die ;; GF/VF-Restlaenge um den tatsaechlichen AS-Fussabdruck kuerzen. Falls NICHT ;; as-vorhanden (Nutzer hat "Kein AS-Element" gewaehlt), beginnt die Kette ;; direkt am Startpunkt - deltaL bleibt die gemessene Rohlaenge (kein ;; Fussabdruck abzuziehen). Rueckgabe: (frame deltaL). ;; ;; deltaL kommt als reine, bereits auf hz-neu projizierte Distanz vom ;; UNVERAENDERTEN p-aktuell herein (siehe vfl-in-abstand/vfl-neue-linie- ;; messen - dort wird NIE mehr ein absoluter Punkt gefuehrt). Der reale ;; AS-Austritt (car frame) liegt exakt auf derselben Achse hz-neu (das ;; AS-Element wird flach IN hz-neu eingefuegt, siehe vfl-insert-as-element) - ;; die noetige Restlaenge ist damit einfach die urspruengliche Distanz MINUS ;; die tatsaechliche (gemessene) AS-Fussabdrucklaenge, keine Punkt-Projektion ;; noetig (Ersatz fuer das fruehere vfl-projiziere-distanz auf pick-punkt). (defun vfl-kettenanfang-baustein (p-aktuell hz-neu deltaL as-seite as-vorhanden / frame fussabdruck) (if as-vorhanden (progn (setq frame (vfl-insert-as-element "GF" p-aktuell hz-neu 0.0 as-seite)) (setq fussabdruck (vfl-planar-dist p-aktuell (car frame))) (setq deltaL (- deltaL fussabdruck)) (princ (ssg-textf "vfl-info-as-eingefuegt" (list (rtos deltaL 2 1)))) ) (progn (setq frame (make-frame-from-dir p-aktuell (hz-winkel->xu hz-neu 0.0))) (princ (ssg-text "vfl-info-kein-as")) ) ) (list frame deltaL) ) ;; ES-Winkel (30/90) + Seite erst am Kettenende abfragen. Setzt *vfl-es-winkel* ;; und die ES-Masse (ein-dx/dz) fuer die Variante. Rueckgabe: Seite (links/rechts). ;; ;; Das ES-Element bekommt einen EIGENEN STEP-Marker "ES" (vfl-journal-mark), ;; obwohl es nicht in einem eigenen Hauptschleifen-Durchlauf, sondern am Ende ;; des letzten Segments gebaut wird. Damit wird ES zu einem regulaeren "Glied" ;; und ist ueber die bestehende Glied-Maschinerie (vfl-journal-glieder/-slice/ ;; -splice) genauso editierbar wie ein GF-Bogen - ohne fehleranfaelligen ;; Tail-Sonderfall. Der Marker steht VOR den beiden ES-Eingaben (Winkel, Seite), ;; sodass diese als Glied-Inhalt darauf folgen. Beim Replay wird der Marker in ;; vfl-replay-pop automatisch uebersprungen; die beiden STR-Werte poppen danach ;; regulaer. ;; ES-Masse setzen (kein Bau, nur Globals): Winkel merken und die ;; ein-dx/ein-dz-Masse des ES-Elements laden. Aus der Frage-Schale gezogen, ;; damit der Daten-Pfad sie ohne Frage setzen kann. ;; *vfl-es-winkel* wird LAZY von den Blocknamen-Bauern gelesen (vfl-es-winkel ;; weiter oben) - es MUSS also vor dem ersten ES-Insert stehen, sonst waehlt ;; der Bau den falschen Block. (defun vfl-es-masse-setzen (winkel seite) (setq *vfl-es-winkel* winkel) (vf-set-es-masse winkel seite) seite) (defun vfl-frage-es-seite ( / antwort es-seite) (vfl-journal-mark "ES") (if (vfl-wizard-aktiv) (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")))) (setq *vfl-es-winkel* (vfl-in-value "STR" (function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite (princ (ssg-text "gf-seite-ein-header")) (princ (ssg-text "gf-seite-links")) (princ (ssg-text "gf-seite-rechts")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "gf-seite-ein-header")) (setq es-seite (if (= antwort "2") "rechts" "links")) (vfl-es-masse-setzen *vfl-es-winkel* es-seite) es-seite ) ;; Separator (300mm) an der aktuellen Stelle einfuegen (bei 3-Grad-Neigung, ;; Frame-Kettung ueber KS). Rueckgabe: neuer Frame am Separator-Ausgang. ;; Genutzt fuer den optionalen Zwischen-Separator zwischen zwei Foerderern. (defun vfl-insert-separator (frame / hz w sep-endpunkt) (setq hz (car (frame->hz-winkel frame))) (setq w (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (setq sep-endpunkt (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" (car frame) hz w *vfk-separator-laenge* 0)) (setq *vfl-acc-separator* (1+ *vfl-acc-separator*)) (make-frame-from-dir sep-endpunkt (hz-winkel->xu hz w)) ) ;; ES-Element am Kettenende: Separator (300mm) + ES-Element. ;; typ="GF": Neigung = winkel des GF-Segments. ;; typ="VF": Neigung = 3 Grad (Auslauf einer VF-Einheit endet auf 3 Grad). ;; Das ES-Element wird rein per KS-zu-KS an den Separator angekettet ;; (`insert-block-ks-to-ks`) - sein KS_EIN folgt exakt dem Separator-Ausgang ;; (Position + Neigung). KEIN Z-Ziel (anders als im Standalone-Gefaelle, wo eine ;; feste Endhoehe erzwungen wird): der Linienzug laeuft frei aus, ein Z-Ziel ;; wuerde die ES-Hoehe kuenstlich verschieben -> Versatz. hoehe-ziel wird daher ;; hier nicht mehr verwendet (bleibt fuer Signatur-Kompatibilitaet). (defun vfl-insert-es-element (typ frame hz winkel hoehe-ziel es-seite / w-eff sep-endpunkt sep-frame) (setq w-eff (if (= typ "GF") winkel (ssg-cfg-or "vario" "gefaelle_winkel" 3))) (setq sep-endpunkt (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" (car frame) hz w-eff *vfk-separator-laenge* 0)) (setq sep-frame (make-frame-from-dir sep-endpunkt (hz-winkel->xu hz w-eff))) (if (boundp '*vfl-acc-separator*) (setq *vfl-acc-separator* (1+ *vfl-acc-separator*))) ; Separator vor ES (insert-block-ks-to-ks (strcat "ES_Element_" (vfl-es-winkel) "_" es-seite) sep-frame) ) ;; ============================================================ ;; TEIL 4: BLOCK-ERSTELLUNG (Nummerierung + Attribute) ;; ============================================================ (defun vfl-block-erstellen (vfl-nummer anzahl-gf anzahl-vf hoehe-von hoehe-bis delta-l-total as-seite es-seite startpunkt lastEnt / vfl-bname vfl-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"). ;; Rueckgabe: (frame anzahl-koerper ende-flag es-seite-oder-nil). ;; Soll-Ist-Vergleich am Kettenende ausgeben (Zielpunkt aus dem ;; Modus-1-Zielmodus, gesetzt in vfl-body-abschluss). Stand vorher zweimal ;; wortgleich im Abschluss - einmal fuer "Kettenende ohne ES", einmal fuer ;; "Kettenende mit ES"; die Faelle unterscheiden sich nur darin, WANN sie ;; gemeldet werden, nicht WAS. ;; Loescht *vfl-ziel-punkt* danach: der Report gehoert zu genau einem ;; Kettenende, ein zweiter Aufruf soll nichts mehr melden. (defun vfl-ziel-report (frame) (if *vfl-ziel-punkt* (progn (princ (ssg-text "vfl-ist-ziel-vergleich-header")) (princ (ssg-textf "vfl-soll-xyz" (list (rtos (car *vfl-ziel-punkt*) 2 1) (rtos (cadr *vfl-ziel-punkt*) 2 1) (rtos (caddr *vfl-ziel-punkt*) 2 1)))) (princ (ssg-textf "vfl-ist-xyz" (list (rtos (car (car frame)) 2 1) (rtos (cadr (car frame)) 2 1) (rtos (caddr (car frame)) 2 1)))) (princ (ssg-textf "vfl-abweichung-xyz" (list (rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1) (rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1) (rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1)))) (setq *vfl-ziel-punkt* nil))) (princ)) (defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF auto-ende / antwort res es-s ende es-gewuenscht) ;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf. (princ (ssg-text "vfl-gf-verteilung-header")) (princ (ssg-text "vfl-gf-verteilung-haelfte")) (princ (ssg-text "vfl-gf-verteilung-ganz-einlauf")) (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"))) (setq frame (nth 0 res) es-gewuenscht (nth 3 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")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-ja-separator-es") (ssg-text "vfl-nein-weiterbauen")) 2 "vfl-ist-kettenende-frage")) ) ) ) (cond ((= antwort "kein-es") (setq ende t) ;; Ist-Ziel-Report auch ohne ES (Vergleich Soll-Zielpunkt vs. tatsaechliches ;; Kettenende nach GF2/Motor). (vfl-ziel-report frame) ) ((= antwort "1") (setq es-s (vfl-frage-es-seite)) (setq frame (vfl-insert-es-element "VF" frame (car (frame->hz-winkel frame)) 0.0 (caddr (car frame)) es-s)) (setq ende t) ;; Ist-Ziel-Report (Option 3): Soll-ES (aus vfl-body-abschluss) vs. Ist-ES. (vfl-ziel-report frame) ) (t (princ (ssg-text "vfl-sep-an-stelle-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-nein")) (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 as-vorhanden erg old-error vfl-ins dbg-an hoehe-vorschlaege hoehe-ab hoehe-auf hoehe-fallback) (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. ;; *ssg-ils-dim*: der Editier-/Konverter-Pfad setzt vor dem Replay einen ;; Dimensions-Override und raeumt ihn NACH der Rueckkehr wieder ab. Bei einem ;; Abbruch kehrt der Aufruf nie dorthin zurueck (der Handler beendet den ;; Befehl), daher MUSS der Override hier zurueckgesetzt werden - sonst bliebe ;; er fuer den Rest der Sitzung stehen und alle folgenden Einfuegungen liefen ;; in der falschen Dimension. (setq *error* (function (lambda (msg) (setq *error* old-error) (setq *ssg-ils-dim* nil) (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 (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 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-linie-gf-1")) (princ (ssg-text "vfl-menu-linie-vf-2")) (princ (ssg-text "vfl-menu-horizontal-vf-3")) (princ (ssg-text "vfl-menu-linie-ende-4")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-4-def1") (list (ssg-text "vfl-menu-linie-gf-1") (ssg-text "vfl-menu-linie-vf-2") (ssg-text "vfl-menu-horizontal-vf-3") (ssg-text "vfl-menu-linie-ende-4")) 1 "vfl-naechstes-element-header")) (setq wahl (cond ((= antwort "2") "Linie-VF") ((= antwort "3") "Horizontal-VF") ((= antwort "4") (setq linie-ende-modus t) "Linie") (t "Linie-GF"))) ; "1" oder leer ) ) ;; Segmenttyp steht fest -> Glied-Label nachtragen (fuer die Edit-Liste). (vfl-journal-steplabel wahl) (progn (cond ((= wahl "GF-Bogen") (setq frame (vfl-insert-gf-bogen frame)) (setq p-aktuell (car frame)) ) ;; --- 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)) ) ) (if (< deltaL *vfk-vf-mindestlaenge*) (progn (princ (ssg-text "vfl-fehler-horizontal-vf-kurz")) (if dbg-an (dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Horizontal-VF zu kurz (deltaL=" (rtos deltaL 2 0) ")")))) (progn ;; VF-Einheit mit horizontalem ersten Koerper (winkel=0, L_VF=deltaL, ;; L_GF = Mindestlaenge fuer den Einlauf-Anschluss). (if dbg-an (dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss horizontal (deltaL=" (rtos deltaL 2 0) " L_GF=" (rtos *vfl-gf-min-laenge* 2 0) " L_VF=" (rtos deltaL 2 0) ")"))) (setq vf-einheit-res (vfl-vf-einheit-abschluss frame hz-neu "Ab" 0 *vfl-gf-min-laenge* deltaL nil)) (setq frame (nth 0 vf-einheit-res)) (setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res))) (if (nth 2 vf-einheit-res) (setq fertig t)) (if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res))) (setq letzter-typ "VF") (setq p-aktuell (car frame)) (if dbg-an (dbgmsg (strcat "GEOMETRIE ERFOLG: Horizontal-VF-Einheit gebaut, neue Position=" (dbg-tostring p-aktuell)))) ) ) ) ;; --- Neue Linie: GF (Nutzer legt den Typ explizit fest) --- ((= wahl "Linie-GF") ;; 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)) (setq gf-max-winkel (float (ssg-cfg-or "vario" "gefaelle_winkel" 3))) (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) (if (vfl-wizard-aktiv) (vl-catch-all-apply 'vflw-gruppe-gefaelle-impl (list (vfl-gf-hoehe-vorschlag (caddr p-aktuell))))) (princ (ssg-text "vfl-gefaelle-festlegen-header")) (princ (ssg-text "vfl-gefaelle-opt-hoehe")) (princ (ssg-text "vfl-gefaelle-opt-winkel")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "vfl-gefaelle-opt-hoehe") (ssg-text "vfl-gefaelle-opt-winkel")) 1 "vfl-gefaelle-festlegen-header")) (if (= antwort "2") (progn ;; Winkel direkt vorgeben - deltaH ergibt sich aus deltaL*tan(winkel). (setq winkel (vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel" (list (rtos gf-max-winkel 2 1))))) (if (null winkel) (setq winkel gf-max-winkel)) (if (or (<= winkel 0.0) (> winkel gf-max-winkel)) (progn (vfl-meldung (ssg-textf "vfl-alert-winkel-ungueltig" (list (rtos winkel 2 1) (rtos gf-max-winkel 2 1)))) (setq gf-ok nil)) (progn (setq richtung "Ab") (setq deltaH (* deltaL (/ (sin (* winkel (/ pi 180.0))) (cos (* winkel (/ pi 180.0)))))) ) ) ) (progn ;; Gegebene Hoehe - 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)) (cond ((= richtung "Auf") (vfl-meldung (ssg-text "vfl-alert-gf-kann-nicht-steigen")) (if dbg-an (dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-GF kann nicht steigen" " (deltaL=" (rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0) ")"))) (setq gf-ok nil)) (t (setq winkel (* (atan (/ deltaH deltaL)) (/ 180.0 pi))) (if (> winkel gf-max-winkel) (progn (vfl-meldung (ssg-textf "vfl-alert-gefaelle-zu-steil" (list (rtos winkel 2 1) (rtos gf-max-winkel 2 1)))) (if dbg-an (dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-GF zu steil (deltaL=" (rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0) " winkel=" (rtos winkel 2 1) " max=" (rtos gf-max-winkel 2 1) ")"))) (setq gf-ok nil)) ) ) ) ) ) (if gf-ok (progn (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)))) (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")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3") (list (ssg-text "vfl-kettenende-opt-ja-es") (ssg-text "vfl-kettenende-opt-ja-ohne-es") (ssg-text "vfl-kettenende-opt-nein")) 3 "vfl-ist-kettenende-header")) (cond ((= antwort "1") (setq es-seite (vfl-frage-es-seite)) (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 (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 (vfl-meldung (ssg-textf "vfl-alert-vf-nicht-baubar" (list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung))) (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)) (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 (vfl-meldung (ssg-textf "vfl-alert-segment-nicht-baubar" (list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung))) (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") (progn (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")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3") (list (ssg-text "vfl-kettenende-opt-ja-es") (ssg-text "vfl-kettenende-opt-ja-ohne-es") (ssg-text "vfl-kettenende-opt-nein")) 3 "vfl-ist-kettenende-header")) ) ) (cond ((= antwort "1") (setq es-seite (vfl-frage-es-seite)) (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)) (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")) (start_list "winkel") (add_list (ssg-text "vfl-winkel-30")) (add_list (ssg-text "vfl-winkel-60")) (add_list (ssg-text "vfl-winkel-90")) (end_list) ;; Winkel 30/60/90 -> Listenposition 0/1/2 (set_tile "winkel" (itoa (- (length *vfk-gf-bogen-winkel*) (length (member vor-winkel *vfk-gf-bogen-winkel*))))) (start_list "seite") (add_list (ssg-text "gf-seite-links")) (add_list (ssg-text "gf-seite-rechts")) (end_list) (set_tile "seite" (if (= vor-seite-code "2") "1" "0")) (action_tile "accept" "(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (list (nth (atoi gwinkel) *vfk-gf-bogen-winkel*) ; Listenposition 0/1/2 -> 30/60/90 (if (= gseite "1") "2" "1")) ; Liste 0=links/1=rechts -> code "1"/"2" nil)))) ;; Pre-fill-faehiger Winkel+Seite+Variante-Dialog fuer die Vario-Kurve (nutzt ;; das bestehende vflw_variokurve-Tile mit Vorbelegung). Wizard-Optionsreihen- ;; folge: Winkel (30 60 90), Seite (links rechts), Variante (aussen innen) - ;; genau wie vflw-gruppe-variokurve-impl. vor-* sind die aktuellen Werte: ;; vor-winkel echter Wert 30/60/90, vor-seite-code/vor-variante-code je "1"/"2". ;; Rueckgabe: (winkel seite-code variante-code) oder nil bei Abbruch. (defun vfl-glied-vario-dialog (vor-winkel vor-seite-code vor-variante-code / dat dcl-pfad ergebnis gwinkel gseite gvariante) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl")) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog "vflw_variokurve" dat)) (progn (if (and dat (>= dat 0)) (unload_dialog dat)) (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil) (progn (set_tile "kopf" (ssg-text "vfl-variokurve-winkel-header")) (start_list "winkel") (add_list (ssg-text "vfl-opt3-30grad")) (add_list (ssg-text "vfl-opt2-60grad")) (add_list (ssg-text "vfl-opt1-90grad")) (end_list) ;; Winkel 30/60/90 -> Listenposition 0/1/2 (set_tile "winkel" (itoa (- (length *vfk-gf-bogen-winkel*) (length (member vor-winkel *vfk-gf-bogen-winkel*))))) (start_list "seite") (add_list (ssg-text "gf-seite-links")) (add_list (ssg-text "gf-seite-rechts")) (end_list) (set_tile "seite" (if (= vor-seite-code "2") "1" "0")) (start_list "variante") (add_list (ssg-text "vfl-variante-aussen")) (add_list (ssg-text "vfl-variante-innen")) (end_list) (set_tile "variante" (if (= vor-variante-code "2") "1" "0")) (action_tile "accept" "(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (setq gvariante (get_tile \"variante\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (list (nth (atoi gwinkel) *vfk-gf-bogen-winkel*) ; Listenposition 0/1/2 -> 30/60/90 (if (= gseite "1") "2" "1") ; Liste 0=links/1=rechts -> "1"/"2" (if (= gvariante "1") "2" "1")) ; Liste 0=aussen/1=innen -> "1"/"2" nil)))) ;; Pre-fill-faehiger Winkel+Seite-Dialog fuer AS/ES-Element: nur ZWEI ;; Winkel-Optionen (90/30, in genau dieser Listen-Reihenfolge - wie ;; vf-frage-element-winkel/vflw-gruppe-winkel-seite-impl), Winkel als STRING ;; "90"/"30" (nicht Index). kopf-key waehlt die Kopfzeile (AS: vf-winkel-aus- ;; header, ES: vf-winkel-ein-header). Rueckgabe: (winkel-str seite-code) oder ;; nil bei Abbruch. seite-code "1"=links / "2"=rechts. (defun vfl-glied-as-es-dialog (kopf-key vor-winkel-str vor-seite-code / dat dcl-pfad ergebnis gwinkel gseite) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl")) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog "vflw_winkel_seite" dat)) (progn (if (and dat (>= dat 0)) (unload_dialog dat)) (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil) (progn (set_tile "kopf" (ssg-text kopf-key)) (start_list "winkel") (add_list (ssg-text "vf-winkel-90")) (add_list (ssg-text "vf-winkel-30")) (end_list) (set_tile "winkel" (if (= vor-winkel-str "30") "1" "0")) ; Liste 0=90/1=30 (start_list "seite") (add_list (ssg-text "gf-seite-links")) (add_list (ssg-text "gf-seite-rechts")) (end_list) (set_tile "seite" (if (= vor-seite-code "2") "1" "0")) (action_tile "accept" "(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (list (if (= gwinkel "1") "30" "90") ; Liste 0=90/1=30 -> "90"/"30" (if (= gseite "1") "2" "1")) ; Liste 0=links/1=rechts -> "1"/"2" 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 ;; Fehlgeschlagene Konvertierung NICHT stumm verschlucken: der alte Block ;; ist per entdel schon weg, die Teil-Geometrie liegt frei in der ;; Zeichnung (der *error*-Handler in vf-linienzug-modus kann hier nicht ;; greifen, weil vl-catch-all-apply den Abbruch vorher abfaengt - das ist ;; hier gewollt, damit die Batch-Schleife weiterlaeuft). Meldung mit ;; Blockname, damit der betroffene Block auffindbar bleibt. (if (vl-catch-all-error-p ok) (progn (princ (ssg-textf "vfl-konvert-fehler" (list bname (vl-catch-all-error-message ok)))) nil) T)) nil)) (defun vfl-edit-ent (ent / xd marker journal glieder glieder-alle has-as n i pos trunc edit-modus dim) (setq xd (vfl-journal-xdata-lesen ent)) (if (null xd) (progn (alert (ssg-text "vfl-edit-kein-journal")) (exit))) (setq marker (car xd) journal (cdr xd)) ;; Dimension des Bestandsblocks merken, damit der Doppelklick-Neubau ;; dimensionstreu bleibt (sonst baut er in der globalen DXFM_DIM, weil beim ;; Doppelklick kein *ssg-ils-dim*-Override aktiv ist). Wird VOR dem entdel ;; gelesen; der Override greift beim anschliessenden Replay/Weiterbau. (setq dim (ssg-dim-xdata-lesen ent)) (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) ;; WICHTIG: DIREKTER Aufruf, KEIN vl-catch-all-apply! ;; Der Neuaufbau ist interaktiv - bricht der Nutzer ihn ab (ESC -> ;; (exit) im Bau-Ablauf), MUSS der *error*-Handler in ;; vf-linienzug-modus laufen und die bis dahin gebaute Teil-Geometrie ;; zu einem VF_n-Block wickeln. Ein vl-catch-all-apply faengt den ;; Abbruch VOR *error* ab: der Handler kaeme nie zum Zug, der alte ;; Block ist durch das entdel oben aber schon weg - die ganze Kette ;; bliebe als loses Einzelteil-Haufen ohne Block in der Zeichnung ;; liegen (nicht mehr per Doppelklick editierbar). Genau das war der ;; Fehler "VF-Block aufgebrochen". ;; Das Abraeumen des Dim-Overrides uebernimmt im Abbruchfall der ;; Handler selbst (dort ebenfalls (setq *ssg-ils-dim* nil)), denn ;; die naechste Zeile wird dann nicht mehr erreicht. (vf-linienzug-modus) (setq *ssg-ils-dim* nil))))) (princ)) ;; 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) ;; DIREKTER Aufruf, KEIN vl-catch-all-apply - identische Begruendung wie im ;; Sektions-Zweig von vfl-edit-ent (siehe dortiger Kommentar): der alte Block ;; ist per entdel schon weg, bei einem Abbruch muss der *error*-Handler von ;; vf-linienzug-modus2 die Teil-Geometrie wickeln. Den Dim-Override raeumt im ;; Abbruchfall der Handler ab. (vf-linienzug-modus2) (setq *ssg-ils-dim* nil) (princ)) ;; ============================================================ ;; RECOVERY: Kette aus der Sektions-XDATA der Zeichnung neu aufbauen ;; ============================================================ ;; Wofuer: bleibt eine Linienzug-Kette als LOSE Geometrie ohne VF_n-Block in ;; der Zeichnung liegen (der Block war schon per entdel weg, der Neuaufbau ;; wurde abgebrochen und konnte nicht gewickelt werden), ist sie nicht mehr per ;; Doppelklick editierbar. Die Eingaben sind aber nicht verloren: jedes Entity ;; traegt den Journal-Abschnitt der Iteration, in der es entstand ;; (SSG_VF_EDIT_SEG, indiziert mit dem ERSTEN Glied-Index darin - siehe ;; vfl-segment-xdata-sichern), und die Entities der ersten Iteration ;; zusaetzlich die Praeambel (SSG_VF_EDIT_PRE). Daraus laesst sich das ;; Ketten-Journal zusammensetzen und die Kette identisch neu bauen - diesmal ;; sauber als VF_n-Block mit Ketten-XDATA. ;; ;; Quelle ist AUSSCHLIESSLICH die Zeichnung selbst. Die .dbg-Dateien sind ;; reine Ausgabe und werden hier bewusst NICHT gelesen (sie werden bei jedem ;; Lauf neu angelegt, siehe dbgopen). ;; ;; Ablauf: Geometrie waehlen -> Sektionen sammeln und nach Glied-Index sortieren ;; -> Journal (Praeambel + Glieder 1..k) stumm abspielen -> danach normal ;; weiterbauen. Die alte Geometrie wird erst NACH einem erfolgreichen Neuaufbau ;; geloescht (bricht der Neuaufbau ab, bleibt sie samt ihrer XDATA stehen und ;; der Versuch ist wiederholbar). ;; Praeambel interaktiv erfragen - nur fuer Altbestand ohne SSG_VF_EDIT_PRE ;; (Ketten, die vor der Einfuehrung der Praeambel-XDATA gebaut wurden). ;; Reihenfolge/Arten MUESSEN dem Kopf von vf-linienzug-modus entsprechen: ;; PT (Startpunkt), REAL (Starthoehe), STR (AS ja="1"/nein="2") und bei AS ;; zusaetzlich STR (Winkel "30"/"90") + STR (Seite links="1"/rechts="2"). ;; Rueckgabe: Praeambel-Journal oder nil (Abbruch). (defun vfl-praeambel-erfragen ( / p h as w s out) (princ (ssg-text "vfl-restore-keine-praeambel")) (setq p (getpoint (ssg-text "vfl-prompt-startpunkt-kette"))) (if (null p) nil (progn (setq h (getreal (ssg-textf "vfl-prompt-hoehe-startpunkt-kette" (list (rtos (caddr p) 2 1))))) (if (null h) (setq h (caddr p))) (initget "Ja Nein") (setq as (getkword (ssg-text "vfl-restore-frage-as"))) (if (null as) (setq as "Ja")) (setq out (list (cons "PT" p) (cons "REAL" h) (cons "STR" (if (= as "Nein") "2" "1")))) (if (/= as "Nein") (progn ;; gleiche Frage wie im Bau-Ablauf (liefert "30"/"90") (setq w (vf-frage-element-winkel "vf-winkel-aus-header")) (initget "Links Rechts") (setq s (getkword (ssg-text "vfl-restore-frage-as-seite"))) (if (null s) (setq s "Links")) (setq out (append out (list (cons "STR" w) (cons "STR" (if (= s "Rechts") "2" "1"))))))) out))) ;; Sektionen aus einer Auswahl sammeln. Rueckgabe: Liste (idx . slice), ;; aufsteigend nach idx, jeder Index nur EINMAL (alle Entities eines Gliedes ;; tragen dieselbe Slice). (defun vfl-sektionen-sammeln (ss / i n ent seg idx out) (setq out '() i 0 n (sslength ss)) (while (< i n) (setq ent (ssname ss i)) (setq seg (vfl-journal-xdata-lesen-seg ent)) (if seg (progn (setq idx (car seg)) (if (not (assoc idx out)) (setq out (cons (cons idx (cdr seg)) out))))) (setq i (1+ i))) (vl-sort out (function (lambda (a b) (< (car a) (car b)))))) ;; Praeambel aus der Auswahl lesen (erstes Entity, das eine traegt). (defun vfl-praeambel-sammeln (ss / i n pre) (setq i 0 n (sslength ss) pre nil) (while (and (< i n) (null pre)) (setq pre (vfl-journal-xdata-lesen-pre (ssname ss i))) (setq i (1+ i))) pre) (defun c:VF_SEKTION_RESTORE ( / ss sektionen pre journal teile k erwartet luecke i n sek e alt-liste) (princ (ssg-text "vfl-restore-prompt-auswahl")) (setq ss (ssget)) (cond ((null ss) (princ (ssg-text "vfl-abgebrochen"))) ((null (setq sektionen (vfl-sektionen-sammeln ss))) (princ (ssg-text "vfl-restore-keine-sektionen"))) (t ;; Sektionen aneinanderhaengen, solange sie LUECKENLOS ab Glied 1 ;; anschliessen. Ein Sektions-Record ist mit dem Index seines ERSTEN ;; Gliedes abgelegt und kann mehrere Glieder enthalten (VF-Einheit mit ;; Vario-Kurven) - der naechste erwartete Index ist daher ;; erster-Index + Anzahl der Glieder darin, nicht einfach +1. ;; Bei einer Luecke wird nur der Anfang wiederhergestellt: ein fehlendes ;; Glied in der Mitte wuerde alle folgenden an die falsche Position setzen. (setq teile '() k 0 erwartet 1 luecke nil) (foreach sek sektionen (if (and (not luecke) (= (car sek) erwartet)) (progn (setq teile (cons (cdr sek) teile)) (setq k (+ k (vfl-steps-zaehlen (cdr sek)))) (setq erwartet (1+ k))) (setq luecke t))) (if luecke (princ (ssg-textf "vfl-restore-luecke" (list (itoa erwartet) (itoa k))))) (if (= k 0) (princ (ssg-text "vfl-restore-keine-sektionen")) (progn ;; Praeambel: aus der Zeichnung, sonst erfragen (Altbestand ohne ;; SSG_VF_EDIT_PRE). (setq pre (vfl-praeambel-sammeln ss)) (if (null pre) (setq pre (vfl-praeambel-erfragen))) (if (null pre) (princ (ssg-text "vfl-abgebrochen")) (progn (setq journal (apply 'append (cons pre (reverse teile)))) (princ (ssg-textf "vfl-restore-gefunden" (list (itoa k) (itoa (length journal))))) ;; Enames der alten Geometrie merken - geloescht wird ERST nach ;; einem erfolgreichen Neuaufbau (siehe unten). (setq alt-liste '() i 0 n (sslength ss)) (while (< i n) (setq alt-liste (cons (ssname ss i) alt-liste)) (setq i (1+ i))) ;; Neu bauen. DIREKTER Aufruf: bricht der Bau ab, wickelt der ;; *error*-Handler in vf-linienzug-modus den Zwischenstand zu ;; einem Block - und die Zeilen danach (Loeschen) laufen NICHT ;; mehr. Die alte Geometrie samt ihrer Sektions-XDATA bleibt also ;; erhalten und der Versuch ist wiederholbar. (vfl-journal-replay-start journal) (vf-linienzug-modus) ;; Erfolg: alte lose Geometrie entfernen. Sie liegt VOR lastEnt und ;; ist deshalb nicht im neuen Block gelandet (vgl. ;; vfl-block-erstellen), wuerde aber deckungsgleich darunter ;; liegenbleiben. (foreach e alt-liste (if e (entdel e))) (princ (ssg-textf "vfl-restore-geloescht" (list (itoa (length alt-liste))))))))))) (princ)) ;; DCL-Dialog nach Doppelklick: Editier-Modus waehlen. ;; n = Anzahl Glieder (nur fuer die Kopfzeile). Vorbelegung "rueck" (das ;; bisherige Verhalten, geringste Ueberraschung). Rueckgabe: "rueck", "glied" ;; oder nil (Abbrechen/Escape). Bei fehlendem/kaputtem DCL faellt der Dialog ;; auf "rueck" zurueck (statt die Bearbeitung ganz zu blockieren) - so bleibt ;; der bestehende Editierpfad auch dann erreichbar. (defun vfl-dlg-modus (n / dcl-pfad dat wahl ergebnis) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit_modus.dcl")) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog "vfl_edit_modus" dat)) (progn (if dat (unload_dialog dat)) (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) "rueck") ; Fallback: bisheriges Verhalten (progn ;; Nur der Kopftext wird zur Laufzeit gesetzt; die Optionslabels stehen ;; statisch (deutsch) im DCL - siehe vfl_edit_modus.dcl. get_tile "modus" ;; liefert den key des gewaehlten radio_button. Default "modus_rueck" ist ;; im DCL per value="1" vorbelegt. (set_tile "kopf" (ssg-textf "vfl-dlg-modus-kopf" (list (itoa n)))) (action_tile "accept" "(setq wahl (get_tile \"modus\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (cond ((/= ergebnis 1) nil) ((= wahl "modus_glied") "glied") (t "rueck"))))) ; modus_rueck (o. leer) = zuruecksetzen ;; DCL-Dialog: Sektion waehlen, auf die die Kette zurueckgesetzt wird. ;; glieder = Liste der Glied-Labels (interne Tokens, vfl-journal-glieder), in ;; Bau-Reihenfolge. Vorbelegung auf den letzten Eintrag (voller Stand = reines ;; Fortsetzen ohne Kuerzung). Rueckgabe: gewaehlte Position (1-basiert) oder ;; nil bei Abbrechen/Escape. (defun vfl-dlg-position (glieder / n dcl-pfad dat idx ergebnis i) (setq n (length glieder)) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit.dcl")) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog "vfl_edit" dat)) (progn (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil) (progn (set_tile "kopf" (ssg-textf "vfl-dlg-kopf-sektionen" (list (itoa n)))) (start_list "position") (setq i 1) (foreach g glieder (add_list (strcat (itoa i) " - " (vfl-glied-label-text g))) (setq i (1+ i))) (end_list) (set_tile "position" (itoa (1- n))) ; letzter Eintrag vorbelegt (0-basierter Index) (action_tile "accept" "(setq idx (atoi (get_tile \"position\"))) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (1+ idx) nil) ) ) ) ;; ============================================================ ;; DIAGNOSE: Blockstruktur (KS_EIN/KS_AUS) untersuchen ;; ============================================================ ;; Zeigt, wie ein Block intern aufgebaut ist - insbesondere, ob KS_EIN/KS_AUS ;; auf der ersten Explode-Ebene als Unterbloecke liegen und welche Laengen ihre ;; Achslinien haben (ks-line-axis erwartet X~1/~100, Y~2, Z~3). Damit laesst ;; sich klaeren, warum extract-ks-from-block bei den Vario_Kurve-Bloecken ;; "KS_EIN/KS_AUS fehlen" meldet. ;; Aufruf in BricsCAD: VFL_KS_DIAG -> Blockname eingeben. (defun c:VFL_KS_DIAG ( / bname obj subs s nm inner il ilnm ps pe len) (setq bname (getstring "\nBlockname fuer KS-Diagnose: ")) (setq bname (ensure-block-loaded bname)) (if (not (tblsearch "BLOCK" bname)) (progn (princ (strcat "\nBlock '" bname "' nicht gefunden.")) (exit))) (setq obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) bname 1.0 1.0 1.0 0)) (princ (strcat "\n==================================================")) (princ (strcat "\n=== Struktur von '" bname "' (Ebene 1) ===")) (setq subs (vlax-invoke obj 'Explode)) (foreach s subs (if (not (vlax-erased-p s)) (progn (setq nm (vla-get-ObjectName s)) (if (= nm "AcDbBlockReference") (progn (princ (strcat "\n BlockRef: '" (vla-get-Name s) "' (Ebene 2:)")) (setq inner (vlax-invoke s 'Explode)) (foreach il inner (if (not (vlax-erased-p il)) (progn (setq ilnm (vla-get-ObjectName il)) (cond ((= ilnm "AcDbLine") (setq ps (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint il)))) (setq pe (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint il)))) (setq len (vec-length (list (- (car pe)(car ps)) (- (cadr pe)(cadr ps)) (- (caddr pe)(caddr ps))))) (princ (strcat "\n Line len=" (rtos len 2 3) " axis=" (if (ks-line-axis len) (ks-line-axis len) "?")))) ((= ilnm "AcDbBlockReference") (princ (strcat "\n BlockRef(verschachtelt): '" (vla-get-Name il) "'"))) (t (princ (strcat "\n " ilnm))) ) (vla-Delete il) ) ) ) ) (princ (strcat "\n " nm)) ) (vla-Delete s) ) ) ) (princ "\n=== Ende Diagnose ===") (princ "\n==================================================") (princ) ) ;; ============================================================ ;; REGISTRIERUNG ;; ============================================================ ;; berechne-fn/einfuege-fn werden fuer "linienzug" NICHT im normalen Schema ;; verwendet (eigener Befehlsablauf, siehe Kommentar am Dateianfang) - beide ;; sind daher nur Platzhalter, die c:VarioFoerderer nie aufruft (Dispatch ;; erfolgt dort direkt auf vf-linienzug-modus). (defun vfl-berechne-platzhalter (deltaL deltaH richtung seite) (princ "\n[vf_linienzug] FEHLER: berechne-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.") (list nil nil nil nil) ) (defun vfl-einfuege-platzhalter (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz) (princ "\n[vf_linienzug] FEHLER: einfuege-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.") startpunkt ) ;; ============================================================ ;; MODUS 2: 3D-OBJEKTE WAEHLEN (Meilenstein 1 - GF-Teil) ;; ============================================================ ;; Baut die Kette aus einem GEZEICHNETEN Pfad (LINE/ARC). Ablauf: ;; Objekte waehlen -> gf-sortiere-objekte -> gf-analysiere-kette ;; -> Eck-Winkel-Vorpruefung -> segmentweise (Variante B) live bauen -> ES. ;; In diesem Meilenstein ist NUR der GF-Teil aktiv (GF-Gerade mit eigener ;; Neigung <=3 Grad, GF-Bogen). Die VF-Zweige sind als TODO (Meilenstein 2) ;; markiert und werden uebersprungen. ;; Bekannte Naeherungen (in BricsCAD verifizieren): ;; - Eck-Trimmung nur an erster/letzter Geraden (-aus-dx bzw. -300-ein-dx, ;; wie gf-linienzug-modus); Separatoren VOR GF-Boegen noch NICHT gesetzt. ;; - GF-Bogen hat feste Eigen-Neigung -> bei unterschiedlichen Nachbar- ;; Neigungen entsteht ein (akzeptierter) Knick. ;; Alle Eck-Winkel des Pfades gegen 30/60/90 Grad pruefen (Toleranz tol). ;; Rueckgabe: nil (alle ok) oder der erste abweichende Winkel (Grad). (defun vfl2-pruefe-eckwinkel (kette tol / item obj sa ea sweep bad) (setq bad nil) (foreach item kette (setq obj (car item)) (if (and (null bad) (= (vla-get-ObjectName obj) "AcDbArc")) (progn (setq sa (vla-get-StartAngle obj) ea (vla-get-EndAngle obj)) (setq sweep (if (>= ea sa) (- ea sa) (+ (- ea sa) (* 2.0 pi)))) (setq sweep (* sweep (/ 180.0 pi))) (if (not (or (< (abs (- sweep 30.0)) tol) (< (abs (- sweep 60.0)) tol) (< (abs (- sweep 90.0)) tol))) (setq bad sweep)) ) ) ) bad ) ;; AS-Element fuer Modus 2 (GF): gemischte Verankerung. ;; - Laengsrichtung (entlang hz): KS_EIN auf den Startpunkt (Laengsposition) ;; - Querrichtung (senkrecht hz): KS_AUS auf den Pfad (Kettenmittellinie) ;; Umsetzung: (1) AS mit KS_EIN am Startpunkt platzieren, (2) Querversatz des ;; KS_AUS zum Pfad messen, (3) AS senkrecht zu hz um -Versatz verschieben. ;; Ergebnis: KS_EIN.X = Startpunkt.X, KS_EIN quer um das AS-Y-Mass versetzt, ;; KS_AUS liegt exakt auf dem Pfad -> die ganze Kette folgt der Mittellinie. ;; Rueckgabe: (korrigierter) Frame am KS_AUS. ;; winkel-Parameter bleibt aus Call-Kompatibilitaet bestehen (vfl2-insert-as-vf ;; ruft mit 0.0), wird aber NICHT mehr fuer eine Kippung verwendet: das AS- ;; Element hat keine eigene Neigung (per Einzel-Insert-Test in BricsCAD ;; bestaetigt, siehe vfl-insert-as-element in Modus 1) - unabhaengig vom ;; folgenden Segmenttyp (GF/VF) wird es IMMER flach eingefuegt. (defun vfl2-insert-as-gf (startpunkt hz winkel as-seite / ein-hz-as rad-h xu-ein frame blk ks-aus rad-hz perp-x perp-y d-perp sx sy as-turn rad-ein de-x de-y de-dot-np t-shift) ;; Schwenk aus dem AS-Block MESSEN (30/90/gerade), KS_EIN so drehen, dass ;; KS_AUS entlang hz zeigt: ein-hz = hz - plan-turn. (setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite))) (setq ein-hz-as (- hz as-turn)) (setq rad-h (* (float ein-hz-as) (/ pi 180.0))) (setq xu-ein (list (cos rad-h) (sin rad-h) 0.0)) ;; (1) KS_EIN auf den Startpunkt (Laengsposition korrekt) (setq frame (insert-block-mixed-to-ks (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite) (make-frame-from-dir startpunkt xu-ein) (caddr startpunkt) "KS_EIN" "KS_EIN")) (setq blk (entlast)) ;; (2) Querversatz des KS_AUS zum Pfad (Einheits-Querrichtung senkrecht zu hz) (setq ks-aus (car frame)) (setq rad-hz (* (float hz) (/ pi 180.0))) (setq perp-x (- (sin rad-hz)) perp-y (cos rad-hz)) ; Normale zum Pfad (setq d-perp (+ (* (- (car ks-aus) (car startpunkt)) perp-x) (* (- (cadr ks-aus) (cadr startpunkt)) perp-y))) ;; (3) AS ENTLANG der KS_EIN-Achse verschieben (nicht senkrecht zum Pfad): ;; damit landet KS_AUS auf dem Pfad UND der Startpunkt bleibt auf der KS_EIN- ;; Achse. Beim 90-Grad-Element ist die KS_EIN-Achse senkrecht zum Pfad -> das ;; ist identisch zum bisherigen Querschub. (setq rad-ein (* (float ein-hz-as) (/ pi 180.0))) (setq de-x (cos rad-ein) de-y (sin rad-ein)) ; KS_EIN-Achsrichtung (setq de-dot-np (+ (* de-x perp-x) (* de-y perp-y))) (setq t-shift (if (> (abs de-dot-np) 1e-6) (/ d-perp de-dot-np) 0.0)) (setq sx (* (- t-shift) de-x) sy (* (- t-shift) de-y)) (if (> (abs t-shift) 1e-6) (vla-Move (vlax-ename->vla-object blk) (vlax-3D-point '(0.0 0.0 0.0)) (vlax-3D-point (list sx sy 0.0)))) ;; (4) korrigierten KS_AUS-Frame zurueckgeben (Richtung unveraendert) (list (list (+ (car ks-aus) sx) (+ (cadr ks-aus) sy) (caddr ks-aus)) (cadr frame) (caddr frame) (cadddr frame)) ) ;; VF-Start-AS (Modus 2): identische Platzierung wie beim GF-Start, aber FLACH ;; (0 Grad Neigung). Das AS wird mit KS_EIN auf den Startpunkt gesetzt und dann ;; senkrecht zu hz auf den Pfad geschoben (reine KS-Kettung, KS_AUS auf Pfad). ;; Damit liegt auch eine mit VF beginnende Kette auf dem gezeichneten Pfad. (defun vfl2-insert-as-vf (startpunkt hz as-seite) (vfl2-insert-as-gf startpunkt hz 0.0 as-seite)) ;; VF-Einheit OEFFNEN (Modus 2): GF1 (Basis-Staustrecke) + Separator + ;; Umlenkstation. Rueckgabe: Frame nach der Umlenkstation (Beginn reiner VF). (defun vfl2-vf-open (frame hz / f) (setq f (vfl-frame-3grad (vfs-vf-entry (car frame) *vfl-gf-min-laenge* hz) 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")))) (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 (vfl-meldung (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 (vfl-meldung (ssg-text "vfl-vwnb-alert-keine-gerade")) (exit))) ;; --- 6. Bau-Schleife (Meilenstein 2: GF + VF-Laeufe, Run-State-Machine) --- ;; run-typ: nil / "GF" / "VF". Beim Wechsel GF<->VF wird die VF-Einheit ;; geoeffnet (GF1+Separator+Umlenk) bzw. geschlossen (Motor+GF2). ;; v1-Naeherung Laenge: Entry-Fussabdruck wird vom ersten VF-Koerper abgezogen; ;; der Exit (Motor+GF2) wird beim Schliessen ANGEHAENGT (verlaengert den VF-Lauf ;; ggue. dem gezeichneten Pfad; feinere Laengen-Reservierung -> spaeter). (setq i 0) (while (< i n) (setq seg (nth i segmente) typ (car seg) hz (cadr seg)) (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 (vfl-meldung (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit))) (if (= run-typ "VF") ; VF-Lauf vor GF-Bogen schliessen (progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame)))) (setq run-typ nil))) (setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite)) (setq run-typ "GF")))) ) (setq i (1+ i))) ;; --- 7. Kettenende: offenen VF-Lauf schliessen, dann Separator + ES --- (if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit))) ;; vfl-frage-es-seite nutzt intern bereits vfl-in-value/vfl-menu - wird also ;; automatisch mitgeloggt, kein manueller dbgmsg noetig. (setq es-seite (vfl-frage-es-seite)) (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 vf-run-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 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 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 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 (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 (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 (vfl-meldung (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) klass=GF/VF ;; Plan-Eintrag Bogen : ("Bogen" hz chord bwinkel bseite klass) (setq n (length segmente) i 0 plan '()) (while (< i n) (setq seg (nth i segmente) typ (car seg) hz (cadr seg) laenge (caddr seg)) (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))) T)) ; Modus 2: Vario-Kurve immer erlaubt (vfl-seg-highlight seg-ent nil))) (cond ((= typ "Linie") (princ (ssg-textf "vfl-m3-seg-gerade" (list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1)))) (cond ;; Direkt nach einer Vario-Kurve: automatisch VF (keine Abfrage) - ;; die Kurve sitzt mitten in der VF-Einheit, es MUSS VF folgen. (nach-kurve (princ (ssg-text "vfl-m3-auto-vf")) (setq plan (cons (list "Linie" hz laenge "VF" nil) plan)) (setq nach-kurve nil)) (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") (setq plan (cons (list "Linie" hz laenge "VF" nil) plan)) (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*))) (setq plan (cons (list "Linie" hz laenge "GF" winkel) plan))))))) ((= 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))) (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")) (if (= antwort "2") (progn (princ (ssg-text "vfl-m3-variante-frage")) (setq kv-variante (if (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-variante-aussen") (ssg-text "vfl-variante-innen")) 2 "vfl-m3-variante-frage") "1") "aussen" "innen")) (setq plan (cons (list "Bogen" hz laenge bwinkel bseite "Vario-Kurve" kv-variante) plan)) (setq nach-kurve t)) ; naechste Gerade automatisch VF (progn (setq plan (cons (list "Bogen" hz laenge bwinkel bseite "GF-Bogen" nil) plan)) (setq nach-kurve nil))))) (setq i (1+ i))) (setq plan (reverse plan)) ;; --- 6. VF-Lauf finden: VF-Geraden UND Vario-Kurven bilden EINEN Lauf --- ;; (Vario-Kurve gehoert in die VF-Einheit, unterbricht den Lauf also NICHT). (setq vf-start -1 vf-ende -1 vf-count 0 in-vf nil i 0) (foreach e plan ;; NICHT "member" nennen: eine gleichnamige Lokale verdeckt in AutoLISP das ;; Builtin member, das weiter unten im selben Scope gebraucht wird. (setq vf-run-member (or (and (= (car e) "Linie") (= (nth 3 e) "VF")) (and (= (car e) "Bogen") (= (nth 5 e) "Vario-Kurve")))) (if vf-run-member (progn (if (not in-vf) (setq vf-count (1+ vf-count) vf-start i in-vf t)) (setq vf-ende i)) (setq in-vf nil)) (setq i (1+ i))) (if (/= vf-count 1) (progn (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=========================================") ;; ================= 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) ;; *ssg-ils-dim* hier zuruecksetzen - Begruendung siehe gleichlautende Stelle ;; im Handler von vf-linienzug-modus (Abbruch kehrt nie zum Aufrufer zurueck, ;; der den Override abraeumen wuerde). (setq *error* (function (lambda (msg) (setq *error* old-error) (setq *ssg-ils-dim* nil) (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)) ;; 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)))))))) (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)) ((= typ "Bogen") (setq bwinkel (nth 3 seg) bseite (nth 4 seg) klass (nth 5 seg)) (if (= klass "GF-Bogen") (progn (if (null frame) (progn (vfl-meldung (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit))) (setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite))) (princ (ssg-text "vfl-m3-kurve-front-uebersprungen"))))) (setq i (1+ i))) ;; Front-Anker (gemessen). Falls die VF-Bruecke ganz vorne liegt: AS (falls ;; gewuenscht) jetzt setzen. (setq hz (cadr (nth vf-start plan))) (if (null frame) (setq frame (if as-vorhanden (vfl2-insert-as-vf startpunkt hz as-seite) (make-frame-from-dir startpunkt (hz-winkel->xu hz 0.0))))) (setq z-front (caddr (car frame))) ;; --- B2: Back-Abstieg -> Junction; Kletterer + Horizontal-Mitte bestimmen --- (setq z-junction (+ (float end-hoehe) (vfl3-dback plan (1+ vf-ende) n last-line ein))) (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)) (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 = 800 (Umlenk+Sep). berechne rechnet Motor-/Uebergangs-Abstieg NICHT, ;; daher Kletterhoehe um diese Abstiege anpassen (GF2 bleibt ~0). ;; - Ohne flache Zone (Einzel-Bruecke): feste = 1300 (inkl. Motor), keine Anpassung. (setq rad3v (* *vfk-gefaelle-winkel* (/ pi 180.0))) (if (> hor-pairs 0) (setq feste-vf *vfk-feste-horizontal-kettenende* dH-adj (- dH-bruecke (+ (* *vfk-stations-laenge* (sin rad3v)) *vfk-bruecke-korrektur*))) ; Motor + auf_3/ab_3 (setq feste-vf *vfk-feste-horizontal-linienzug* dH-adj dH-bruecke)) (setq wahl3 (vfl3-waehle-winkel climber-span dH-adj feste-vf)) (if (null wahl3) (progn (princ (ssg-text "vfl-m3-kein-winkel")) (princ) (exit))) (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. 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")) (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) (if (= br-gf-mode 2) (ssg-text "vfl-m3-vert-halb") (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) (setq pt (vfs-vf-entry pt br-gf1 letzt-koerper-hz)) ; GF1 + Separator + Umlenk (3 Grad) (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") (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))) (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 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 (princ (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)) ;; 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))) (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)) ((= 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___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___TEF_ (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_ (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)