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 Drehteller-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")))
|
||
(cons "VF_Bogen_A_60" (itoa (vfl-get-count *vfl-acc-variokurve* "A_60")))
|
||
(cons "VF_Bogen_A_30" (itoa (vfl-get-count *vfl-acc-variokurve* "A_30")))
|
||
(cons "VF_Bogen_I_90" (itoa (vfl-get-count *vfl-acc-variokurve* "I_90")))
|
||
(cons "VF_Bogen_I_60" (itoa (vfl-get-count *vfl-acc-variokurve* "I_60")))
|
||
(cons "VF_Bogen_I_30" (itoa (vfl-get-count *vfl-acc-variokurve* "I_30")))
|
||
(cons "ANZAHL_SEPARATOR" (itoa *vfl-acc-separator*))
|
||
)
|
||
)
|
||
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
|
||
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
|
||
(ssg-id-generate vfl-insert))
|
||
(princ (ssg-textf "vfl-block-erstellt" (list vfl-bname typ-str)))
|
||
vfl-insert
|
||
)
|
||
|
||
;; Baut eine komplette VarioFoerderer-Einheit und schliesst sie ab:
|
||
;; GF-Verteilung fragen -> vfl-vf-einheit (Umlenk..Motor, mehrsegmentig)
|
||
;; -> Kettenende? Ja: Separator+ES (Ende); Nein: optionaler Zwischen-Separator.
|
||
;; winkel1=0 => horizontaler Anfangs-Koerper (Option "Neue horizontal VF").
|
||
;; auto-ende: T => keine Kettenende-Frage, es wird direkt Separator + ES
|
||
;; gesetzt (Option "Neue Linie BIS Kettenende").
|
||
;; Rueckgabe: (frame anzahl-koerper ende-flag es-seite-oder-nil).
|
||
(defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF auto-ende /
|
||
antwort res es-s ende es-gewuenscht)
|
||
;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf.
|
||
(princ (ssg-text "vfl-gf-verteilung-header"))
|
||
(princ (ssg-text "vfl-gf-verteilung-haelfte"))
|
||
(princ (ssg-text "vfl-gf-verteilung-ganz-einlauf"))
|
||
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
|
||
(list (ssg-text "vfl-gf-verteilung-haelfte")
|
||
(ssg-text "vfl-gf-verteilung-ganz-einlauf")) 2
|
||
"vfl-gf-verteilung-header"))
|
||
(setq res (vfl-vf-einheit frame hz richtung winkel L_GF L_VF (= antwort "1")))
|
||
(setq frame (nth 0 res) es-gewuenscht (nth 3 res))
|
||
;; Kettenende? Bei auto-ende (Kettenende-Modus) ohne Frage direkt ES setzen.
|
||
;; ziel-ende (Option 3 IN der VF-Einheit) OHNE ES-Wunsch (dort abgefragt,
|
||
;; siehe vfl-vf-einheit): Kette endet direkt hier, kein Separator+ES, keine
|
||
;; weitere Frage. ziel-ende MIT ES-Wunsch ODER auto-ende (Option 4): ohne
|
||
;; Frage direkt Separator + ES. Sonst normal fragen - zwischen einem AS und
|
||
;; ES koennen mehrere Foerderer liegen.
|
||
(if (and (nth 2 res) (not es-gewuenscht))
|
||
(setq antwort "kein-es")
|
||
(if (or auto-ende (nth 2 res))
|
||
(setq antwort "1")
|
||
(progn
|
||
(princ (ssg-text "vfl-ist-kettenende-frage"))
|
||
(princ (ssg-text "vfl-ja-separator-es"))
|
||
(princ (ssg-text "vfl-nein-weiterbauen"))
|
||
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
|
||
(list (ssg-text "vfl-ja-separator-es")
|
||
(ssg-text "vfl-nein-weiterbauen")) 2
|
||
"vfl-ist-kettenende-frage"))
|
||
)
|
||
)
|
||
)
|
||
(cond
|
||
((= antwort "kein-es")
|
||
(setq ende t)
|
||
;; Ist-Ziel-Report auch ohne ES (Vergleich Soll-Zielpunkt vs. tatsaechliches
|
||
;; Kettenende nach GF2/Motor).
|
||
(if *vfl-ziel-punkt*
|
||
(progn
|
||
(princ (ssg-text "vfl-ist-ziel-vergleich-header"))
|
||
(princ (ssg-textf "vfl-soll-xyz"
|
||
(list (rtos (car *vfl-ziel-punkt*) 2 1)
|
||
(rtos (cadr *vfl-ziel-punkt*) 2 1)
|
||
(rtos (caddr *vfl-ziel-punkt*) 2 1))))
|
||
(princ (ssg-textf "vfl-ist-xyz"
|
||
(list (rtos (car (car frame)) 2 1)
|
||
(rtos (cadr (car frame)) 2 1)
|
||
(rtos (caddr (car frame)) 2 1))))
|
||
(princ (ssg-textf "vfl-abweichung-xyz"
|
||
(list (rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1)
|
||
(rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1)
|
||
(rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1))))
|
||
(setq *vfl-ziel-punkt* nil)
|
||
)
|
||
)
|
||
)
|
||
((= antwort "1")
|
||
(setq es-s (vfl-frage-es-seite))
|
||
(setq frame (vfl-insert-es-element "VF" frame
|
||
(car (frame->hz-winkel frame)) 0.0
|
||
(caddr (car frame)) es-s))
|
||
(setq ende t)
|
||
;; Ist-Ziel-Report (Option 3): Soll-ES (aus vfl-body-abschluss) vs. Ist-ES.
|
||
(if *vfl-ziel-punkt*
|
||
(progn
|
||
(princ (ssg-text "vfl-ist-ziel-vergleich-header"))
|
||
(princ (ssg-textf "vfl-soll-xyz"
|
||
(list (rtos (car *vfl-ziel-punkt*) 2 1)
|
||
(rtos (cadr *vfl-ziel-punkt*) 2 1)
|
||
(rtos (caddr *vfl-ziel-punkt*) 2 1))))
|
||
(princ (ssg-textf "vfl-ist-xyz"
|
||
(list (rtos (car (car frame)) 2 1)
|
||
(rtos (cadr (car frame)) 2 1)
|
||
(rtos (caddr (car frame)) 2 1))))
|
||
(princ (ssg-textf "vfl-abweichung-xyz"
|
||
(list (rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1)
|
||
(rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1)
|
||
(rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1))))
|
||
(setq *vfl-ziel-punkt* nil)
|
||
)
|
||
)
|
||
)
|
||
(t
|
||
(princ (ssg-text "vfl-sep-an-stelle-frage"))
|
||
(princ (ssg-text "vfl-ja"))
|
||
(princ (ssg-text "vfl-nein"))
|
||
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
|
||
(list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2
|
||
"vfl-sep-an-stelle-frage"))
|
||
(if (= antwort "1") (setq frame (vfl-insert-separator frame)))
|
||
)
|
||
)
|
||
(list frame (nth 1 res) ende es-s)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 5: HAUPTBEFEHL - MODUS 1 (MANUELLE EINGABE)
|
||
;; ============================================================
|
||
(defun vf-linienzug-modus ( / startpunkt start-hoehe as-seite es-seite antwort wahl
|
||
p-aktuell linie-mess hoehe-neu hoehe-bis deltaL deltaH richtung hz-neu
|
||
entscheidung typ winkel L_GF L_VF vf-einheit-res
|
||
frame letzter-typ fertig linie-ende-modus rad3
|
||
anzahl-gf anzahl-vf vfl-nummer lastEnt seg-lastEnt
|
||
gf-max-winkel gf-ok kettenanfang
|
||
as-vorhanden erg old-error vfl-ins dbg-an
|
||
hoehe-vorschlaege hoehe-ab hoehe-auf hoehe-fallback)
|
||
(princ "\n\n=========================================")
|
||
(princ (ssg-text "vfl-modus1-header"))
|
||
(princ "\n=========================================")
|
||
(princ (ssg-text "vfl-modus1-beschreibung"))
|
||
|
||
;; --- Debug-Session (Schalter "vfl-modus1", DEFAULT AN) ------------------
|
||
;; (dbg-schalter-off "vfl-modus1") deaktiviert bei Bedarf das Loggen.
|
||
;; Geloggt wird ueber vfl-journal-record/-mark/-steplabel (siehe dort) -
|
||
;; das erfasst automatisch JEDE interaktive Eingabe dieses Modus (Punkte,
|
||
;; Hoehen, Winkel, Menue-Auswahlen) samt Glied-Uebergaengen, ohne dass jede
|
||
;; einzelne Aufrufstelle im Bau-Ablauf separat instrumentiert werden muss.
|
||
(setq dbg-an (dbg-schalter-open "vfl-modus1" "vfl_modus1.dbg" "DXFM_LOG"))
|
||
(if dbg-an
|
||
(progn
|
||
(dbgf "vf-linienzug-modus")
|
||
(dbgmsg "=== SESSION Modus 1 (Manuelle Eingabe) START ===")
|
||
;; Diagnose: falls dieser Lauf ein Replay ist (Editieren/Fortsetzen,
|
||
;; *vfl-replay-queue* gesetzt), die EINGEHENDE Replay-Queue als JSON
|
||
;; ausgeben - VOR dem Neuaufbau, daher auch bei einem Absturz mitten im
|
||
;; Replay sichtbar (anders als das XDATA-JOURNAL-JSON in
|
||
;; vfl-journal-xdata-schreiben, das erst nach erfolgreichem Bau laeuft).
|
||
;; So laesst sich ein Desync direkt an der Eingangs-Sequenz ablesen.
|
||
(if *vfl-replay-queue*
|
||
(dbgmsg (strcat "REPLAY-QUEUE-JSON " (vfl-journal->json *vfl-replay-queue*)))
|
||
(dbgmsg "LIVE-BAU (kein Replay)"))
|
||
(dbgflush)))
|
||
|
||
;; Abhaengigkeit: die GF-Segmente/-Boegen nutzen Funktionen aus
|
||
;; Gefaellestrecke.lsp (gf-insert-hz-incl-scaled, gf-bogen-blockname, ...).
|
||
;; Bei reiner VarioFoerderer-Ladung ohne Gefaellestrecke wuerde der GF-Zweig
|
||
;; fehlschlagen - deshalb hier pruefen.
|
||
(if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED"))))
|
||
(progn
|
||
(alert (ssg-text "vfl-alert-gf-modul-fehlt"))
|
||
(exit)
|
||
)
|
||
)
|
||
|
||
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
|
||
|
||
;; --- Abbruch-Sicherung scharf schalten (VOR dem ersten Prompt!) ---
|
||
;; Ab hier kann jederzeit Geometrie entstehen. Ein *error*-Handler faengt
|
||
;; jeden Abbruch (ESC / (exit) / Laufzeitfehler) ab und WICKELT die bereits
|
||
;; eingefuegte Teil-Geometrie (alles nach lastEnt) zu einem VF_n-Block mit
|
||
;; dem vollen aktuellen Eingabe-Journal als XDATA (vfl-modus-abbruch-sichern)
|
||
;; - die Geometrie bleibt stehen und ist per Doppelklick sofort weiter
|
||
;; editierbar/fortsetzbar (kein Rollback mehr, kein separater
|
||
;; "Fortsetzen"-Mechanismus noetig).
|
||
;; Die Installation MUSS vor dem allerersten vfl-in-*-Aufruf erfolgen: ein
|
||
;; echtes ESC (nicht ein leeres Enter) loest bei JEDEM get*-Aufruf sofort
|
||
;; *error* aus (nicht nil) - ohne den Handler wuerde ein ESC in diesem
|
||
;; Fenster auf den vorherigen Handler zurueckfallen (im Editier-Pfad: der
|
||
;; ssg-start-Handler ohne Wickeln - der bereits geloeschte Original-Block
|
||
;; waere dann ersatzlos weg). lastEnt/old-error/vfl-nummer/anzahl-gf/
|
||
;; anzahl-vf/startpunkt/frame/as-seite/es-seite sind zur Aufrufzeit
|
||
;; dynamisch gebunden und daher im Handler-Lambda sichtbar (AutoLISP
|
||
;; dynamic scoping, gilt fuer die gesamte Laufzeit dieses Aufrufs, auch
|
||
;; tief verschachtelt z.B. in vfl-vf-einheit).
|
||
(setq vfl-nummer (vf-next-number))
|
||
(setq lastEnt (vf-lastent-ohne-attribute))
|
||
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
|
||
(setq old-error *error*)
|
||
;; Abbruch-Handler: zuerst *error* zuruecksetzen (kein rekursiver
|
||
;; Wiedereintritt bei einem Fehler waehrend des Wickelns), dann wickeln.
|
||
;; Laeuft der Aufruf innerhalb einer ssg-start-Sitzung (Editier-Pfad via
|
||
;; c:VARIOFOERDERER_EDIT -> vfl-edit-ent), wird diese mit ssg-end sauber
|
||
;; geschlossen (Undo-Gruppe, gesicherte Systemvariablen, *error* aus dem
|
||
;; Sitzungs-Frame) - sonst bliebe die von ssg-start geoeffnete Undo-Gruppe
|
||
;; offen.
|
||
(setq *error*
|
||
(function (lambda (msg)
|
||
(setq *error* old-error)
|
||
(vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf
|
||
startpunkt frame as-seite es-seite "linienzug")
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
|
||
(dbgreturn nil)
|
||
(dbgclose)))
|
||
(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
|
||
(princ))))
|
||
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
|
||
(list "vfl-prompt-startpunkt-kette" "Starthoehe (Z, mm):")))
|
||
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-prompt-startpunkt-kette")))
|
||
(if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
|
||
;; Hoehe (Z) des Startpunkts abfragen und in die Z-Koordinate uebernehmen.
|
||
(setq start-hoehe
|
||
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt-kette" (list (rtos (caddr startpunkt) 2 1)))))
|
||
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
|
||
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
|
||
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-as-setzen-frage")))
|
||
(princ (ssg-text "vfl-as-setzen-frage"))
|
||
(princ (ssg-text "vfl-ja"))
|
||
(princ (ssg-text "vfl-as-nein"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list (ssg-text "vfl-ja") (ssg-text "vfl-as-nein")) 1
|
||
"vfl-as-setzen-frage"))
|
||
(setq as-vorhanden (/= antwort "2"))
|
||
(if as-vorhanden
|
||
(progn
|
||
(setq *vfl-as-winkel*
|
||
(vfl-in-value "STR"
|
||
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
|
||
(princ (ssg-text "vfl-aus-seite-header"))
|
||
(princ (ssg-text "gf-seite-links"))
|
||
(princ (ssg-text "gf-seite-rechts"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
|
||
"vfl-aus-seite-header"))
|
||
(setq as-seite (if (= antwort "2") "rechts" "links"))
|
||
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
|
||
)
|
||
)
|
||
;; ES-Seite wird erst am Kettenende abgefragt (siehe vfl-frage-es-seite),
|
||
;; da das ES-Element erst dort eingefuegt wird.
|
||
|
||
(setq p-aktuell startpunkt)
|
||
(setq letzter-typ nil fertig nil frame nil)
|
||
(setq anzahl-gf 0 anzahl-vf 0)
|
||
(vfl-acc-reset)
|
||
|
||
(while (not fertig)
|
||
;; --- Naechstes Element bestimmen ---
|
||
;; Nach einem GF-Segment ODER einer geschlossenen VF-Einheit (beide enden
|
||
;; auf 3-Grad-Neigung) darf ein GF-Bogen oder eine neue Linie folgen. Nur
|
||
;; am Kettenanfang folgt direkt eine neue Linie. Vario-Kurven werden
|
||
;; INNERHALB der VF-Einheit behandelt (vfl-vf-einheit).
|
||
;; Menue immer anzeigen; GF-Bogen nur, wenn bereits ein Frame existiert
|
||
;; (am Kettenanfang gibt es keinen Vorgaenger-Rahmen fuer einen Bogen).
|
||
;; Lueckenlose Nummerierung: GF-Bogen (nur mit Frame) ist immer Option 1;
|
||
;; ohne Frame ruecken die uebrigen Optionen auf 1..4 auf.
|
||
;; "Neue Linie" ist in zwei explizite Zweige aufgeteilt (GF / Ab-Auf-VF) -
|
||
;; der Nutzer legt den Segmenttyp direkt fest, keine Geometrie-Automatik
|
||
;; mehr wie bei "Neue Linie BIS Kettenende" (die bleibt unveraendert und
|
||
;; nutzt weiterhin vfl-segment-entscheidung).
|
||
(princ (ssg-text "vfl-naechstes-element-header"))
|
||
(setq linie-ende-modus nil)
|
||
;; Glied-Checkpoint am Iterationskopf setzen; Label wird nach der Auswahl
|
||
;; nachgetragen (vfl-journal-steplabel), damit jedes Glied seine eigene
|
||
;; Menue-Auswahl + Segment-Eingaben vollstaendig umschliesst (fuer den
|
||
;; gliedweisen Ruecksprung beim Editieren).
|
||
;; seg-lastEnt: Schnappschuss VOR diesem Glied, fuer die Segment-XDATA
|
||
;; (vfl-segment-xdata-sichern, siehe Ende der cond unten) - dieselbe
|
||
;; Hilfsfunktion wie beim Ketten-lastEnt (oben), damit ATTRIB/SEQEND-
|
||
;; Ketten eines vorherigen INSERTs konsistent uebersprungen werden.
|
||
(setq seg-lastEnt (vf-lastent-ohne-attribute))
|
||
(vfl-journal-mark "?")
|
||
(if frame
|
||
(progn
|
||
(princ (ssg-text "vfl-menu-gf-bogen-1"))
|
||
(princ (ssg-text "vfl-menu-linie-gf-2"))
|
||
(princ (ssg-text "vfl-menu-linie-vf-3"))
|
||
(princ (ssg-text "vfl-menu-horizontal-vf-4"))
|
||
(princ (ssg-text "vfl-menu-linie-ende-5"))
|
||
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-5-def2")
|
||
(list (ssg-text "vfl-menu-gf-bogen-1")
|
||
(ssg-text "vfl-menu-linie-gf-2")
|
||
(ssg-text "vfl-menu-linie-vf-3")
|
||
(ssg-text "vfl-menu-horizontal-vf-4")
|
||
(ssg-text "vfl-menu-linie-ende-5")) 2
|
||
"vfl-naechstes-element-header"))
|
||
(setq wahl (cond ((= antwort "1") "GF-Bogen")
|
||
((= antwort "3") "Linie-VF")
|
||
((= antwort "4") "Horizontal-VF")
|
||
((= antwort "5") (setq linie-ende-modus t) "Linie")
|
||
(t "Linie-GF"))) ; "2" oder leer
|
||
)
|
||
(progn
|
||
(princ (ssg-text "vfl-menu-linie-gf-1"))
|
||
(princ (ssg-text "vfl-menu-linie-vf-2"))
|
||
(princ (ssg-text "vfl-menu-horizontal-vf-3"))
|
||
(princ (ssg-text "vfl-menu-linie-ende-4"))
|
||
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-4-def1")
|
||
(list (ssg-text "vfl-menu-linie-gf-1")
|
||
(ssg-text "vfl-menu-linie-vf-2")
|
||
(ssg-text "vfl-menu-horizontal-vf-3")
|
||
(ssg-text "vfl-menu-linie-ende-4")) 1
|
||
"vfl-naechstes-element-header"))
|
||
(setq wahl (cond ((= antwort "2") "Linie-VF")
|
||
((= antwort "3") "Horizontal-VF")
|
||
((= antwort "4") (setq linie-ende-modus t) "Linie")
|
||
(t "Linie-GF"))) ; "1" oder leer
|
||
)
|
||
)
|
||
;; Segmenttyp steht fest -> Glied-Label nachtragen (fuer die Edit-Liste).
|
||
(vfl-journal-steplabel wahl)
|
||
|
||
(progn
|
||
(cond
|
||
((= wahl "GF-Bogen")
|
||
(setq frame (vfl-insert-gf-bogen frame))
|
||
(setq p-aktuell (car frame))
|
||
)
|
||
|
||
;; --- Neue horizontal VF: VF-Einheit mit horizontalem Anfangs-Koerper ---
|
||
((= wahl "Horizontal-VF")
|
||
(setq linie-mess (vfl-neue-linie-messen p-aktuell
|
||
(if frame (car (frame->hz-winkel frame)) nil)))
|
||
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
|
||
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
|
||
(setq kettenanfang (null frame))
|
||
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen, reale
|
||
;; Restlaenge aus dem tatsaechlichen KS_AUS nachrechnen (siehe
|
||
;; vfl-kettenanfang-baustein).
|
||
(if kettenanfang
|
||
(progn
|
||
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
|
||
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
|
||
)
|
||
)
|
||
(if (< deltaL 1000.0)
|
||
(progn
|
||
(princ (ssg-text "vfl-fehler-horizontal-vf-kurz"))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Horizontal-VF zu kurz (deltaL="
|
||
(rtos deltaL 2 0) ")"))))
|
||
(progn
|
||
;; VF-Einheit mit horizontalem ersten Koerper (winkel=0, L_VF=deltaL,
|
||
;; L_GF = Mindestlaenge fuer den Einlauf-Anschluss).
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss horizontal (deltaL=" (rtos deltaL 2 0)
|
||
" L_GF=" (rtos *vfl-gf-min-laenge* 2 0) " L_VF=" (rtos deltaL 2 0) ")")))
|
||
(setq vf-einheit-res
|
||
(vfl-vf-einheit-abschluss frame hz-neu "Ab" 0 *vfl-gf-min-laenge* deltaL nil))
|
||
(setq frame (nth 0 vf-einheit-res))
|
||
(setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res)))
|
||
(if (nth 2 vf-einheit-res) (setq fertig t))
|
||
(if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res)))
|
||
(setq letzter-typ "VF")
|
||
(setq p-aktuell (car frame))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE ERFOLG: Horizontal-VF-Einheit gebaut, neue Position="
|
||
(dbg-tostring p-aktuell))))
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Neue Linie: GF (Nutzer legt den Typ explizit fest) ---
|
||
((= wahl "Linie-GF")
|
||
;; Fahrtrichtung folgt dem vorherigen Element (Frame); nur das erste
|
||
;; Segment (frame=nil) definiert die Richtung frei.
|
||
(setq linie-mess (vfl-neue-linie-messen p-aktuell
|
||
(if frame (car (frame->hz-winkel frame)) nil)))
|
||
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
|
||
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
|
||
(setq kettenanfang (null frame))
|
||
(setq gf-max-winkel (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
|
||
(if (< deltaL 1.0)
|
||
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
|
||
(progn
|
||
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
|
||
;; (Richtung hz-neu jetzt bekannt) und die GF-Restlaenge aus dem
|
||
;; TATSAECHLICHEN KS_AUS nachrechnen (siehe vfl-kettenanfang-
|
||
;; baustein). Keine Fussabdruck-Schaetzung mehr: sowohl KS_EIN- als
|
||
;; auch Ursprung-basierte Vorab-Messung ignorieren die Drehteller-
|
||
;; Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
|
||
;; anwendet, und liefern daher einen falschen Wert (empirisch
|
||
;; bestaetigt: ~210mm Schaetzung vs. tatsaechlich ~420mm noetiger
|
||
;; Versatz).
|
||
(if kettenanfang
|
||
(progn
|
||
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
|
||
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
|
||
)
|
||
)
|
||
;; Nach dem AS-Einfuegen kann die reale Restlaenge (aus dem
|
||
;; tatsaechlichen KS_AUS neu gemessen) kleiner als der urspruenglich
|
||
;; gepickte Rohwert sein - bei einem knapp gepickten Punkt sogar
|
||
;; NEGATIV (das AS-Element allein braucht bereits mehr Platz als bis
|
||
;; zum Klickpunkt vorhanden war). Ohne diese zweite Pruefung wuerde
|
||
;; vfl-insert-gf-segment mit negativem deltaL "erfolgreich" eine
|
||
;; entartete/unsichtbare GF-Strecke bauen (leerer Sprung zwischen AS
|
||
;; und dem naechsten Element) statt den Nutzer erneut picken zu
|
||
;; lassen - siehe vfl-fehler-linie-zu-kurz oben (dieselbe Meldung).
|
||
;; Sofortiger Abbruch DIESES Zweigs (kein Weiterfragen nach Winkel/
|
||
;; Hoehe fuer ein Segment, das ohnehin nicht gebaut werden kann) -
|
||
;; gf-ok wird unten sonst mehrfach ueberschrieben.
|
||
(if (< deltaL 1.0)
|
||
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
|
||
(progn
|
||
(setq gf-ok t)
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-gefaelle-impl
|
||
(list (vfl-gf-hoehe-vorschlag (caddr p-aktuell)))))
|
||
(princ (ssg-text "vfl-gefaelle-festlegen-header"))
|
||
(princ (ssg-text "vfl-gefaelle-opt-hoehe"))
|
||
(princ (ssg-text "vfl-gefaelle-opt-winkel"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list (ssg-text "vfl-gefaelle-opt-hoehe")
|
||
(ssg-text "vfl-gefaelle-opt-winkel")) 1
|
||
"vfl-gefaelle-festlegen-header"))
|
||
(if (= antwort "2")
|
||
(progn
|
||
;; Winkel direkt vorgeben - deltaH ergibt sich aus deltaL*tan(winkel).
|
||
(setq winkel
|
||
(vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel" (list (rtos gf-max-winkel 2 1)))))
|
||
(if (null winkel) (setq winkel gf-max-winkel))
|
||
(if (or (<= winkel 0.0) (> winkel gf-max-winkel))
|
||
(progn
|
||
(alert (ssg-textf "vfl-alert-winkel-ungueltig"
|
||
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
|
||
(setq gf-ok nil))
|
||
(progn
|
||
(setq richtung "Ab")
|
||
(setq deltaH (* deltaL (/ (sin (* winkel (/ pi 180.0)))
|
||
(cos (* winkel (/ pi 180.0))))))
|
||
)
|
||
)
|
||
)
|
||
(progn
|
||
;; Gegebene Hoehe - wie bisher, aber Winkel wird daraus abgeleitet
|
||
;; und gegen den GF-Maximalwinkel geprueft (GF kann nicht steigen).
|
||
;; p-aktuell ist ab hier immer der reale Referenzpunkt (bei
|
||
;; Kettenanfang das echte KS_AUS des AS-Elements). Vorschlag/
|
||
;; Enter-Default = vfl-gf-hoehe-vorschlag (siehe dort), NICHT
|
||
;; die unveraenderte Ist-Hoehe - sonst waere deltaH=0 und die
|
||
;; GF-Pruefung wiese den Wert als "kann nicht steigen" ab.
|
||
(setq hoehe-neu
|
||
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt"
|
||
(list (rtos (vfl-gf-hoehe-vorschlag (caddr p-aktuell)) 2 1)))))
|
||
(if (null hoehe-neu) (setq hoehe-neu (vfl-gf-hoehe-vorschlag (caddr p-aktuell))))
|
||
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
|
||
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
|
||
(setq deltaH (abs deltaH))
|
||
(cond
|
||
((= richtung "Auf")
|
||
(alert (ssg-text "vfl-alert-gf-kann-nicht-steigen"))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-GF kann nicht steigen"
|
||
" (deltaL=" (rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0) ")")))
|
||
(setq gf-ok nil))
|
||
(t
|
||
(setq winkel (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
|
||
(if (> winkel gf-max-winkel)
|
||
(progn
|
||
(alert (ssg-textf "vfl-alert-gefaelle-zu-steil"
|
||
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-GF zu steil (deltaL="
|
||
(rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0)
|
||
" winkel=" (rtos winkel 2 1) " max=" (rtos gf-max-winkel 2 1) ")")))
|
||
(setq gf-ok nil))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(if gf-ok
|
||
(progn
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE: vfl-insert-gf-segment (deltaL=" (rtos deltaL 2 0)
|
||
" hz=" (rtos hz-neu 2 1) " winkel=" (rtos winkel 2 1) ")")))
|
||
(setq frame (vfl-insert-gf-segment (car frame) hz-neu deltaL winkel))
|
||
(setq anzahl-gf (1+ anzahl-gf))
|
||
(vfl-acc-gf-seg (/ deltaL (cos (* (float winkel) (/ pi 180.0)))) winkel)
|
||
(setq letzter-typ "GF")
|
||
(setq p-aktuell (car frame))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE ERFOLG: GF-Segment gebaut, neue Position="
|
||
(dbg-tostring p-aktuell))))
|
||
(princ (ssg-text "vfl-ist-kettenende-header"))
|
||
(princ (ssg-text "vfl-kettenende-opt-ja-es"))
|
||
(princ (ssg-text "vfl-kettenende-opt-ja-ohne-es"))
|
||
(princ (ssg-text "vfl-kettenende-opt-nein"))
|
||
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3")
|
||
(list (ssg-text "vfl-kettenende-opt-ja-es")
|
||
(ssg-text "vfl-kettenende-opt-ja-ohne-es")
|
||
(ssg-text "vfl-kettenende-opt-nein")) 3
|
||
"vfl-ist-kettenende-header"))
|
||
(cond
|
||
((= antwort "1")
|
||
(setq es-seite (vfl-frage-es-seite))
|
||
(setq frame (vfl-insert-es-element "GF" frame hz-neu winkel
|
||
(caddr (car frame)) es-seite))
|
||
(setq fertig t))
|
||
((= antwort "2") (setq fertig t))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Neue Linie: Ab/Auf VF (Nutzer legt den Typ explizit fest) ---
|
||
((= wahl "Linie-VF")
|
||
(setq linie-mess (vfl-neue-linie-messen p-aktuell
|
||
(if frame (car (frame->hz-winkel frame)) nil)))
|
||
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
|
||
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
|
||
(setq kettenanfang (null frame))
|
||
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen, reale
|
||
;; Restlaenge aus dem tatsaechlichen KS_AUS nachrechnen (siehe
|
||
;; vfl-kettenanfang-baustein).
|
||
(if kettenanfang
|
||
(progn
|
||
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
|
||
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
|
||
)
|
||
)
|
||
(if (< deltaL 1000.0)
|
||
(princ (ssg-text "vfl-fehler-vf-kurz"))
|
||
(progn
|
||
(setq hoehe-vorschlaege (vfl-vf-hoehe-vorschlaege (caddr p-aktuell) deltaL))
|
||
(setq hoehe-ab (nth 0 hoehe-vorschlaege) hoehe-auf (nth 1 hoehe-vorschlaege))
|
||
(setq hoehe-fallback (if hoehe-ab hoehe-ab (caddr p-aktuell)))
|
||
(vfl-hoehe-hinweis-falls-noetig hoehe-ab hoehe-auf)
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl
|
||
(list (list hoehe-ab hoehe-auf (caddr p-aktuell)))))
|
||
(setq hoehe-neu
|
||
(vfl-in-real
|
||
(if (and hoehe-ab hoehe-auf)
|
||
(ssg-textf "vfl-prompt-hoehe-linienendpunkt-2"
|
||
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1)))
|
||
(ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos hoehe-fallback 2 1))))))
|
||
(if (null hoehe-neu) (setq hoehe-neu hoehe-fallback))
|
||
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
|
||
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
|
||
(setq deltaH (abs deltaH))
|
||
(setq entscheidung (vfl-vf-entscheidung deltaL deltaH richtung))
|
||
(setq typ (nth 0 entscheidung) winkel (nth 1 entscheidung)
|
||
L_GF (nth 2 entscheidung) L_VF (nth 3 entscheidung))
|
||
(if (null typ)
|
||
(progn
|
||
(alert (ssg-textf "vfl-alert-vf-nicht-baubar"
|
||
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie-VF nicht baubar (deltaL="
|
||
(rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0)
|
||
" richtung=" richtung ")"))))
|
||
(progn
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss (deltaL=" (rtos deltaL 2 0)
|
||
" deltaH=" (rtos deltaH 2 0) " richtung=" richtung
|
||
" winkel=" (rtos (float winkel) 2 1)
|
||
" L_GF=" (rtos L_GF 2 0) " L_VF=" (rtos L_VF 2 0) ")")))
|
||
(setq vf-einheit-res
|
||
(vfl-vf-einheit-abschluss frame hz-neu richtung winkel L_GF L_VF nil))
|
||
(setq frame (nth 0 vf-einheit-res))
|
||
(setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res)))
|
||
(if (nth 2 vf-einheit-res) (setq fertig t))
|
||
(if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res)))
|
||
(setq letzter-typ "VF")
|
||
(setq p-aktuell (car frame))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE ERFOLG: VF-Einheit gebaut, neue Position="
|
||
(dbg-tostring p-aktuell))))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
((= wahl "Linie") ;; --- Neue Linie BIS Kettenende (automatische GF/VF-Entscheidung, unveraendert) ---
|
||
;; Fahrtrichtung folgt dem vorherigen Element (Frame); nur das erste
|
||
;; Segment (frame=nil) definiert die Richtung frei.
|
||
(setq linie-mess (vfl-neue-linie-messen p-aktuell
|
||
(if frame (car (frame->hz-winkel frame)) nil)))
|
||
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
|
||
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess))
|
||
(setq kettenanfang (null frame))
|
||
(if (< deltaL 1.0)
|
||
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
|
||
(progn
|
||
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
|
||
;; (immer flach, typ-unabhaengig - siehe vfl-insert-as-element;
|
||
;; welcher Segmenttyp folgt, steht hier noch nicht fest), reale
|
||
;; Restlaenge aus dem tatsaechlichen KS_AUS nachrechnen (siehe
|
||
;; vfl-kettenanfang-baustein).
|
||
(if kettenanfang
|
||
(progn
|
||
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu deltaL as-seite as-vorhanden))
|
||
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
|
||
)
|
||
)
|
||
;; Nach dem AS-Einfuegen kann die reale Restlaenge (aus dem
|
||
;; tatsaechlichen KS_AUS neu gemessen) kleiner als der urspruenglich
|
||
;; gepickte Rohwert sein - bei einem knapp gepickten Punkt sogar
|
||
;; NEGATIV. Ohne diese zweite Pruefung wuerde die Kurzsegment-
|
||
;; Automatik unten (< 1000mm) mit negativem deltaL trotzdem ein
|
||
;; "erfolgreiches" GF-Segment bauen (entartete/unsichtbare Strecke,
|
||
;; das naechste Element - z.B. ein GF-Bogen - erscheint dann direkt
|
||
;; am AS-Element, obwohl der Nutzer davor noch eine Linie wollte).
|
||
(if (< deltaL 1.0)
|
||
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
|
||
(progn
|
||
;; Segment-Typ bestimmen. Kurzsegment (deltaL < 1000 mm): KEINE
|
||
;; Hoehenabfrage - automatisch 3-Grad-Gefaellestrecke. Grund: ein VF
|
||
;; braucht >= 1000 mm deltaL (Umlenk- + Motorstation = 500+500 mm),
|
||
;; und eine GF ist mindestens 3 Grad geneigt. Die Endhoehe ergibt
|
||
;; sich damit fest aus deltaH = deltaL*tan(3 Grad).
|
||
;; Im Kettenende-Modus (Option 4) wird IMMER nach der Zielhoehe
|
||
;; gefragt (Kurzsegment-Automatik hier ueberspringen).
|
||
(if (and (< deltaL 1000.0) (not linie-ende-modus))
|
||
(progn
|
||
(setq typ "GF" winkel 3.0 richtung "Ab" L_GF nil L_VF nil)
|
||
(setq deltaH (* deltaL (/ (sin (* 3.0 (/ pi 180.0)))
|
||
(cos (* 3.0 (/ pi 180.0))))))
|
||
(setq hoehe-neu (- (caddr p-aktuell) deltaH))
|
||
(princ (ssg-textf "vfl-info-kurzes-segment"
|
||
(list (rtos deltaL 2 0) (rtos deltaH 2 1))))
|
||
)
|
||
(progn
|
||
(setq hoehe-vorschlaege (vfl-segment-hoehe-vorschlaege (caddr p-aktuell) deltaL))
|
||
(setq hoehe-ab (nth 0 hoehe-vorschlaege) hoehe-auf (nth 1 hoehe-vorschlaege))
|
||
(setq hoehe-fallback (if hoehe-ab hoehe-ab (caddr p-aktuell)))
|
||
(vfl-hoehe-hinweis-falls-noetig hoehe-ab hoehe-auf)
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl
|
||
(list (list hoehe-ab hoehe-auf (caddr p-aktuell)))))
|
||
(setq hoehe-neu
|
||
(vfl-in-real
|
||
(if (and hoehe-ab hoehe-auf)
|
||
(ssg-textf "vfl-prompt-hoehe-linienendpunkt-2"
|
||
(list (rtos hoehe-ab 2 1) (rtos hoehe-auf 2 1)))
|
||
(ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos hoehe-fallback 2 1))))))
|
||
(if (null hoehe-neu) (setq hoehe-neu hoehe-fallback))
|
||
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
|
||
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
|
||
(setq deltaH (abs deltaH))
|
||
;; Kettenende-Modus (Option 4): Der abgefragte Endpunkt (XY+Z)
|
||
;; ist das exakte Ende der Kette NACH Separator + ES-Element.
|
||
;; Deren Footprint (Separator 300 mm bei ~3 Grad + ES-Element
|
||
;; ein-dx/ein-dz) muss vom baubaren GF/VF-Segment reserviert
|
||
;; (abgezogen) werden, damit das ES-Element genau am Zielpunkt
|
||
;; endet. Naeherung: Separator-Neigung = 3 Grad (Auslauf).
|
||
(if linie-ende-modus
|
||
(progn
|
||
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3))
|
||
(/ pi 180.0)))
|
||
(setq deltaL (max 1.0 (- deltaL (* 300.0 (cos rad3))
|
||
(abs (if ein-dx ein-dx 0.0)))))
|
||
(setq deltaH (max 0.0 (- deltaH (* 300.0 (sin rad3))
|
||
(abs (if ein-dz ein-dz 0.0)))))
|
||
(princ (ssg-textf "vfl-info-kettenende-footprint"
|
||
(list (rtos deltaL 2 0) (rtos deltaH 2 0))))
|
||
)
|
||
)
|
||
(setq entscheidung (vfl-segment-entscheidung deltaL deltaH richtung))
|
||
(setq typ (nth 0 entscheidung) winkel (nth 1 entscheidung)
|
||
L_GF (nth 2 entscheidung) L_VF (nth 3 entscheidung))
|
||
)
|
||
)
|
||
|
||
(if (null typ)
|
||
(progn
|
||
(alert (ssg-textf "vfl-alert-segment-nicht-baubar"
|
||
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE FEHLGESCHLAGEN: Linie (automatisch) nicht baubar"
|
||
" (deltaL=" (rtos deltaL 2 0) " deltaH=" (rtos deltaH 2 0)
|
||
" richtung=" richtung ")"))))
|
||
(progn
|
||
(if (= typ "GF")
|
||
(progn
|
||
;; --- reine Gefaellestrecke ---
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE: vfl-insert-gf-segment (deltaL=" (rtos deltaL 2 0)
|
||
" hz=" (rtos hz-neu 2 1) " winkel=" (rtos (float winkel) 2 1) ")")))
|
||
(setq frame (vfl-insert-gf-segment (car frame) hz-neu deltaL winkel))
|
||
(setq anzahl-gf (1+ anzahl-gf))
|
||
;; GF-Segment erfassen (Schraeglaenge = deltaL/cos(winkel))
|
||
(vfl-acc-gf-seg (/ deltaL (cos (* (float winkel) (/ pi 180.0)))) winkel)
|
||
(setq letzter-typ "GF")
|
||
(setq p-aktuell (car frame))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE ERFOLG: GF-Segment gebaut, neue Position="
|
||
(dbg-tostring p-aktuell))))
|
||
;; Kettenende-Modus (Option 4): ohne Frage direkt ES setzen.
|
||
;; Sonst nachfragen, ob die Kette hier endet.
|
||
(if linie-ende-modus
|
||
(setq antwort "1")
|
||
(progn
|
||
(princ (ssg-text "vfl-ist-kettenende-header"))
|
||
(princ (ssg-text "vfl-kettenende-opt-ja-es"))
|
||
(princ (ssg-text "vfl-kettenende-opt-ja-ohne-es"))
|
||
(princ (ssg-text "vfl-kettenende-opt-nein"))
|
||
(setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3")
|
||
(list (ssg-text "vfl-kettenende-opt-ja-es")
|
||
(ssg-text "vfl-kettenende-opt-ja-ohne-es")
|
||
(ssg-text "vfl-kettenende-opt-nein")) 3
|
||
"vfl-ist-kettenende-header"))
|
||
)
|
||
)
|
||
(cond
|
||
((= antwort "1")
|
||
(setq es-seite (vfl-frage-es-seite))
|
||
(setq frame (vfl-insert-es-element "GF" frame hz-neu winkel
|
||
(caddr (car frame)) es-seite))
|
||
(setq fertig t))
|
||
((= antwort "2") (setq fertig t))
|
||
)
|
||
)
|
||
(progn
|
||
;; --- VarioFoerderer-Einheit (Umlenk..Motor, mehrsegmentig) ---
|
||
;; linie-ende-modus=T -> direkt Kettenende (Separator + ES).
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE: vfl-vf-einheit-abschluss (deltaL=" (rtos deltaL 2 0)
|
||
" deltaH=" (rtos deltaH 2 0) " richtung=" richtung
|
||
" winkel=" (rtos (float winkel) 2 1)
|
||
" L_GF=" (rtos L_GF 2 0) " L_VF=" (rtos L_VF 2 0)
|
||
" linie-ende-modus=" (if linie-ende-modus "T" "nil") ")")))
|
||
(setq vf-einheit-res
|
||
(vfl-vf-einheit-abschluss frame hz-neu richtung winkel L_GF L_VF
|
||
linie-ende-modus))
|
||
(setq frame (nth 0 vf-einheit-res))
|
||
(setq anzahl-vf (+ anzahl-vf (nth 1 vf-einheit-res)))
|
||
(if (nth 2 vf-einheit-res) (setq fertig t))
|
||
(if (nth 3 vf-einheit-res) (setq es-seite (nth 3 vf-einheit-res)))
|
||
(setq letzter-typ "VF")
|
||
(setq p-aktuell (car frame))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "GEOMETRIE ERFOLG: VF-Einheit gebaut, neue Position="
|
||
(dbg-tostring p-aktuell))))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
;; Segment-XDATA: alle seit seg-lastEnt neu erzeugten Entities dieses
|
||
;; Glieds mit ihrer eigenen Journal-Teilsequenz markieren (rein additiv,
|
||
;; siehe vfl-segment-xdata-sichern) - muss laufen, WAEHREND die Entities
|
||
;; noch frei in der Zeichnung liegen (vor dem -BLOCK-Sweep in
|
||
;; vfl-block-erstellen unten).
|
||
(vl-catch-all-apply 'vfl-segment-xdata-sichern (list seg-lastEnt wahl))
|
||
)
|
||
)
|
||
|
||
(setq hoehe-bis (caddr (car frame)))
|
||
;; DELTA_L: planare Gesamtdistanz Start -> Kettenende
|
||
(setq vfl-ins
|
||
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
|
||
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite
|
||
startpunkt lastEnt))
|
||
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug" +
|
||
;; Chunks) -> spaeter per Doppelklick editierbar (vfl-edit-ent).
|
||
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins "linienzug"))
|
||
;; Erfolgreicher Abschluss: *error* zuruecksetzen.
|
||
(setq *error* old-error)
|
||
|
||
(princ "\n\n=========================================")
|
||
(princ (ssg-text "vfl-kette-eingefuegt"))
|
||
(princ "\n=========================================")
|
||
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer)
|
||
" (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")"))
|
||
(dbgmsg "=== SESSION Modus 1 ENDE ===")
|
||
(dbgreturn (list "VF" vfl-nummer))
|
||
(dbgclose)))
|
||
(princ)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; EDITIEREN: gliedweise zuruecknehmen + Neuaufbau per Replay
|
||
;; ============================================================
|
||
;; Aufgerufen aus c:VARIOFOERDERER_EDIT (Doppelklick auf VF_n mit XDATA-Marker
|
||
;; "linienzug", egal ob fertiggestellt oder durch einen Abbruch gewickelt).
|
||
;; Liest das Eingabe-Journal vom Block, listet die Glieder, laesst per
|
||
;; DCL-Dialog (vfl-dlg-position) eine Sektion waehlen, auf die zurueckgesetzt
|
||
;; wird, loescht den alten Block und baut die Kette neu: die behaltenen
|
||
;; Glieder werden stumm abgespielt, danach laeuft die Eingabe interaktiv fuer
|
||
;; die geaenderten/neuen Glieder weiter. Vorbelegung im Dialog = voller Stand
|
||
;; -> Doppelklick + sofort OK setzt einen abgebrochenen Bau nahtlos fort.
|
||
;; Marker-Dispatch: "linienzug" (Modus 1) -> abschnittsweises Zuruecksetzen
|
||
;; wie bisher; "linienzug2" (Modus 2) -> voller Reset ohne Sektionswahl
|
||
;; (vfl-edit-ent2) - Modus 2s Klassifizierungs-Schleife traegt keine
|
||
;; Glied-Marker, ein Sektions-Dialog wie bei Modus 1 ist dafuer (noch) nicht
|
||
;; vorgesehen.
|
||
;; ============================================================
|
||
;; EINZELSEGMENT-BEARBEITUNG (ein Glied aendern, Rest behalten)
|
||
;; ============================================================
|
||
;; Idee: das Ketten-Journal ist die vollstaendige, wiederabspielbare Bau-
|
||
;; Anleitung. Ein einzelnes Glied editieren = dessen Journal-Teilsequenz durch
|
||
;; eine neue ersetzen (vfl-journal-splice) und danach das GESAMTE ersetzte
|
||
;; Journal still abspielen (vfl-journal-replay-start + vf-linienzug-modus) -
|
||
;; exakt derselbe Mechanismus wie der Sektions-Ruecksprung, nur mit chirurgisch
|
||
;; ersetztem statt abgeschnittenem Journal. Die Glieder VOR dem geaenderten
|
||
;; spielen identisch wie zuvor ab (gleicher Frame), das geaenderte Glied mit
|
||
;; neuen Werten, die Glieder DANACH mit ihren ORIGINAL-Werten - aber ab dem
|
||
;; neuen Austritts-Frame des geaenderten Glieds neu verkettet. Das leistet die
|
||
;; bestehende Replay-Schleife von allein (jedes Glied baut relativ zum Frame
|
||
;; des Vorgaengers), ohne Zusatzlogik.
|
||
;;
|
||
;; Umfang: sauber einzeln editierbar sind Glieder mit reiner Winkel-/Seiten-
|
||
;; Entscheidung ohne Punkt-/Hoehen-Eingabe: GF-Bogen (Winkel 30/60/90 + Seite),
|
||
;; AS-Element (Winkel 30/90 + Seite, liegt in der Praeambel) und ES-Element
|
||
;; (Winkel 30/90 + Seite, eigenes STEP-Glied seit vfl-frage-es-seite). Andere
|
||
;; Glieder (Linie-GF/-VF, Horizontal-VF, Linie-bis-Ende) enthalten Punktwahl +
|
||
;; Hoehen und teils VF-interne Vario-Kurven - fuer die ist der Sektions-
|
||
;; Ruecksprung ("rueck") der passende Weg. Sie werden hier mit einem Hinweis
|
||
;; abgewiesen (statt eine halbfertige In-Place-Bearbeitung anzubieten).
|
||
|
||
;; Neue Journal-Teilsequenz fuer einen GF-Bogen aus den im Dialog gewaehlten
|
||
;; Werten bauen. Aufbau exakt wie vom Live-Bau erzeugt: STEP-Eintrag, dann
|
||
;; ("STR" . "1") fuer die "Naechstes Element waehlen"-Menueantwort (Option 1 =
|
||
;; GF-Bogen, siehe vf-linienzug-modus Hauptschleife - vfl-journal-mark setzt
|
||
;; den STEP-Checkpoint VOR dieser Menuefrage, vfl-journal-steplabel schreibt
|
||
;; danach nur das Label um, fuegt aber KEINEN neuen Eintrag ein; die
|
||
;; Menueantwort bleibt also als eigener Journal-Eintrag direkt nach dem STEP
|
||
;; stehen), dann ("INT" . winkel) + ("STR" . seite-code) aus
|
||
;; vfl-insert-gf-bogen (vfl-menu-winkel Winkel, vfl-menu Seite). winkel ist der
|
||
;; ECHTE Winkelwert 30/60/90 (kein Index mehr), seite-code "1"=links,
|
||
;; "2"=rechts. Ein GF-Bogen kann nie das erste Kettenglied sein (am
|
||
;; Kettenanfang bietet das Menue "GF-Bogen" gar nicht erst an, siehe
|
||
;; Hauptschleife) - die Menueantwort ist daher immer aus dem 5er-Menue (frame
|
||
;; vorhanden) und immer "1". Rueckgabe: forward-order Journal-Teilsequenz.
|
||
;; Struktur kommt aus *vfl-glied-schema* ("GF-Bogen": menue winkel seite) -
|
||
;; hier nur der Adapter (Aufrufsignatur bleibt winkel/seite-code).
|
||
(defun vfl-gf-bogen-slice-bauen (winkel seite-code)
|
||
(vfl-schema-slice-bauen "GF-Bogen" (list "1" winkel seite-code)))
|
||
|
||
;; Aktuellen (Winkel, Seiten-Code) aus einer bestehenden GF-Bogen-Slice lesen
|
||
;; (fuer die Dialog-Vorbelegung). Liest ueber das Schema (menue/winkel/seite)
|
||
;; und wirft das menue-Feld weg. Der Winkel wird zusaetzlich ueber
|
||
;; vfl-winkel-normieren auf 30/60/90 gebracht (faengt auch Alt-Journals mit
|
||
;; Index 1/2/3 ab: idx-Werte werden zum Default 90 normiert - solche Altbloecke
|
||
;; sind ohnehin selten und der Nutzer sieht/korrigiert den Winkel im
|
||
;; vorbelegten Dialog). Defaults: menue "1", Winkel 90, Seite links "1".
|
||
(defun vfl-gf-bogen-slice-werte (slice / werte w s)
|
||
(setq werte (vfl-schema-slice-werte "GF-Bogen" slice (list "1" 90 "1")))
|
||
(setq w (cadr werte) s (caddr werte))
|
||
(list (vfl-winkel-normieren w *vfk-gf-bogen-winkel* 90) s))
|
||
|
||
;; Pre-fill-faehiger Winkel+Seite-Dialog fuer den GF-Bogen (nutzt das
|
||
;; bestehende vflw_winkel_seite-Tile aus dem Wizard-DCL, aber mit Vorbelegung
|
||
;; auf die aktuellen Werte - anders als vflw-gruppe-winkel-seite-impl, das
|
||
;; immer bei 0 startet und daher nicht wiederverwendet werden kann, ohne den
|
||
;; Live-Bau zu beruehren). Rueckgabe: (winkel seite-code) oder nil bei
|
||
;; Abbruch. winkel 30/60/90 (echter Wert), seite-code "1"/"2".
|
||
(defun vfl-glied-gf-bogen-dialog (vor-winkel vor-seite-code /
|
||
dat dcl-pfad ergebnis gwinkel gseite)
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vflw_winkel_seite" dat))
|
||
(progn (if (and dat (>= dat 0)) (unload_dialog dat))
|
||
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
|
||
(progn
|
||
(set_tile "kopf" (ssg-text "vfl-gf-bogen-winkel-header"))
|
||
(start_list "winkel")
|
||
(add_list (ssg-text "vfl-winkel-30"))
|
||
(add_list (ssg-text "vfl-winkel-60"))
|
||
(add_list (ssg-text "vfl-winkel-90"))
|
||
(end_list)
|
||
;; Winkel 30/60/90 -> Listenposition 0/1/2
|
||
(set_tile "winkel" (itoa (- (length *vfk-gf-bogen-winkel*)
|
||
(length (member vor-winkel *vfk-gf-bogen-winkel*)))))
|
||
(start_list "seite")
|
||
(add_list (ssg-text "gf-seite-links"))
|
||
(add_list (ssg-text "gf-seite-rechts"))
|
||
(end_list)
|
||
(set_tile "seite" (if (= vor-seite-code "2") "1" "0"))
|
||
(action_tile "accept"
|
||
"(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(if (= ergebnis 1)
|
||
(list (nth (atoi gwinkel) *vfk-gf-bogen-winkel*) ; Listenposition 0/1/2 -> 30/60/90
|
||
(if (= gseite "1") "2" "1")) ; Liste 0=links/1=rechts -> code "1"/"2"
|
||
nil))))
|
||
|
||
;; Pre-fill-faehiger Winkel+Seite+Variante-Dialog fuer die Vario-Kurve (nutzt
|
||
;; das bestehende vflw_variokurve-Tile mit Vorbelegung). Wizard-Optionsreihen-
|
||
;; folge: Winkel (30 60 90), Seite (links rechts), Variante (aussen innen) -
|
||
;; genau wie vflw-gruppe-variokurve-impl. vor-* sind die aktuellen Werte:
|
||
;; vor-winkel echter Wert 30/60/90, vor-seite-code/vor-variante-code je "1"/"2".
|
||
;; Rueckgabe: (winkel seite-code variante-code) oder nil bei Abbruch.
|
||
(defun vfl-glied-vario-dialog (vor-winkel vor-seite-code vor-variante-code /
|
||
dat dcl-pfad ergebnis gwinkel gseite gvariante)
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vflw_variokurve" dat))
|
||
(progn (if (and dat (>= dat 0)) (unload_dialog dat))
|
||
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
|
||
(progn
|
||
(set_tile "kopf" (ssg-text "vfl-variokurve-winkel-header"))
|
||
(start_list "winkel")
|
||
(add_list (ssg-text "vfl-opt3-30grad"))
|
||
(add_list (ssg-text "vfl-opt2-60grad"))
|
||
(add_list (ssg-text "vfl-opt1-90grad"))
|
||
(end_list)
|
||
;; Winkel 30/60/90 -> Listenposition 0/1/2
|
||
(set_tile "winkel" (itoa (- (length *vfk-gf-bogen-winkel*)
|
||
(length (member vor-winkel *vfk-gf-bogen-winkel*)))))
|
||
(start_list "seite")
|
||
(add_list (ssg-text "gf-seite-links"))
|
||
(add_list (ssg-text "gf-seite-rechts"))
|
||
(end_list)
|
||
(set_tile "seite" (if (= vor-seite-code "2") "1" "0"))
|
||
(start_list "variante")
|
||
(add_list (ssg-text "vfl-variante-aussen"))
|
||
(add_list (ssg-text "vfl-variante-innen"))
|
||
(end_list)
|
||
(set_tile "variante" (if (= vor-variante-code "2") "1" "0"))
|
||
(action_tile "accept"
|
||
"(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (setq gvariante (get_tile \"variante\")) (done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(if (= ergebnis 1)
|
||
(list (nth (atoi gwinkel) *vfk-gf-bogen-winkel*) ; Listenposition 0/1/2 -> 30/60/90
|
||
(if (= gseite "1") "2" "1") ; Liste 0=links/1=rechts -> "1"/"2"
|
||
(if (= gvariante "1") "2" "1")) ; Liste 0=aussen/1=innen -> "1"/"2"
|
||
nil))))
|
||
|
||
;; Pre-fill-faehiger Winkel+Seite-Dialog fuer AS/ES-Element: nur ZWEI
|
||
;; Winkel-Optionen (90/30, in genau dieser Listen-Reihenfolge - wie
|
||
;; vf-frage-element-winkel/vflw-gruppe-winkel-seite-impl), Winkel als STRING
|
||
;; "90"/"30" (nicht Index). kopf-key waehlt die Kopfzeile (AS: vf-winkel-aus-
|
||
;; header, ES: vf-winkel-ein-header). Rueckgabe: (winkel-str seite-code) oder
|
||
;; nil bei Abbruch. seite-code "1"=links / "2"=rechts.
|
||
(defun vfl-glied-as-es-dialog (kopf-key vor-winkel-str vor-seite-code /
|
||
dat dcl-pfad ergebnis gwinkel gseite)
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vf_linienzug_wizard.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vflw_winkel_seite" dat))
|
||
(progn (if (and dat (>= dat 0)) (unload_dialog dat))
|
||
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
|
||
(progn
|
||
(set_tile "kopf" (ssg-text kopf-key))
|
||
(start_list "winkel")
|
||
(add_list (ssg-text "vf-winkel-90"))
|
||
(add_list (ssg-text "vf-winkel-30"))
|
||
(end_list)
|
||
(set_tile "winkel" (if (= vor-winkel-str "30") "1" "0")) ; Liste 0=90/1=30
|
||
(start_list "seite")
|
||
(add_list (ssg-text "gf-seite-links"))
|
||
(add_list (ssg-text "gf-seite-rechts"))
|
||
(end_list)
|
||
(set_tile "seite" (if (= vor-seite-code "2") "1" "0"))
|
||
(action_tile "accept"
|
||
"(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(if (= ergebnis 1)
|
||
(list (if (= gwinkel "1") "30" "90") ; Liste 0=90/1=30 -> "90"/"30"
|
||
(if (= gseite "1") "2" "1")) ; Liste 0=links/1=rechts -> "1"/"2"
|
||
nil))))
|
||
|
||
;; --- AS-/ES-Element (Winkel 30/90 + Seite links/rechts) ---
|
||
;; AS und ES sind KEINE ueber das Hauptmenue gewaehlten Glieder, ihre Slice
|
||
;; traegt daher KEINE fuehrende Menue-Antwort (anders als der GF-Bogen). Aufbau:
|
||
;; AS: gehoert in die PRAEAMBEL (vor dem 1. STEP), Eintraege: STR(winkel)
|
||
;; STR(seite) - siehe vf-linienzug-modus Kettenanfang. AS ist damit KEIN
|
||
;; STEP-Glied und wird ueber die Praeambel-Splice (vfl-journal-splice-as)
|
||
;; bearbeitet.
|
||
;; ES: hat seit vfl-frage-es-seite einen EIGENEN STEP-Marker "ES" und ist
|
||
;; damit ein regulaeres Glied. Slice: STEP("ES") STR(winkel) STR(seite).
|
||
;; winkel-str ist bei beiden "30" oder "90" (Rueckgabe vf-frage-element-winkel,
|
||
;; via vfl-in-value "STR" journalisiert), seite-code "1"=links / "2"=rechts.
|
||
|
||
;; Aktuelle (winkel-str seite-code) aus einer ES-Glied-Slice lesen (2 STR nach
|
||
;; dem STEP: erst Winkel, dann Seite). Struktur/Defaults aus *vfl-glied-schema*
|
||
;; ("ES": winkel seite). Defaults 90/links.
|
||
(defun vfl-es-slice-werte (slice)
|
||
(vfl-schema-slice-werte "ES" slice (list "90" "1")))
|
||
|
||
;; Neue ES-Glied-Slice bauen: STEP("ES") + STR(winkel) + STR(seite), Struktur
|
||
;; aus dem Schema.
|
||
(defun vfl-es-slice-bauen (winkel-str seite-code)
|
||
(vfl-schema-slice-bauen "ES" (list winkel-str seite-code)))
|
||
|
||
;; --- Vario-Kurve (Winkel 30/60/90 + Seite + Variante) --------------------
|
||
;; Slice: STEP("Vario-Kurve") INT(winkel) STR(seite) STR(variante), Struktur aus
|
||
;; *vfl-glied-schema* ("Vario-Kurve"). winkel echter Wert 90/60/30 (kein Index),
|
||
;; seite/variante als Menue-Code "1"/"2" (seite: 1=links/2=rechts, variante:
|
||
;; 1=aussen/2=innen - genau wie im Live-Bau vfl-insert-vario-kurve
|
||
;; journalisiert). Aktuelle Werte aus einer bestehenden Slice lesen; Defaults
|
||
;; 90/links/innen (innen = Live-Bau-Default, vfl-menu-Vorgabe 2).
|
||
(defun vfl-vario-slice-werte (slice / werte)
|
||
(setq werte (vfl-schema-slice-werte "Vario-Kurve" slice (list 90 "1" "2")))
|
||
;; Winkel gegen Fremdwerte absichern (analog GF-Bogen).
|
||
(list (vfl-winkel-normieren (car werte) *vfk-gf-bogen-winkel* 90)
|
||
(cadr werte) (caddr werte)))
|
||
|
||
;; Neue Vario-Kurve-Slice bauen.
|
||
(defun vfl-vario-slice-bauen (winkel seite-code variante-code)
|
||
(vfl-schema-slice-bauen "Vario-Kurve" (list winkel seite-code variante-code)))
|
||
|
||
;; Neue Vario-Kurve-Slice bauen, die den SCHWANZ der alten Slice erhaelt.
|
||
;; WICHTIG - Sonderfall gegenueber GF-Bogen/ES: Die Vario-Kurve ist das EINZIGE
|
||
;; STEP-Glied, das MITTEN in einem umschliessenden Konstrukt (der VF-Einheit)
|
||
;; steht. Nach ihren drei eigenen Werten (INT winkel, STR seite, STR variante)
|
||
;; folgen im Journal - noch VOR dem naechsten STEP - weitere Antworten der
|
||
;; VF-Einheit-Schleife ("Ist Endpunkt?", "Naechstes VF-Element?" usw.). Ein
|
||
;; naiver vfl-journal-splice (der die GANZE Slice bis zum naechsten STEP
|
||
;; ersetzt) wuerde diese nachfolgenden VF-Antworten VERWERFEN und beim Replay
|
||
;; die restliche Kette verschieben (Bug, adversarial verifiziert). Daher hier:
|
||
;; nur die drei Vario-Felder direkt nach dem STEP ersetzen, ALLE weiteren
|
||
;; Eintraege der alten Slice unveraendert anhaengen. alt-slice = die vom
|
||
;; vfl-journal-slice gelieferte Original-Slice dieses Vario-Glieds.
|
||
;; Rueckgabe: neue Slice (STEP INT STR STR + originaler Schwanz).
|
||
(defun vfl-vario-slice-splicen (alt-slice winkel seite-code variante-code /
|
||
schwanz rest n)
|
||
;; Schwanz = alt-slice OHNE das fuehrende STEP und die naechsten drei
|
||
;; Eintraege (winkel/seite/variante). Robust ueber die feste Feldzahl (3)
|
||
;; des Vario-Schemas statt ueber kind-Rateraten.
|
||
(setq rest (cdr alt-slice)) ; STEP weg
|
||
(setq n 0)
|
||
(while (and rest (< n 3)) ; die drei Vario-Felder weg
|
||
(setq rest (cdr rest) n (1+ n)))
|
||
(setq schwanz rest) ; alles Weitere (VF-Antworten) bleibt
|
||
(append (vfl-vario-slice-bauen winkel seite-code variante-code) schwanz))
|
||
|
||
;; AS-Werte aus der PRAEAMBEL lesen: die beiden STR direkt VOR dem 1. STEP, die
|
||
;; auf den AS-ja/nein-STR folgen (Reihenfolge im Journal: PT REAL STR(ja/nein)
|
||
;; [STR(winkel) STR(seite)]). Nur gueltig, wenn AS vorhanden (as-ja /= "2").
|
||
;; Rueckgabe: (winkel-str seite-code) oder nil, wenn kein AS.
|
||
(defun vfl-as-werte-lesen (journal / praeambel str-liste)
|
||
(setq praeambel (vfl-journal-praeambel journal))
|
||
(setq str-liste '())
|
||
(foreach e praeambel
|
||
(if (= (car e) "STR") (setq str-liste (cons (cdr e) str-liste))))
|
||
(setq str-liste (reverse str-liste)) ; [ja/nein, winkel, seite] in Reihenfolge
|
||
(if (and (>= (length str-liste) 3) (/= (car str-liste) "2"))
|
||
(list (cadr str-liste) (caddr str-liste))
|
||
nil))
|
||
|
||
;; Praeambel (alle Eintraege vor dem 1. STEP) als Liste in Reihenfolge.
|
||
(defun vfl-journal-praeambel (journal / out done)
|
||
(setq out '() done nil)
|
||
(foreach e journal
|
||
(if (and (not done) (= (car e) "STEP")) (setq done t))
|
||
(if (not done) (setq out (cons e out))))
|
||
(reverse out))
|
||
|
||
;; AS-Winkel/Seite in der Praeambel ersetzen (die beiden STR nach dem
|
||
;; ja/nein-STR), Rest des Journals unveraendert. Erwartet, dass AS vorhanden
|
||
;; ist (3 STR in der Praeambel). Gibt das komplette neue Journal zurueck.
|
||
(defun vfl-journal-splice-as (journal winkel-str seite-code / out str-idx done)
|
||
(setq out '() str-idx 0 done nil)
|
||
(foreach e journal
|
||
(cond
|
||
(done (setq out (cons e out))) ; ab 1. STEP: unveraendert
|
||
((= (car e) "STEP") (setq done t) (setq out (cons e out)))
|
||
((= (car e) "STR")
|
||
(setq str-idx (1+ str-idx))
|
||
(cond
|
||
((= str-idx 2) (setq out (cons (cons "STR" winkel-str) out))) ; AS-Winkel
|
||
((= str-idx 3) (setq out (cons (cons "STR" seite-code) out))) ; AS-Seite
|
||
(t (setq out (cons e out))))) ; ja/nein bleibt
|
||
(t (setq out (cons e out))))) ; PT/REAL bleiben
|
||
(reverse out))
|
||
|
||
;; Einzelnes Glied bearbeiten. glieder = Glied-Label-Liste (Bau-Reihenfolge,
|
||
;; enthaelt jetzt ggf. das synthetische "AS" ganz vorne und "ES" als regulaeres
|
||
;; Glied). journal = volles Ketten-Journal. Waehlt per Liste ein Glied, laesst
|
||
;; dessen Eigenschaften aendern (GF-Bogen, AS, ES), ersetzt die Teilsequenz und
|
||
;; baut die Kette komplett neu auf (stummer Voll-Replay). Bricht der Neuaufbau
|
||
;; ab, wickelt der bestehende *error*-Handler in vf-linienzug-modus den
|
||
;; Zwischenstand - kein Sonderfall noetig.
|
||
;;
|
||
;; glieder-alle = die dem Picker angezeigte Liste (inkl. evtl. "AS" an Position
|
||
;; 1); pos ist 1-basiert darauf. STEP-Glieder (GF-Bogen, ES, ...) werden ueber
|
||
;; ihren STEP-Index angesprochen - dieser ist pos MINUS 1, falls "AS" als
|
||
;; synthetischer erster Listeneintrag vorhanden ist (AS ist kein STEP).
|
||
(defun vfl-edit-glied (ent journal glieder-alle has-as / pos label
|
||
step-idx alt-slice vorwerte neuwerte neu-slice spliced)
|
||
(setq pos (vfl-dlg-position glieder-alle))
|
||
(if (null pos)
|
||
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
|
||
(setq label (nth (1- pos) glieder-alle))
|
||
;; STEP-Index eines gewaehlten STEP-Glieds: bei vorhandenem "AS"-Listenkopf
|
||
;; um 1 nach vorne verschoben (AS belegt Listenposition 1, ist aber kein STEP).
|
||
(setq step-idx (if has-as (1- pos) pos))
|
||
(cond
|
||
;; --- AS-Element (Praeambel, kein STEP) ---
|
||
((= label "AS")
|
||
(setq vorwerte (vfl-as-werte-lesen journal))
|
||
(if (null vorwerte)
|
||
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
|
||
(setq neuwerte (vfl-glied-as-es-dialog "vf-winkel-aus-header"
|
||
(car vorwerte) (cadr vorwerte)))
|
||
(if (null neuwerte)
|
||
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
|
||
(setq spliced (vfl-journal-splice-as journal (car neuwerte) (cadr neuwerte)))
|
||
(entdel ent)
|
||
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
|
||
(vfl-journal-replay-start spliced)
|
||
(vf-linienzug-modus))
|
||
;; --- ES-Element (eigenes STEP-Glied) ---
|
||
((= label "ES")
|
||
(setq alt-slice (vfl-journal-slice journal step-idx))
|
||
(setq vorwerte (vfl-es-slice-werte alt-slice))
|
||
(setq neuwerte (vfl-glied-as-es-dialog "vf-winkel-ein-header"
|
||
(car vorwerte) (cadr vorwerte)))
|
||
(if (null neuwerte)
|
||
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
|
||
(setq neu-slice (vfl-es-slice-bauen (car neuwerte) (cadr neuwerte)))
|
||
(setq spliced (vfl-journal-splice journal step-idx neu-slice))
|
||
(entdel ent)
|
||
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
|
||
(vfl-journal-replay-start spliced)
|
||
(vf-linienzug-modus))
|
||
;; --- GF-Bogen (STEP-Glied mit fuehrender Menue-Antwort) ---
|
||
((= label "GF-Bogen")
|
||
(setq alt-slice (vfl-journal-slice journal step-idx))
|
||
(setq vorwerte (vfl-gf-bogen-slice-werte alt-slice))
|
||
(setq neuwerte (vfl-glied-gf-bogen-dialog (car vorwerte) (cadr vorwerte)))
|
||
(if (null neuwerte)
|
||
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
|
||
(setq neu-slice (vfl-gf-bogen-slice-bauen (car neuwerte) (cadr neuwerte)))
|
||
(setq spliced (vfl-journal-splice journal step-idx neu-slice))
|
||
(entdel ent)
|
||
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
|
||
;; Voller stummer Replay des gespliceten Journals: die Queue beschreibt
|
||
;; die Kette bis zum Ende, daher faellt vf-linienzug-modus nicht in den
|
||
;; Live-Modus, sondern baut 1:1 mit dem geaenderten Glied fertig.
|
||
(vfl-journal-replay-start spliced)
|
||
(vf-linienzug-modus))
|
||
;; --- Vario-Kurve (STEP-Glied INNERHALB einer VF-Einheit) ---
|
||
;; Gleiche Slice/Splice/Replay-Maschinerie wie GF-Bogen; die Vario-Kurve hat
|
||
;; seit vfl-insert-vario-kurve einen eigenen STEP-Marker und ist damit ein
|
||
;; regulaeres Glied. Aendert Winkel/Seite/Variante, Rest der Kette bleibt.
|
||
((= label "Vario-Kurve")
|
||
(setq alt-slice (vfl-journal-slice journal step-idx))
|
||
(setq vorwerte (vfl-vario-slice-werte alt-slice))
|
||
(setq neuwerte (vfl-glied-vario-dialog (car vorwerte) (cadr vorwerte) (caddr vorwerte)))
|
||
(if (null neuwerte)
|
||
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
|
||
;; Schwanz-erhaltende Slice: die Vario-Kurve steht MITTEN in der VF-Einheit,
|
||
;; nach ihren 3 Werten folgen weitere VF-Antworten in derselben Slice. Nur
|
||
;; die 3 Vario-Felder ersetzen, den Rest behalten (siehe
|
||
;; vfl-vario-slice-splicen) - sonst verschiebt sich beim Replay die Kette.
|
||
(setq neu-slice (vfl-vario-slice-splicen alt-slice
|
||
(car neuwerte) (cadr neuwerte) (caddr neuwerte)))
|
||
(setq spliced (vfl-journal-splice journal step-idx neu-slice))
|
||
(entdel ent)
|
||
(princ (ssg-textf "vfl-glied-geaendert" (list (itoa pos))))
|
||
(vfl-journal-replay-start spliced)
|
||
(vf-linienzug-modus))
|
||
(t
|
||
(alert (ssg-textf "vfl-glied-nicht-editierbar"
|
||
(list (vfl-glied-label-text label))))
|
||
(princ (ssg-text "vfl-edit-abgebrochen"))))
|
||
(princ))
|
||
|
||
(defun vfl-edit-ent (ent / xd marker journal glieder glieder-alle has-as n i pos trunc edit-modus)
|
||
(setq xd (vfl-journal-xdata-lesen ent))
|
||
(if (null xd)
|
||
(progn (alert (ssg-text "vfl-edit-kein-journal")) (exit)))
|
||
(setq marker (car xd) journal (cdr xd))
|
||
(if (= marker "linienzug2")
|
||
(vfl-edit-ent2 ent journal)
|
||
(progn
|
||
(setq glieder (vfl-journal-glieder journal))
|
||
(setq n (length glieder))
|
||
;; AS ist kein STEP-Glied (steht in der Praeambel). Fuer den Glied-Edit
|
||
;; wird es als synthetischer erster Listeneintrag "AS" vorangestellt,
|
||
;; falls in der Kette ein AS vorhanden ist (vfl-as-werte-lesen liefert
|
||
;; dann nicht nil). has-as steuert in vfl-edit-glied den STEP-Index-
|
||
;; Versatz (AS belegt Listenposition 1, ist aber kein STEP). Der Sektions-
|
||
;; Ruecksetz-Modus nutzt weiterhin die reine STEP-Liste (glieder), ES ist
|
||
;; darin bereits als eigenes Glied enthalten.
|
||
(setq has-as (and (vfl-as-werte-lesen journal) t))
|
||
(setq glieder-alle (if has-as (cons "AS" glieder) glieder))
|
||
;; NEU: zuerst Modus waehlen (Sektion zuruecksetzen ODER ein einzelnes
|
||
;; Glied bearbeiten). Alte Bloecke ohne Segment-XDATA funktionieren in
|
||
;; beiden Zweigen, da beide allein aus dem Ketten-Journal arbeiten.
|
||
(setq edit-modus (vfl-dlg-modus n))
|
||
(cond
|
||
((null edit-modus)
|
||
(princ (ssg-text "vfl-edit-abgebrochen")))
|
||
((= edit-modus "glied")
|
||
(vfl-edit-glied ent journal glieder-alle has-as))
|
||
(t
|
||
;; --- bestehender Ablauf: Sektion zuruecksetzen (unveraendert) ---
|
||
(princ (ssg-textf "vfl-edit-kette-header" (list (itoa n))))
|
||
(setq i 1)
|
||
(foreach g glieder
|
||
(princ (strcat "\n " (itoa i) ") " (vfl-glied-label-text g)))
|
||
(setq i (1+ i)))
|
||
(setq pos (vfl-dlg-position glieder))
|
||
(if (null pos)
|
||
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
|
||
(setq trunc (vfl-journal-truncate journal pos))
|
||
;; Alten Block entfernen (wie Standard/Etage: entdel + kompletter Neuaufbau).
|
||
;; Bricht der Neuaufbau selbst ab, wickelt vfl-modus-abbruch-sichern den
|
||
;; Zwischenstand automatisch zu einem neuen Block - kein Sonderfall noetig.
|
||
(entdel ent)
|
||
(princ (ssg-textf "vfl-edit-abgespielt" (list (itoa pos) (itoa (- n pos)))))
|
||
;; Behaltene Glieder abspielen, dann live weiterbauen.
|
||
(vfl-journal-replay-start trunc)
|
||
(vf-linienzug-modus)))))
|
||
(princ))
|
||
|
||
;; Modus-2-Block per Doppelklick zuruecksetzen: voller Reset - die komplette
|
||
;; gespeicherte Eingabe (inkl. der gewaehlten Pfad-Objekte, siehe
|
||
;; vfl-in-selection) wird 1:1 stumm abgespielt, identischer Neuaufbau. Kein
|
||
;; Sektions-Dialog; der Nutzer kann den neu entstandenen Block danach ganz
|
||
;; normal weiterbearbeiten oder loeschen.
|
||
(defun vfl-edit-ent2 (ent journal)
|
||
(entdel ent)
|
||
(princ (ssg-text "vfl-edit2-reset-info"))
|
||
(vfl-journal-replay-start journal)
|
||
(vf-linienzug-modus2)
|
||
(princ))
|
||
|
||
;; DCL-Dialog nach Doppelklick: Editier-Modus waehlen.
|
||
;; n = Anzahl Glieder (nur fuer die Kopfzeile). Vorbelegung "rueck" (das
|
||
;; bisherige Verhalten, geringste Ueberraschung). Rueckgabe: "rueck", "glied"
|
||
;; oder nil (Abbrechen/Escape). Bei fehlendem/kaputtem DCL faellt der Dialog
|
||
;; auf "rueck" zurueck (statt die Bearbeitung ganz zu blockieren) - so bleibt
|
||
;; der bestehende Editierpfad auch dann erreichbar.
|
||
(defun vfl-dlg-modus (n / dcl-pfad dat wahl ergebnis)
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit_modus.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vfl_edit_modus" dat))
|
||
(progn
|
||
(if dat (unload_dialog dat))
|
||
(alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad)))
|
||
"rueck") ; Fallback: bisheriges Verhalten
|
||
(progn
|
||
;; Nur der Kopftext wird zur Laufzeit gesetzt; die Optionslabels stehen
|
||
;; statisch (deutsch) im DCL - siehe vfl_edit_modus.dcl. get_tile "modus"
|
||
;; liefert den key des gewaehlten radio_button. Default "modus_rueck" ist
|
||
;; im DCL per value="1" vorbelegt.
|
||
(set_tile "kopf" (ssg-textf "vfl-dlg-modus-kopf" (list (itoa n))))
|
||
(action_tile "accept" "(setq wahl (get_tile \"modus\")) (done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(cond
|
||
((/= ergebnis 1) nil)
|
||
((= wahl "modus_glied") "glied")
|
||
(t "rueck"))))) ; modus_rueck (o. leer) = zuruecksetzen
|
||
|
||
;; DCL-Dialog: Sektion waehlen, auf die die Kette zurueckgesetzt wird.
|
||
;; glieder = Liste der Glied-Labels (interne Tokens, vfl-journal-glieder), in
|
||
;; Bau-Reihenfolge. Vorbelegung auf den letzten Eintrag (voller Stand = reines
|
||
;; Fortsetzen ohne Kuerzung). Rueckgabe: gewaehlte Position (1-basiert) oder
|
||
;; nil bei Abbrechen/Escape.
|
||
(defun vfl-dlg-position (glieder / n dcl-pfad dat idx ergebnis i)
|
||
(setq n (length glieder))
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vfl_edit" dat))
|
||
(progn (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
|
||
(progn
|
||
(set_tile "kopf" (ssg-textf "vfl-dlg-kopf-sektionen" (list (itoa n))))
|
||
(start_list "position")
|
||
(setq i 1)
|
||
(foreach g glieder
|
||
(add_list (strcat (itoa i) " - " (vfl-glied-label-text g)))
|
||
(setq i (1+ i)))
|
||
(end_list)
|
||
(set_tile "position" (itoa (1- n))) ; letzter Eintrag vorbelegt (0-basierter Index)
|
||
(action_tile "accept" "(setq idx (atoi (get_tile \"position\"))) (done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(if (= ergebnis 1) (1+ idx) nil)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; DIAGNOSE: Blockstruktur (KS_EIN/KS_AUS) untersuchen
|
||
;; ============================================================
|
||
;; Zeigt, wie ein Block intern aufgebaut ist - insbesondere, ob KS_EIN/KS_AUS
|
||
;; auf der ersten Explode-Ebene als Unterbloecke liegen und welche Laengen ihre
|
||
;; Achslinien haben (ks-line-axis erwartet X~1/~100, Y~2, Z~3). Damit laesst
|
||
;; sich klaeren, warum extract-ks-from-block bei den Vario_Kurve-Bloecken
|
||
;; "KS_EIN/KS_AUS fehlen" meldet.
|
||
;; Aufruf in BricsCAD: VFL_KS_DIAG -> Blockname eingeben.
|
||
(defun c:VFL_KS_DIAG ( / bname obj subs s nm inner il ilnm ps pe len)
|
||
(setq bname (getstring "\nBlockname fuer KS-Diagnose: "))
|
||
(setq bname (ensure-block-loaded bname))
|
||
(if (not (tblsearch "BLOCK" bname))
|
||
(progn (princ (strcat "\nBlock '" bname "' nicht gefunden.")) (exit)))
|
||
(setq obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) bname 1.0 1.0 1.0 0))
|
||
(princ (strcat "\n=================================================="))
|
||
(princ (strcat "\n=== Struktur von '" bname "' (Ebene 1) ==="))
|
||
(setq subs (vlax-invoke obj 'Explode))
|
||
(foreach s subs
|
||
(if (not (vlax-erased-p s))
|
||
(progn
|
||
(setq nm (vla-get-ObjectName s))
|
||
(if (= nm "AcDbBlockReference")
|
||
(progn
|
||
(princ (strcat "\n BlockRef: '" (vla-get-Name s) "' (Ebene 2:)"))
|
||
(setq inner (vlax-invoke s 'Explode))
|
||
(foreach il inner
|
||
(if (not (vlax-erased-p il))
|
||
(progn
|
||
(setq ilnm (vla-get-ObjectName il))
|
||
(cond
|
||
((= ilnm "AcDbLine")
|
||
(setq ps (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint il))))
|
||
(setq pe (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint il))))
|
||
(setq len (vec-length (list (- (car pe)(car ps))
|
||
(- (cadr pe)(cadr ps))
|
||
(- (caddr pe)(caddr ps)))))
|
||
(princ (strcat "\n Line len=" (rtos len 2 3)
|
||
" axis=" (if (ks-line-axis len) (ks-line-axis len) "?"))))
|
||
((= ilnm "AcDbBlockReference")
|
||
(princ (strcat "\n BlockRef(verschachtelt): '" (vla-get-Name il) "'")))
|
||
(t (princ (strcat "\n " ilnm)))
|
||
)
|
||
(vla-Delete il)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(princ (strcat "\n " nm))
|
||
)
|
||
(vla-Delete s)
|
||
)
|
||
)
|
||
)
|
||
(princ "\n=== Ende Diagnose ===")
|
||
(princ "\n==================================================")
|
||
(princ)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; REGISTRIERUNG
|
||
;; ============================================================
|
||
;; berechne-fn/einfuege-fn werden fuer "linienzug" NICHT im normalen Schema
|
||
;; verwendet (eigener Befehlsablauf, siehe Kommentar am Dateianfang) - beide
|
||
;; sind daher nur Platzhalter, die c:VarioFoerderer nie aufruft (Dispatch
|
||
;; erfolgt dort direkt auf vf-linienzug-modus).
|
||
(defun vfl-berechne-platzhalter (deltaL deltaH richtung seite)
|
||
(princ "\n[vf_linienzug] FEHLER: berechne-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.")
|
||
(list nil nil nil nil)
|
||
)
|
||
(defun vfl-einfuege-platzhalter (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz)
|
||
(princ "\n[vf_linienzug] FEHLER: einfuege-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.")
|
||
startpunkt
|
||
)
|
||
;; ============================================================
|
||
;; MODUS 2: 3D-OBJEKTE WAEHLEN (Meilenstein 1 - GF-Teil)
|
||
;; ============================================================
|
||
;; Baut die Kette aus einem GEZEICHNETEN Pfad (LINE/ARC). Ablauf:
|
||
;; Objekte waehlen -> gf-sortiere-objekte -> gf-analysiere-kette
|
||
;; -> Eck-Winkel-Vorpruefung -> segmentweise (Variante B) live bauen -> ES.
|
||
;; In diesem Meilenstein ist NUR der GF-Teil aktiv (GF-Gerade mit eigener
|
||
;; Neigung <=3 Grad, GF-Bogen). Die VF-Zweige sind als TODO (Meilenstein 2)
|
||
;; markiert und werden uebersprungen.
|
||
;; Bekannte Naeherungen (in BricsCAD verifizieren):
|
||
;; - Eck-Trimmung nur an erster/letzter Geraden (-aus-dx bzw. -300-ein-dx,
|
||
;; wie gf-linienzug-modus); Separatoren VOR GF-Boegen noch NICHT gesetzt.
|
||
;; - GF-Bogen hat feste Eigen-Neigung -> bei unterschiedlichen Nachbar-
|
||
;; Neigungen entsteht ein (akzeptierter) Knick.
|
||
|
||
;; Alle Eck-Winkel des Pfades gegen 30/60/90 Grad pruefen (Toleranz tol).
|
||
;; Rueckgabe: nil (alle ok) oder der erste abweichende Winkel (Grad).
|
||
(defun vfl2-pruefe-eckwinkel (kette tol / item obj sa ea sweep bad)
|
||
(setq bad nil)
|
||
(foreach item kette
|
||
(setq obj (car item))
|
||
(if (and (null bad) (= (vla-get-ObjectName obj) "AcDbArc"))
|
||
(progn
|
||
(setq sa (vla-get-StartAngle obj) ea (vla-get-EndAngle obj))
|
||
(setq sweep (if (>= ea sa) (- ea sa) (+ (- ea sa) (* 2.0 pi))))
|
||
(setq sweep (* sweep (/ 180.0 pi)))
|
||
(if (not (or (< (abs (- sweep 30.0)) tol)
|
||
(< (abs (- sweep 60.0)) tol)
|
||
(< (abs (- sweep 90.0)) tol)))
|
||
(setq bad sweep))
|
||
)
|
||
)
|
||
)
|
||
bad
|
||
)
|
||
|
||
;; AS-Element fuer Modus 2 (GF): gemischte Verankerung.
|
||
;; - Laengsrichtung (entlang hz): KS_EIN auf den Startpunkt (Laengsposition)
|
||
;; - Querrichtung (senkrecht hz): KS_AUS auf den Pfad (Kettenmittellinie)
|
||
;; Umsetzung: (1) AS mit KS_EIN am Startpunkt platzieren, (2) Querversatz des
|
||
;; KS_AUS zum Pfad messen, (3) AS senkrecht zu hz um -Versatz verschieben.
|
||
;; Ergebnis: KS_EIN.X = Startpunkt.X, KS_EIN quer um das AS-Y-Mass versetzt,
|
||
;; KS_AUS liegt exakt auf dem Pfad -> die ganze Kette folgt der Mittellinie.
|
||
;; Rueckgabe: (korrigierter) Frame am KS_AUS.
|
||
;; winkel-Parameter bleibt aus Call-Kompatibilitaet bestehen (vfl2-insert-as-vf
|
||
;; ruft mit 0.0), wird aber NICHT mehr fuer eine Kippung verwendet: das AS-
|
||
;; Element hat keine eigene Neigung (per Einzel-Insert-Test in BricsCAD
|
||
;; bestaetigt, siehe vfl-insert-as-element in Modus 1) - unabhaengig vom
|
||
;; folgenden Segmenttyp (GF/VF) wird es IMMER flach eingefuegt.
|
||
(defun vfl2-insert-as-gf (startpunkt hz winkel as-seite /
|
||
ein-hz-as rad-h xu-ein frame blk ks-aus
|
||
rad-hz perp-x perp-y d-perp sx sy as-turn
|
||
rad-ein de-x de-y de-dot-np t-shift)
|
||
;; Schwenk aus dem AS-Block MESSEN (30/90/gerade), KS_EIN so drehen, dass
|
||
;; KS_AUS entlang hz zeigt: ein-hz = hz - plan-turn.
|
||
(setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)))
|
||
(setq ein-hz-as (- hz as-turn))
|
||
(setq rad-h (* (float ein-hz-as) (/ pi 180.0)))
|
||
(setq xu-ein (list (cos rad-h) (sin rad-h) 0.0))
|
||
;; (1) KS_EIN auf den Startpunkt (Laengsposition korrekt)
|
||
(setq frame (insert-block-mixed-to-ks
|
||
(strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)
|
||
(make-frame-from-dir startpunkt xu-ein)
|
||
(caddr startpunkt) "KS_EIN" "KS_EIN"))
|
||
(setq blk (entlast))
|
||
;; (2) Querversatz des KS_AUS zum Pfad (Einheits-Querrichtung senkrecht zu hz)
|
||
(setq ks-aus (car frame))
|
||
(setq rad-hz (* (float hz) (/ pi 180.0)))
|
||
(setq perp-x (- (sin rad-hz)) perp-y (cos rad-hz)) ; Normale zum Pfad
|
||
(setq d-perp (+ (* (- (car ks-aus) (car startpunkt)) perp-x)
|
||
(* (- (cadr ks-aus) (cadr startpunkt)) perp-y)))
|
||
;; (3) AS ENTLANG der KS_EIN-Achse verschieben (nicht senkrecht zum Pfad):
|
||
;; damit landet KS_AUS auf dem Pfad UND der Startpunkt bleibt auf der KS_EIN-
|
||
;; Achse. Beim 90-Grad-Element ist die KS_EIN-Achse senkrecht zum Pfad -> das
|
||
;; ist identisch zum bisherigen Querschub.
|
||
(setq rad-ein (* (float ein-hz-as) (/ pi 180.0)))
|
||
(setq de-x (cos rad-ein) de-y (sin rad-ein)) ; KS_EIN-Achsrichtung
|
||
(setq de-dot-np (+ (* de-x perp-x) (* de-y perp-y)))
|
||
(setq t-shift (if (> (abs de-dot-np) 1e-6) (/ d-perp de-dot-np) 0.0))
|
||
(setq sx (* (- t-shift) de-x) sy (* (- t-shift) de-y))
|
||
(if (> (abs t-shift) 1e-6)
|
||
(vla-Move (vlax-ename->vla-object blk)
|
||
(vlax-3D-point '(0.0 0.0 0.0)) (vlax-3D-point (list sx sy 0.0))))
|
||
;; (4) korrigierten KS_AUS-Frame zurueckgeben (Richtung unveraendert)
|
||
(list (list (+ (car ks-aus) sx) (+ (cadr ks-aus) sy) (caddr ks-aus))
|
||
(cadr frame) (caddr frame) (cadddr frame))
|
||
)
|
||
|
||
;; VF-Start-AS (Modus 2): identische Platzierung wie beim GF-Start, aber FLACH
|
||
;; (0 Grad Neigung). Das AS wird mit KS_EIN auf den Startpunkt gesetzt und dann
|
||
;; senkrecht zu hz auf den Pfad geschoben (reine KS-Kettung, KS_AUS auf Pfad).
|
||
;; Damit liegt auch eine mit VF beginnende Kette auf dem gezeichneten Pfad.
|
||
(defun vfl2-insert-as-vf (startpunkt hz as-seite)
|
||
(vfl2-insert-as-gf startpunkt hz 0.0 as-seite))
|
||
|
||
;; VF-Einheit OEFFNEN (Modus 2): GF1 (Basis-Staustrecke) + Separator +
|
||
;; Umlenkstation. Rueckgabe: Frame nach der Umlenkstation (Beginn reiner VF).
|
||
(defun vfl2-vf-open (frame hz / f)
|
||
(setq f (vfl-frame-3grad (vfs-vf-entry (car frame) *vfl-gf-min-laenge* hz) hz))
|
||
(if (> *vfl-gf-min-laenge* 0.1)
|
||
(vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
|
||
f)
|
||
|
||
;; VF-Einheit SCHLIESSEN (Modus 2): Motorstation + GF2 (Basis), KEIN Separator
|
||
;; (der sitzt erst am Kettenende bzw. optional zwischen Foerderern). Rueckgabe:
|
||
;; Frame nach GF2.
|
||
(defun vfl2-vf-close (frame hz / f)
|
||
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
|
||
(setq f (vfl-frame-3grad (vfs-vf-exit (car frame) *vfl-gf-min-laenge* hz nil) hz))
|
||
(if (> *vfl-gf-min-laenge* 0.1)
|
||
(vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
|
||
f)
|
||
|
||
;; Vario-Winkel (Vertikalbogen) auf die verfuegbaren Werte 3..51 einrasten.
|
||
(defun vfl2-snap-vfwinkel (w / liste best bd d)
|
||
(setq liste (ssg-cfg-or "vario" "bogen_winkel" '(3 6 9 12 15 18 21 27 33 39 45 51)))
|
||
(setq best (car liste) bd 1e9)
|
||
(foreach x liste (setq d (abs (- x w))) (if (< d bd) (setq bd d best x)))
|
||
best)
|
||
|
||
(defun vf-linienzug-modus3 ( / ss obj-liste startpunkt start-hoehe as-seite
|
||
es-seite kette segmente n i seg typ hz laenge
|
||
bwinkel bseite frame antwort winkel deltaL
|
||
anzahl-gf anzahl-vf vfl-nummer lastEnt hoehe-bis
|
||
ecke-bad first-line last-line letzt-winkel
|
||
aus ein soll-ende ist-ende run-typ richtn best-w
|
||
kvariante L_VF ent-fp rad3 just-open
|
||
dbg-an old-error)
|
||
(princ "\n\n=========================================")
|
||
(princ (ssg-text "vfl-vwnb-titel"))
|
||
(princ "\n=========================================")
|
||
|
||
;; --- Debug-Session (Schalter "vfl-modus3", DEFAULT AN) -------------------
|
||
;; Bei Bedarf abschaltbar: (dbg-schalter-off "vfl-modus3") in der Konsole.
|
||
;; Alle interaktiven Eingaben (Punkte, Hoehen, Seiten, Winkel, Menue-
|
||
;; Auswahlen) laufen ueber die vfl-in-*-Wrapper und werden dadurch
|
||
;; automatisch ueber vfl-journal-record mitgeloggt (siehe dort) - hier nur
|
||
;; noch Session-Start/-Ende + Zwischenergebnisse, die NICHT direkt aus einer
|
||
;; Nutzereingabe stammen (Analyse-Ergebnis, Segment-Header, Bau-Ergebnis).
|
||
;; *vfl-journal*/*vflw-pending* werden dabei nebenbei mitbefuellt, aber von
|
||
;; Modus 3 nirgends gelesen/persistiert (kein Replay/XDATA wie bei Modus 1/2
|
||
;; - das ist hier bewusst NICHT mit umgebaut, nur das Logging).
|
||
;; Der *error*-Handler schliesst die Datei bei Abbruch sauber.
|
||
(setq dbg-an (dbg-schalter-open "vfl-modus3" "vfl_modus3.dbg" "DXFM_LOG"))
|
||
(if dbg-an
|
||
(progn
|
||
(dbgf "vf-linienzug-modus3")
|
||
(dbgmsg "=== SESSION Modus 3 (Vorwaerts-Nachbau) START ===")
|
||
(dbgflush)))
|
||
(setq old-error *error*)
|
||
(setq *error*
|
||
(function (lambda (msg)
|
||
(setq *error* old-error)
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
|
||
(dbgreturn nil)
|
||
(dbgclose)))
|
||
(if old-error (old-error msg) (princ)))))
|
||
|
||
;; Abhaengigkeit Gefaellestrecke-Modul (GF-Bausteine)
|
||
(if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED"))))
|
||
(progn (alert (ssg-text "vfl-m3-alert-gf-modul")) (exit)))
|
||
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
|
||
|
||
;; --- 1. Pfad-Objekte waehlen (LINE/ARC) ---
|
||
(princ (ssg-text "vfl-m3-pfad-waehlen"))
|
||
(setq ss (vfl-in-selection '((0 . "LINE,ARC"))))
|
||
(if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
|
||
(setq obj-liste (mapcar 'vlax-ename->vla-object ss))
|
||
|
||
;; --- 2. Startpunkt (hoehere Seite) + Hoehe + AS-Seite ---
|
||
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-startpunkt")))
|
||
(if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
|
||
(setq start-hoehe (vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt"
|
||
(list (rtos (caddr startpunkt) 2 1)))))
|
||
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
|
||
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
|
||
;; vf-frage-element-winkel ruft direkt getstring/vflw-wahl auf (kein
|
||
;; vfl-in-*-Wrapper darin) - manuell mitloggen, sonst wuerde diese eine
|
||
;; Eingabe durchrutschen.
|
||
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
|
||
(if dbg-an (progn (dbgmsg "AS-Winkel:") (dbg '*vfl-as-winkel*) (dbgflush)))
|
||
(princ (ssg-text "vfl-vwnb-aus-seite-menu"))
|
||
(setq as-seite (if (= (vfl-in-string (ssg-text "prompt-wahl-1-2")) "2") "rechts" "links"))
|
||
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
|
||
|
||
;; --- 3. Sortieren + Analysieren ---
|
||
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
|
||
(if (null kette)
|
||
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit)))
|
||
(setq segmente (gf-analysiere-kette kette))
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "ANALYSE: " (itoa (length segmente)) " Segment(e) erkannt"))
|
||
(dbg 'segmente)
|
||
(dbgflush)))
|
||
|
||
;; --- 4. Eck-Winkel-Vorpruefung (vor dem Bau) ---
|
||
(setq ecke-bad (vfl2-pruefe-eckwinkel kette 5.0))
|
||
(if ecke-bad
|
||
(progn
|
||
(alert (ssg-textf "vfl-vwnb-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
|
||
(exit)))
|
||
|
||
;; --- 5. Setup ---
|
||
(setq aus (if aus-dx aus-dx 576.0) ein (if ein-dx ein-dx 576.0))
|
||
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
|
||
;; Entry-Fussabdruck (planar) einer VF-Einheit: GF1(Basis)+Separator(300)+Umlenk(500)
|
||
(setq ent-fp (* (+ *vfl-gf-min-laenge* 300.0 500.0) (cos rad3)))
|
||
(setq run-typ nil)
|
||
(setq vfl-nummer (vf-next-number))
|
||
(setq lastEnt (vf-lastent-ohne-attribute))
|
||
(vfl-acc-reset)
|
||
(setq anzahl-gf 0 anzahl-vf 0 frame nil n (length segmente))
|
||
;; erste/letzte "Linie" fuer die Trimmung bestimmen
|
||
(setq first-line -1 last-line -1 i 0)
|
||
(while (< i n)
|
||
(if (= (car (nth i segmente)) "Linie")
|
||
(progn (if (< first-line 0) (setq first-line i)) (setq last-line i)))
|
||
(setq i (1+ i)))
|
||
(if (< first-line 0)
|
||
(progn (alert (ssg-text "vfl-vwnb-alert-keine-gerade")) (exit)))
|
||
|
||
;; --- 6. Bau-Schleife (Meilenstein 2: GF + VF-Laeufe, Run-State-Machine) ---
|
||
;; run-typ: nil / "GF" / "VF". Beim Wechsel GF<->VF wird die VF-Einheit
|
||
;; geoeffnet (GF1+Separator+Umlenk) bzw. geschlossen (Motor+GF2).
|
||
;; v1-Naeherung Laenge: Entry-Fussabdruck wird vom ersten VF-Koerper abgezogen;
|
||
;; der Exit (Motor+GF2) wird beim Schliessen ANGEHAENGT (verlaengert den VF-Lauf
|
||
;; ggue. dem gezeichneten Pfad; feinere Laengen-Reservierung -> spaeter).
|
||
(setq i 0)
|
||
(while (< i n)
|
||
(setq seg (nth i segmente) typ (car seg) hz (cadr seg))
|
||
(cond
|
||
;; ===================== GERADE =====================
|
||
((= typ "Linie")
|
||
(setq laenge (caddr seg))
|
||
(princ (ssg-textf "vfl-m3-seg-gerade"
|
||
(list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1))))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "SEGMENT " (itoa (1+ i)) "/" (itoa n)
|
||
" GERADE (laenge=" (rtos laenge 2 0) " hz=" (rtos hz 2 1) ")")))
|
||
(princ (ssg-text "vfl-vwnb-typ-gerade"))
|
||
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2-3-4")))
|
||
(cond
|
||
;; --- GF-Gerade ---
|
||
((or (= antwort "") (= antwort "1"))
|
||
(if (= run-typ "VF") ; offenen VF-Lauf schliessen
|
||
(progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
|
||
(setq run-typ nil)))
|
||
(setq winkel (vfl-in-real (ssg-text "vfl-m3-prompt-gf-neigung")))
|
||
(if (null winkel) (setq winkel 3.0))
|
||
(if (> winkel 3.0)
|
||
(progn (princ (ssg-text "vfl-m3-hinweis-gf-max")) (setq winkel 3.0)))
|
||
(if (null frame)
|
||
(setq frame (vfl2-insert-as-gf startpunkt hz winkel as-seite)))
|
||
(setq deltaL laenge)
|
||
;; erste Gerade: AS-Fussabdruck ENTLANG des Pfads exakt aus KS_AUS abziehen
|
||
(if (= i first-line)
|
||
(setq deltaL (- deltaL
|
||
(+ (* (- (car (car frame)) (car startpunkt)) (cos (* hz (/ pi 180.0))))
|
||
(* (- (cadr (car frame)) (cadr startpunkt)) (sin (* hz (/ pi 180.0))))))))
|
||
(if (= i last-line) (setq deltaL (- deltaL 300.0 ein)))
|
||
(setq deltaL (max 100.0 deltaL))
|
||
(setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel))
|
||
(vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel)
|
||
(setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel run-typ "GF"))
|
||
;; --- VF-Gerade (Ab / Auf / Horizontal) ---
|
||
(t
|
||
(setq richtn (cond ((= antwort "3") "Auf") ((= antwort "4") "horizontal") (t "Ab")))
|
||
(setq just-open nil)
|
||
(if (null frame) ; AS (flach) am Kettenanfang, KS_AUS auf Pfad
|
||
(setq frame (vfl2-insert-as-vf startpunkt hz as-seite)))
|
||
(if (not (= run-typ "VF")) ; VF-Einheit oeffnen
|
||
(progn (setq frame (vfl2-vf-open frame hz))
|
||
(setq run-typ "VF" just-open t)))
|
||
(if (= richtn "horizontal")
|
||
(setq best-w 0)
|
||
(progn
|
||
(setq best-w (vfl-in-int (ssg-text "vfl-vwnb-prompt-vario-winkel")))
|
||
(if (null best-w) (setq best-w 3))
|
||
(setq best-w (vfl2-snap-vfwinkel best-w))
|
||
(if dbg-an (progn (dbgmsg "Vario-Winkel (gesnapt):") (dbg 'best-w) (dbgflush)))))
|
||
(setq L_VF laenge)
|
||
(if just-open (setq L_VF (- L_VF ent-fp))) ; Entry-Fussabdruck reservieren
|
||
(setq L_VF (max 100.0 L_VF))
|
||
(setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn best-w L_VF hz) hz))
|
||
(vfl-acc-vf-seg richtn best-w L_VF)
|
||
(setq anzahl-vf (1+ anzahl-vf) run-typ "VF"))))
|
||
;; ===================== ECK / BOGEN =====================
|
||
((= typ "Bogen")
|
||
(setq bwinkel (nth 3 seg) bseite (nth 4 seg))
|
||
(princ (ssg-textf "vfl-m3-seg-bogen"
|
||
(list (itoa (1+ i)) (itoa n) (itoa bwinkel) bseite)))
|
||
(if dbg-an
|
||
(dbgmsg (strcat "SEGMENT " (itoa (1+ i)) "/" (itoa n)
|
||
" BOGEN (bwinkel=" (itoa bwinkel) " bseite=" bseite ")")))
|
||
(princ (ssg-text "vfl-m3-typ-bogen"))
|
||
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
|
||
(if (= antwort "2")
|
||
;; --- Vario-Kurve (nur im VF-Lauf) ---
|
||
(if (not (= run-typ "VF"))
|
||
(princ (ssg-text "vfl-vwnb-kurve-nur-vf"))
|
||
(progn
|
||
(princ (ssg-text "vfl-m3-variante-frage"))
|
||
(setq kvariante (if (= (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")) "1") "aussen" "innen"))
|
||
(setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite kvariante))))
|
||
;; --- GF-Bogen ---
|
||
(progn
|
||
(if (null frame)
|
||
(progn (alert (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit)))
|
||
(if (= run-typ "VF") ; VF-Lauf vor GF-Bogen schliessen
|
||
(progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
|
||
(setq run-typ nil)))
|
||
(setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite))
|
||
(setq run-typ "GF"))))
|
||
)
|
||
(setq i (1+ i)))
|
||
|
||
;; --- 7. Kettenende: offenen VF-Lauf schliessen, dann Separator + ES ---
|
||
(if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit)))
|
||
;; vfl-frage-es-seite nutzt intern bereits vfl-in-value/vfl-menu - wird also
|
||
;; automatisch mitgeloggt, kein manueller dbgmsg noetig.
|
||
(setq es-seite (vfl-frage-es-seite))
|
||
(if (= run-typ "VF")
|
||
(progn
|
||
(setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
|
||
(setq frame (vfl-insert-es-element "VF" frame (car (frame->hz-winkel frame))
|
||
0.0 (caddr (car frame)) es-seite)))
|
||
(setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame))
|
||
(if letzt-winkel letzt-winkel 3.0) (caddr (car frame)) es-seite)))
|
||
|
||
;; --- 8. Block + Ist-Ziel-Report ---
|
||
(setq hoehe-bis (caddr (car frame)))
|
||
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
|
||
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt)
|
||
|
||
(setq soll-ende (caddr (last kette))) ; Endpunkt des letzten gezeichneten Segments
|
||
(setq ist-ende (car frame)) ; ES-KS_AUS
|
||
(princ "\n\n=========================================")
|
||
(princ (ssg-text "vfl-vwnb-eingefuegt"))
|
||
(princ (ssg-textf "vfl-vwnb-soll-ende"
|
||
(list (rtos (car soll-ende) 2 1) (rtos (cadr soll-ende) 2 1))))
|
||
(princ (ssg-textf "vfl-vwnb-ist-ende"
|
||
(list (rtos (car ist-ende) 2 1) (rtos (cadr ist-ende) 2 1) (rtos (caddr ist-ende) 2 1))))
|
||
(princ (ssg-textf "vfl-vwnb-abweichung-xy"
|
||
(list (rtos (- (car ist-ende) (car soll-ende)) 2 1)
|
||
(rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1))))
|
||
(princ "\n=========================================")
|
||
|
||
;; --- Debug-Session sauber abschliessen ---
|
||
(setq *error* old-error)
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer)
|
||
" (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")"))
|
||
(dbg 'soll-ende)
|
||
(dbg 'ist-ende)
|
||
(dbgmsg "=== SESSION Modus 3 ENDE ===")
|
||
(dbgreturn (list "VF" vfl-nummer))
|
||
(dbgclose)))
|
||
(princ)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; MODUS 3: Pfad + Ziel-Hoehe (Randwert-Solver) - M3a
|
||
;; Schritt 1+2: Geruest + Klassifizierung + Anker-Report. NOCH KEIN Bauen.
|
||
;; Details siehe doc/VarioFoerderer_Linienzug_Prinzipien.md, Abschnitt 14.
|
||
;; ============================================================
|
||
|
||
;; Signierte Z-Aenderung (mm) einer GF-Geraden: negativ = Abfall.
|
||
;; l-planar = XY-Planlaenge (aus Pfad), winkel = Neigung in Grad (fallend).
|
||
;; Ueber die Planlaenge gilt dz = -L * tan(winkel) (Fussabdruck bleibt L,
|
||
;; die 3D-Laenge waechst mit L/cos, siehe Doc 14.1).
|
||
(defun vfl3-gf-dz (l-planar winkel / rad)
|
||
(setq rad (* (float winkel) (/ pi 180.0)))
|
||
(- (* (float l-planar) (/ (sin rad) (cos rad)))))
|
||
|
||
;; Signierte Z-Aenderung eines Plan-Eintrags.
|
||
;; GF-Gerade -> -L*tan(winkel)
|
||
;; GF-Bogen -> dz aus gf-bogen-masse (Block-KS)
|
||
;; Vario-Kurve -> 0 (auf 0 Grad geflacht)
|
||
;; VF-Gerade -> nil (unbekannt = Teil der Bruecke)
|
||
(defun vfl3-seg-dz (e)
|
||
(cond
|
||
((= (car e) "Linie")
|
||
(if (= (nth 3 e) "GF") (vfl3-gf-dz (caddr e) (nth 4 e)) nil))
|
||
((= (car e) "Bogen")
|
||
(if (= (nth 5 e) "Vario-Kurve")
|
||
0.0
|
||
(cadr (gf-bogen-masse (nth 3 e) (nth 4 e)))))
|
||
(t 0.0)))
|
||
|
||
;; Loest die VF-Bruecke ueber den Modus-1-Solver berechne-alle-winkel.
|
||
;; Die Bruecke sitzt MITTIG in der Kette -> KEIN terminales AS/ES
|
||
;; (aus-dx/aus-dz/ein-dx/ein-dz = 0), feste-hz = *vfl-feste-horizontal* (1300:
|
||
;; Umlenk 500 + Motor 500 + Einlauf-Separator 300). GF1/GF2 bleiben fest 3 Grad,
|
||
;; ihre Laenge variiert (das ist der Ausgleich, siehe Doc 14.3).
|
||
;; dH-signiert: negativ = Auf (steigt), positiv = Ab (faellt).
|
||
;; Rueckgabe: (winkel L_GF L_VF richtung) oder nil (kein passender Winkel).
|
||
(defun vfl3-solve-bruecke (span dH-signiert extra-fest /
|
||
o-adx o-adz o-eix o-eiz richtung fh res winkel)
|
||
(setq richtung (if (< dH-signiert 0) "Auf" "Ab"))
|
||
(setq fh (+ (if (boundp '*vfl-feste-horizontal*) *vfl-feste-horizontal* 1300.0)
|
||
(if extra-fest extra-fest 0.0)))
|
||
;; terminale AS/ES-Masse fuer die mittige Bruecke ausblenden (Save/Restore)
|
||
(setq o-adx aus-dx o-adz aus-dz o-eix ein-dx o-eiz ein-dz)
|
||
(setq aus-dx 0.0 aus-dz 0.0 ein-dx 0.0 ein-dz 0.0)
|
||
(setq res (berechne-alle-winkel span (abs dH-signiert) richtung fh))
|
||
(setq aus-dx o-adx aus-dz o-adz ein-dx o-eix ein-dz o-eiz)
|
||
(setq winkel (car res))
|
||
(if winkel (list winkel (cadr res) (caddr res) richtung) nil))
|
||
|
||
;; GF-Bogen-dz, wenn der Bogen bei Neigung theta (Grad) KS-gekettet wird:
|
||
;; der lokale (dx,dz) des Blocks wird um theta gekippt.
|
||
;; Z-Anteil = -dx*sin(theta) + dz*cos(theta) (negativ = Abfall)
|
||
(defun vfl3-bogen-dz-incl (bwinkel bseite theta / m dx dz rad)
|
||
(setq m (gf-bogen-masse bwinkel bseite) dx (car m) dz (cadr m))
|
||
(setq rad (* (float theta) (/ pi 180.0)))
|
||
(+ (* (- dx) (sin rad)) (* dz (cos rad))))
|
||
|
||
;; Exakter Gesamt-Abstieg (positiv, mm) des BACK-Laufs (Plan-Segmente ab
|
||
;; start-idx bis n-1) PLUS Auslauf-Separator (300 mm, bei aktueller Neigung) +
|
||
;; ES-Eigen-dz. Spiegelt den tatsaechlichen Bau (Trimmung der letzten Geraden um
|
||
;; 300+ein-fp, GF-Bogen bei Neigung). Eintritts-Neigung = 3 Grad (die Bruecke
|
||
;; endet mit GF2 auf 3 Grad). So wird die Junction-Hoehe exakt statt geschaetzt.
|
||
(defun vfl3-dback (plan start-idx n last-idx ein-fp / i seg drop inc w dL rad)
|
||
(setq drop 0.0 inc 3.0 i start-idx)
|
||
(while (< i n)
|
||
(setq seg (nth i plan))
|
||
(cond
|
||
((= (car seg) "Linie")
|
||
(setq w (nth 4 seg) dL (caddr seg))
|
||
(if (= i last-idx) (setq dL (- dL 300.0 ein-fp)))
|
||
(setq dL (max 100.0 dL))
|
||
(setq rad (* (float w) (/ pi 180.0)))
|
||
(setq drop (+ drop (* dL (/ (sin rad) (cos rad)))))
|
||
(setq inc w))
|
||
((= (car seg) "Bogen")
|
||
(if (= (nth 5 seg) "GF-Bogen")
|
||
(setq drop (- drop (vfl3-bogen-dz-incl (nth 3 seg) (nth 4 seg) inc))))))
|
||
(setq i (1+ i)))
|
||
;; Auslauf-Separator (300 mm bei aktueller Neigung inc) + ES-Eigen-dz
|
||
(setq rad (* (float inc) (/ pi 180.0)))
|
||
(setq drop (+ drop (* 300.0 (/ (sin rad) (cos rad)))))
|
||
(setq drop (+ drop (abs (if ein-dz ein-dz 65.0))))
|
||
drop)
|
||
|
||
;; Feste (von der Kletterlaenge UNABHAENGIGE) Z-Aenderung einer VF-Einheit bei
|
||
;; Kletterwinkel w (ohne GF2, das wird gemessen): GF1+Sep(300)+Umlenk(500)+
|
||
;; Motor(500) (alle 3 Grad, senkend) + je Kletterer zwei Boegen + je
|
||
;; Horizontal-Mitte-Koerper zwei 3-Grad-Uebergangsboegen. Einbau-Rotationen wie
|
||
;; in vfs-vf-koerper; Bogen-dz_eff = -dx*sin(rot) + dz_roh*cos(rot) (am Log
|
||
;; verifiziert). So ist die Hoehe rein rechnerisch bestimmt -> Kletterlaenge folgt.
|
||
(defun vfl3-einheit-fix-dz (w n-climb n-hor gf1 richtung /
|
||
pi180 rad3 s3 tot m1 m2 r1 r2 dz1 dz2)
|
||
(setq pi180 (/ pi 180.0) rad3 (* 3.0 pi180) s3 (sin rad3) tot 0.0)
|
||
;; feste 3-Grad-Teile senken immer ab (GF1 + Separator + Umlenk + Motor)
|
||
(setq tot (- tot (* (+ (float gf1) 300.0 500.0 500.0) s3)))
|
||
;; Kletterer-Boegen (Rotationen wie vfs-vf-koerper: 1. Bogen @3, 2. Bogen @(3-w)/(w+3))
|
||
(if (= richtung "Auf")
|
||
(setq m1 (get-bogen-mass bogen-auf w) r1 rad3
|
||
m2 (get-bogen-mass bogen-ab w) r2 (* (- 3 w) pi180))
|
||
(setq m1 (get-bogen-mass bogen-ab w) r1 rad3
|
||
m2 (get-bogen-mass bogen-auf w) r2 (* (+ w 3) pi180)))
|
||
(setq dz1 (+ (* (- (car m1)) (sin r1)) (* (caddr m1) (cos r1))))
|
||
(setq dz2 (+ (* (- (car m2)) (sin r2)) (* (caddr m2) (cos r2))))
|
||
(setq tot (+ tot (* n-climb (+ dz1 dz2))))
|
||
;; Horizontal-Mitte-Koerper: auf_3@3 + ab_3@0
|
||
(setq m1 (get-bogen-mass bogen-auf 3) m2 (get-bogen-mass bogen-ab 3))
|
||
(setq dz1 (+ (* (- (car m1)) (sin rad3)) (* (caddr m1) (cos rad3))))
|
||
(setq dz2 (caddr m2))
|
||
(setq tot (+ tot (* n-hor (+ dz1 dz2))))
|
||
tot)
|
||
|
||
;; Fester PLANARER (XY-)Fussabdruck einer VF-Einheit bei Kletterwinkel w
|
||
;; (ohne die Kletter-Strecken selbst): Stationen (GF1+Sep+Umlenk+Motor, @3 Grad)
|
||
;; + je Kletterer die zwei Boegen + je Horizontal-Mitte-Koerper die zwei
|
||
;; 3-Grad-Boegen. dx_eff = dx*cos(rot) + dz_roh*sin(rot) (am Log verifiziert).
|
||
;; Dient der Winkelwahl: Fussabdruck + Kletter-Planlaenge soll die Lauflaenge treffen.
|
||
(defun vfl3-einheit-fix-dx (w n-climb n-hor gf1 richtung /
|
||
pi180 rad3 tot m1 m2 r1 r2 dx1 dx2)
|
||
(setq pi180 (/ pi 180.0) rad3 (* 3.0 pi180) tot 0.0)
|
||
(setq tot (* (+ (float gf1) 300.0 500.0 500.0) (cos rad3))) ; Stationen planar
|
||
(if (= richtung "Auf")
|
||
(setq m1 (get-bogen-mass bogen-auf w) r1 rad3
|
||
m2 (get-bogen-mass bogen-ab w) r2 (* (- 3 w) pi180))
|
||
(setq m1 (get-bogen-mass bogen-ab w) r1 rad3
|
||
m2 (get-bogen-mass bogen-auf w) r2 (* (+ w 3) pi180)))
|
||
(setq dx1 (+ (* (car m1) (cos r1)) (* (caddr m1) (sin r1))))
|
||
(setq dx2 (+ (* (car m2) (cos r2)) (* (caddr m2) (sin r2))))
|
||
(setq tot (+ tot (* n-climb (+ dx1 dx2))))
|
||
(setq m1 (get-bogen-mass bogen-auf 3) m2 (get-bogen-mass bogen-ab 3))
|
||
(setq dx1 (+ (* (car m1) (cos rad3)) (* (caddr m1) (sin rad3)))) ; auf_3 @ 3
|
||
(setq dx2 (car m2)) ; ab_3 @ 0
|
||
(setq tot (+ tot (* n-hor (+ dx1 dx2))))
|
||
tot)
|
||
|
||
;; Uebergang von der 3-Grad-Kletterbasis in die FLACHE Zone (0 Grad): EIN auf_3-Bogen
|
||
;; (Rotation 3 Grad). Rueckgabe: neuer Punkt.
|
||
(defun vfl3-flach-ein (pt hz / m)
|
||
(setq m (get-bogen-mass bogen-auf 3))
|
||
(insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt 3 (car m) (caddr m) hz))
|
||
|
||
;; Uebergang aus der flachen Zone (0 Grad) zurueck auf 3-Grad-Basis: EIN ab_3-Bogen
|
||
;; (Rotation 0 Grad). Rueckgabe: neuer Punkt.
|
||
(defun vfl3-flach-aus (pt hz / m)
|
||
(setq m (get-bogen-mass bogen-ab 3))
|
||
(insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" pt 0 (car m) (caddr m) hz))
|
||
|
||
;; Kletter-Segment loesen und Winkel WAEHLEN LASSEN (Modus-1-Solver + vfl-waehle-winkel).
|
||
;; Mittige Bruecke -> KEIN terminales AS/ES (Masse auf 0, Save/Restore). feste = fester
|
||
;; Horizontal-Anteil des Kletter-Segments (Umlenk+Separator = 800; Motor sitzt spaeter
|
||
;; am Kettenende). Rueckgabe: (winkel L_GF L_VF richtung) oder nil.
|
||
(defun vfl3-waehle-winkel (span dH-signiert feste /
|
||
o-adx o-adz o-eix o-eiz richtung res wahl)
|
||
(setq richtung (if (< dH-signiert 0) "Auf" "Ab"))
|
||
(setq o-adx aus-dx o-adz aus-dz o-eix ein-dx o-eiz ein-dz)
|
||
(setq aus-dx 0.0 aus-dz 0.0 ein-dx 0.0 ein-dz 0.0)
|
||
(setq res (berechne-alle-winkel span (abs dH-signiert) richtung feste))
|
||
(setq aus-dx o-adx aus-dz o-adz ein-dx o-eix ein-dz o-eiz)
|
||
(setq wahl (vfl-waehle-winkel (nth 3 res)))
|
||
(if wahl (list (car wahl) (cadr wahl) (caddr wahl) richtung) nil))
|
||
|
||
;; Letzte Fueller-Laenge so, dass der Endpunkt auf der ES-KS_AUS-Achse liegt.
|
||
;; pt = Fueller-Start (flach 0 Grad), seg-hz = letzte Richtung, es-block = ES-Block,
|
||
;; gf2 = erwartete GF2-Laenge, rad3 = 3 Grad (rad). Modell: der Schwanz (Fueller +
|
||
;; ab_3 + Motor + GF2 + Separator + ES) verschiebt sich starr entlang seg-hz.
|
||
;; KS_AUS = pt + (fill + C)*dp + perp-es*np
|
||
;; C = 196 (ab_3) + (Motor 500 + GF2 + Sep 300)*cos3 + along-es
|
||
;; Achse u_a = seg-hz + (KS_AUS.xu - KS_EIN.xu)_Block ; (Endpunkt-KS_AUS)*n_a=0 -> fill
|
||
(defun vfl3-es-fueller (pt endp seg-hz es-block gf2 rad3 /
|
||
info theta dpx dpy npx npy phi vx vy vwx vwy
|
||
along-es perp-es ua na-x na-y cc dp-na np-na ep-na)
|
||
(setq info (vf-element-ks-info es-block))
|
||
(if (null info)
|
||
(- (+ (* (- (car endp) (car pt)) (cos (* seg-hz (/ pi 180.0))))
|
||
(* (- (cadr endp) (cadr pt)) (sin (* seg-hz (/ pi 180.0)))))
|
||
(+ 196.0 (* (+ 800.0 gf2) (cos rad3)))) ; Fallback: Along-Naeherung
|
||
(progn
|
||
(setq theta (* seg-hz (/ pi 180.0)))
|
||
(setq dpx (cos theta) dpy (sin theta)) ; seg-hz Richtung
|
||
(setq npx (- (sin theta)) npy (cos theta)) ; senkrecht zu seg-hz
|
||
(setq phi (* (- seg-hz (car info)) (/ pi 180.0))) ; Block -> Welt
|
||
(setq vx (caddr info) vy (cadddr info))
|
||
(setq vwx (- (* vx (cos phi)) (* vy (sin phi)))) ; V_es (Welt)
|
||
(setq vwy (+ (* vx (sin phi)) (* vy (cos phi))))
|
||
(setq along-es (+ (* vwx dpx) (* vwy dpy)))
|
||
(setq perp-es (+ (* vwx npx) (* vwy npy)))
|
||
(setq ua (* (+ seg-hz (- (cadr info) (car info))) (/ pi 180.0))) ; KS_AUS-Achse
|
||
(setq na-x (- (sin ua)) na-y (cos ua)) ; senkrecht zur KS_AUS-Achse
|
||
(setq cc (+ 196.0 (* (+ 800.0 gf2) (cos rad3)) along-es))
|
||
(setq dp-na (+ (* dpx na-x) (* dpy na-y)))
|
||
(setq np-na (+ (* npx na-x) (* npy na-y)))
|
||
(setq ep-na (+ (* (- (car endp) (car pt)) na-x) (* (- (cadr endp) (cadr pt)) na-y)))
|
||
(if (> (abs dp-na) 1e-6)
|
||
(- (/ (- ep-na (* perp-es np-na)) dp-na) cc)
|
||
100.0))))
|
||
|
||
(defun vf-linienzug-modus2 ( / ss k obj-liste startpunkt start-hoehe as-seite
|
||
endpunkt end-hoehe es-seite kette segmente n i seg
|
||
typ hz laenge bwinkel bseite antwort winkel klass
|
||
plan e ecke-bad vf-start vf-ende dz z-front
|
||
z-junction dH-bruecke span-bruecke dH-gesamt
|
||
vf-count in-vf richtn req-w loesung
|
||
aus ein first-line last-line frame deltaL
|
||
br-winkel br-gf1 br-gf2 br-lvf br-richtn pt
|
||
letzt-winkel vfl-nummer lastEnt anzahl-gf anzahl-vf
|
||
hoehe-bis soll-ende ist-ende old-error vfl-ins
|
||
member carrier-idx kv-variante seg-hz letzt-koerper-hz
|
||
vf-first-line vf-last-line climber-span mid-hor
|
||
z-aftermotor gf2-drop gf2-planar br-lvf this-lvf
|
||
nach-kurve n-climb n-hor target-climb winkel-list
|
||
fdz fdx wslope lvf planar-len ang-diff best-diff w
|
||
climb-thresh longest-idx climbers nonclimber-len
|
||
nonclimber-cnt nkurve kurve-chords run-span
|
||
hor-koerper-len hor-pairs flat-p fill-len wahl3
|
||
rad3v feste-vf dH-adj dir-x dir-y fill-D end-hz
|
||
gf-total br-gf-mode br-gf2-exp filler-A-len filler-a-done
|
||
as-vorhanden es-vorhanden dbg-an dbg-old-error)
|
||
(princ "\n\n=========================================")
|
||
(princ (ssg-text "vfl-m3-titel"))
|
||
(princ "\n=========================================")
|
||
|
||
;; --- Debug-Session (Schalter "vfl-modus2", DEFAULT AN) ------------------
|
||
;; (dbg-schalter-off "vfl-modus2") deaktiviert bei Bedarf. Alle Eingaben
|
||
;; laufen bereits durchgehend ueber die vfl-in-*-Wrapper (siehe unten) und
|
||
;; werden dadurch automatisch ueber vfl-journal-record mitgeloggt (analog
|
||
;; Modus 1). Ein FRUEHER, duenner *error*-Hook schliesst die Datei bereits
|
||
;; sauber, falls waehrend Phase A (Klassifizierungsfragen, noch keine
|
||
;; Geometrie) abgebrochen wird - die eigentliche Abbruch-Sicherung (Wickeln
|
||
;; der Teil-Geometrie) wird erst spaeter zu Beginn von Phase B installiert
|
||
;; (siehe dortiger Kommentar) und uebernimmt das Schliessen dann von hier.
|
||
(setq dbg-an (dbg-schalter-open "vfl-modus2" "vfl_modus2.dbg" "DXFM_LOG"))
|
||
(if dbg-an
|
||
(progn
|
||
(dbgf "vf-linienzug-modus2")
|
||
(dbgmsg "=== SESSION Modus 2 (3D-Objekte + Ziel-Hoehe) START ===")
|
||
(dbgflush)))
|
||
(setq dbg-old-error *error*)
|
||
(setq *error*
|
||
(function (lambda (msg)
|
||
(setq *error* dbg-old-error)
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
|
||
(dbgreturn nil)
|
||
(dbgclose)))
|
||
(if dbg-old-error (dbg-old-error msg) (princ)))))
|
||
|
||
;; Abhaengigkeit Gefaellestrecke-Modul
|
||
(if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED"))))
|
||
(progn (alert (ssg-text "vfl-m3-alert-gf-modul")) (exit)))
|
||
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
|
||
|
||
;; --- 1. Pfad-Objekte waehlen ---
|
||
(princ (ssg-text "vfl-m3-pfad-waehlen"))
|
||
(setq ss (vfl-in-selection '((0 . "LINE,ARC"))))
|
||
(if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
|
||
(setq obj-liste (mapcar 'vlax-ename->vla-object ss))
|
||
|
||
;; --- 2. Startpunkt + Z + AS-Seite ---
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
|
||
(list "vfl-m3-prompt-startpunkt" "Starthoehe (Z, mm):")))
|
||
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-startpunkt")))
|
||
(if (null startpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit)))
|
||
(setq start-hoehe (vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt"
|
||
(list (rtos (caddr startpunkt) 2 1)))))
|
||
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
|
||
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-as-setzen-frage")))
|
||
(princ (ssg-text "vfl-as-setzen-frage"))
|
||
(princ (ssg-text "vfl-ja"))
|
||
(princ (ssg-text "vfl-m3-as-nein"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list (ssg-text "vfl-ja") (ssg-text "vfl-m3-as-nein")) 1
|
||
"vfl-as-setzen-frage"))
|
||
(setq as-vorhanden (/= antwort "2"))
|
||
(if as-vorhanden
|
||
(progn
|
||
(setq *vfl-as-winkel*
|
||
(vfl-in-value "STR"
|
||
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
|
||
(princ (ssg-text "gf-seite-aus-header"))
|
||
(princ (ssg-text "gf-seite-links"))
|
||
(princ (ssg-text "gf-seite-rechts"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
|
||
"gf-seite-aus-header"))
|
||
(setq as-seite (if (= antwort "2") "rechts" "links"))
|
||
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
|
||
)
|
||
)
|
||
|
||
;; --- 3. Endpunkt + Z + ES-Seite (NEU in Modus 3) ---
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
|
||
(list "vfl-m3-prompt-endpunkt" "Zielhoehe (Z, mm):")))
|
||
(setq endpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-endpunkt")))
|
||
(if (null endpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit)))
|
||
(setq end-hoehe (vfl-in-real (ssg-textf "vfl-m3-prompt-zielhoehe"
|
||
(list (rtos (caddr endpunkt) 2 1)))))
|
||
(if (null end-hoehe) (setq end-hoehe (caddr endpunkt)))
|
||
(setq endpunkt (list (car endpunkt) (cadr endpunkt) end-hoehe))
|
||
(if (vfl-wizard-aktiv)
|
||
(vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-es-setzen-frage")))
|
||
(princ (ssg-text "vfl-es-setzen-frage"))
|
||
(princ (ssg-text "vfl-ja"))
|
||
(princ (ssg-text "vfl-es-nein-zielpunkt"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list (ssg-text "vfl-ja") (ssg-text "vfl-es-nein-zielpunkt")) 1
|
||
"vfl-es-setzen-frage"))
|
||
(setq es-vorhanden (/= antwort "2"))
|
||
(if es-vorhanden
|
||
(progn
|
||
(setq *vfl-es-winkel*
|
||
(vfl-in-value "STR"
|
||
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite
|
||
(princ (ssg-text "gf-seite-ein-header"))
|
||
(princ (ssg-text "gf-seite-links"))
|
||
(princ (ssg-text "gf-seite-rechts"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
|
||
"gf-seite-ein-header"))
|
||
(setq es-seite (if (= antwort "2") "rechts" "links"))
|
||
(vf-set-es-masse *vfl-es-winkel* es-seite) ; Masse fuer Variante
|
||
)
|
||
)
|
||
|
||
;; --- 4. Sortieren + Analysieren + Eck-Vorpruefung ---
|
||
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
|
||
(if (null kette)
|
||
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit)))
|
||
(setq segmente (gf-analysiere-kette kette))
|
||
(setq ecke-bad (vfl2-pruefe-eckwinkel kette 5.0))
|
||
(if ecke-bad
|
||
(progn
|
||
(alert (ssg-textf "vfl-m3-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
|
||
(exit)))
|
||
|
||
;; --- 5. Klassifizierung (Phase A: nur speichern, nichts bauen) ---
|
||
;; Plan-Eintrag Gerade: ("Linie" hz laenge klass winkel) klass=GF/VF
|
||
;; Plan-Eintrag Bogen : ("Bogen" hz chord bwinkel bseite klass)
|
||
(setq n (length segmente) i 0 plan '())
|
||
(while (< i n)
|
||
(setq seg (nth i segmente) typ (car seg) hz (cadr seg) laenge (caddr seg))
|
||
(cond
|
||
((= typ "Linie")
|
||
(princ (ssg-textf "vfl-m3-seg-gerade"
|
||
(list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1))))
|
||
(cond
|
||
;; Direkt nach einer Vario-Kurve: automatisch VF (keine Abfrage) -
|
||
;; die Kurve sitzt mitten in der VF-Einheit, es MUSS VF folgen.
|
||
(nach-kurve
|
||
(princ (ssg-text "vfl-m3-auto-vf"))
|
||
(setq plan (cons (list "Linie" hz laenge "VF" nil) plan))
|
||
(setq nach-kurve nil))
|
||
(t
|
||
(princ (ssg-text "vfl-m3-typ-gerade"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list "GF (Neigungswinkel)" "VF (Bruecke)") 1
|
||
"vfl-m3-typ-gerade"))
|
||
(if (= antwort "2")
|
||
(setq plan (cons (list "Linie" hz laenge "VF" nil) plan))
|
||
(progn
|
||
(setq winkel (vfl-in-real (ssg-text "vfl-m3-prompt-gf-neigung")))
|
||
(if (null winkel) (setq winkel 3.0))
|
||
(if (> winkel 3.0)
|
||
(progn (princ (ssg-text "vfl-m3-hinweis-gf-max")) (setq winkel 3.0)))
|
||
(setq plan (cons (list "Linie" hz laenge "GF" winkel) plan)))))))
|
||
((= typ "Bogen")
|
||
(setq bwinkel (nth 3 seg) bseite (nth 4 seg))
|
||
(princ (ssg-textf "vfl-m3-seg-bogen"
|
||
(list (itoa (1+ i)) (itoa n) (itoa bwinkel) bseite)))
|
||
(princ (ssg-text "vfl-m3-typ-bogen"))
|
||
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list "GF-Bogen" "Vario-Kurve") 1
|
||
"vfl-m3-typ-bogen"))
|
||
(if (= antwort "2")
|
||
(progn
|
||
(princ (ssg-text "vfl-m3-variante-frage"))
|
||
(setq kv-variante (if (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2")
|
||
(list (ssg-text "vfl-variante-aussen") (ssg-text "vfl-variante-innen")) 2
|
||
"vfl-m3-variante-frage")
|
||
"1") "aussen" "innen"))
|
||
(setq plan (cons (list "Bogen" hz laenge bwinkel bseite "Vario-Kurve" kv-variante) plan))
|
||
(setq nach-kurve t)) ; naechste Gerade automatisch VF
|
||
(progn
|
||
(setq plan (cons (list "Bogen" hz laenge bwinkel bseite "GF-Bogen" nil) plan))
|
||
(setq nach-kurve nil)))))
|
||
(setq i (1+ i)))
|
||
(setq plan (reverse plan))
|
||
|
||
;; --- 6. VF-Lauf finden: VF-Geraden UND Vario-Kurven bilden EINEN Lauf ---
|
||
;; (Vario-Kurve gehoert in die VF-Einheit, unterbricht den Lauf also NICHT).
|
||
(setq vf-start -1 vf-ende -1 vf-count 0 in-vf nil i 0)
|
||
(foreach e plan
|
||
(setq member (or (and (= (car e) "Linie") (= (nth 3 e) "VF"))
|
||
(and (= (car e) "Bogen") (= (nth 5 e) "Vario-Kurve"))))
|
||
(if member
|
||
(progn
|
||
(if (not in-vf) (setq vf-count (1+ vf-count) vf-start i in-vf t))
|
||
(setq vf-ende i))
|
||
(setq in-vf nil))
|
||
(setq i (1+ i)))
|
||
|
||
(if (/= vf-count 1)
|
||
(progn
|
||
(princ (ssg-textf "vfl-m3-vf-laeufe" (list (itoa vf-count))))
|
||
(princ (ssg-text "vfl-m3-vf-lauf-noetig"))
|
||
(princ (ssg-text "vfl-m3-vf-lauf-m3b"))
|
||
(exit)))
|
||
;; Traeger-Stueck = laengste VF-Gerade im Lauf (traegt die ganze Hoehe).
|
||
(setq carrier-idx -1 i vf-start)
|
||
(while (<= i vf-ende)
|
||
(setq seg (nth i plan))
|
||
(if (and (= (car seg) "Linie") (= (nth 3 seg) "VF"))
|
||
(if (or (< carrier-idx 0) (> (caddr seg) (caddr (nth carrier-idx plan))))
|
||
(setq carrier-idx i)))
|
||
(setq i (1+ i)))
|
||
(if (< carrier-idx 0)
|
||
(progn (princ (ssg-text "vfl-m3-vf-lauf-ohne-gerade")) (exit)))
|
||
|
||
;; --- 7. Anker rechnen ---
|
||
;; Vorwaerts: Start-Z durch alle Front-Segmente (Index < vf-start).
|
||
(setq z-front (float start-hoehe) i 0)
|
||
(while (< i vf-start)
|
||
(setq dz (vfl3-seg-dz (nth i plan)))
|
||
(if dz (setq z-front (+ z-front dz)))
|
||
(setq i (1+ i)))
|
||
;; Rueckwaerts: Ziel-Z durch alle Back-Segmente (Index > vf-ende).
|
||
;; Vorwaerts gilt Z_next = Z_prev + dz -> rueckwaerts Z_prev = Z_next - dz.
|
||
(setq z-junction (float end-hoehe) i (1- n))
|
||
(while (> i vf-ende)
|
||
(setq dz (vfl3-seg-dz (nth i plan)))
|
||
(if dz (setq z-junction (- z-junction dz)))
|
||
(setq i (1- i)))
|
||
|
||
;; Bruecken-Spannweite = Summe der VF-Geraden-Planlaengen im Lauf.
|
||
(setq span-bruecke 0.0 i vf-start)
|
||
(while (<= i vf-ende)
|
||
(setq seg (nth i plan))
|
||
(if (= (car seg) "Linie") (setq span-bruecke (+ span-bruecke (caddr seg))))
|
||
(setq i (1+ i)))
|
||
|
||
(setq dH-bruecke (- z-front z-junction))
|
||
(setq dH-gesamt (- (float start-hoehe) (float end-hoehe)))
|
||
|
||
;; --- 8. Anker-Report (noch kein Bauen) ---
|
||
(princ "\n\n=========================================")
|
||
(princ (ssg-text "vfl-m3-anker-vorschau-header"))
|
||
(princ "\n=========================================")
|
||
(princ (ssg-textf "vfl-m3-start-hoehe" (list (rtos (float start-hoehe) 2 1))))
|
||
(princ (ssg-textf "vfl-m3-ziel-hoehe" (list (rtos (float end-hoehe) 2 1))))
|
||
(princ (ssg-textf "vfl-m3-delta-h-gesamt" (list (rtos dH-gesamt 2 1))))
|
||
(princ (ssg-textf "vfl-m3-vf-lauf-segmente" (list (itoa (1+ vf-start)) (itoa (1+ vf-ende)))))
|
||
(princ (ssg-textf "vfl-m3-front-anker-vorschau" (list (rtos z-front 2 1))))
|
||
(princ (ssg-textf "vfl-m3-junction-anker-vorschau" (list (rtos z-junction 2 1))))
|
||
;; Vorzeichen = Richtung (VF ist angetrieben, kann steigen UND fallen).
|
||
(setq richtn (cond ((< dH-bruecke -0.1) (ssg-text "vfl-m3-richtung-auf"))
|
||
((> dH-bruecke 0.1) (ssg-text "vfl-m3-richtung-ab"))
|
||
(t (ssg-text "vfl-m3-richtung-horizontal"))))
|
||
(setq req-w (if (> span-bruecke 1.0)
|
||
(* (atan (/ (abs dH-bruecke) span-bruecke)) (/ 180.0 pi))
|
||
0.0))
|
||
(princ (ssg-textf "vfl-m3-bruecke-dh" (list (rtos dH-bruecke 2 1) (rtos span-bruecke 2 0))))
|
||
(princ (ssg-textf "vfl-m3-bruecke-richtung" (list richtn)))
|
||
(princ (ssg-text "vfl-m3-vf-angetrieben"))
|
||
(princ (ssg-textf "vfl-m3-mittlere-neigung" (list (rtos req-w 2 1))))
|
||
(if (> req-w 51.0)
|
||
(princ (ssg-text "vfl-m3-warnung-zu-steil"))
|
||
(princ (ssg-text "vfl-m3-vario-bereich-ok")))
|
||
|
||
(princ (ssg-text "vfl-m3-anker-hinweis"))
|
||
(princ "\n=========================================")
|
||
|
||
;; ================= PHASE B: BAUEN (messen statt schaetzen) =================
|
||
;; VF-Lauf darf mehrsegmentig sein (VF-Geraden + Vario-Kurven, EINE VF-Einheit).
|
||
;; Nummerierung + Akkumulatoren + AS/ES-Fussabdruecke. Ohne AS-Element (aus-
|
||
;; vorhanden=nil) faellt der Fussabdruck weg - die Kette beginnt direkt am
|
||
;; Startpunkt, also 0 statt Block-/Fallback-Mass.
|
||
(setq aus (if as-vorhanden (if aus-dx aus-dx 576.0) 0.0)
|
||
ein (if es-vorhanden (if ein-dx ein-dx 576.0) 0.0))
|
||
(setq vfl-nummer (vf-next-number))
|
||
(setq lastEnt (vf-lastent-ohne-attribute))
|
||
(vfl-acc-reset)
|
||
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
|
||
;; --- Abbruch-Sicherung ab hier scharf (analog Modus 1, siehe dortiger
|
||
;; Kommentar) - Phase A (oben) baut noch keine Geometrie, ein Abbruch
|
||
;; waehrend der Klassifizierungsfragen haette also ohnehin nichts zu
|
||
;; wickeln. Ab Phase B kann jederzeit Geometrie entstehen.
|
||
;; *error* ist hier bereits der fruehe dbg-Hook vom Funktionsanfang - wir
|
||
;; loesen ihn komplett ab (Ruecksprungziel ist dbg-old-error, NICHT der
|
||
;; dbg-Hook selbst) und uebernehmen das dbgclose gleich mit, sonst wuerde
|
||
;; bei einem Abbruch ab hier doppelt geschlossen.
|
||
(setq old-error dbg-old-error)
|
||
(setq *error*
|
||
(function (lambda (msg)
|
||
(setq *error* old-error)
|
||
(vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf
|
||
startpunkt frame as-seite es-seite "linienzug2")
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
|
||
(dbgreturn nil)
|
||
(dbgclose)))
|
||
(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
|
||
(princ))))
|
||
;; erste/letzte Gerade fuer AS/ES-Trimmung bestimmen
|
||
(setq first-line -1 last-line -1 i 0)
|
||
(while (< i n)
|
||
(if (= (car (nth i plan)) "Linie")
|
||
(progn (if (< first-line 0) (setq first-line i)) (setq last-line i)))
|
||
(setq i (1+ i)))
|
||
|
||
;; --- B1: FRONT-Lauf bauen (Segmente 0 .. vf-start-1) -> Front-Anker MESSEN ---
|
||
(princ (ssg-text "vfl-m3-phase-b1"))
|
||
(setq i 0)
|
||
(while (< i vf-start)
|
||
(setq seg (nth i plan) typ (car seg) hz (cadr seg))
|
||
(cond
|
||
((= typ "Linie")
|
||
(setq winkel (nth 4 seg))
|
||
;; AS zuerst platzieren (falls gewuenscht), damit der echte KS_AUS bekannt
|
||
;; ist. Ohne AS-Element beginnt die Kette direkt am Startpunkt (flach) -
|
||
;; die nachfolgende Fussabdruck-Trimmung wird dann automatisch zu 0, da
|
||
;; (car frame) bereits gleich startpunkt ist.
|
||
(if (null frame)
|
||
(setq frame (if as-vorhanden
|
||
(vfl2-insert-as-gf startpunkt hz winkel as-seite)
|
||
(make-frame-from-dir startpunkt (hz-winkel->xu hz 0.0)))))
|
||
(setq deltaL (caddr seg))
|
||
;; erste Gerade: AS-Fussabdruck ENTLANG des Pfads exakt aus KS_AUS abziehen
|
||
;; (das Block-Maß aus-dx stimmt nach dem Achs-Versatz nicht mehr).
|
||
(if (= i first-line)
|
||
(setq deltaL (- deltaL
|
||
(+ (* (- (car (car frame)) (car startpunkt)) (cos (* hz (/ pi 180.0))))
|
||
(* (- (cadr (car frame)) (cadr startpunkt)) (sin (* hz (/ pi 180.0))))))))
|
||
(setq deltaL (max 100.0 deltaL))
|
||
(setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel))
|
||
(vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel)
|
||
(setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel))
|
||
((= typ "Bogen")
|
||
(setq bwinkel (nth 3 seg) bseite (nth 4 seg) klass (nth 5 seg))
|
||
(if (= klass "GF-Bogen")
|
||
(progn
|
||
(if (null frame)
|
||
(progn (alert (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit)))
|
||
(setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite)))
|
||
(princ (ssg-text "vfl-m3-kurve-front-uebersprungen")))))
|
||
(setq i (1+ i)))
|
||
|
||
;; Front-Anker (gemessen). Falls die VF-Bruecke ganz vorne liegt: AS (falls
|
||
;; gewuenscht) jetzt setzen.
|
||
(setq hz (cadr (nth vf-start plan)))
|
||
(if (null frame)
|
||
(setq frame (if as-vorhanden
|
||
(vfl2-insert-as-vf startpunkt hz as-seite)
|
||
(make-frame-from-dir startpunkt (hz-winkel->xu hz 0.0)))))
|
||
(setq z-front (caddr (car frame)))
|
||
|
||
;; --- B2: Back-Abstieg -> Junction; Kletterer + Horizontal-Mitte bestimmen ---
|
||
(setq z-junction (+ (float end-hoehe)
|
||
(vfl3-dback plan (1+ vf-ende) n last-line ein)))
|
||
(setq dH-bruecke (- z-front z-junction))
|
||
;; Modell: EIN Vario mit Horizontal-Mitte. Nur VF-Geraden, die LANG GENUG sind
|
||
;; (Vertikalboegen brauchen viel Platz), tragen die Hoehe (Kletterer, gleicher
|
||
;; Winkel). Zu kurze VF-Geraden werden horizontal (nur Anschluss/Motor).
|
||
;; Mindestens die laengste VF-Gerade klettert immer.
|
||
(setq climb-thresh (if (boundp '*vfl-min-climber-laenge*) *vfl-min-climber-laenge* 3000.0))
|
||
(setq longest-idx -1 i vf-start)
|
||
(while (<= i vf-ende)
|
||
(setq seg (nth i plan))
|
||
(if (and (= (car seg) "Linie") (= (nth 3 seg) "VF"))
|
||
(if (or (< longest-idx 0) (> (caddr seg) (caddr (nth longest-idx plan))))
|
||
(setq longest-idx i)))
|
||
(setq i (1+ i)))
|
||
(setq climbers '() climber-span 0.0 nonclimber-len 0.0 nonclimber-cnt 0
|
||
nkurve 0 kurve-chords 0.0 i vf-start)
|
||
(while (<= i vf-ende)
|
||
(setq seg (nth i plan))
|
||
(cond
|
||
((and (= (car seg) "Linie") (= (nth 3 seg) "VF"))
|
||
(if (or (= i longest-idx) (>= (caddr seg) climb-thresh))
|
||
(setq climbers (cons i climbers) climber-span (+ climber-span (caddr seg)))
|
||
(setq nonclimber-len (+ nonclimber-len (caddr seg)) nonclimber-cnt (1+ nonclimber-cnt))))
|
||
((= (car seg) "Bogen")
|
||
(setq nkurve (1+ nkurve) kurve-chords (+ kurve-chords (caddr seg)))))
|
||
(setq i (1+ i)))
|
||
(setq climbers (reverse climbers) n-climb (length climbers))
|
||
;; Flache Zone (Kurve + horizontale Fueller) hat GENAU EIN Uebergangspaar
|
||
;; (ein auf_3 rein, ein ab_3 raus), unabhaengig von der Zahl der Fueller/Kurven.
|
||
(setq hor-pairs (if (or (> nkurve 0) (> nonclimber-cnt 0)) 1 0))
|
||
(setq run-span (+ climber-span nonclimber-len kurve-chords))
|
||
(setq br-gf1 400.0) ; feste kleine GF1
|
||
(setq br-richtn (if (< dH-bruecke 0) "Auf" "Ab"))
|
||
(setq target-climb (- z-junction z-front)) ; noetige Netto-Hoehe (Auf>0)
|
||
;; Kletter-Segment als Standard-Vario loesen; GF wird BERECHNET (L_GF) und der
|
||
;; Winkel WAEHLBAR (mehrere gueltige -> Nutzer waehlt). feste = 800 (Umlenk+Sep;
|
||
;; Motor sitzt am Kettenende). Die flache Zone gleicht danach die Laenge aus.
|
||
(princ (ssg-text "vfl-m3-standard-vario-header"))
|
||
(princ (ssg-textf "vfl-m3-front-anker-gemessen" (list (rtos z-front 2 1))))
|
||
(princ (ssg-textf "vfl-m3-junction-exakt" (list (rtos z-junction 2 1))))
|
||
(princ (ssg-textf "vfl-m3-kletter-info"
|
||
(list (rtos target-climb 2 1) (itoa n-climb) (itoa nkurve) (itoa nonclimber-cnt))))
|
||
;; feste-Horizontal + Hoehen-Anpassung fuer den Solver:
|
||
;; - Mit flacher Zone: Motor sitzt am Kettenende (nicht im Kletter-Segment) ->
|
||
;; feste = 800 (Umlenk+Sep). berechne rechnet Motor-/Uebergangs-Abstieg NICHT,
|
||
;; daher Kletterhoehe um diese Abstiege anpassen (GF2 bleibt ~0).
|
||
;; - Ohne flache Zone (Einzel-Bruecke): feste = 1300 (inkl. Motor), keine Anpassung.
|
||
(setq rad3v (* 3.0 (/ pi 180.0)))
|
||
(if (> hor-pairs 0)
|
||
(setq feste-vf 800.0
|
||
dH-adj (- dH-bruecke (+ (* 500.0 (sin rad3v)) 10.48))) ; Motor + auf_3/ab_3
|
||
(setq feste-vf 1300.0 dH-adj dH-bruecke))
|
||
(setq wahl3 (vfl3-waehle-winkel climber-span dH-adj feste-vf))
|
||
(if (null wahl3)
|
||
(progn (princ (ssg-text "vfl-m3-kein-winkel"))
|
||
(princ) (exit)))
|
||
(setq br-winkel (car wahl3) gf-total (cadr wahl3) br-lvf (caddr wahl3) br-richtn (cadddr wahl3))
|
||
;; GF-Verteilung: 1 = alles am Einlauf (GF1); 2 = 1/2 GF1 + 1/2 GF2. Bei 1/2/1/2
|
||
;; wird der im Kletter-Segment durch das halbe GF1 frei werdende Platz mit einem
|
||
;; horizontalen Fueller-A gefuellt; GF2 (~1/2 L_GF) sitzt hinter dem Motor, der
|
||
;; ES-Laengen-Abschluss zieht seinen Fussabdruck ab (Fueller-B wird kuerzer).
|
||
(princ (ssg-text "vfl-m3-gf-verteilung"))
|
||
(setq br-gf-mode
|
||
(if (= (vfl-menu (ssg-text "prompt-wahl-1-2")
|
||
(list "Alles am Einlauf (GF1)" "1/2 GF1 + 1/2 GF2") 1
|
||
"vfl-m3-gf-verteilung") "2") 2 1))
|
||
(if (= br-gf-mode 2)
|
||
(setq br-gf1 (/ gf-total 2.0) br-gf2-exp (/ gf-total 2.0)
|
||
filler-A-len (* (/ gf-total 2.0) (cos rad3v)))
|
||
(setq br-gf1 gf-total br-gf2-exp 0.0 filler-A-len 0.0))
|
||
(setq filler-a-done nil)
|
||
(princ (ssg-textf "vfl-m3-vario-ergebnis"
|
||
(list (itoa br-winkel)
|
||
(if (= br-richtn "Auf") (ssg-text "vfl-m3-richtung-auf-kurz")
|
||
(ssg-text "vfl-m3-richtung-ab-kurz"))
|
||
(rtos br-lvf 2 0)
|
||
(rtos gf-total 2 0)
|
||
(if (= br-gf-mode 2) (ssg-text "vfl-m3-vert-halb")
|
||
(ssg-text "vfl-m3-vert-ganz")))))
|
||
|
||
;; --- B3: Standard-Vario (Klettern, 3-Grad-Basis) + flache Zone (0 Grad) ---
|
||
;; Die flache Zone (Vario-Kurve + horizontaler Fueller) haengt EINMAL ueber auf_3
|
||
;; ein und EINMAL ueber ab_3 aus; Kurve und Fueller sind bei 0 Grad DIREKT
|
||
;; verbunden (keine Zwischen-Boegen). Der horizontale Fueller gleicht die
|
||
;; Restlaenge aus (letztes Stueck vor dem Motor getrimmt).
|
||
(setq pt (car frame) letzt-koerper-hz (cadr (nth vf-start plan)) flat-p nil)
|
||
(setq pt (vfs-vf-entry pt br-gf1 letzt-koerper-hz)) ; GF1 + Separator + Umlenk (3 Grad)
|
||
(vfl-acc-gf-seg br-gf1 3)
|
||
(setq i vf-start)
|
||
(while (<= i vf-ende)
|
||
(setq seg (nth i plan) seg-hz (cadr seg))
|
||
(cond
|
||
;; --- Kletterer (geneigt, 3-Grad-Basis) ---
|
||
((and (= (car seg) "Linie") (member i climbers))
|
||
(if flat-p (progn (setq pt (vfl3-flach-aus pt seg-hz)) (setq flat-p nil)))
|
||
(setq this-lvf (max 100.0 (* br-lvf (/ (caddr seg) climber-span))))
|
||
(setq pt (vfs-vf-koerper pt br-richtn br-winkel this-lvf seg-hz))
|
||
(vfl-acc-vf-seg br-richtn br-winkel this-lvf)
|
||
(setq anzahl-vf (1+ anzahl-vf) letzt-koerper-hz seg-hz))
|
||
;; --- kurze VF-Gerade -> horizontaler Fueller (0 Grad) ---
|
||
((= (car seg) "Linie")
|
||
(if (not flat-p)
|
||
(progn (setq pt (vfl3-flach-ein pt letzt-koerper-hz)) (setq flat-p t)
|
||
;; Fueller-A: der im Kletter-Segment durch 1/2 GF1 frei werdende Platz
|
||
(if (and (> filler-A-len 0.1) (not filler-a-done))
|
||
(progn (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm"
|
||
pt filler-A-len 0 letzt-koerper-hz))
|
||
(vfl-acc-vf-seg "horizontal" 0 filler-A-len)
|
||
(setq anzahl-vf (1+ anzahl-vf) filler-a-done t)))))
|
||
(if (= i vf-ende)
|
||
;; letzter Fueller, MIT ES-Element (unveraendert): Laenge so, dass der
|
||
;; ENDPUNKT auf der ES-KS_AUS-ACHSE liegt (Spiegel der AS-Regel). Der
|
||
;; Schwanz (Fueller + ab_3 + Motor + GF2 + Separator + ES) verschiebt
|
||
;; sich starr entlang seg-hz mit dem Fueller; KS_AUS = pt + (fill + C)*
|
||
;; dp + perp-es*np, Achse u_a = seg-hz + ES-Turn. Aus (Endpunkt -
|
||
;; KS_AUS)*n_a = 0 folgt fill (n_a senkrecht zu u_a). OHNE ES-Element
|
||
;; (Nutzerwunsch): keine Achsen-Korrektur noetig, da nach Motor+GF2
|
||
;; nichts mehr gebaut wird - Fueller zielt direkt auf den Endpunkt.
|
||
(setq fill-len
|
||
(if es-vorhanden
|
||
(vfl3-es-fueller pt endpunkt seg-hz
|
||
(strcat "ES_Element_" (vfl-es-winkel) "_" es-seite)
|
||
br-gf2-exp rad3v)
|
||
(- (+ (* (- (car endpunkt) (car pt)) (cos (* seg-hz (/ pi 180.0))))
|
||
(* (- (cadr endpunkt) (cadr pt)) (sin (* seg-hz (/ pi 180.0)))))
|
||
(* (+ 500.0 br-gf2-exp) (cos rad3v)))
|
||
)
|
||
)
|
||
(setq fill-len (caddr seg)))
|
||
(setq fill-len (max 100.0 fill-len))
|
||
(setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt fill-len 0 seg-hz))
|
||
(vfl-acc-vf-seg "horizontal" 0 fill-len) (setq anzahl-vf (1+ anzahl-vf))
|
||
(setq letzt-koerper-hz seg-hz))
|
||
;; --- Vario-Kurve (flach, direkt bei 0 Grad) ---
|
||
((= (car seg) "Bogen")
|
||
(if (not flat-p)
|
||
(progn (setq pt (vfl3-flach-ein pt letzt-koerper-hz)) (setq flat-p t)
|
||
;; Fueller-A: der im Kletter-Segment durch 1/2 GF1 frei werdende Platz
|
||
(if (and (> filler-A-len 0.1) (not filler-a-done))
|
||
(progn (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm"
|
||
pt filler-A-len 0 letzt-koerper-hz))
|
||
(vfl-acc-vf-seg "horizontal" 0 filler-A-len)
|
||
(setq anzahl-vf (1+ anzahl-vf) filler-a-done t)))))
|
||
(setq bwinkel (nth 3 seg) bseite (nth 4 seg) kv-variante (nth 6 seg))
|
||
(setq frame (make-frame-from-dir pt (hz-winkel->xu letzt-koerper-hz 0.0)))
|
||
(setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite
|
||
(if kv-variante kv-variante "innen")))
|
||
(setq pt (car frame))
|
||
(if (< i vf-ende) (setq letzt-koerper-hz (cadr (nth (1+ i) plan))))))
|
||
(setq i (1+ i)))
|
||
(if flat-p (progn (setq pt (vfl3-flach-aus pt letzt-koerper-hz)) (setq flat-p nil))) ; zurueck 3 Grad
|
||
;; Motorstation (ohne GF2)
|
||
(setq pt (vfs-vf-exit pt 0.0 letzt-koerper-hz nil))
|
||
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
|
||
;; GF2 = gemessener exakter Hoehen-Ausgleich (Abstieg bis zur Junction)
|
||
(setq z-aftermotor (caddr pt))
|
||
(setq gf2-drop (- z-aftermotor z-junction))
|
||
(if (< gf2-drop 0.0)
|
||
(progn
|
||
(princ (ssg-textf "vfl-m3-warnung-gf2-negativ" (list (rtos (- gf2-drop) 2 1))))
|
||
(setq gf2-drop 0.0)))
|
||
(setq gf2-planar (/ gf2-drop (/ (sin (* 3.0 (/ pi 180.0))) (cos (* 3.0 (/ pi 180.0))))))
|
||
(if (> gf2-planar 0.1)
|
||
(progn
|
||
(princ (ssg-textf "vfl-m3-gf2-ausgleich" (list (rtos gf2-planar 2 1))))
|
||
(setq frame (vfl-insert-gf-segment pt letzt-koerper-hz gf2-planar 3))
|
||
(vfl-acc-gf-seg (/ gf2-planar (cos (* 3.0 (/ pi 180.0)))) 3))
|
||
(setq frame (vfl-frame-3grad pt letzt-koerper-hz)))
|
||
(setq hz letzt-koerper-hz)
|
||
|
||
;; --- B4: BACK-Lauf bauen (Segmente vf-ende+1 .. n-1) ---
|
||
(setq i (1+ vf-ende))
|
||
(while (< i n)
|
||
(setq seg (nth i plan) typ (car seg) hz (cadr seg))
|
||
(cond
|
||
((= typ "Linie")
|
||
(setq winkel (nth 4 seg) deltaL (caddr seg))
|
||
;; Footprint fuer Separator(300)+ES nur reservieren, wenn ES-Element
|
||
;; gewuenscht ist (ein=0 sonst, siehe oben) - ohne ES entfaellt auch
|
||
;; der abschliessende Separator.
|
||
(if (= i last-line) (setq deltaL (- deltaL (if es-vorhanden 300.0 0.0) ein)))
|
||
(setq deltaL (max 100.0 deltaL))
|
||
(setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel))
|
||
(vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel)
|
||
(setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel))
|
||
((= typ "Bogen")
|
||
(setq bwinkel (nth 3 seg) bseite (nth 4 seg) klass (nth 5 seg))
|
||
(if (= klass "GF-Bogen")
|
||
(setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite))
|
||
(princ (ssg-text "vfl-m3-kurve-back-uebersprungen")))))
|
||
(setq i (1+ i)))
|
||
|
||
;; --- B5: Kettenende Separator + ES (nur falls gewuenscht) ---
|
||
(if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit)))
|
||
(if es-vorhanden
|
||
(setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame))
|
||
(if letzt-winkel letzt-winkel 3.0) (caddr (car frame)) es-seite)))
|
||
|
||
;; ---------- Block + Ist-Ziel-Report ----------
|
||
(setq hoehe-bis (caddr (car frame)))
|
||
(setq vfl-ins
|
||
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
|
||
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt))
|
||
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug2") ->
|
||
;; spaeter per Doppelklick editierbar (vfl-edit-ent2: voller Reset, kein
|
||
;; Sektions-Dialog wie bei Modus 1 - siehe dortiger Kommentar).
|
||
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins "linienzug2"))
|
||
;; Erfolgreicher Abschluss: *error* zuruecksetzen.
|
||
(setq *error* old-error)
|
||
(setq soll-ende endpunkt ist-ende (car frame))
|
||
(princ "\n\n=========================================")
|
||
(princ (ssg-text "vfl-m3-fertig-header"))
|
||
(princ (ssg-textf "vfl-m3-ziel-soll"
|
||
(list (rtos (car soll-ende) 2 1) (rtos (cadr soll-ende) 2 1) (rtos (caddr soll-ende) 2 1))))
|
||
(princ (ssg-textf "vfl-m3-es-ist"
|
||
(list (rtos (car ist-ende) 2 1) (rtos (cadr ist-ende) 2 1) (rtos (caddr ist-ende) 2 1))))
|
||
(princ (ssg-textf "vfl-m3-abweichung"
|
||
(list (rtos (- (car ist-ende) (car soll-ende)) 2 1)
|
||
(rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1)
|
||
(rtos (- (caddr ist-ende) (caddr soll-ende)) 2 1))))
|
||
;; Zerlegung bezogen auf die ES-KS_AUS-ACHSE: Quer (senkrecht zur Achse) soll
|
||
;; ~0 sein (Endpunkt liegt auf der KS_AUS-Achse), Laengs = ES-Ausladung.
|
||
(setq end-hz (car (frame->hz-winkel frame))) ; KS_AUS-Achsrichtung
|
||
(setq dir-x (cos (* end-hz (/ pi 180.0))) dir-y (sin (* end-hz (/ pi 180.0))))
|
||
(princ (ssg-textf "vfl-m3-laengs-quer"
|
||
(list (rtos (+ (* (- (car ist-ende) (car soll-ende)) dir-x)
|
||
(* (- (cadr ist-ende) (cadr soll-ende)) dir-y)) 2 1)
|
||
(rtos (+ (* (- (car ist-ende) (car soll-ende)) (- dir-y))
|
||
(* (- (cadr ist-ende) (cadr soll-ende)) dir-x)) 2 1))))
|
||
(princ (ssg-text "vfl-m3-achse-hinweis"))
|
||
(princ "\n=========================================")
|
||
|
||
(if dbg-an
|
||
(progn
|
||
(dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer)
|
||
" (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")"))
|
||
(dbg 'soll-ende)
|
||
(dbg 'ist-ende)
|
||
(dbgmsg "=== SESSION Modus 2 ENDE ===")
|
||
(dbgreturn (list "VF" vfl-nummer))
|
||
(dbgclose)))
|
||
(princ)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 5: KETTE ZUSAMMENFUEHREN
|
||
;; ============================================================
|
||
;; Vario_Kette_Merge: eine Kette aus bereits in der Zeichnung liegenden
|
||
;; Vario-Foerderer-Bausteinen (lose Einzelteile WIE AUCH bereits fertig
|
||
;; gewickelte VF_n-Bloecke, in beliebiger Mischung) wird ab einem gewaehlten
|
||
;; Start-Baustein ueber die reale KS_AUS->KS_EIN-Nachbarschaft verfolgt und zu
|
||
;; EINEM neuen Gesamt-VF_n-Block verschmolzen. Die Attribute werden dabei aus
|
||
;; der gefundenen Bausteinfolge NEU hergeleitet (dieselben Akkumulatoren/
|
||
;; Formeln wie beim interaktiven Bau in Modus 1/2 - vfl-acc-*,
|
||
;; ssg-strecke-attrib-defs -, nur rueckwirkend nach dem Auffinden statt
|
||
;; waehrend des Bauens gefuellt). Nur VORWAERTS ab dem gewaehlten
|
||
;; Start-Baustein (keine Rueckwaerts-Suche).
|
||
;;
|
||
;; Alle beteiligten Bausteintypen tragen laut Nutzerbestaetigung ein eigenes
|
||
;; KS_EIN/KS_AUS (auch Umlenk-/Motorstation, Vertikalboegen, das gestreckte
|
||
;; Zwischenstueck und der Separator) - die Verkettung laeuft daher komplett
|
||
;; ueber KS-Nachbarschaft, keine Bounding-Box-Geometrie noetig.
|
||
;;
|
||
;; Ein angetroffener VF_n-Wrapper wird beim Erfassen SOFORT (temporaer) in
|
||
;; seine Sub-Elemente aufgeloest, die dann wie von Anfang an lose Bauteile
|
||
;; behandelt werden (vfl-kette-sammle-alle) - eine fruehere Fassung versuchte
|
||
;; stattdessen, fuer einen Wrapper EINEN Gesamt-KS_EIN/KS_AUS per "welcher
|
||
;; Punkt hat kein Gegenstueck"-Heuristik zu bestimmen; das schlug bei langen
|
||
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl (siehe
|
||
;; [[project_vario_kette_merge]] Update 6).
|
||
|
||
;; Toleranzen (mm) fuer die Nachbarschaftspruefung zwischen zwei Bausteinen:
|
||
;; <= tol-eng -> gilt als sauber verbunden, Kette geht weiter
|
||
;; <= tol-weit -> sieht verbunden aus, ist es aber nicht -> Warnung, Kettenende
|
||
;; > tol-weit -> kein Zusammenhang, normales (stilles) Kettenende
|
||
(if (null *vfl-kette-tol-eng*) (setq *vfl-kette-tol-eng* 2.0))
|
||
(if (null *vfl-kette-tol-weit*) (setq *vfl-kette-tol-weit* 100.0))
|
||
|
||
;; Kleine Feld-Zugriffe auf einen Ketten-Datensatz
|
||
;; (ename bname ks-ein-punkt ks-aus-punkt wrapper-ename)
|
||
;; ename = nil und wrapper-ename gesetzt: Sub-Element eines aufgeloesten
|
||
;; VF_n-Wrappers (wrapper-ename = dessen Original-Ename). Sonst: eigenstaen-
|
||
;; diges Bauteil (ename gesetzt, wrapper-ename nil).
|
||
(defun vfl-kette-rec-ename (rec) (nth 0 rec))
|
||
(defun vfl-kette-rec-bname (rec) (nth 1 rec))
|
||
(defun vfl-kette-rec-ein (rec) (nth 2 rec))
|
||
(defun vfl-kette-rec-aus (rec) (nth 3 rec))
|
||
(defun vfl-kette-rec-wrapper (rec) (nth 4 rec))
|
||
|
||
;; String an einem Trennzeichen aufteilen (reine Teilstring-Suche, keine
|
||
;; Wildcards). Bei "_"-Trennung eines Bausteinnamens liefert das die
|
||
;; Namensteile unabhaengig vom Dimensions-Suffix (_2D/_3D) - der steht immer
|
||
;; am Ende und wird von den (nur von vorne indizierenden) Zugriffen unten
|
||
;; ignoriert.
|
||
(defun vfl-kette-split (str delim / pos ergebnis rest)
|
||
(setq ergebnis '() rest str)
|
||
(while (setq pos (vl-string-search delim rest))
|
||
(setq ergebnis (append ergebnis (list (substr rest 1 pos))))
|
||
(setq rest (substr rest (+ pos 1 (strlen delim))))
|
||
)
|
||
(append ergebnis (list rest))
|
||
)
|
||
(defun vfl-kette-teil (bname idx) (nth idx (vfl-kette-split bname "_")))
|
||
|
||
;; Bausteintyp aus dem Blocknamen ableiten. Scanner/Separator_SP (manuelle
|
||
;; Sensor-Bloecke, siehe count_sep_scan.lsp) gehoeren NICHT zur Kette selbst
|
||
;; und tauchen hier bewusst nicht auf.
|
||
(defun vfl-kette-typ (bname)
|
||
(cond
|
||
((wcmatch bname "VF_*") "WRAPPER")
|
||
((wcmatch bname "AS_Element_*") "AS")
|
||
((wcmatch bname "ES_Element_*") "ES")
|
||
((wcmatch bname "Gefaellebogen_*") "GFBOGEN")
|
||
((wcmatch bname "Vario_Kurve_*") "KURVE")
|
||
((wcmatch bname "Vario_Umlenkstation_*") "UMLENK")
|
||
((wcmatch bname "Vario_Motorstation_*") "MOTOR")
|
||
((wcmatch bname "Vario_Bogen_auf_*") "BOGENAUF")
|
||
((wcmatch bname "Vario_Bogen_ab_*") "BOGENAB")
|
||
((wcmatch bname "Staustrecke_SP_1000_mm*") "STRECKE")
|
||
((wcmatch bname "Staustrecke_Separator_SP_300_mm*") "SEP")
|
||
(t "UNBEKANNT")
|
||
)
|
||
)
|
||
|
||
;; Gemessene Neigung (Grad, positiv=abwaerts wie frame->hz-winkel) zwischen
|
||
;; zwei Welt-Punkten.
|
||
(defun vfl-kette-neigung (ein aus / dx dy dz horiz)
|
||
(setq dx (- (car aus) (car ein)) dy (- (cadr aus) (cadr ein)) dz (- (caddr aus) (caddr ein)))
|
||
(setq horiz (sqrt (+ (* dx dx) (* dy dy))))
|
||
(if (> horiz 1e-6) (* (atan (- dz) horiz) (/ 180.0 pi)) 0.0)
|
||
)
|
||
(defun vfl-kette-round (x) (atoi (rtos x 2 0)))
|
||
|
||
;; Attribut-Wert auf "" erzwingen. ssg-attrib-set-on ueberspringt leere Werte
|
||
;; bewusst als "keine Ueberschreibung" (ATTDEF-Default bleibt stehen) - hier
|
||
;; soll das Feld aber ABSICHTLICH geleert werden (z.B. SEITE_AS/SEITE_ES,
|
||
;; wenn die Kette kein AS-/ES-Element hat und der ATTDEF-Default "rechts"
|
||
;; sonst faelschlich stehen bliebe).
|
||
(defun vfl-kette-attrib-leeren (ent tag / obj ed typ etag)
|
||
(setq obj (entnext ent))
|
||
(while obj
|
||
(setq ed (entget obj))
|
||
(setq typ (cdr (assoc 0 ed)))
|
||
(if (equal typ "SEQEND")
|
||
(setq obj nil)
|
||
(progn
|
||
(if (and (equal typ "ATTRIB") (equal (cdr (assoc 2 ed)) tag))
|
||
(progn (entmod (subst (cons 1 "") (assoc 1 ed) ed)) (entupd obj)))
|
||
(setq obj (entnext obj))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; KS_EIN/KS_AUS-URSPRUNGSPUNKTE (Welt-Koordinaten, keine Richtung) eines
|
||
;; Bausteins ermitteln - robust gegen NICHT-UNIFORME Skalierung (z.B.
|
||
;; Staustrecke_SP_1000_mm, das per insert-inclined-scaled-block auf die
|
||
;; reale Segmentlaenge gestreckt wird). extract-ks-from-block-raw
|
||
;; (vf_core.lsp) klassifiziert die 3 Achslinien im KS-Sub-Block ueber ihre
|
||
;; ABSOLUTE LAENGE (ks-line-axis, feste Baender ~1/~100 Einheiten) - wird die
|
||
;; Fahrtrichtungs-Achslinie mitgestreckt, faellt sie aus diesem Raster und
|
||
;; die Extraktion schlaegt still fehl (empirisch bestaetigt: bei den meisten
|
||
;; Staustrecke-Instanzen "KS_EIN/KS_AUS FEHLT"). Uebernimmt daher die in
|
||
;; ks_segmente.lsp (kseg-collect-lose) bereits bewaehrte Methode: an einer
|
||
;; KOPIE die Skalierung auf 1:1:1 zuruecksetzen (Marker wieder nominal lang,
|
||
;; Extraktion funktioniert normal), KS_EIN/KS_AUS dort lesen, danach den
|
||
;; KS_AUS-Versatz mit dem echten XScaleFactor zurueckrechnen (die Streckung
|
||
;; wirkt lokal rein auf der Block-X-Achse/Docking-Richtung; nach Rotation ins
|
||
;; Weltsystem hat der Versatzvektor i.A. X-/Y-/Z-Anteile, die Streckung wirkt
|
||
;; aber auf alle drei mit demselben Faktor sx - Y/Z-Skalierung bleibt bei
|
||
;; dieser Teilefamilie immer 1.0). Kopie wird sofort wieder geloescht -
|
||
;; block-obj selbst bleibt unveraendert.
|
||
;; Rueckgabe: (("KS_EIN" . punkt) ("KS_AUS" . punkt)) - je nur wenn gefunden.
|
||
(defun vfl-kette-ks-ursprung (block-obj / sx copyobj ksdata kez kaz ergebnis)
|
||
(setq sx (vla-get-XScaleFactor block-obj))
|
||
(setq copyobj (vla-Copy block-obj))
|
||
(vla-put-XScaleFactor copyobj 1.0)
|
||
(vla-put-YScaleFactor copyobj 1.0)
|
||
(vla-put-ZScaleFactor copyobj 1.0)
|
||
(setq ksdata (extract-ks-from-block-raw copyobj))
|
||
(if (not (vlax-erased-p copyobj)) (vl-catch-all-apply 'vla-Delete (list copyobj)))
|
||
(setq kez (if (assoc "KS_EIN" ksdata) (car (cadr (assoc "KS_EIN" ksdata))) nil))
|
||
(setq kaz (if (assoc "KS_AUS" ksdata) (car (cadr (assoc "KS_AUS" ksdata))) nil))
|
||
(if (and kez kaz (/= sx 1.0))
|
||
(setq kaz (list
|
||
(+ (car kez) (* sx (- (car kaz) (car kez))))
|
||
(+ (cadr kez) (* sx (- (cadr kaz) (cadr kez))))
|
||
(+ (caddr kez) (* sx (- (caddr kaz) (caddr kez))))
|
||
))
|
||
)
|
||
(setq ergebnis '())
|
||
(if kez (setq ergebnis (cons (cons "KS_EIN" kez) ergebnis)))
|
||
(if kaz (setq ergebnis (cons (cons "KS_AUS" kaz) ergebnis)))
|
||
ergebnis
|
||
)
|
||
|
||
;; Alle Vario-Kette-Bausteine der Zeichnung einsammeln (lose Einzelteile UND
|
||
;; die Sub-Elemente bereits gewickelter VF_n - siehe vfl-kette-typ). Ein
|
||
;; angetroffener VF_n-Wrapper wird SOFORT (temporaer) in seine Sub-Elemente
|
||
;; aufgeloest und JEDES Sub-Element als eigener Datensatz mit direkt lesbarem
|
||
;; KS_EIN/KS_AUS erfasst - keine "welcher Punkt hat kein Gegenstueck"-
|
||
;; Heuristik fuer einen Gesamt-Punkt mehr noetig (die schlug bei langen
|
||
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl, siehe
|
||
;; [[project_vario_kette_merge]]). Die Kettenverfolgung faedelt die
|
||
;; Sub-Elemente danach ueber ihre echten KS-Punkte in der richtigen
|
||
;; Reihenfolge auf - unabhaengig von der Explode-Reihenfolge.
|
||
;; ename = nil fuer ein Sub-Element eines Wrappers (die temporaere
|
||
;; Explode-Kopie wurde bereits wieder geloescht); wrapper-ename identifiziert
|
||
;; in diesem Fall den ORIGINAL-Wrapper (fuer den finalen Merge-Schritt).
|
||
;; Rueckgabe: Liste von (ename bname ein aus wrapper-ename).
|
||
(defun vfl-kette-sammle-alle ( / ss i ename bname typ obj kinder kind
|
||
sub-ks child-bname child-ks records)
|
||
(setq records '())
|
||
(setq ss (ssget "X" '((0 . "INSERT"))))
|
||
(if ss
|
||
(progn
|
||
(setq i 0)
|
||
(while (< i (sslength ss))
|
||
(setq ename (ssname ss i))
|
||
(setq bname (cdr (assoc 2 (entget ename))))
|
||
(setq typ (vfl-kette-typ bname))
|
||
(cond
|
||
((= typ "WRAPPER")
|
||
(setq obj (vlax-ename->vla-object ename))
|
||
(setq kinder (vlax-invoke obj 'Explode))
|
||
(foreach kind kinder
|
||
(if (and (not (vlax-erased-p kind))
|
||
(= (vla-get-ObjectName kind) "AcDbBlockReference"))
|
||
(progn
|
||
(setq child-bname (vla-get-Name kind))
|
||
(setq child-ks (vfl-kette-ks-ursprung kind))
|
||
(setq records
|
||
(cons (list nil child-bname
|
||
(cdr (assoc "KS_EIN" child-ks))
|
||
(cdr (assoc "KS_AUS" child-ks))
|
||
ename)
|
||
records))
|
||
)
|
||
)
|
||
)
|
||
(foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind)))
|
||
)
|
||
((/= typ "UNBEKANNT")
|
||
(setq obj (vlax-ename->vla-object ename))
|
||
(setq sub-ks (vfl-kette-ks-ursprung obj))
|
||
(setq records
|
||
(cons (list ename bname
|
||
(cdr (assoc "KS_EIN" sub-ks))
|
||
(cdr (assoc "KS_AUS" sub-ks))
|
||
nil)
|
||
records))
|
||
)
|
||
)
|
||
(setq i (1+ i))
|
||
)
|
||
)
|
||
)
|
||
records
|
||
)
|
||
|
||
;; Naechsten Datensatz in rest-liste suchen, dessen KS_EIN am naechsten am
|
||
;; gegebenen KS_AUS-Punkt liegt. Rueckgabe: (rec . abstand) oder nil.
|
||
(defun vfl-kette-naechster (aus-punkt rest-liste / rec bester bester-d d)
|
||
(setq bester nil bester-d nil)
|
||
(foreach rec rest-liste
|
||
(if (vfl-kette-rec-ein rec)
|
||
(progn
|
||
(setq d (distance aus-punkt (vfl-kette-rec-ein rec)))
|
||
(if (or (null bester-d) (< d bester-d))
|
||
(progn (setq bester rec) (setq bester-d d)))
|
||
)
|
||
)
|
||
)
|
||
(if bester (cons bester bester-d) nil)
|
||
)
|
||
|
||
;; Kette ab start-rec NUR VORWAERTS verfolgen. Rueckgabe: (list kette warnung)
|
||
;; kette = Liste der Datensaetze in Ketten-Reihenfolge (mind. start-rec)
|
||
;; warnung = (letzter-bname kandidat-bname abstand) wenn eine Luecke im
|
||
;; tol-weit-Band gefunden wurde, sonst nil.
|
||
;; letzter-fund = (rec . abstand) des zuletzt geprueften (aber verworfenen)
|
||
;; Kandidaten - Diagnose-Hilfe, wenn die Kette bei Laenge 1
|
||
;; endet (dann kein warnung, aber evtl. trotzdem ein Fund
|
||
;; ausserhalb von tol-weit).
|
||
;; verdaechtig = Liste (vorgaenger-bname naechster-bname abstand) fuer jeden
|
||
;; Anschluss, dessen Abstand > 0.5mm war - eine echte, absichtlich
|
||
;; gebaute KS-zu-KS-Verbindung sollte praktisch bei 0mm liegen;
|
||
;; ein spuerbarer (aber noch innerhalb tol-eng liegender)
|
||
;; Abstand deutet auf eine ZUFAELLIG nahe, aber NICHT wirklich
|
||
;; zusammengehoerige Stelle hin (z.B. zwei unabhaengige Linien,
|
||
;; die im Layout nahe beieinander liegen/sich kreuzen).
|
||
(defun vfl-kette-verfolgen (start-rec alle-records / rest kette aktuell fund fertig warnung letzter-fund verdaechtig)
|
||
(setq rest (vl-remove start-rec alle-records))
|
||
(setq kette (list start-rec))
|
||
(setq aktuell start-rec)
|
||
(setq warnung nil)
|
||
(setq letzter-fund nil)
|
||
(setq verdaechtig '())
|
||
(setq fertig nil)
|
||
(while (not fertig)
|
||
(setq fund (vfl-kette-naechster (vfl-kette-rec-aus aktuell) rest))
|
||
(setq letzter-fund fund)
|
||
(cond
|
||
((null fund) (setq fertig T))
|
||
((<= (cdr fund) *vfl-kette-tol-eng*)
|
||
(if (> (cdr fund) 0.5)
|
||
(setq verdaechtig (cons (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)) verdaechtig)))
|
||
(setq aktuell (car fund))
|
||
(setq kette (append kette (list aktuell)))
|
||
(setq rest (vl-remove aktuell rest))
|
||
(setq letzter-fund nil)
|
||
)
|
||
((<= (cdr fund) *vfl-kette-tol-weit*)
|
||
(setq warnung (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)))
|
||
(setq fertig T)
|
||
)
|
||
(t (setq fertig T))
|
||
)
|
||
)
|
||
(list kette warnung letzter-fund verdaechtig)
|
||
)
|
||
|
||
;; Attribute des neuen Gesamt-Blocks aus der gefundenen Bausteinfolge
|
||
;; herleiten: dieselben Akkumulatoren (vfl-acc-*) wie beim interaktiven Bau,
|
||
;; hier rueckwirkend anhand der Bausteinfolge gefuellt statt waehrend des
|
||
;; Bauens. Sub-Elemente eines bereits gewickelten VF_n wurden beim Erfassen
|
||
;; (vfl-kette-sammle-alle) bereits aufgeloest und durchlaufen hier dieselbe
|
||
;; Typ-Klassifikation wie von Anfang an lose Bauteile - lose Einzelteile und
|
||
;; fertige VF_n lassen sich dadurch beliebig mischen. chain-start/chain-end =
|
||
;; Gesamt-KS_EIN/KS_AUS der ganzen Kette (Welt-Z liefert Hoehe-von/-bis
|
||
;; direkt, kein erneutes Auslesen noetig).
|
||
;; Rueckgabe: (list attribut-alist typ-str).
|
||
(defun vfl-kette-baue-attribute (kette neuer-bname chain-start chain-end /
|
||
rec typ bname anzahl-vf phase entry-info gemessen betrag richtung
|
||
as-seite es-seite delta-l erster letzter ergebnis typ-str)
|
||
(vfl-acc-reset)
|
||
(setq anzahl-vf 0)
|
||
(setq phase "gf")
|
||
(setq entry-info nil)
|
||
(setq delta-l 0.0)
|
||
;; Leer (nicht "rechts") als Default: falls die Kette (Ausnahmefall) ohne
|
||
;; eigenes AS-/ES-Element beginnt/endet, soll das im Attribut auch als
|
||
;; "keins vorhanden" erkennbar bleiben statt eine falsche Seite vorzutaeuschen.
|
||
(setq as-seite "" es-seite "")
|
||
(setq erster (car kette))
|
||
(setq letzter (car (reverse kette)))
|
||
|
||
(foreach rec kette
|
||
(setq bname (vfl-kette-rec-bname rec))
|
||
(setq typ (vfl-kette-typ bname))
|
||
(if (and (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))
|
||
(setq delta-l (+ delta-l (distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec)))))
|
||
|
||
(cond
|
||
;; Wrapper-Records gibt es nicht mehr - ein angetroffener VF_n wurde
|
||
;; bereits beim Erfassen (vfl-kette-sammle-alle) in seine Sub-Elemente
|
||
;; aufgeloest; jedes davon durchlaeuft hier dieselbe Typ-Klassifikation
|
||
;; wie ein von Anfang an loses Bauteil.
|
||
((= typ "AS")
|
||
(if (equal rec erster) (setq as-seite (vfl-kette-teil bname 3))))
|
||
|
||
((= typ "ES")
|
||
(if (equal rec letzter) (setq es-seite (vfl-kette-teil bname 3))))
|
||
|
||
((= typ "GFBOGEN")
|
||
;; Gefaellebogen_<seite>_<winkel>_R500
|
||
(setq *vfl-acc-gfbogen*
|
||
(vfl-inc-count *vfl-acc-gfbogen*
|
||
(strcat (if (= (vfl-kette-teil bname 1) "rechts") "R" "L") "_" (vfl-kette-teil bname 2)))))
|
||
|
||
((= typ "KURVE")
|
||
;; Vario_Kurve_<seite>_<winkel>_TEF_<variante>
|
||
(setq *vfl-acc-variokurve*
|
||
(vfl-inc-count *vfl-acc-variokurve*
|
||
(strcat (if (= (vfl-kette-teil bname 5) "aussen") "A" "I") "_" (vfl-kette-teil bname 3)))))
|
||
|
||
((= typ "UMLENK")
|
||
(setq phase "vf")
|
||
(setq anzahl-vf (1+ anzahl-vf))
|
||
(setq entry-info nil))
|
||
|
||
((= typ "MOTOR")
|
||
;; Vario_Motorstation_500mm_<seite>
|
||
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list (vfl-kette-teil bname 3))))
|
||
(setq phase "gf")
|
||
(setq entry-info nil))
|
||
|
||
((or (= typ "BOGENAUF") (= typ "BOGENAB"))
|
||
(if (null entry-info)
|
||
(setq entry-info rec) ; erster Bogen des Koerper-Tripels
|
||
(progn
|
||
;; Zweiter Bogen schliesst das Tripel. Neigung/Richtung ueber die
|
||
;; ECHTE Geometrie messen (Anfang des ersten bis Ende des zweiten
|
||
;; Bogens) - die Blocknamen allein sind fuer den 3-Grad/horizontal-
|
||
;; Fall mehrdeutig (beide nutzen "auf_3"/"ab_3", vfs-vf-koerper).
|
||
(setq gemessen (vfl-kette-neigung (vfl-kette-rec-ein entry-info) (vfl-kette-rec-aus rec)))
|
||
(setq betrag (vfl-kette-round (abs gemessen)))
|
||
(setq richtung (if (< gemessen 0.0) "Auf" "Ab"))
|
||
(vfl-acc-vf-seg richtung betrag
|
||
(distance (vfl-kette-rec-aus entry-info) (vfl-kette-rec-ein rec)))
|
||
(setq entry-info nil)
|
||
)
|
||
)
|
||
)
|
||
|
||
((= typ "STRECKE")
|
||
(if (= phase "gf")
|
||
(vfl-acc-gf-seg
|
||
(distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))
|
||
(abs (vfl-kette-neigung (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))))
|
||
;; Innerhalb eines Koerper-Tripels traegt das Zwischenstueck selbst
|
||
;; nichts direkt bei - Laenge/Neigung werden beim schliessenden
|
||
;; Bogen (s.o.) aus der Gesamtspanne des Tripels gemessen.
|
||
)
|
||
)
|
||
|
||
((= typ "SEP")
|
||
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*)))
|
||
)
|
||
)
|
||
|
||
(setq typ-str
|
||
(if (or (> anzahl-vf 0) (> (length *vfl-acc-lgf*) 1)
|
||
(> (length *vfl-acc-gfbogen*) 0) (> (length *vfl-acc-variokurve*) 0))
|
||
"Streckengruppe" "Gefaellestrecke"))
|
||
|
||
(setq ergebnis
|
||
(list
|
||
(cons "Bezeichnung" neuer-bname)
|
||
(cons "ARTINR" "6220")
|
||
(cons "MONTAGEHOEHE_m" (rtos (/ (+ (caddr chain-start) (caddr chain-end)) 2000.0) 2 3))
|
||
(cons "HOEHE_VON_mm" (itoa (fix (caddr chain-start))))
|
||
(cons "HOEHE_BIS_mm" (itoa (fix (caddr chain-end))))
|
||
(cons "DELTA_H_mm" (itoa (fix (abs (- (caddr chain-end) (caddr chain-start))))))
|
||
(cons "DELTA_L_mm" (itoa (fix delta-l)))
|
||
(cons "TYP" typ-str)
|
||
(cons "SEITE_AS" as-seite)
|
||
(cons "SEITE_ES" es-seite)
|
||
(cons "ANZAHL_GF" (itoa (length *vfl-acc-lgf*)))
|
||
(cons "L_GF_m" (vfl-join-komma *vfl-acc-lgf*))
|
||
(cons "GF_WINKEL" (vfl-join-komma *vfl-acc-gfwinkel*))
|
||
(cons "GF_Bogen_L_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_90")))
|
||
(cons "GF_Bogen_L_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_60")))
|
||
(cons "GF_Bogen_L_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_30")))
|
||
(cons "GF_Bogen_R_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_90")))
|
||
(cons "GF_Bogen_R_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_60")))
|
||
(cons "GF_Bogen_R_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_30")))
|
||
(cons "ANZAHL_VF" (itoa anzahl-vf))
|
||
(cons "MOTORSEITE" (vfl-join-komma *vfl-acc-motorseite*))
|
||
(cons "L_VF_m" (vfl-join-komma *vfl-acc-lvf*))
|
||
(cons "ANTRIEBFAHRTRICHTUNG" (vfl-join-komma *vfl-acc-richtung*))
|
||
(cons "VF_WINKEL" (vfl-join-komma *vfl-acc-winkel*))
|
||
(cons "VF_Bogen_A_90" (itoa (vfl-get-count *vfl-acc-variokurve* "A_90")))
|
||
(cons "VF_Bogen_A_60" (itoa (vfl-get-count *vfl-acc-variokurve* "A_60")))
|
||
(cons "VF_Bogen_A_30" (itoa (vfl-get-count *vfl-acc-variokurve* "A_30")))
|
||
(cons "VF_Bogen_I_90" (itoa (vfl-get-count *vfl-acc-variokurve* "I_90")))
|
||
(cons "VF_Bogen_I_60" (itoa (vfl-get-count *vfl-acc-variokurve* "I_60")))
|
||
(cons "VF_Bogen_I_30" (itoa (vfl-get-count *vfl-acc-variokurve* "I_30")))
|
||
(cons "ANZAHL_SEPARATOR" (itoa *vfl-acc-separator*))
|
||
)
|
||
)
|
||
(list ergebnis typ-str)
|
||
)
|
||
|
||
(defun c:Vario_Kette_Merge ( / sel start-ename start-bname alle-records start-rec
|
||
start-obj start-ins kandidaten bester-d d r
|
||
lauf kette warnung naechster-fund merge-ss leaf-enames aufgeloeste-wrapper
|
||
chain-start chain-end neuer-bname
|
||
rec kinder kind erg aggregiert typ-str neuer-insert def
|
||
leaf-ename leaf-obj leaf-noch-da verdaechtig v)
|
||
(ssg-start "Vario_Kette_Merge" nil)
|
||
(princ (ssg-text "vfl-kette-titel"))
|
||
(setq sel (entsel (ssg-text "vfl-kette-start-waehlen")))
|
||
(if (null sel)
|
||
(progn (princ (ssg-text "vfl-kette-kein-objekt")) (ssg-end) (exit)))
|
||
(setq start-ename (car sel))
|
||
(setq start-bname (cdr (assoc 2 (entget start-ename))))
|
||
(if (= (vfl-kette-typ (if start-bname start-bname "")) "UNBEKANNT")
|
||
(progn
|
||
(princ (ssg-textf "vfl-kette-kein-vf-block" (list (if start-bname start-bname "?"))))
|
||
(ssg-end) (exit)))
|
||
|
||
(setq alle-records (vfl-kette-sammle-alle))
|
||
|
||
(setq start-rec nil)
|
||
(foreach rec alle-records (if (equal (vfl-kette-rec-ename rec) start-ename) (setq start-rec rec)))
|
||
(if (and (null start-rec) (= (vfl-kette-typ start-bname) "WRAPPER"))
|
||
(progn
|
||
;; Nutzer hat einen VF_n-Wrapper direkt gewaehlt - der wurde beim
|
||
;; Erfassen bereits in seine Sub-Elemente aufgeloest (keins davon
|
||
;; traegt mehr diesen ename). Das Sub-Element mit KS_EIN am naechsten
|
||
;; zum InsertionPoint des Wrappers gilt als dessen Kettenanfang - das
|
||
;; ist per Bauart (ssg-block-wrap-welt bekommt immer den Kettenanfang
|
||
;; als Basispunkt) exakt der richtige Punkt.
|
||
(setq start-obj (vlax-ename->vla-object start-ename))
|
||
(setq start-ins (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint start-obj))))
|
||
(setq kandidaten (vl-remove-if-not
|
||
(function (lambda (r) (and (equal (vfl-kette-rec-wrapper r) start-ename) (vfl-kette-rec-ein r))))
|
||
alle-records))
|
||
(setq bester-d nil)
|
||
(foreach r kandidaten
|
||
(setq d (distance start-ins (vfl-kette-rec-ein r)))
|
||
(if (or (null bester-d) (< d bester-d)) (progn (setq start-rec r) (setq bester-d d)))
|
||
)
|
||
)
|
||
)
|
||
(if (null start-rec)
|
||
(progn
|
||
(princ (ssg-textf "vfl-kette-start-nicht-gefunden-diag"
|
||
(list (itoa (length alle-records)) (if start-bname start-bname "?")
|
||
(itoa (length (vl-remove-if-not
|
||
(function (lambda (r) (equal (vfl-kette-rec-bname r) start-bname)))
|
||
alle-records))))))
|
||
(ssg-end) (exit)))
|
||
(if (null (vfl-kette-rec-ein start-rec))
|
||
(progn (princ (ssg-text "vfl-kette-start-ohne-ks-ein")) (ssg-end) (exit)))
|
||
|
||
(setq lauf (vfl-kette-verfolgen start-rec alle-records))
|
||
(setq kette (car lauf))
|
||
(setq warnung (cadr lauf))
|
||
(setq naechster-fund (caddr lauf))
|
||
(setq verdaechtig (nth 3 lauf))
|
||
|
||
(if (< (length kette) 2)
|
||
(progn
|
||
(princ (ssg-textf "vfl-kette-diag-startbaustein"
|
||
(list (vfl-kette-rec-bname start-rec)
|
||
(rtos (car (vfl-kette-rec-aus start-rec)) 2 1)
|
||
(rtos (cadr (vfl-kette-rec-aus start-rec)) 2 1)
|
||
(rtos (caddr (vfl-kette-rec-aus start-rec)) 2 1))))
|
||
(if naechster-fund
|
||
(princ (ssg-textf "vfl-kette-diag-naechster-kandidat"
|
||
(list (vfl-kette-rec-bname (car naechster-fund))
|
||
(rtos (cdr naechster-fund) 2 1)
|
||
(rtos *vfl-kette-tol-eng* 2 1)
|
||
(rtos *vfl-kette-tol-weit* 2 1))))
|
||
(princ (ssg-textf "vfl-kette-diag-kein-anderer" (list (itoa (length alle-records))))))
|
||
(princ (ssg-text "vfl-kette-nur-ein-baustein")) (ssg-end) (exit)))
|
||
|
||
(princ (ssg-textf "vfl-kette-gefunden" (list (itoa (length kette)))))
|
||
(foreach rec kette (princ (strcat "\n " (vfl-kette-rec-bname rec))))
|
||
(if warnung
|
||
(princ (ssg-textf "vfl-kette-luecke-warnung"
|
||
(list (car warnung) (cadr warnung) (rtos (caddr warnung) 2 1)))))
|
||
;; DIAGNOSE: Anschluesse mit spuerbarem (>0.5mm), aber noch innerhalb
|
||
;; tol-eng liegendem Abstand - Verdacht auf zufaellig nahe, aber nicht
|
||
;; wirklich zusammengehoerige Bauteile (z.B. zwei unabhaengige Linien, die
|
||
;; im Layout nahe beieinander liegen).
|
||
(if verdaechtig
|
||
(foreach v verdaechtig
|
||
(princ (ssg-textf "vfl-kette-diag-verdaechtig"
|
||
(list (car v) (cadr v) (rtos (caddr v) 2 3)))))
|
||
)
|
||
|
||
;; Attribute aus der Bausteinfolge herleiten, bevor irgendetwas an der
|
||
;; Zeichnung veraendert wird (chain-start/chain-end kommen aus dem ersten/
|
||
;; letzten Datensatz in kette).
|
||
(setq neuer-bname (strcat "VF_" (itoa (vf-next-number))))
|
||
(setq chain-start (vfl-kette-rec-ein (car kette)))
|
||
(setq chain-end (vfl-kette-rec-aus (car (reverse kette))))
|
||
(setq erg (vfl-kette-baue-attribute kette neuer-bname chain-start chain-end))
|
||
(setq aggregiert (car erg))
|
||
(setq typ-str (cadr erg))
|
||
|
||
;; Aufgeloeste Wrapper-Sub-Elemente: der ORIGINAL-Wrapper wird (einmal je
|
||
;; distinktem wrapper-ename, da er i.d.R. mehrere Sub-Element-Datensaetze
|
||
;; in kette beisteuert) jetzt fuer REAL explodiert - Sub-Elemente bleiben
|
||
;; als Bloecke erhalten, ATTRIB-Textreste werden verworfen, Original
|
||
;; geloescht. Lose Einzel-Bausteine werden unveraendert direkt uebernommen (_.-BLOCK
|
||
;; unten SOLLTE sie beim Wickeln konsumieren, wie bei frisch gebauter
|
||
;; Geometrie - leaf-enames wird trotzdem mitgefuehrt, um sie nach dem
|
||
;; Wickeln sicherheitshalber explizit zu entfernen, falls _.-BLOCK sie aus
|
||
;; irgendeinem Grund NICHT aus dem Modellraum nimmt (doppelte/ueberlappende
|
||
;; Geometrie waere sonst die Folge).
|
||
(setq merge-ss (ssadd))
|
||
(setq leaf-enames '())
|
||
(setq aufgeloeste-wrapper '())
|
||
(foreach rec kette
|
||
(if (vfl-kette-rec-wrapper rec)
|
||
(if (not (member (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
|
||
(progn
|
||
(setq aufgeloeste-wrapper (cons (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
|
||
(setq kinder (vlax-invoke (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)) 'Explode))
|
||
(foreach kind kinder
|
||
(if (not (vlax-erased-p kind))
|
||
(if (= (vla-get-ObjectName kind) "AcDbBlockReference")
|
||
(ssadd (vlax-vla-object->ename kind) merge-ss)
|
||
(vla-Delete kind)
|
||
)
|
||
)
|
||
)
|
||
(vla-Delete (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)))
|
||
)
|
||
)
|
||
(progn
|
||
(setq leaf-enames (cons (vfl-kette-rec-ename rec) leaf-enames))
|
||
(ssadd (vfl-kette-rec-ename rec) merge-ss)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Frische ATTDEFs am Kettenanfang (wie vfl-block-erstellen), neu wickeln.
|
||
(foreach def (ssg-strecke-attrib-defs typ-str)
|
||
(entmake
|
||
(list '(0 . "ATTDEF")
|
||
(cons 10 chain-start)
|
||
(cons 11 chain-start)
|
||
'(40 . 50.0)
|
||
(cons 1 (cadr def))
|
||
(cons 2 (car def))
|
||
(cons 3 (car def))
|
||
'(70 . 1)
|
||
'(72 . 0)
|
||
'(74 . 0)))
|
||
(ssadd (entlast) merge-ss)
|
||
)
|
||
(setq neuer-insert (ssg-block-wrap-welt neuer-bname chain-start merge-ss))
|
||
(ssg-attrib-set-on neuer-insert aggregiert)
|
||
;; SEITE_AS/SEITE_ES explizit leeren, wenn die Kette (Ausnahmefall) ohne
|
||
;; eigenes AS-/ES-Element beginnt/endet - ssg-attrib-set-on wuerde einen
|
||
;; leeren Wert sonst als "keine Ueberschreibung" behandeln und den
|
||
;; ATTDEF-Default "rechts" faelschlich stehen lassen.
|
||
(if (= (cdr (assoc "SEITE_AS" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_AS"))
|
||
(if (= (cdr (assoc "SEITE_ES" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_ES"))
|
||
(if (car (atoms-family 1 '("SSG-ID-GENERATE"))) (ssg-id-generate neuer-insert))
|
||
|
||
;; Sicherheitsnetz: lose Einzelteile, die _.-BLOCK aus irgendeinem Grund NICHT
|
||
;; aus dem Modellraum entfernt hat, jetzt explizit loeschen - verhindert
|
||
;; doppelte/ueberlappende Geometrie (altes Original + neuer Gesamt-Block).
|
||
(setq leaf-noch-da 0)
|
||
(foreach leaf-ename leaf-enames
|
||
(setq leaf-obj (vl-catch-all-apply 'vlax-ename->vla-object (list leaf-ename)))
|
||
(if (and (not (vl-catch-all-error-p leaf-obj)) leaf-obj (not (vlax-erased-p leaf-obj)))
|
||
(progn
|
||
(setq leaf-noch-da (1+ leaf-noch-da))
|
||
(vla-Delete leaf-obj)
|
||
)
|
||
)
|
||
)
|
||
(if (> leaf-noch-da 0)
|
||
(princ (strcat "\n [Diagnose] " (itoa leaf-noch-da)
|
||
" lose Einzelteil(e) waren nach _.-BLOCK noch im Modellraum vorhanden - jetzt nachtraeglich entfernt.")))
|
||
|
||
(princ (ssg-textf "vfl-kette-fertig" (list neuer-bname (itoa (length kette)))))
|
||
(ssg-end)
|
||
(princ)
|
||
)
|
||
|
||
(vf-typ-registrieren
|
||
"linienzug"
|
||
'vfl-berechne-platzhalter
|
||
'vfl-einfuege-platzhalter
|
||
(ssg-text "vfc-typ-linienzug-beschreibung"))
|
||
|
||
(princ "\n>>> vf_linienzug.lsp geladen - Typ 'linienzug' registriert")
|
||
(princ)
|