m.stangl
bf0237666b
Die gueltige AS/ES-Winkel-Menge ("30"/"90") stand als Literal doppelt im
Glied-Schema. Jetzt einmalig als *vfk-as-es-winkel* in vf_konstanten.lsp,
Schema referenziert sie (mit Fallback in vf_linienzug).
BEWUSST bei STRING geblieben (nicht INT): AS/ES ist echt 2-wertig (keine
60-Grad-Bloecke), das Journal fuehrt AS/ES-Winkel als STR - eine Umstellung auf
INT haette Journal-Format + Alt-Block-Editier-Kompatibilitaet beruehrt (2
Cluster) fuer reine Konsistenz. Zentrale Konstante beseitigt die Streuung ohne
dieses Risiko (Entscheidung mit Nutzer abgestimmt).
Die index-basierten Dialog-Mappings (if gwinkel "1" -> "30"/"90") bleiben,
da sie an feste 2-Options-DCL-Layouts gebunden sind (keine Listen-Lookups).
Paren-Balance geprueft.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
5963 lines
304 KiB
Common Lisp
5963 lines
304 KiB
Common Lisp
;; ============================================================
|
||
;; 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_<winkel>_<seite>).
|
||
(defun vfl-as-winkel () (if (boundp '*vfl-as-winkel*) *vfl-as-winkel* "90"))
|
||
(defun vfl-es-winkel () (if (boundp '*vfl-es-winkel*) *vfl-es-winkel* "90"))
|
||
|
||
;; ============================================================
|
||
;; TEIL 0b: EINGABE-JOURNAL (RECORD & REPLAY)
|
||
;; ============================================================
|
||
;; Jede interaktive Eingabe im Modus-1-Aufrufbaum laeuft ueber die Wrapper
|
||
;; vfl-in-point/-string/-real/-int. Diese arbeiten in zwei Modi:
|
||
;; Record (*vfl-replay-queue* = nil): normal fragen + in *vfl-journal* anhaengen.
|
||
;; Replay (*vfl-replay-queue* gesetzt): naechsten gespeicherten Wert liefern
|
||
;; (nicht fragen) und ebenfalls in *vfl-journal* anhaengen. Laeuft die
|
||
;; Queue leer, wird ab hier wieder live gefragt (nahtloser Uebergang).
|
||
;; Weil der Builder deterministisch bzgl. seiner Eingaben ist, reproduziert das
|
||
;; Abspielen desselben Journals exakt dieselbe Kette. *vfl-journal* wird beim
|
||
;; Replay komplett neu aufgebaut (durch die erneute Ausfuehrung), die Queue ist
|
||
;; nur Lesequelle.
|
||
;;
|
||
;; Journal-Eintrag: (kind . value) mit kind aus
|
||
;; "PT" Punkt (Liste x y z) "STR" String (auch "")
|
||
;; "REAL" Realzahl "INT" Ganzzahl
|
||
;; "NIL" Abbruch/Default (value nil) "STEP" Glied-Checkpoint (value = Label)
|
||
;; *vfl-journal* wird in UMGEKEHRTER Reihenfolge gehalten (neuestes zuerst, cons).
|
||
|
||
(defun vfl-journal-reset ()
|
||
(setq *vfl-journal* '() *vfl-replay-queue* nil)
|
||
(if (boundp '*vflw-pending*) (setq *vflw-pending* nil)))
|
||
|
||
;; Eintrag anhaengen (vorn, da Reverse-Reihenfolge).
|
||
;; Zusaetzlich (falls ein Debug-Schalter fuer die aktuelle Sitzung eine .dbg-
|
||
;; Datei geoeffnet hat, siehe ssg_dbg.lsp/dbg-schalter-open) wird jeder
|
||
;; Eintrag als FRAGE/ANTWORT-Paar mitgeloggt - da ALLE interaktiven Eingaben
|
||
;; von Modus 1 UND Modus 2 durch diesen einen Punkt laufen (vfl-in-point/
|
||
;; -string/-real/-int/-value/-selection), deckt das beide Modi komplett ab,
|
||
;; ohne jede einzelne Aufrufstelle im Bau-Ablauf separat instrumentieren zu
|
||
;; muessen. Modus 3 nutzt bewusst rohe getstring/getreal/getint (reine
|
||
;; Konsole, kein Journal) und wird stattdessen direkt in vf-linienzug-modus3
|
||
;; mit eigenen dbgmsg-Aufrufen geloggt. dbgmsg/dbg sind von sich aus No-Ops,
|
||
;; solange keine .dbg-Datei offen ist (*dbg-path* nil) - daher hier bewusst
|
||
;; UNBEDINGT aufgerufen, kein eigener An/Aus-Check noetig.
|
||
(defun vfl-journal-record (kind val)
|
||
(setq *vfl-journal* (cons (cons kind val) *vfl-journal*))
|
||
(if (= kind "STEP")
|
||
(dbgmsg (strcat "--- GLIED: " (if val (vl-princ-to-string val) "?") " ---"))
|
||
(progn
|
||
(dbgmsg (strcat "EINGABE [" kind "]:"))
|
||
(dbg val)
|
||
(dbgflush))))
|
||
|
||
;; Glied-Checkpoint setzen (Label spaeter via vfl-journal-steplabel setzbar).
|
||
(defun vfl-journal-mark (label)
|
||
(vfl-journal-record "STEP" label))
|
||
|
||
;; Label des JUENGSTEN STEP-Eintrags nachtraeglich setzen (der Segmenttyp steht
|
||
;; erst nach der Menue-Auswahl fest, der Marker sitzt aber am Iterationskopf).
|
||
(defun vfl-journal-steplabel (label / found)
|
||
(setq found nil)
|
||
(setq *vfl-journal*
|
||
(mapcar
|
||
(function (lambda (e)
|
||
(if (and (not found) (= (car e) "STEP"))
|
||
(progn (setq found t) (cons "STEP" label))
|
||
e)))
|
||
*vfl-journal*))
|
||
(dbgmsg (strcat "--- GLIED-LABEL: " (if label label "?") " ---"))
|
||
(dbgflush)
|
||
label)
|
||
|
||
;; Naechsten Eingabe-Eintrag aus der Replay-Queue poppen (STEP-Marker dabei
|
||
;; ueberspringen - die werden bei der erneuten Ausfuehrung neu erzeugt).
|
||
;; Rueckgabe: (value) als 1-elementige Liste, falls ein Eintrag da war
|
||
;; (unterscheidet einen echten nil-Wert von einer leeren Queue); nil, wenn die
|
||
;; Queue erschoepft ist (danach faellt der Wrapper auf Live-Eingabe zurueck).
|
||
(defun vfl-replay-pop ( / e)
|
||
(while (and *vfl-replay-queue* (= (car (car *vfl-replay-queue*)) "STEP"))
|
||
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*)))
|
||
(if *vfl-replay-queue*
|
||
(progn
|
||
(setq e (car *vfl-replay-queue*))
|
||
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*))
|
||
(list (cdr e)))
|
||
nil))
|
||
|
||
;; ============================================================
|
||
;; TEIL 0b-1b: GLIED-SCHEMA (single source of truth)
|
||
;; ============================================================
|
||
;; Das Journal ist und bleibt eine flache (kind . value)-Liste - das Format auf
|
||
;; der XDATA aendert sich NICHT (keine Migration noetig, Replay unveraendert).
|
||
;; Neu ist nur eine zentrale, DEKLARATIVE Beschreibung, welche Felder in welcher
|
||
;; Reihenfolge und mit welchem Typ ein Glied ausmachen. Damit gibt es genau EINE
|
||
;; Stelle, die die Struktur eines Glieds kennt - Bauen, Lesen, Validieren und
|
||
;; das Debug-Log leiten sich alle daraus ab (kein Auseinanderlaufen von je-Typ-
|
||
;; slice-bauen/slice-werte mehr, aus dem der Winkel-Bug entstand).
|
||
;;
|
||
;; Ein Feld ist: (name kind werte). name = Feldname (fuers Log), kind = Journal-
|
||
;; kind ("STR"/"INT"/"REAL"/"PT"), werte = Liste erlaubter Werte oder nil (frei).
|
||
;; Das fuehrende STEP (Glied-Checkpoint) ist NICHT Teil der Feldliste - es wird
|
||
;; von den Slice-Helfern separat vorangestellt bzw. beim Lesen uebersprungen.
|
||
;;
|
||
;; Nur die FESTEN, kurzen Glieder sind hier erfasst (AS, ES, GF-Bogen, Vario-
|
||
;; Kurve). Die VF-Einheit/Horizontal-VF ist ein variabler Dialog-Fluss mit
|
||
;; optionsabhaengiger Feldzahl - sie ist bewusst KEIN Feld-Record und wird
|
||
;; weiter direkt behandelt (nicht einzeln editierbar, siehe vfl-edit-glied).
|
||
;;
|
||
;; Feldkonventionen (wie vom bestehenden Code erzeugt):
|
||
;; seite "1"=links / "2"=rechts
|
||
;; menue fuehrende "Naechstes Element waehlen"-Antwort (nur GF-Bogen: "1")
|
||
;; winkel GF-Bogen/Vario-Kurve als INT (30/60/90), AS/ES als STR ("30"/"90")
|
||
;; GF-Bogen/Vario-Kurve-Winkel kommen zentral aus *vfk-gf-bogen-winkel*, AS/ES-
|
||
;; Winkel aus *vfk-as-es-winkel* (beide vf_konstanten.lsp) - hier nicht mehr
|
||
;; hartcodiert. Daher (list ...) statt Quote fuer die betroffenen Winkel-Slots.
|
||
;; Fallback, falls vf_konstanten (aus irgendeinem Grund) nicht geladen wurde.
|
||
(if (null *vfk-gf-bogen-winkel*) (setq *vfk-gf-bogen-winkel* '(30 60 90)))
|
||
(if (null *vfk-as-es-winkel*) (setq *vfk-as-es-winkel* '("30" "90")))
|
||
(setq *vfl-glied-schema*
|
||
(list
|
||
(cons "AS"
|
||
(list (list "winkel" "STR" *vfk-as-es-winkel*)
|
||
'("seite" "STR" ("1" "2"))))
|
||
(cons "ES"
|
||
(list (list "winkel" "STR" *vfk-as-es-winkel*)
|
||
'("seite" "STR" ("1" "2"))))
|
||
(cons "GF-Bogen"
|
||
(list '("menue" "STR" ("1"))
|
||
(list "winkel" "INT" *vfk-gf-bogen-winkel*)
|
||
'("seite" "STR" ("1" "2"))))
|
||
(cons "Vario-Kurve"
|
||
(list (list "winkel" "INT" *vfk-gf-bogen-winkel*)
|
||
'("seite" "STR" ("1" "2"))
|
||
'("variante" "STR" ("1" "2"))))))
|
||
|
||
;; --- VF-Einheit: Sub-Step-Referenz (variable Laenge) ---------------------
|
||
;; Die VF-Einheit (Linie-VF / Horizontal-VF) ist KEIN Glied mit fester Feldzahl,
|
||
;; sondern eine SCHLEIFE, die beliebig viele Sub-Segmente aneinanderhaengt, bis
|
||
;; der Nutzer "Ende" waehlt. Sie kann ausserdem Vario-Kurven ENTHALTEN. Ein
|
||
;; starres Feld-Schema wie oben passt daher nicht.
|
||
;;
|
||
;; Diese Referenz beschreibt die EINZELNEN Teilfragen, die im VF-Fluss auftreten
|
||
;; koennen - jede fuer sich ein kleiner benannter Record. Anders als bei den
|
||
;; festen Gliedern ist die REIHENFOLGE hier verzweigungsabhaengig; die Benennung
|
||
;; im Log erfolgt deshalb ueber das Wert-Muster (nicht ueber eine feste
|
||
;; Position). Zweck: lesbares Log ("VF.sep-vor = ja") + Wert-Validierung, OHNE
|
||
;; den fragilen Bau-Fluss nachzubauen. min/max = wie oft die Teilfrage je
|
||
;; VF-Einheit auftreten kann (Doku-Wert; die Schleife macht max offen = nil).
|
||
;;
|
||
;; Teilfrage kind werte min max Bedeutung
|
||
;; menue STR "3"/"4" 1 1 Hauptmenue-Wahl Linie-VF/Horizontal-VF
|
||
;; laenge DL - 1 n Reststrecke (Punktwahl -> dL)
|
||
;; zielhoehe REAL - 0 n Zielhoehe (nur Auf/Ab bzw. Linie-VF)
|
||
;; sep-vor STR "1"/"2" 0 n Separator vor (horizontaler Koerper)
|
||
;; sep-nach STR "1"/"2" 0 n Separator nach (horizontaler Koerper)
|
||
;; ist-ende STR "1"/"2"/"3" 1 n "Ist Endpunkt der Foerderer?" (Schleife)
|
||
;; naechstes-vf STR "1"/"2"/"3" 0 n Fortsetzung Horiz./Vario-Kurve/Auf-Ab
|
||
;; es-gewuenscht STR "1"/"2" 0 1 ES setzen? (nur Kettenende-Option 3)
|
||
;; variokurve.* siehe Glied "Vario-Kurve" (eingebettet moeglich)
|
||
;;
|
||
;; Fuer die Log-Benennung (vfl-schema-log-vf) reicht die Unterscheidung nach
|
||
;; Wert-Muster: eine STR mit Wert "3" ist ein 1-3-Menue-Schritt, "1"/"2" eine
|
||
;; Ja/Nein-Frage; REAL/DL sind Laenge bzw. Hoehe.
|
||
(setq *vfl-vf-substeps*
|
||
(list
|
||
'("STR-menue" "STR" ("3" "4")) ; fuehrende Menue-Wahl
|
||
'("STR-janein" "STR" ("1" "2")) ; sep-vor/-nach, es-gewuenscht
|
||
'("STR-menue3" "STR" ("1" "2" "3")))) ; ist-ende, naechstes-vf
|
||
|
||
;; Feldliste eines Glied-Typs (nil, wenn nicht im Schema - z.B. VF-Einheit).
|
||
(defun vfl-schema-felder (label) (cdr (assoc label *vfl-glied-schema*)))
|
||
(defun vfl-schema-feld-name (feld) (car feld))
|
||
(defun vfl-schema-feld-kind (feld) (cadr feld))
|
||
(defun vfl-schema-feld-werte (feld) (caddr feld))
|
||
|
||
;; Prueft EINEN Wert gegen eine Felddefinition. Rueckgabe: nil = ok, sonst ein
|
||
;; Fehlertext (fuer Log/Alert). Prueft (a) den Typ passend zum kind und (b) die
|
||
;; erlaubten Werte, falls im Feld angegeben.
|
||
(defun vfl-schema-feld-pruefen (feld val / kind werte typ-ok)
|
||
(setq kind (vfl-schema-feld-kind feld) werte (vfl-schema-feld-werte feld))
|
||
(setq typ-ok
|
||
(cond ((= kind "STR") (= (type val) 'STR))
|
||
((= kind "INT") (= (type val) 'INT))
|
||
((= kind "REAL") (or (= (type val) 'REAL) (= (type val) 'INT)))
|
||
((= kind "PT") (and (listp val) (= (length val) 3)))
|
||
(t t)))
|
||
(cond
|
||
((not typ-ok)
|
||
(strcat (vfl-schema-feld-name feld) ": erwartet " kind ", ist "
|
||
(vl-princ-to-string (type val))))
|
||
((and werte (not (member val werte)))
|
||
(strcat (vfl-schema-feld-name feld) "=" (vl-princ-to-string val)
|
||
" nicht in erlaubten Werten " (vl-princ-to-string werte)))
|
||
(t nil)))
|
||
|
||
;; Baut eine Journal-Slice aus einem Glied-Label und einer Werteliste (in
|
||
;; Feldreihenfolge). Stellt das STEP voran. AS ist ein Sonderfall (kein STEP -
|
||
;; Praeambel), daher hier NICHT erlaubt (nil-Rueckgabe). Validiert jeden Wert
|
||
;; vor dem Bauen; bei einem Fehler wird er als dbgmsg protokolliert, der Wert
|
||
;; aber trotzdem geschrieben (Sicherung geht vor - lieber ein warnendes Log als
|
||
;; ein verworfener Bau). Rueckgabe: forward-order Slice (Liste (kind . value)).
|
||
(defun vfl-schema-slice-bauen (label werte / felder out feld val fehler)
|
||
(setq felder (vfl-schema-felder label))
|
||
(if (or (null felder) (= label "AS"))
|
||
nil
|
||
(progn
|
||
(setq out (list (cons "STEP" label)))
|
||
(while felder
|
||
(setq feld (car felder) val (car werte))
|
||
(setq fehler (vfl-schema-feld-pruefen feld val))
|
||
(if fehler (dbgmsg (strcat ">> SCHEMA-WARN " label "." fehler)))
|
||
(setq out (append out (list (cons (vfl-schema-feld-kind feld) val))))
|
||
(setq felder (cdr felder) werte (cdr werte)))
|
||
out)))
|
||
|
||
;; Liest die Feldwerte aus einer Glied-Slice (STEP + Felder) in Feldreihenfolge.
|
||
;; Nimmt der Reihe nach den naechsten Eintrag, dessen kind zum jeweiligen Feld
|
||
;; passt (ueberspringt das fuehrende STEP automatisch). Fehlt ein Wert oder
|
||
;; stimmt der Typ nicht, wird der (optionale) Default aus defaults an dieser
|
||
;; Position eingesetzt. Rueckgabe: Werteliste in Feldreihenfolge.
|
||
(defun vfl-schema-slice-werte (label slice defaults / felder rest out feld val gefunden)
|
||
(setq felder (vfl-schema-felder label) rest slice out '())
|
||
(while felder
|
||
(setq feld (car felder) gefunden nil)
|
||
;; naechsten passenden Eintrag suchen (STEP und Fremdtypen ueberspringen)
|
||
(while (and rest (not gefunden))
|
||
(if (= (car (car rest)) (vfl-schema-feld-kind feld))
|
||
(setq val (cdr (car rest)) gefunden t))
|
||
(setq rest (cdr rest)))
|
||
(setq out (append out (list (if gefunden val (car defaults)))))
|
||
(setq felder (cdr felder) defaults (cdr defaults)))
|
||
out)
|
||
|
||
;; Benanntes Debug-Log fuer eine ganze Glied-Slice: statt roher [INT] value=90-
|
||
;; Zeilen die Felder als "GF-Bogen.winkel = 90". No-Op ohne offene .dbg-Datei.
|
||
;; Wird beim Sichern (vfl-segment-xdata-sichern) genutzt.
|
||
(defun vfl-schema-log-slice (label slice / felder werte feld fehler)
|
||
(setq felder (vfl-schema-felder label))
|
||
(if felder
|
||
(progn
|
||
(setq werte (vfl-schema-slice-werte label slice
|
||
(mapcar '(lambda (f) nil) felder)))
|
||
(dbgmsg (strcat ">> GLIED " label ":"))
|
||
(while felder
|
||
(setq feld (car felder))
|
||
(setq fehler (vfl-schema-feld-pruefen feld (car werte)))
|
||
(dbgmsg (strcat " " (vfl-schema-feld-name feld) " = "
|
||
(vl-princ-to-string (car werte))
|
||
(if fehler (strcat " <!! " fehler) "")))
|
||
(setq felder (cdr felder) werte (cdr werte)))
|
||
(dbgflush))))
|
||
|
||
;; Benennt einen EINZELNEN VF-Slice-Eintrag (kind . value) nach Wert-Muster
|
||
;; (siehe *vfl-vf-substeps*). Rueckgabe: (name . fehlertext-oder-nil). laufend =
|
||
;; wie oft schon eine STR gesehen wurde (die 1. STR einer VF-Einheit ist die
|
||
;; menue-Wahl "3"/"4", spaetere STR sind Ja/Nein- bzw. 1-3-Menue-Schritte).
|
||
(defun vfl-vf-substep-benennen (eintrag pos-str / kind val name fehler)
|
||
(setq kind (car eintrag) val (cdr eintrag))
|
||
(cond
|
||
((= kind "STEP") (cons "STEP" nil))
|
||
((= kind "DL") (cons "laenge" nil)) ; Punktwahl -> Reststrecke
|
||
((= kind "REAL") (cons "hoehe" nil)) ; Zielhoehe (Auf/Ab bzw. Linie-VF)
|
||
((= kind "PT") (cons "punkt" nil))
|
||
((= kind "INT") ; eingebettete Vario-Kurve
|
||
(setq fehler (vfl-schema-feld-pruefen (list "vk-winkel" "INT" *vfk-gf-bogen-winkel*) val))
|
||
(cons "variokurve.winkel" fehler))
|
||
((= kind "STR")
|
||
(cond
|
||
((= pos-str 0) ; 1. STR = fuehrende Menue-Wahl
|
||
(setq fehler (vfl-schema-feld-pruefen '("menue" "STR" ("3" "4")) val))
|
||
(cons "menue" fehler))
|
||
((member val '("3")) ; nur 1-3-Menue kann "3" sein
|
||
(cons "ist-ende/naechstes-vf" nil))
|
||
((member val '("1" "2")) ; ja/nein ODER 1-3 (1/2)
|
||
(cons "wahl(1/2)" nil))
|
||
(t (cons "str" (strcat "unerwarteter STR-Wert " (vl-princ-to-string val))))))
|
||
(t (cons kind nil))))
|
||
|
||
;; Benanntes Debug-Log fuer eine ganze VF-Einheit-Slice (variable Laenge). Statt
|
||
;; roher [STR]/[REAL]-Zeilen jede Teilfrage benannt ("VF.menue = 4",
|
||
;; "VF.laenge = 4566.7", "VF.wahl(1/2) = 2"). Validiert dabei, was validierbar
|
||
;; ist (menue-Wert, eingebettete Vario-Kurven-Winkel). No-Op ohne offene .dbg.
|
||
(defun vfl-schema-log-vf (label slice / rest e paar name fehler pos-str)
|
||
(dbgmsg (strcat ">> GLIED " label " (VF-Einheit, variable Laenge):"))
|
||
(setq rest slice pos-str 0)
|
||
(foreach e rest
|
||
(if (/= (car e) "STEP")
|
||
(progn
|
||
(setq paar (vfl-vf-substep-benennen e pos-str))
|
||
(setq name (car paar) fehler (cdr paar))
|
||
(dbgmsg (strcat " " name " = " (vl-princ-to-string (cdr e))
|
||
(if fehler (strcat " <!! " fehler) "")))
|
||
(if (= (car e) "STR") (setq pos-str (1+ pos-str))))))
|
||
(dbgflush))
|
||
|
||
;; ============================================================
|
||
;; TEIL 0b-2: WIZARD-EINGABE (DCL statt Konsole)
|
||
;; ============================================================
|
||
;; Ersetzt NUR die LIVE-Eingabe (frischer Bau) durch DCL-Dialoge
|
||
;; (dcl/vf_linienzug_wizard.dcl). Journal-Replay (Editieren bestehender
|
||
;; Ketten, vfl-edit-ent) ist UNVERAENDERT: er liefert seinen Wert ueber
|
||
;; "popped" und erreicht den Wizard-Zweig unten gar nicht erst.
|
||
;; Die ORIGINALEN Konsolen-Fragen (princ + getstring/getreal/getint an jeder
|
||
;; Aufrufstelle) bleiben vollstaendig im Code stehen (weiterhin de/en ueber
|
||
;; ssg-text/lang/*.json) - sie laufen bei *vfl-wizard-mode* = nil unveraendert
|
||
;; wie bisher. Schnell zurueckschalten: Befehl VF_WIZARD_AUS bzw.
|
||
;; (setq *vfl-wizard-mode* nil).
|
||
;; Sicherheitsnetz: jeder Wizard-Aufruf ist per vl-catch-all-apply
|
||
;; abgesichert - jeder Fehler (fehlendes DCL, kaputtes Tile etc.) faellt
|
||
;; automatisch und lautlos auf die alte Konsolen-Eingabe zurueck, es gibt
|
||
;; also keinen Abbruch-Pfad, der NUR durch den Wizard entsteht.
|
||
(if (not (boundp '*vfl-wizard-mode*)) (setq *vfl-wizard-mode* T))
|
||
(if (not (boundp '*vflw-menu-optionen*)) (setq *vflw-menu-optionen* nil))
|
||
(if (not (boundp '*vflw-menu-default*)) (setq *vflw-menu-default* 1))
|
||
(if (not (boundp '*vflw-menu-frage*)) (setq *vflw-menu-frage* nil))
|
||
|
||
;; Effektiver Wizard-Zustand: Wizard-DCL-Dialoge nur, wenn *vfl-wizard-mode*
|
||
;; gesetzt UND die GUI global nicht abgeschaltet ist (Tests: (ssg-gui-aus)).
|
||
;; Bei abgeschalteter GUI fallen alle Eingaben auf den Konsolen-/getXXX-Pfad
|
||
;; zurueck, den die Testrunner per Mock/Replay bedienen.
|
||
(defun vfl-wizard-mode-p ()
|
||
(and *vfl-wizard-mode*
|
||
(or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))))
|
||
|
||
;; Wizard-GRUPPEN-Dialoge (vflw-gruppe-*-impl) duerfen NUR bei echter Live-
|
||
;; Eingabe aufgehen - waehrend eines Journal-Replays (Editieren/Fortsetzen
|
||
;; einer bestehenden Kette, *vfl-replay-queue* gesetzt) liefern vfl-in-point/
|
||
;; -string/-real/-int/-value ihre Werte bereits stumm aus der Replay-Queue;
|
||
;; ein trotzdem geoeffneter Gruppen-Dialog wuerde einerseits unnoetig
|
||
;; blockieren und andererseits seine Antworten in *vflw-pending* ablegen, wo
|
||
;; sie NICHT konsumiert werden (die Wrapper pruefen die Replay-Queue zuerst)
|
||
;; und liegen bleiben - sobald die Replay-Queue erschoepft ist und auf Live-
|
||
;; Eingabe umgeschaltet wird, liest der naechste Wrapper diese laengst
|
||
;; veralteten, falsch typisierten Werte statt neu zu fragen (siehe
|
||
;; vfl-neue-linie-messen: fuehrte zu einem String-statt-Punkt-Absturz).
|
||
(defun vfl-wizard-aktiv () (and (vfl-wizard-mode-p) (null *vfl-replay-queue*)))
|
||
|
||
(defun c:VF_WIZARD_AN ()
|
||
(setq *vfl-wizard-mode* T)
|
||
(princ "\nVF-Linienzug-Assistent: EIN (DCL-Dialoge)")
|
||
(princ))
|
||
(defun c:VF_WIZARD_AUS ()
|
||
(setq *vfl-wizard-mode* nil)
|
||
(princ "\nVF-Linienzug-Assistent: AUS (Konsolen-Fragen)")
|
||
(princ))
|
||
|
||
(defun vflw-dcl-pfad ()
|
||
(strcat (vl-string-translate "\\" "/" (getenv "DXFM_DCL")) "/vf_linienzug_wizard.dcl"))
|
||
|
||
;; Text fuer Dialog-Anzeige (Kopfzeile ODER Popup-Listen-Option) saeubern:
|
||
;; fuehrende Newlines/Leerzeichen entfernen, DANACH ein fuehrendes
|
||
;; Konsolen-Ziffernpraefix wie "1 - " (aus "1 - 90 Grad", "2 - Links" usw.)
|
||
;; abschneiden - im Dialog klickt der Nutzer die Option, die Ziffer braucht
|
||
;; er nur an der Kommandozeile. Die Ziffer/der Index selbst wird davon nicht
|
||
;; beruehrt: Popup-Auswahl und Pending-Queue arbeiten weiterhin ueber die
|
||
;; Listenposition (get_tile "..." liefert einen 0-basierten Index), nicht
|
||
;; ueber diesen Anzeigetext. Kopfzeilen-Texte beginnen nie mit einer Ziffer
|
||
;; und sind von diesem zweiten Schritt daher unberuehrt.
|
||
(defun vflw-clean (s / i n)
|
||
(while (and (> (strlen s) 0) (member (substr s 1 1) (list "\n" " ")))
|
||
(setq s (substr s 2)))
|
||
(setq n (strlen s) i 1)
|
||
(while (and (<= i n) (wcmatch (substr s i 1) "#")) (setq i (1+ i)))
|
||
(if (> i 1)
|
||
(progn
|
||
(while (and (<= i n) (= (substr s i 1) " ")) (setq i (1+ i)))
|
||
(if (and (<= i n) (= (substr s i 1) "-"))
|
||
(progn
|
||
(setq i (1+ i))
|
||
(while (and (<= i n) (= (substr s i 1) " ")) (setq i (1+ i)))
|
||
(setq s (substr s i))))))
|
||
s)
|
||
|
||
;; Generischer Zahlen-Dialog (ersetzt getreal). Rueckgabe: reale Zahl oder
|
||
;; nil (Abbruch/leer - wie getreal bei blossem Enter, von den Aufrufern
|
||
;; bereits ueberall mit einem Default abgefangen).
|
||
(defun vflw-zahl-impl (prompt / dat dcl-pfad dlg-wert ergebnis)
|
||
(setq dcl-pfad (vflw-dcl-pfad))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vflw_zahl" dat))
|
||
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil)
|
||
(progn
|
||
(set_tile "kopf" (vflw-clean prompt))
|
||
(action_tile "accept" "(setq dlg-wert (get_tile \"wert\")) (done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(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-3: GRUPPEN-DIALOGE (PENDING-QUEUE)
|
||
;; ============================================================
|
||
;; Mehrere Fragen, die im Ablauf IMMER unmittelbar hintereinander kommen
|
||
;; (kein Zwischenschritt, keine Verzweigung dazwischen), werden im Wizard in
|
||
;; EINEM Dialog gemeinsam erfasst (siehe vflw-gruppe-* unten). Die
|
||
;; darunterliegende Aufruf-Reihenfolge in vf-linienzug-modus/vfl-* bleibt
|
||
;; dabei WOERTLICH UNVERAENDERT (weiterhin ein vfl-in-point/-string/-real/
|
||
;; -int/-value-Aufruf pro Wert, in derselben Reihenfolge) - nur die HERKUNFT
|
||
;; des Werts aendert sich: statt live zu fragen (oder einen Einzel-Dialog zu
|
||
;; zeigen) wird der naechste Wert aus *vflw-pending* entnommen, den der
|
||
;; Gruppen-Dialog vorher dort abgelegt hat. Journal-Aufzeichnung passiert
|
||
;; weiterhin in JEDEM einzelnen vfl-in-*-Aufruf selbst - Editieren/Replay
|
||
;; bestehender Ketten ist dadurch unveraendert (siehe TEIL 0b-2).
|
||
;; Bricht der Nutzer den Gruppen-Dialog ab, bleibt *vflw-pending* leer -
|
||
;; die nachfolgenden vfl-in-*-Aufrufe fallen dann automatisch auf ihre
|
||
;; EINZEL-Dialoge zurueck (kein Sonderfall noetig).
|
||
(if (not (boundp '*vflw-pending*)) (setq *vflw-pending* nil))
|
||
(defun vflw-pending-pop ( / v)
|
||
(if *vflw-pending*
|
||
(progn (setq v (car *vflw-pending*)) (setq *vflw-pending* (cdr *vflw-pending*)) (list v))
|
||
nil))
|
||
(defun vflw-pending-push-all (vals) (setq *vflw-pending* (append *vflw-pending* vals)) nil)
|
||
|
||
;; --- Eingabe-Wrapper ---
|
||
;; kind steuert nur, wie ein FRISCH live erfasster Wert typisiert wird; beim
|
||
;; Replay wird der gespeicherte Wert unveraendert durchgereicht.
|
||
;;
|
||
;; Alle Basis-Wrapper teilen dasselbe 3-Zweig-Muster (Replay-Queue ->
|
||
;; Pending-Queue -> Live-Eingabe) plus Journal-Aufzeichnung. Dieses Skelett
|
||
;; ist EINMAL in vfl-in-value (weiter unten) implementiert; die folgenden
|
||
;; Wrapper liefern nur ihre Live-Eingabe-Funktion (livefn) und ihr kind-Tag.
|
||
;; Journal-Format und Signaturen bleiben damit unveraendert (63 Aufrufstellen).
|
||
;; Ausnahme: vfl-in-selection (OBJS/Handles) hat abweichende Replay-/Journal-
|
||
;; Logik und bleibt eigenstaendig.
|
||
(defun vfl-in-point (base prompt)
|
||
(vfl-in-value "PT" (function (lambda () (vfl-getpoint base prompt)))))
|
||
|
||
;; Objektauswahl (Modus 2: Pfad-Objekte). Wie die anderen Wrapper repliziert
|
||
;; bzw. journalisiert - aber KEIN Wizard-Dialog (Objektwahl braucht wie
|
||
;; Punktwahl die Zeichnung, kein DCL-Fenster wuerde hier helfen). Beim Replay
|
||
;; werden die gespeicherten Handles zurueck in Enames aufgeloest; Handles
|
||
;; sind - anders als Enames - ueber Sitzungen hinweg stabil und damit fuer
|
||
;; die XDATA-Persistenz geeignet. Loest sich ein Handle nicht mehr auf (z.B.
|
||
;; weil der Nutzer die urspruengliche Pfad-Geometrie zwischenzeitlich
|
||
;; geloescht hat), wird das klar gemeldet statt eine unvollstaendige Auswahl
|
||
;; stillschweigend weiterzureichen.
|
||
(defun vfl-in-selection (filter / popped v handles h en k ss fehlt)
|
||
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
|
||
(if popped
|
||
(progn
|
||
(setq handles (car popped) v nil fehlt 0)
|
||
(foreach h handles
|
||
(setq en (vl-catch-all-apply 'handent (list h)))
|
||
(if (or (vl-catch-all-error-p en) (null en))
|
||
(setq fehlt (1+ fehlt))
|
||
(setq v (cons en v))))
|
||
(setq v (reverse v))
|
||
(if (> fehlt 0)
|
||
(alert (ssg-textf "vfl-m3-alert-objekte-fehlen" (list (itoa fehlt))))))
|
||
(progn
|
||
(setq ss (ssget filter))
|
||
(setq v nil)
|
||
(if ss
|
||
(progn
|
||
(setq k 0)
|
||
(while (< k (sslength ss))
|
||
(setq v (cons (ssname ss k) v))
|
||
(setq k (1+ k)))
|
||
(setq v (reverse v))))))
|
||
(setq handles (mapcar (function (lambda (e) (cdr (assoc 5 (entget e))))) v))
|
||
(vfl-journal-record (if v "OBJS" "NIL") handles)
|
||
v)
|
||
|
||
;; String: "" (Enter) ist ein GUELTIGER String (kein Abbruch) -> "STR". Daher
|
||
;; das strikte STR-Praedikat statt der Default-non-nil-Pruefung.
|
||
(defun vfl-in-string (prompt)
|
||
(vfl-in-value-p "STR"
|
||
(function (lambda (v) (eq (type v) 'STR)))
|
||
(function (lambda ()
|
||
(if (and (vfl-wizard-mode-p) *vflw-menu-optionen*)
|
||
(vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt)
|
||
*vflw-menu-optionen* *vflw-menu-default*)
|
||
(getstring prompt))))))
|
||
|
||
(defun vfl-in-real (prompt)
|
||
(vfl-in-value "REAL"
|
||
(function (lambda ()
|
||
(if (vfl-wizard-mode-p) (vflw-zahl prompt) (getreal prompt))))))
|
||
|
||
(defun vfl-in-int (prompt)
|
||
(vfl-in-value "INT"
|
||
(function (lambda ( / vs)
|
||
(if (and (vfl-wizard-mode-p) *vflw-menu-optionen*)
|
||
(progn
|
||
(setq vs (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt)
|
||
*vflw-menu-optionen* *vflw-menu-default*))
|
||
(if (and vs (> (strlen vs) 0)) (atoi vs) nil))
|
||
(getint prompt))))))
|
||
|
||
;; Menue-Wrapper: princ-Ausgabe der Optionen bleibt beim Aufrufer unveraendert
|
||
;; stehen (Konsolen-Fallback, de/en via ssg-text) - hier wird nur die
|
||
;; ABSCHLIESSENDE Eingabe-Zeile ersetzt. frage-key: ssg-text-Schluessel der
|
||
;; eigentlichen Frage (die Kopfzeile, die vorher separat per princ ausgegeben
|
||
;; wurde, z.B. "vfl-ist-endpunkt-frage") - OHNE das wuerde der Wizard-Dialog
|
||
;; nur die generische "Ihre Wahl (1/2/3)..."-Zeile zeigen und die eigentliche
|
||
;; Frage bliebe unsichtbar (nur auf der Konsole hinter dem Dialog). Die
|
||
;; Lokalvariablen sind ueber die '/'-Deklaration dynamisch nur waehrend
|
||
;; dieses Aufrufs sichtbar (AutoLISP dynamic scoping) und wirken daher
|
||
;; ausschliesslich auf den EINEN vfl-in-string/-int-Aufruf im Rumpf.
|
||
(defun vfl-menu (prompt option-labels default-idx frage-key /
|
||
*vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*)
|
||
(setq *vflw-menu-optionen* option-labels)
|
||
(setq *vflw-menu-default* default-idx)
|
||
(setq *vflw-menu-frage* frage-key)
|
||
(vfl-in-string prompt))
|
||
(defun vfl-menu-int (prompt option-labels default-idx frage-key /
|
||
*vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*)
|
||
(setq *vflw-menu-optionen* option-labels)
|
||
(setq *vflw-menu-default* default-idx)
|
||
(setq *vflw-menu-frage* frage-key)
|
||
(vfl-in-int prompt))
|
||
|
||
;; Winkel-Menue: fragt einen WINKELWERT (30/60/90) ab und journalisiert ihn
|
||
;; als echten Winkel (INT-Eintrag = 30/60/90), NICHT als Auswahl-Index 1/2/3.
|
||
;; Damit ist jedes Journal/Log selbsterklaerend und alle GF-Bogen-/Vario-Kurve-
|
||
;; Stellen (Live-Bau, Slice, Edit) teilen denselben Wert. winkel-werte ist die
|
||
;; Liste der zur Optionsreihenfolge gehoerenden Winkel (einheitlich (30 60 90)
|
||
;; fuer GF-Bogen UND Vario-Kurve); default-winkel der vorbelegte Winkelwert. Bei Konsolen-Eingabe
|
||
;; tippt der Nutzer den Winkel direkt (30/60/90); ungueltige Eingaben fallen auf
|
||
;; den naechstliegenden gueltigen Wert bzw. den Default. Rueckgabe: Winkel (Int).
|
||
(defun vfl-menu-winkel (prompt option-labels winkel-werte default-winkel frage-key /
|
||
*vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage* v)
|
||
(setq *vflw-menu-optionen* option-labels)
|
||
(setq *vflw-menu-frage* frage-key)
|
||
;; Default-Index = Position des Default-Winkels in winkel-werte (1-basiert).
|
||
(setq *vflw-menu-default*
|
||
(+ 1 (- (length winkel-werte) (length (member default-winkel winkel-werte)))))
|
||
(setq v (vfl-in-value "INT"
|
||
(function (lambda () (vfl-winkel-live prompt winkel-werte default-winkel)))))
|
||
;; Absicherung: nur gueltige Winkel zulassen (auch bei Alt-Journals mit Index).
|
||
(vfl-winkel-normieren v winkel-werte default-winkel))
|
||
|
||
;; Live-Abfrage eines Winkelwerts. Wizard: Auswahl aus den Labels, Position ->
|
||
;; winkel-werte. Konsole: direkte Zahleneingabe (ENTER = Default).
|
||
(defun vfl-winkel-live (prompt winkel-werte default-winkel / vs idx r)
|
||
(if (and (vfl-wizard-mode-p) *vflw-menu-optionen*)
|
||
(progn
|
||
(setq vs (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt)
|
||
*vflw-menu-optionen* *vflw-menu-default*))
|
||
(setq idx (if (and vs (> (strlen vs) 0)) (atoi vs) 0))
|
||
(if (and (>= idx 1) (<= idx (length winkel-werte)))
|
||
(nth (1- idx) winkel-werte)
|
||
default-winkel))
|
||
(progn
|
||
(setq r (getint prompt))
|
||
(if r r default-winkel))))
|
||
|
||
;; Normiert einen (moeglicherweise aus Alt-Journals stammenden Index oder einen
|
||
;; frei getippten Wert) auf einen gueltigen Winkel aus winkel-werte. Ein Wert,
|
||
;; der bereits gueltig ist, bleibt unveraendert. Ansonsten Default.
|
||
(defun vfl-winkel-normieren (v winkel-werte default-winkel / n)
|
||
(setq n (cond ((null v) default-winkel)
|
||
((= (type v) 'STR) (atoi v))
|
||
(T v)))
|
||
(if (member n winkel-werte) n default-winkel))
|
||
|
||
;; Generisches Eingabe-Skelett: der gemeinsame 3-Zweig-Ablauf (Replay-Queue ->
|
||
;; Pending-Queue -> Live-Eingabe) plus Journal-Aufzeichnung, den alle Basis-
|
||
;; Wrapper (vfl-in-point/-string/-real/-int) teilen. livefn ist ein aufrufbares
|
||
;; Objekt ohne Argumente (die eigentliche Live-Eingabe, z.B. getpoint/getreal
|
||
;; oder eine fragende Hilfsfunktion wie vf-frage-element-winkel); es wird NUR
|
||
;; aufgerufen, wenn weder Replay- noch Pending-Wert vorliegt.
|
||
;; kind: Journal-Typ eines frisch/gueltig erfassten Werts. Ein non-nil v gilt
|
||
;; als gueltig (-> kind), nil als Abbruch (-> "NIL"). Fuer Faelle, in denen die
|
||
;; Gueltigkeit strenger geprueft werden muss (z.B. vfl-in-string: "" ist ein
|
||
;; gueltiger String), siehe vfl-in-value-p.
|
||
(defun vfl-in-value (kind livefn / popped v)
|
||
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
|
||
(if popped
|
||
(setq v (car popped))
|
||
(progn
|
||
(setq popped (vflw-pending-pop))
|
||
(if popped (setq v (car popped)) (setq v (apply livefn nil)))))
|
||
(vfl-journal-record (if v kind "NIL") v)
|
||
v)
|
||
|
||
;; Variante mit explizitem Gueltig-Praedikat (fuer vfl-in-string: "" ist gueltig).
|
||
(defun vfl-in-value-p (kind gueltig-p livefn / popped v)
|
||
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
|
||
(if popped
|
||
(setq v (car popped))
|
||
(progn
|
||
(setq popped (vflw-pending-pop))
|
||
(if popped (setq v (car popped)) (setq v (apply livefn nil)))))
|
||
(vfl-journal-record (if (apply gueltig-p (list v)) kind "NIL") v)
|
||
v)
|
||
|
||
;; --- String-Hilfen (generisch, Trenner beliebig) ---
|
||
(defun vfl-strjoin (lst sep / s first)
|
||
(setq s "" first t)
|
||
(foreach x lst
|
||
(if first (progn (setq s x) (setq first nil)) (setq s (strcat s sep x))))
|
||
s)
|
||
(defun vfl-strsplit (s sep / pos out)
|
||
(setq out '())
|
||
(while (setq pos (vl-string-search sep s))
|
||
(setq out (cons (substr s 1 pos) out))
|
||
(setq s (substr s (+ pos 1 (strlen sep)))))
|
||
(reverse (cons s out)))
|
||
|
||
;; --- Serialisierung (tagged, selbstbeschreibend) ---
|
||
;; Zeilenformat "kind:payload", Eintraege per "\n" verkettet. getstring/getreal
|
||
;; liefern nie ein Newline, daher ist "\n" ein sicherer Record-Trenner.
|
||
;; "OBJS" (Objektauswahl, Modus 2): Payload = kommagetrennte Liste von
|
||
;; Entity-Handles (Hex-Strings, kollidieren nie mit dem Komma-Trenner).
|
||
;; Handles bleiben - anders als Enames - ueber Sitzungen/Undo hinweg stabil
|
||
;; und sind damit die richtige Persistenzform fuer ssget-Ergebnisse.
|
||
(defun vfl-entry->string (e / k v)
|
||
(setq k (car e) v (cdr e))
|
||
(cond
|
||
((= k "PT") (strcat "PT:" (rtos (car v) 2 6) "," (rtos (cadr v) 2 6) ","
|
||
(rtos (caddr v) 2 6)))
|
||
((= k "REAL") (strcat "REAL:" (rtos v 2 6)))
|
||
((= k "DL") (strcat "DL:" (rtos v 2 6)))
|
||
((= k "INT") (strcat "INT:" (itoa v)))
|
||
((= k "STR") (strcat "STR:" v))
|
||
((= k "STEP") (strcat "STEP:" v))
|
||
((= k "OBJS") (strcat "OBJS:" (vfl-strjoin v ",")))
|
||
(t "NIL:")))
|
||
(defun vfl-string->entry (ln / p kind pay c)
|
||
(setq p (vl-string-search ":" ln))
|
||
(if (null p)
|
||
(cons "NIL" nil)
|
||
(progn
|
||
(setq kind (substr ln 1 p) pay (substr ln (+ p 2)))
|
||
(cond
|
||
((= kind "PT")
|
||
(setq c (vfl-strsplit pay ","))
|
||
(cons "PT" (list (atof (nth 0 c)) (atof (nth 1 c)) (atof (nth 2 c)))))
|
||
((= kind "REAL") (cons "REAL" (atof pay)))
|
||
((= kind "DL") (cons "DL" (atof pay)))
|
||
((= kind "INT") (cons "INT" (atoi pay)))
|
||
((= kind "STR") (cons "STR" pay))
|
||
((= kind "STEP") (cons "STEP" pay))
|
||
((= kind "OBJS") (cons "OBJS" (if (> (strlen pay) 0) (vfl-strsplit pay ",") nil)))
|
||
(t (cons "NIL" nil))))))
|
||
;; forward-journal ist bereits in Bau-Reihenfolge (nicht die umgekehrte
|
||
;; *vfl-journal*-Rohform) - gemeinsame Serialisierung fuer Ketten- UND
|
||
;; Segment-XDATA (vfl-journal-xdata-schreiben / vfl-journal-xdata-schreiben-seg).
|
||
(defun vfl-journal-list->string (forward-journal)
|
||
(vfl-strjoin (mapcar 'vfl-entry->string forward-journal) "\n"))
|
||
(defun vfl-journal->string ()
|
||
(vfl-journal-list->string (reverse *vfl-journal*)))
|
||
|
||
;; --- JSON-Dump des Journals fuer die Debug-Datei (nur Diagnose) ---
|
||
;; Wandelt EINEN Journal-Eintrag (kind . value) in ein JSON-Objekt
|
||
;; {"kind":"PT","value":[x,y,z]} um. String-Werte werden gequotet (mit
|
||
;; einfachem Escaping fuer " und \), Zahlen unquotiert, PT als Zahlen-Array,
|
||
;; OBJS als String-Array, NIL als null. Rein additive Diagnose - beruehrt die
|
||
;; XDATA-Serialisierung (vfl-entry->string) NICHT.
|
||
(defun vfl-json-escape (s / out c i n)
|
||
(setq out "" i 1 n (strlen s))
|
||
(while (<= i n)
|
||
(setq c (substr s i 1))
|
||
(setq out (strcat out (cond ((= c "\"") "\\\"") ((= c "\\") "\\\\") (t c))))
|
||
(setq i (1+ i)))
|
||
out)
|
||
(defun vfl-json-num (x) (rtos x 2 6)) ; einheitliches Zahlformat (wie vfl-entry->string)
|
||
(defun vfl-entry->json (e / k v)
|
||
(setq k (car e) v (cdr e))
|
||
(strcat "{\"kind\":\"" k "\",\"value\":"
|
||
(cond
|
||
((null v) "null")
|
||
((= k "PT") (strcat "[" (vfl-json-num (car v)) "," (vfl-json-num (cadr v)) ","
|
||
(vfl-json-num (caddr v)) "]"))
|
||
((= k "REAL") (vfl-json-num v))
|
||
((= k "DL") (vfl-json-num v))
|
||
((= k "INT") (itoa v))
|
||
((= k "STR") (strcat "\"" (vfl-json-escape v) "\""))
|
||
((= k "STEP") (strcat "\"" (vfl-json-escape v) "\""))
|
||
((= k "OBJS") (strcat "[" (vfl-strjoin
|
||
(mapcar (function (lambda (h) (strcat "\"" (vfl-json-escape h) "\"")))
|
||
v) ",") "]"))
|
||
(t "null"))
|
||
"}"))
|
||
;; forward-journal (Bau-Reihenfolge) als kompakter JSON-Array-String.
|
||
(defun vfl-journal->json (forward-journal)
|
||
(strcat "[" (vfl-strjoin (mapcar 'vfl-entry->json forward-journal) ",") "]"))
|
||
(defun vfl-string->journal (s / out)
|
||
(setq out '())
|
||
(foreach ln (vfl-strsplit s "\n")
|
||
(if (> (strlen ln) 0) (setq out (cons (vfl-string->entry ln) out))))
|
||
(reverse out))
|
||
|
||
;; --- Persistenz am VF_n-Block ueber die SSG_VF_EDIT-XDATA-App ---
|
||
;; Layout der 1000-Gruppen: [0]="linienzug" (Marker), [1..]=Journal-String in
|
||
;; 250-Byte-Chunks (DXF-Limit 255). Rueckwaertskompatibel zum Standard/Etage-
|
||
;; Reader vfs-xdata-lesen, der alle 1000-Werte als Liste liefert.
|
||
(defun vfl-chunk-string (s n / out len)
|
||
(setq out '())
|
||
(while (> (setq len (strlen s)) n)
|
||
(setq out (cons (substr s 1 n) out))
|
||
(setq s (substr s (1+ n))))
|
||
(if (> (strlen s) 0) (setq out (cons s out)))
|
||
(reverse out))
|
||
;; marker: "linienzug" (Modus 1, Sektions-Editieren via vfl-edit-ent) oder
|
||
;; "linienzug2" (Modus 2, vfl-edit-ent2 - voller Reset ohne Sektionswahl,
|
||
;; siehe dortiger Kommentar). Der Marker steht in der ersten 1000-Gruppe und
|
||
;; entscheidet beim Lesen (vfl-journal-xdata-lesen), welcher Editier-Pfad
|
||
;; greift.
|
||
(defun vfl-journal-xdata-schreiben (ent marker / chunks appentry)
|
||
(if (null *vf-xdata-app*) (setq *vf-xdata-app* "SSG_VF_EDIT"))
|
||
(regapp *vf-xdata-app*)
|
||
;; Diagnose: komplettes Journal beim Erzeugen der Geometrie als JSON in die
|
||
;; Debug-Datei (No-Op ohne offene .dbg-Datei, siehe dbgmsg). marker + JSON-
|
||
;; Array der Eintraege in Bau-Reihenfolge.
|
||
(dbgmsg (strcat "XDATA-GESCHRIEBEN marker=" marker))
|
||
(dbgmsg (strcat "XDATA-JOURNAL-JSON " (vfl-journal->json (reverse *vfl-journal*))))
|
||
(dbgflush)
|
||
(setq chunks (vfl-chunk-string (vfl-journal->string) 250))
|
||
(setq appentry
|
||
(cons *vf-xdata-app*
|
||
(cons (cons 1000 marker)
|
||
(mapcar (function (lambda (c) (cons 1000 c))) chunks))))
|
||
(entmod (append (entget ent) (list (list -3 appentry))))
|
||
ent)
|
||
;; Rueckgabe: (marker . journal) oder nil (kein/unbekanntes Journal).
|
||
(defun vfl-journal-xdata-lesen (ent / xd)
|
||
(setq xd (vfs-xdata-lesen ent))
|
||
(if (and xd (member (car xd) '("linienzug" "linienzug2")))
|
||
(cons (car xd) (vfl-string->journal (apply 'strcat (cdr xd))))
|
||
nil))
|
||
|
||
;; --- Segment-XDATA (pro einzelnem Glied-Entity, eigener App-Name) ---
|
||
;; Eigene App "SSG_VF_EDIT_SEG" statt SSG_VF_EDIT: sauber getrennt vom
|
||
;; Ketten-Journal, keine Kollisionsgefahr mit dessen Marker-Schema
|
||
;; ("linienzug"/"linienzug2"/"standard"/"etage"). Wird auf JEDES seit
|
||
;; Glied-Start neu erzeugte Entity geschrieben, WAEHREND es noch frei in der
|
||
;; Zeichnung liegt (vor dem finalen -BLOCK-Sweep in vfl-block-erstellen) -
|
||
;; siehe vfl-segment-xdata-sichern. Rein additive Zusatzinformation: das
|
||
;; bestehende Ketten-Journal (SSG_VF_EDIT) bleibt unabhaengig davon die
|
||
;; primaere/vollstaendige Quelle, Segment-XDATA ist kein Ersatz dafuer.
|
||
;; Layout: [0]="linienzug-seg" (Marker), [1]=Glied-Index (1-basiert, String),
|
||
;; [2..]=Segment-Journal-String in 250-Byte-Chunks.
|
||
(defun vfl-journal-xdata-schreiben-seg (ent seg-idx seg-journal / chunks appentry)
|
||
(regapp "SSG_VF_EDIT_SEG")
|
||
(setq chunks (vfl-chunk-string (vfl-journal-list->string seg-journal) 250))
|
||
(setq appentry
|
||
(cons "SSG_VF_EDIT_SEG"
|
||
(cons (cons 1000 "linienzug-seg")
|
||
(cons (cons 1000 (itoa seg-idx))
|
||
(mapcar (function (lambda (c) (cons 1000 c))) chunks)))))
|
||
(entmod (append (entget ent) (list (list -3 appentry))))
|
||
ent)
|
||
;; Rueckgabe: (seg-idx . segment-journal) oder nil (kein/unbekanntes Segment-XDATA).
|
||
(defun vfl-journal-xdata-lesen-seg (ent / xd app-data werte)
|
||
(setq xd (entget ent '("SSG_VF_EDIT_SEG")))
|
||
(setq app-data (cdr (assoc -3 xd)))
|
||
(if app-data
|
||
(progn
|
||
(setq werte (mapcar 'cdr (cdr (car app-data))))
|
||
(if (and werte (= (car werte) "linienzug-seg") (cadr werte))
|
||
(cons (atoi (cadr werte)) (vfl-string->journal (apply 'strcat (cddr werte))))
|
||
nil))
|
||
nil))
|
||
|
||
;; Wird direkt nach dem Segment-Dispatch-cond in vf-linienzug-modus aufgerufen
|
||
;; (per vl-catch-all-apply abgesichert - ein Fehler hier darf den Hauptbau nie
|
||
;; abbrechen, rein additive Zusatz-XDATA). seg-lastEnt = Schnappschuss VOR
|
||
;; diesem Glied (vf-lastent-ohne-attribute, siehe Aufruf). wahl wird hier
|
||
;; nicht mehr gebraucht (das Label steckt schon im STEP-Eintrag des Journals
|
||
;; via vfl-journal-steplabel) - Parameter bleibt fuer eine spaetere dbgmsg-
|
||
;; Diagnose nuetzlich, daher weiterhin uebergeben.
|
||
;; Ermittelt Glied-Index + Journal-Teilsequenz selbst aus dem aktuellen
|
||
;; *vfl-journal* (zu diesem Zeitpunkt bereits um dieses Glied vollstaendig
|
||
;; ergaenzt) und schreibt sie auf JEDES seit seg-lastEnt neu erzeugte Entity
|
||
;; (entnext-Wanderung, gleiches Muster wie vfl-block-erstellen/
|
||
;; vfl-modus-abbruch-sichern).
|
||
(defun vfl-segment-xdata-sichern (seg-lastEnt wahl / forward-journal seg-idx seg-journal e cnt slice-label)
|
||
(setq forward-journal (reverse *vfl-journal*))
|
||
(setq seg-idx (length (vfl-journal-glieder forward-journal)))
|
||
(setq cnt 0)
|
||
(if (> seg-idx 0)
|
||
(progn
|
||
(setq seg-journal (vfl-journal-slice forward-journal seg-idx))
|
||
;; Tatsaechliches Label der geschnittenen Slice (der STEP-Wert am Anfang).
|
||
;; Kann von wahl (dem Hauptschleifen-Label) ABWEICHEN: enthaelt die
|
||
;; VF-Einheit eine Vario-Kurve, ist DEREN STEP das letzte Glied, seg-idx
|
||
;; zeigt darauf, und die Slice ist die Vario-Kurve-Slice - waehrend wahl
|
||
;; noch "Horizontal-VF"/"Linie-VF" ist. Fuers Log/die Validierung zaehlt
|
||
;; das echte Slice-Label, nicht wahl (sonst falsch etikettiert).
|
||
(setq slice-label
|
||
(if (and seg-journal (= (car (car seg-journal)) "STEP"))
|
||
(cdr (car seg-journal)) wahl))
|
||
(setq e (if seg-lastEnt (entnext seg-lastEnt) (entnext)))
|
||
(while e
|
||
(vfl-journal-xdata-schreiben-seg e seg-idx seg-journal)
|
||
(setq cnt (1+ cnt))
|
||
(setq e (entnext e))
|
||
)
|
||
;; Diagnose: den tatsaechlichen Segment-Journal-Inhalt als JSON loggen
|
||
;; (analog zum Ketten-XDATA-JOURNAL-JSON in vfl-journal-xdata-schreiben)
|
||
;; plus die Anzahl der beschriebenen Entities. No-Op ohne offene .dbg.
|
||
(dbgmsg (strcat "SEGMENT-XDATA-JSON Glied " (itoa seg-idx) " ("
|
||
(if slice-label slice-label "?") ") auf " (itoa cnt) " Entity(s): "
|
||
(vfl-journal->json seg-journal)))
|
||
;; Zusaetzlich benannt loggen (statt roher [INT]/[STR]-Zeilen). Feste
|
||
;; Glieder (AS/ES/GF-Bogen/Vario-Kurve) ueber ihr Feld-Schema
|
||
;; (GF-Bogen.winkel = 90), die VF-Einheit (Linie-VF/Horizontal-VF, variable
|
||
;; Laenge) ueber den Sub-Step-Logger (VF.menue = 4, VF.laenge = ...). Beide
|
||
;; validieren, was validierbar ist, und markieren Abweichungen (<!! ...>).
|
||
;; Ueber slice-label (echtes Glied), nicht wahl.
|
||
(if (vfl-schema-felder slice-label)
|
||
(vfl-schema-log-slice slice-label seg-journal)
|
||
(if (member slice-label '("Linie-VF" "Horizontal-VF"))
|
||
(vfl-schema-log-vf slice-label seg-journal)))
|
||
)
|
||
(dbgmsg (strcat "SEGMENT-XDATA: kein Glied vorhanden (" (if wahl wahl "?") ")"))
|
||
)
|
||
(dbgflush)
|
||
(princ))
|
||
|
||
;; --- Abbruch-Sicherung ---
|
||
;; Alle nach lastEnt erzeugten Entities werden NICHT geloescht, sondern
|
||
;; GENAUSO wie beim erfolgreichen Abschluss (vfl-block-erstellen) zu einem
|
||
;; neuen VF_n-Block gewickelt, mit dem VOLLEN aktuellen Eingabe-Journal
|
||
;; (inkl. des angefangenen, noch unfertigen letzten Gliedes) als XDATA. Die
|
||
;; Geometrie bleibt in der Zeichnung stehen und ist sofort per Doppelklick
|
||
;; weiter editierbar/fortsetzbar (vfl-edit-ent) - unabhaengig davon, ob es
|
||
;; sich um einen frischen Bau oder einen Editier-Neuaufbau handelte (kein
|
||
;; Sonderfall mehr noetig). Aufgerufen aus dem *error*-Handler von
|
||
;; vf-linienzug-modus.
|
||
(defun vfl-modus-abbruch-sichern (lastEnt vfl-nummer anzahl-gf anzahl-vf
|
||
startpunkt frame as-seite es-seite marker /
|
||
e cnt vfl-ins wickel-erg)
|
||
(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* '())
|
||
(if (boundp '*vflw-pending*) (setq *vflw-pending* nil)))
|
||
|
||
;; --- Glied-Zerlegung fuer den Editier-Dialog ---
|
||
;; Labels der Glieder (STEP-Marker) in Bau-Reihenfolge.
|
||
(defun vfl-journal-glieder (forward-journal / out)
|
||
(setq out '())
|
||
(foreach e forward-journal
|
||
(if (= (car e) "STEP") (setq out (cons (cdr e) out))))
|
||
(reverse out))
|
||
|
||
;; Journal auf die ersten (keep) Glieder kuerzen: Praeambel (vor dem 1. STEP)
|
||
;; bleibt immer erhalten; ab dem (keep+1)-ten STEP wird alles verworfen.
|
||
(defun vfl-journal-truncate (forward-journal keep / seen out done)
|
||
(setq seen 0 out '() done nil)
|
||
(foreach e forward-journal
|
||
(if (not done)
|
||
(if (= (car e) "STEP")
|
||
(if (< seen keep)
|
||
(progn (setq seen (1+ seen)) (setq out (cons e out)))
|
||
(setq done t))
|
||
(setq out (cons e out)))))
|
||
(reverse out))
|
||
|
||
;; Journal-Eintraege GENAU eines Glieds liefern: der (from-step-idx)-te STEP
|
||
;; (1-basiert, in Bau-Reihenfolge) bis ausschliesslich dem naechsten STEP.
|
||
;; Praeambel-Eintraege vor dem 1. STEP gehoeren zu keinem Glied und werden
|
||
;; hier nie zurueckgegeben (anders als vfl-journal-truncate, das sie immer
|
||
;; mitnimmt). Genutzt fuer die Segment-XDATA (vfl-segment-xdata-sichern) und
|
||
;; das Ersetzen eines einzelnen Glieds (vfl-journal-splice).
|
||
(defun vfl-journal-slice (forward-journal from-step-idx / seen out started done)
|
||
(setq seen 0 out '() started nil done nil)
|
||
(foreach e forward-journal
|
||
(if (not done)
|
||
(cond
|
||
((and (= (car e) "STEP") started) (setq done t))
|
||
((= (car e) "STEP")
|
||
(setq seen (1+ seen))
|
||
(if (= seen from-step-idx) (progn (setq started t) (setq out (cons e out)))))
|
||
(started (setq out (cons e out))))))
|
||
(reverse out))
|
||
|
||
;; Journal-Eintraege des Glieds (seg-idx) durch (new-seg-journal) ersetzen -
|
||
;; alle anderen Glieder (davor UND danach) sowie die Praeambel bleiben
|
||
;; unveraendert. Gegenstueck zu vfl-journal-slice (welches genau dieses Glied
|
||
;; ISOLIERT liefert). Genutzt von der Einzelsegment-Bearbeitung (vfl-edit-glied).
|
||
(defun vfl-journal-splice (forward-journal seg-idx new-seg-journal / seen out)
|
||
(setq seen 0 out '())
|
||
(foreach e forward-journal
|
||
(progn
|
||
(if (= (car e) "STEP") (setq seen (1+ seen)))
|
||
(cond
|
||
((< seen seg-idx) (setq out (cons e out))) ; vor dem Ziel-Glied: unveraendert
|
||
((> seen seg-idx) (setq out (cons e out))) ; nach dem Ziel-Glied: unveraendert
|
||
((and (= seen seg-idx) (= (car e) "STEP")) ; Ziel-Glied: einmalig durch
|
||
(setq out (append (reverse new-seg-journal) out)))))) ; new-seg-journal ersetzen,
|
||
(reverse out)) ; alle uebrigen Eintraege verwerfen
|
||
|
||
;; Internes (sprachneutrales) Glied-Token in lesbaren Text der AKTUELLEN Sprache
|
||
;; uebersetzen. Da im Journal nur das Token steht, folgt die Anzeige immer der
|
||
;; aktiven Sprache - ein in Deutsch aufgezeichnetes Journal zeigt in englischer
|
||
;; UI englische Labels (und umgekehrt).
|
||
(defun vfl-glied-label-text (w)
|
||
(cond ((= w "GF-Bogen") (ssg-text "vfl-glied-gf-bogen"))
|
||
((= w "Linie-GF") (ssg-text "vfl-glied-gf"))
|
||
((= w "Linie-VF") (ssg-text "vfl-glied-vf"))
|
||
((= w "Horizontal-VF") (ssg-text "vfl-glied-horizontal-vf"))
|
||
((= w "Linie") (ssg-text "vfl-glied-linie"))
|
||
((= w "AS") (ssg-text "vfl-glied-as"))
|
||
((= w "ES") (ssg-text "vfl-glied-es"))
|
||
((= w "Vario-Kurve") (ssg-text "vfl-glied-vario"))
|
||
((= w "?") (ssg-text "vfl-glied-offen"))
|
||
(t w)))
|
||
|
||
;; ============================================================
|
||
;; TEIL 1: SEGMENT-ENTSCHEIDUNG (GF oder VF)
|
||
;; ============================================================
|
||
|
||
;; Aus der Ergebnisliste von berechne-alle-winkel die GUELTIGEN Winkel filtern
|
||
;; und - bei mehreren - den Nutzer waehlen lassen. Rueckgabe: (winkel L_GF L_VF)
|
||
;; oder nil, wenn kein gueltiger Winkel existiert.
|
||
(defun vfl-waehle-winkel (ergebnis-liste / gueltige idx antwort e labels)
|
||
(setq gueltige '())
|
||
(foreach e ergebnis-liste
|
||
(if (and (cadddr e) (numberp (cadr e)) (numberp (caddr e))
|
||
(> (cadr e) 0) (> (caddr e) 0))
|
||
(setq gueltige (append gueltige (list e)))))
|
||
(cond
|
||
((null gueltige) nil)
|
||
((= (length gueltige) 1)
|
||
(setq e (car gueltige)) (list (nth 0 e) (nth 1 e) (nth 2 e)))
|
||
(t
|
||
(princ (ssg-text "vfl-mehrere-winkel-header"))
|
||
(setq idx 1 labels '())
|
||
(foreach e gueltige
|
||
(princ (ssg-textf "vfl-winkel-option"
|
||
(list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))
|
||
(setq labels (append labels
|
||
(list (ssg-textf "vfl-winkel-option" (list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))))
|
||
(setq idx (1+ idx)))
|
||
(setq antwort (vfl-menu-int (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige)))
|
||
labels 1 "vfl-mehrere-winkel-header"))
|
||
(if (or (null antwort) (< antwort 1) (> antwort (length gueltige))) (setq antwort 1))
|
||
(setq e (nth (1- antwort) gueltige))
|
||
(list (nth 0 e) (nth 1 e) (nth 2 e)))))
|
||
|
||
;; 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 1000.0) (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 3.0)
|
||
(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 (* 3.0 (/ pi 180.0)))
|
||
(setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3)))
|
||
(/ 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 3) (+ winkel 3)))
|
||
(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 1000.0) 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 3.0))
|
||
(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 800.0) 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" 800.0))
|
||
(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" 800.0)))
|
||
)
|
||
)
|
||
(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 3.0))
|
||
(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 1000.0)
|
||
(if (= richtung "Auf")
|
||
(list nil nil nil nil)
|
||
(list "GF" 3.0 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 3.0)) *vfl-gf-winkel-toleranz*)
|
||
(list "GF" 3.0 nil nil)
|
||
(vfl-vf-entscheidung deltaL deltaH richtung))
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 2: SEGMENT-EINFUEGUNG (ohne AS/ES - reine Kettenmitte)
|
||
;; ============================================================
|
||
|
||
;; Reine, kontinuierlich skalierte Gefaelleschraege (kein AS/ES, kein Bogen).
|
||
;; punkt: Startpunkt (3D), hz: Horizontalrichtung, deltaL: horizontaler
|
||
;; Fussabdruck, winkel: Neigungswinkel (aus vfl-segment-entscheidung).
|
||
;; Die Schraeglaenge wird aus deltaL/cos(winkel) abgeleitet, damit der
|
||
;; horizontale Fussabdruck exakt deltaL entspricht (deltaH = deltaL*tan(winkel)
|
||
;; ergibt sich damit konsistent). Rueckgabe: neuer Frame am Segmentende.
|
||
(defun vfl-insert-gf-segment (punkt hz deltaL winkel / l-schraeg endpunkt)
|
||
(setq l-schraeg (/ deltaL (cos (* (float winkel) (/ pi 180.0)))))
|
||
(setq endpunkt
|
||
(gf-insert-hz-incl-scaled "Staustrecke_SP_1000_mm" punkt l-schraeg hz winkel))
|
||
(make-frame-from-dir endpunkt (hz-winkel->xu hz winkel))
|
||
)
|
||
|
||
;; Ansicht auf Grundriss (Draufsicht, Welt-UCS) zoomen: nach jedem
|
||
;; Kettenglied mit Geometrieerzeugung wird die neu entstandene Strecke sonst
|
||
;; leicht aus dem sichtbaren Bereich oder in eine schraege 3D-Ansicht
|
||
;; hinauslaufen - der naechste Punkt (vfl-neue-linie-messen, siehe unten)
|
||
;; waere dann schwer/ungenau anzuwaehlen. _PLAN "_World" aendert nur die
|
||
;; ANSICHT, nicht das aktuell aktive BKS. Rein kosmetisch (per
|
||
;; vl-catch-all-apply abgesichert) - ein Fehler hier darf den eigentlichen
|
||
;; Kettenbau nie unterbrechen.
|
||
(defun vfl-view-refresh ( / )
|
||
(vl-catch-all-apply
|
||
(function (lambda ()
|
||
(command "_.PLAN" "_World")
|
||
(command "_.ZOOM" "_Extents")))
|
||
nil)
|
||
(princ))
|
||
|
||
;; --- Hilfsfunktionen fuer die VF-Einheit ---
|
||
|
||
;; Planare (XY-)Distanz und Richtung zwischen zwei Punkten.
|
||
(defun vfl-planar-dist (p1 p2)
|
||
(sqrt (+ (expt (- (car p2) (car p1)) 2) (expt (- (cadr p2) (cadr p1)) 2))))
|
||
(defun vfl-planar-hz (p1 p2)
|
||
(* (atan (- (cadr p2) (cadr p1)) (- (car p2) (car p1))) (/ 180.0 pi)))
|
||
|
||
;; Neue Linie ausmessen: Laenge (deltaL) und Fahrtrichtung (hz) bestimmen.
|
||
;; Ist hz-vorgabe gesetzt (Fahrtrichtung durch das vorherige Element - z.B.
|
||
;; einen GF-Bogen oder eine Vario-Kurve - bereits festgelegt), wird der
|
||
;; gewaehlte Punkt auf diese Richtung PROJIZIERT: die Linie folgt exakt der
|
||
;; Fahrtrichtung, der Nutzer gibt praktisch nur die Laenge vor (eine gerade
|
||
;; Foerderstrecke kann die Richtung nicht aendern). Nur beim allerersten
|
||
;; Segment (hz-vorgabe=nil) definiert der gewaehlte Punkt die Richtung frei.
|
||
;; Punkt-Abfrage mit FESTER 2-Arity (Basispunkt + Prompt). Verhaltensneutraler
|
||
;; Wrapper um das variadische Built-in getpoint: mit Basispunkt (base) wird die
|
||
;; 2-Argument-Form genutzt (Gummiband), ohne (base=nil) die reine Prompt-Form.
|
||
;; Zweck: ein Testmock kann diese feste Signatur ersetzen (getpoint selbst kann
|
||
;; als defun nicht 1- UND 2-argumentig gemockt werden).
|
||
;; DYNMODE waehrend des Picks auf 3 (Pointer- + Dimensions-Input) setzen, damit
|
||
;; BricsCAD Distanz/Winkel dynamisch am Cursor anzeigt (Laengen-Feedback beim
|
||
;; Picken) - danach den Nutzer-Wert wiederherstellen.
|
||
(defun vfl-getpoint (base prompt / old-dynmode pt)
|
||
(setq old-dynmode (vl-catch-all-apply 'getvar (list "DYNMODE")))
|
||
(if (vl-catch-all-error-p old-dynmode) (setq old-dynmode nil))
|
||
(if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" 3)))
|
||
(setq pt (if base (getpoint base prompt) (getpoint prompt)))
|
||
(if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" old-dynmode)))
|
||
pt
|
||
)
|
||
|
||
;; Vorschlagswert fuer die GF-Zielhoehe: die aktuelle Kettenhoehe (ist-hoehe)
|
||
;; UNVERAENDERT als Default anzubieten fuehrt in eine Falle - ein GF-Segment
|
||
;; MUSS fallen (0 Grad Gefaelle gibt es nicht), ein direkt uebernommener
|
||
;; Vorschlag mit deltaH=0 wird also immer als "kann nicht steigen" abgelehnt.
|
||
;; Deshalb hier auf volle mm ABGERUNDET (truncate, nicht rtos-Rundung - die
|
||
;; koennte sonst aufrunden und ueber die Ist-Hoehe hinausgehen) und bei
|
||
;; bereits ganzzahligen Werten zusaetzlich 1mm abgezogen, damit der Vorschlag
|
||
;; immer echt unterhalb der Ist-Hoehe liegt und direkt uebernehmbar ist.
|
||
(defun vfl-gf-hoehe-vorschlag (ist-hoehe / gekappt)
|
||
(setq gekappt (float (fix ist-hoehe)))
|
||
(if (>= gekappt ist-hoehe) (- gekappt 1.0) gekappt))
|
||
|
||
;; Punkt+Prompt-Eingabe fuer eine neue Linie journalfrei in (deltaL . hz)
|
||
;; uebersetzen: LIVE wird ganz normal ein Punkt gepickt (Gummiband), aber
|
||
;; NICHT der Punkt selbst journalisiert, sondern nur die daraus berechnete
|
||
;; Distanz (immer) und - NUR wenn hz-vorgabe nil war (freie Richtung, gilt
|
||
;; ausschliesslich fuer das allererste Segment der Kette) - zusaetzlich die
|
||
;; gesnappte Richtung. Ist hz-vorgabe bereits gesetzt (jedes Nicht-Start-
|
||
;; Segment), journalisiert diese Funktion NUR deltaL - die Richtung ist ja
|
||
;; ohnehin immer die des Vorgaengers, ein Journal-Eintrag dafuer waere
|
||
;; redundant. Rueckgabe: (deltaL . hz) oder nil bei Abbruch/leerer Eingabe.
|
||
(defun vfl-in-abstand (p-akt hz-vorgabe prompt / p2 rad ux uy deltaL hz-aktuell popped)
|
||
(if *vfl-replay-queue*
|
||
(progn
|
||
;; Replay: IMMER nur deltaL aus der Queue lesen (nie einen Punkt). Bei
|
||
;; freier Richtung (hz-vorgabe nil) steht direkt DANACH noch die
|
||
;; gesnappte Richtung als zweiter Eintrag im Journal (siehe
|
||
;; Live-Zweig unten) - Reihenfolge: deltaL, dann optional hz.
|
||
(setq popped (vfl-replay-pop))
|
||
(if (null popped)
|
||
(setq deltaL nil)
|
||
(setq deltaL (car popped)))
|
||
(if (and deltaL (null hz-vorgabe))
|
||
(progn
|
||
(setq popped (vfl-replay-pop))
|
||
(setq hz-aktuell (if popped (car popped) 0.0)))
|
||
(setq hz-aktuell hz-vorgabe)))
|
||
(progn
|
||
;; Live/Wizard: Pending-Queue zuerst pruefen (Konsistenz mit den
|
||
;; anderen vfl-in-*-Wrappern/Sicherheitsnetz, siehe vfl-wizard-aktiv-
|
||
;; Kommentar oben) - aktuell legt kein Gruppen-Dialog hier einen Punkt
|
||
;; ab, dieser Zweig bleibt also praktisch immer leer. Sonst normal
|
||
;; picken (Gummiband). Der Punkt lebt nur hier lokal, er wird nie
|
||
;; journalisiert.
|
||
(setq popped (vflw-pending-pop))
|
||
(setq p2 (if popped (car popped) (vfl-getpoint p-akt prompt)))
|
||
(if (null p2)
|
||
(setq deltaL nil)
|
||
(progn
|
||
(setq hz-aktuell (if hz-vorgabe hz-vorgabe (vfl-hz-snappen-absolut (vfl-planar-hz p-akt p2))))
|
||
(setq rad (* (float hz-aktuell) (/ pi 180.0)) ux (cos rad) uy (sin rad))
|
||
(setq deltaL (+ (* (- (car p2) (car p-akt)) ux) (* (- (cadr p2) (cadr p-akt)) uy)))))))
|
||
;; Journalisieren fuer BEIDE Zweige (Replay UND Live) - wie alle anderen
|
||
;; vfl-in-*-Wrapper (siehe vfl-in-point/-real/-int): ein beim Replay aus der
|
||
;; alten Queue gelesener Wert MUSS ins neue *vfl-journal* uebernommen werden,
|
||
;; sonst fehlt er beim erneuten Speichern (vfl-journal-xdata-schreiben nach
|
||
;; einem Edit) - genau das fuehrte beim ZWEITEN Edit einer Kette zum
|
||
;; deltaL-Desync (die replizierten DL/Richtungs-Eintraege waren im nach dem
|
||
;; ersten Edit gespeicherten Journal verschwunden). Reihenfolge identisch zur
|
||
;; Lese-Reihenfolge oben: erst DL, dann - nur beim ersten Segment
|
||
;; (hz-vorgabe nil) - die gesnappte Richtung als REAL.
|
||
(vfl-journal-record (if deltaL "DL" "NIL") deltaL)
|
||
(if (and deltaL (null hz-vorgabe))
|
||
(vfl-journal-record "REAL" hz-aktuell))
|
||
(if deltaL (cons deltaL hz-aktuell) nil))
|
||
|
||
;; 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 25000.0)
|
||
(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 20000.0)
|
||
(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))) 1.5))
|
||
|
||
;; 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 300 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.
|
||
(defun vfl-baue-horizontal-koerper (frame hz dL ziel-modus gf2-laenge /
|
||
pt m1 sep-vor pt-vor-bogen sep-nach ist-ende-antwort)
|
||
(setq pt (car frame))
|
||
(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"))
|
||
(if (and ziel-modus sep-vor) (setq dL (max 100.0 (- dL 300.0))))
|
||
;; 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 100.0 (- dL (vfl-projiziere-distanz pt-vor-bogen pt hz))))))
|
||
;; Separator NACH abfragen (noch nicht bauen) - im Ziel-Modus VOR der
|
||
;; Laengenberechnung, damit der Fussabdruck feststeht.
|
||
(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 (and ziel-modus sep-nach) (setq dL (max 100.0 (- dL 300.0))))
|
||
;; Im Ziel-Modus: "Ist der Endpunkt der Foerderer?" JETZT abfragen (statt
|
||
;; erst danach in der Aufruferschleife) - der Ausgangs-Fussabdruck
|
||
;; (Vario_Bogen_ab_3 + Motorstation) wird nur reserviert, wenn tatsaechlich
|
||
;; sofort geschlossen wird (Antwort 1 oder 3).
|
||
(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"))
|
||
(cond
|
||
((= ist-ende-antwort "1")
|
||
(setq dL (max 100.0 (- dL (car (get-bogen-mass bogen-ab 3)) 500.0
|
||
(* (if gf2-laenge gf2-laenge 0.0)
|
||
(cos (* 3.0 (/ pi 180.0))))))))
|
||
((= ist-ende-antwort "3")
|
||
(setq dL (max 100.0 (- dL (car (get-bogen-mass bogen-ab 3)) 500.0))))
|
||
)
|
||
)
|
||
)
|
||
;; 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)
|
||
(setq frame (make-frame-from-dir pt (hz-winkel->xu hz 0.0)))
|
||
(if ziel-modus (list frame ist-ende-antwort) frame)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; OPTION 3: KETTENENDE AUS LAUFENDER VF-EINHEIT (ein Motor)
|
||
;; ============================================================
|
||
;; Zerlegt den verbleibenden GERADEN Lauf bis zum Ziel-ES mit der bewaehrten
|
||
;; STANDARD-Logik (wie aussen), aber fuer den Mid-Body-Fall:
|
||
;; - Der Einlauf (AS + GF1 + Separator + Umlenk) ist bereits gebaut und wird
|
||
;; NICHT beruecksichtigt -> aus-dx/aus-dz = 0.
|
||
;; - Fest vor dem ES stehen nur Motor(500) + Auslauf-Separator(300)
|
||
;; -> FESTE_HORIZONTAL = 800.
|
||
;; Ergebnis der Standard-Logik (GF2 = GF, VARIIERT mit dem Winkel):
|
||
;; steiler als 3 Grad / steigend -> gewinkeltes VF + GF2 (Winkeltabelle),
|
||
;; flacher als 3 Grad -> horizontales VF + GF2 (Rest-Laenge ueber
|
||
;; das horizontale Stueck ausgeglichen).
|
||
;; Die Hoehe kommt also aus VF-Winkel/horizontal + GF2, die ueberschuessige
|
||
;; Laenge aus dem horizontalen VF - genau die zweistufige Logik.
|
||
;; 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 800.0)
|
||
(setq res
|
||
(cond
|
||
;; kuerzer als Motor(500)+Separator(300): kein Abschluss baubar
|
||
((< deltaL 800.0) (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" 800.0))))
|
||
(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 3.0)) *vfl-gf-winkel-toleranz*)
|
||
(list "GF" 3.0 nil nil))
|
||
;; steiler als 3 Grad -> Stufe 1: gewinkeltes VF + GF2 (GF2 variiert mit Winkel)
|
||
((> winkel-natuerlich 3.0)
|
||
(setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Ab" 800.0))))
|
||
(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" 800.0))))
|
||
(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.
|
||
(defun vfl-body-abschluss (frame letzt-hz p-umlenk /
|
||
linie-mess dL hzn hn dH richtn rad3 dec typ w lgf lvf
|
||
gf2 cnt p0 tx ty
|
||
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))
|
||
(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))))
|
||
(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 576.0))) (cos rad3)) 800.0)))
|
||
(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)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; 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 ---
|
||
(setq entry-start (car frame))
|
||
(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)
|
||
(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 100.0 (- 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).
|
||
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
|
||
;; Motorstation braucht 3-Grad-Basis: falls die Kette gerade flach endet
|
||
;; (horizontales Stueck ohne ab_3), hier den ab_3-Uebergang nachholen.
|
||
(setq frame (vfl-nach-3grad frame))
|
||
;; Auslauf-GF2: im Kettenende-Modus (Option 3) neu berechnet (ziel-gf2),
|
||
;; sonst aus der GF-Verteilungs-Frage (L_GF2-bau).
|
||
(setq gf2-eff (if ziel-ende ziel-gf2 L_GF2-bau))
|
||
(setq frame (vfl-frame-3grad
|
||
(vfs-vf-exit (car frame) gf2-eff letzt-hz nil) letzt-hz))
|
||
(if (> gf2-eff 0.1)
|
||
(vfl-acc-gf-seg gf2-eff (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
|
||
(list frame vf-count ziel-ende es-gewuenscht)
|
||
)
|
||
|
||
;; 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.
|
||
(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"))
|
||
(vf-set-es-masse *vfl-es-winkel* es-seite)
|
||
es-seite
|
||
)
|
||
|
||
;; Separator (300mm) an der aktuellen Stelle einfuegen (bei 3-Grad-Neigung,
|
||
;; Frame-Kettung ueber KS). Rueckgabe: neuer Frame am Separator-Ausgang.
|
||
;; Genutzt fuer den optionalen Zwischen-Separator zwischen zwei Foerderern.
|
||
(defun vfl-insert-separator (frame / hz w sep-endpunkt)
|
||
(setq hz (car (frame->hz-winkel frame)))
|
||
(setq w (ssg-cfg-or "vario" "gefaelle_winkel" 3))
|
||
(setq sep-endpunkt
|
||
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" (car frame) hz w 300 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 300 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 "SEITE_ES" es-seite)
|
||
;; 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")))
|
||