Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ffbd2d20f0c688f72a59335aa2192c70c52967dc
dxfmakros/Lisp/vf_linienzug.lsp
T

3383 lines
171 KiB
Common Lisp
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;; ============================================================
;; VF_LINIENZUG - Gemischte Gefaellestrecke/VarioFoerderer-Kette
;; Typ "linienzug" fuer VarioFoerderer (3. Typ neben "standard"/"etage")
;; ============================================================
;; Kette: immer genau EIN AS_Element am Anfang, genau EIN ES_Element am Ende,
;; dazwischen beliebig viele Segmente. Jedes gerade Segment wird automatisch
;; klassifiziert:
;; - Endpunkt hoeher als Startpunkt -> immer VF (Gefaelle kann nicht steigen,
;; reine Schwerkraftstrecke)
;; - Endpunkt tiefer, Neigung >= 3 Grad -> reine Gefaellestrecke (GF), da 3
;; Grad im ganzen Projekt die kleinste
;; Neigung ist (Vario_Bogen_auf/ab_3)
;; - Endpunkt tiefer, Neigung < 3 Grad -> VF (zu flach fuer reine GF):
;; erst Horizontale Mitte pruefen
;; (berechne-horizontale-mitte), sonst
;; diskreten Winkel 3-51 Grad suchen
;; (berechne-alle-winkel)
;; Nach einem GF-Segment: naechstes Element nur GF-Bogen oder neue Linie.
;; Nach einem VF-Segment: naechstes Element nur Vario-Kurve oder neue Linie.
;;
;; Architektur-Entscheidung (mit Nutzer abgestimmt): eigener Befehlsablauf,
;; NICHT ueber die berechne-fn/einfuege-fn-Registry (die ist fuer ein einzelnes
;; durchgehendes Segment gedacht, nicht fuer eine interaktive Mehrsegment-Kette).
;; c:VarioFoerderer erkennt den Typ "linienzug" und dispatcht direkt hierher.
;;
;; BEKANNTE EINSCHRAENKUNGEN dieser ersten Version (bitte in BricsCAD pruefen):
;; - Vario_Kurve_*-Bloecke (data/ils/3D/) wurden bislang nirgends im Projekt
;; verwendet. Ob sie KS_EIN/KS_AUS enthalten (Voraussetzung fuer
;; insert-block-ks-to-ks) ist ungeklaert und muss beim ersten Testlauf
;; verifiziert werden.
;; - Am Uebergang GF-Segment -> VF-Segment (ueber "neue Linie", die
;; automatisch als VF eingestuft wird) kann ein sichtbarer Knick entstehen:
;; vfs-mitte-teil beginnt sein erstes Element (GF1) immer fest bei 3 Grad,
;; unabhaengig vom Neigungswinkel des vorangehenden GF-Segments.
;; - Die Fusspunkte von AS-/ES-Element (aus-dx/dz bzw. ein-dx/dz) werden vom
;; Erst- bzw. Letzt-Segment abgezogen (vfl-as-deltaL/H-korrigiert bzw. die
;; Separator+ES-Reservierung im Kettenende-Modus), damit der gepickte
;; Endpunkt vom gebauten GF/VF-Koerper exakt getroffen wird.
;; ============================================================
;; Attribut-Definitionen fuer den Linienzug-Block kommen aus dem gemeinsamen
;; Strecken-Schema in ssg_core.lsp (ssg-strecke-attrib-defs). Der TYP wird zur
;; Laufzeit bestimmt: einsegmentige GF ohne Bogen -> "Gefaellestrecke"
;; (reduziert), sonst -> "Streckengruppe" (voll, segmentweise Werte).
;; Toleranzband (Grad) um die feste 3-Grad-Neigung: liegt der natuerliche
;; Winkel eines fallenden Segments innerhalb 3+/-Toleranz, wird es als reine
;; 3-Grad-Gefaellestrecke gebaut. Steiler -> VF-ab, flacher -> VF (flach).
;; Grund: eine reine Gefaellestrecke ist nie steiler als 3 Grad.
;; Bei Bedarf empirisch anpassen.
(if (null *vfl-gf-winkel-toleranz*) (setq *vfl-gf-winkel-toleranz* 0.5))
;; Mindestlaenge (mm) fuer die 3-Grad-Gefaellestrecke GF1 am Einlauf (zwischen
;; AS und Umlenkstation). Im Linienzug sitzt die gesamte Staustrecke am Einlauf
;; (GF1 = komplettes L_GF), GF2 am Ausgang entfaellt. Faellt das berechnete
;; L_GF darunter, wird GF1 auf diesen Wert angehoben - damit der 3-Grad-
;; Anschluss immer physisch vorhanden ist.
(if (null *vfl-gf-min-laenge*) (setq *vfl-gf-min-laenge* 400.0))
;; Horizontales Budget der festen Elemente im Linienzug-VF:
;; Umlenkstation (500) + Motorstation (500) + EIN Separator am Einlauf (300)
;; = 1300 mm. Der Ausgangs-Separator entfaellt (anders als Standard-VF=1600).
(if (null *vfl-feste-horizontal*) (setq *vfl-feste-horizontal* 1300.0))
;; ============================================================
;; TEIL 0: ATTRIBUT-AKKUMULATOREN (werden waehrend des Baus gefuellt)
;; ============================================================
;; Segment-Listen werden in Bau-Reihenfolge angehaengt und spaeter
;; kommagetrennt in die Attribute geschrieben. Bogen-/Kurven-Zaehler als Alist.
(defun vfl-acc-reset ()
(setq *vfl-acc-lvf* '() ; L_VF je VF-Sub-Segment (m, String)
*vfl-acc-lgf* '() ; L_GF je GF-Segment (m, String) - inkl. GF1/GF2
*vfl-acc-gfwinkel* '() ; Neigungswinkel je GF-Segment (String, parallel zu lgf)
*vfl-acc-richtung* '() ; "Auf"/"Ab"/"horizontal" je VF-Sub-Segment
*vfl-acc-winkel* '() ; Winkel je VF-Sub-Segment (String, 0=horizontal)
*vfl-acc-motorseite* '() ; Seite ("rechts"/"links") je Motorstation
*vfl-acc-gfbogen* '() ; Alist ("L_90".n ...) GF-Boegen
*vfl-acc-variokurve* '() ; Alist ("A_90".n ...) Vario-Kurven
*vfl-ziel-punkt* nil ; Soll-ES-Punkt fuer Option-3-Ist-Ziel-Report
*vfl-acc-separator* 0)) ; Anzahl eingefuegter Separatoren (300 mm)
;; 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 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)
(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)
(foreach e gueltige
(princ (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 (getint (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige)))))
(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)))))
)
)
)
)
;; 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))
)
;; --- 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
)
;; Rueckgabe: (deltaL hz p2) oder nil bei Abbruch. p2 = der rohe gepickte
;; Punkt (fuer Diagnose/Nachrechnung nach dem AS-Element-Insert, siehe
;; vfl-projiziere-distanz). Foerderer-Maximallaenge 25 m: bei Ueberschreitung
;; wird die Eingabe abgelehnt und der Endpunkt erneut abgefragt.
(defun vfl-neue-linie-messen (p-akt hz-vorgabe / p2 rad ux uy deltaL hz-aktuell ergebnis fertig)
(setq fertig nil)
(while (not fertig)
(setq p2 (vfl-getpoint p-akt
(if hz-vorgabe
"\n\nEndpunkt entlang Fahrtrichtung waehlen (bestimmt die Laenge): "
"\n\nEndpunkt der Linie (XY, beliebige Richtung): ")))
(if (null p2)
(setq ergebnis nil fertig t)
(progn
;; Freie Richtung (nur beim allerersten Segment der Kette, hz-vorgabe
;; noch nil): auf das feste 30-Grad-Raster des Weltkoordinatensystems
;; snappen - im System sind Fahrtrichtungen immer 30/60/90-Grad-
;; Vielfache relativ zur Zeichnung, nie ein freier Zwischenwert. Bei
;; einem Retry (zu lang) bleibt hz-vorgabe bewusst nil, damit die
;; Richtung erneut frei gewaehlt werden kann.
(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))
;; Skalarprojektion des gewaehlten Vektors auf die (ggf. gesnappte)
;; Fahrtrichtung
(setq deltaL (+ (* (- (car p2) (car p-akt)) ux) (* (- (cadr p2) (cadr p-akt)) uy)))
(if (> deltaL 25000.0)
(princ (strcat "\n>>> FEHLER: Laenge " (rtos (/ deltaL 1000.0) 2 2)
" m ueberschreitet die Foerderer-Maximallaenge von 25 m"
" - bitte anderen Endpunkt waehlen."))
(progn
(setq ergebnis (list deltaL hz-aktuell p2))
(setq fertig t)
)
)
)
)
)
ergebnis
)
;; Planare Projektionsdistanz von neu-basis zu ziel-punkt entlang der
;; Fahrtrichtung hz (Grad) - wird genutzt, um nach dem AS-Element-Insert die
;; tatsaechlich noetige Restlaenge (vom echten KS_AUS zum urspruenglich
;; gepickten Punkt) direkt zu berechnen. Bewusst KEINE Fussabdruck-Schaetzung
;; (weder aus KS_EIN->KS_AUS noch aus Block-Ursprung->KS_AUS): beide ignorieren
;; die Dreh­teller-Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
;; anwendet, und liefern empirisch bestaetigt einen falschen Wert (~210mm
;; Schaetzung vs. ~420mm tatsaechlich noetiger Versatz bei AS_Element_30).
(defun vfl-projiziere-distanz (neu-basis ziel-punkt hz / rad)
(setq rad (* (float hz) (/ pi 180.0)))
(+ (* (- (car ziel-punkt) (car neu-basis)) (cos rad))
(* (- (cadr ziel-punkt) (cadr neu-basis)) (sin rad))))
;; Rahmen am Ende eines vfs-*-Bausteins: die Bausteine (Entry/Koerper/Exit)
;; enden IMMER auf der 3-Grad-Basisneigung (siehe Prinzipien-Dok Abschnitt 6).
(defun vfl-frame-3grad (punkt hz)
(make-frame-from-dir punkt (hz-winkel->xu hz (ssg-cfg-or "vario" "gefaelle_winkel" 3))))
;; 20-Meter-Regel: warnt, wenn die VF-Segmente seit der Umlenkstation 20 m
;; ueberschreiten (Prinzipien-Dok Abschnitt 7). v1: nur Hinweis, kein
;; automatisches Einfuegen einer Zwischen-Motorstation.
(defun vfl-20m-check (p-umlenk p-akt / laenge)
(setq laenge (vfl-planar-dist p-umlenk p-akt))
(if (> laenge 20000.0)
(princ (ssg-textf "vfl-20m-hinweis" (list (rtos (/ laenge 1000.0) 2 2))))
)
)
;; Baut EINE reine VarioFoerderer-Einheit als interaktive Sub-Kette:
;; genau EINE Umlenkstation (Eingang) ... beliebig viele Koerper-Sub-Segmente
;; und Vario-Kurven ... genau EINE Motorstation (Ausgang). Siehe Prinzipien-Dok
;; Abschnitt 2+4. Jedes Koerper-Sub-Segment beginnt/endet auf 3-Grad-Neigung.
;; frame: Eingangsrahmen (KS_AUS des Vorgaenger-Elements, i.d.R. AS-Element).
;; hz1/richtung1/winkel1/L_GF1/L_VF1: Daten des ersten (bereits klassifizierten)
;; VF-Linien-Sub-Segments aus vfl-segment-entscheidung.
;; gf-am-ausgang: T => halbe Staustrecke als GF2 am Ausgang (ohne Separator),
;; nil => gesamte Staustrecke am Einlauf (GF1), kein GF2.
;; Neigung des Frames aus der xu-Richtung ablesen: T => (nahezu) flach (0 Grad),
;; nil => auf 3-Grad-Basis. Damit wird der Uebergang auf_3/ab_3 nur dann gesetzt,
;; wenn wirklich ein Neigungswechsel noetig ist.
(defun vfl-frame-flach-p (frame)
(< (abs (cadr (frame->hz-winkel frame))) 1.5))
;; Separator (300 mm) HORIZONTAL (0 Grad) an einen Punkt anfuegen - fuer das
;; horizontale Stueck, wo der Separator in der 0-Grad-Ebene liegt (NICHT auf der
;; 3-Grad-Basis wie vfl-insert-separator). Rueckgabe: Endpunkt.
(defun vfl-sep-hz (pt hz / ep)
(princ (ssg-text "vfl-sep-horizontal-info"))
(setq ep (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" pt hz 0 300 0))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
ep)
;; Uebergang zurueck auf die 3-Grad-Basis, FALLS der Frame gerade flach (0 Grad)
;; ist: fuegt einen Vario_Bogen_ab_3 ein. Wird vor jedem 3-Grad-Element
;; (gewinkeltes VF, Motorstation, ES) aufgerufen, damit der ab_3-Uebergang erst
;; DANN kommt, wenn er wirklich gebraucht wird (die flache Zone bleibt sonst
;; flach). Ist der Frame schon auf 3-Grad-Basis, bleibt er unveraendert.
(defun vfl-nach-3grad (frame / hz m pt)
(if (vfl-frame-flach-p frame)
(progn
(setq hz (car (frame->hz-winkel frame)))
(setq m (get-bogen-mass bogen-ab 3))
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" (car frame)
0 (car m) (caddr m) hz))
(vfl-frame-3grad pt hz))
frame))
;; Horizontales Sub-Segment bauen. Die flache Zone (0 Grad) wird NICHT mehr
;; automatisch mit ab_3 auf die 3-Grad-Basis zurueckgefuehrt - das Stueck ENDET
;; FLACH. Der ab_3-Uebergang kommt erst, wenn ein 3-Grad-Element folgt
;; (vfl-nach-3grad). Der auf_3-Eintritt wird nur gesetzt, wenn der Frame noch
;; NICHT flach ist (sonst bleibt die laufende flache Zone erhalten). Separatoren
;; VOR/NACH liegen in der 0-Grad-Ebene. Rueckgabe: neuer Frame (flach, 0 Grad).
;; ziel-modus=T: dL ist die GESAMT-Zielstrecke ab pt (der Nutzer hat einen
;; Endpunkt gepickt, den die Kette exakt treffen soll). In diesem Fall werden
;; ALLE Fragen, die die spaeter tatsaechlich gebaute Laenge beeinflussen
;; (Separator VOR/NACH, UND "Ist der Endpunkt der Foerderer?"), VOR der
;; Laengenberechnung gestellt - erst wenn wirklich alle Informationen da sind,
;; wird dL final berechnet und die horizontale Strecke gebaut. Das verhindert,
;; dass die Kette am Ende ueber den gepickten Punkt hinausragt, nur weil
;; nachtraeglich noch ein Separator oder eine Motorstation dazukommt.
;; gf2-laenge: die (schon feststehende) GF2-Laenge aus der GF-Verteilungs-
;; Frage (L_GF2-bau in vfl-vf-einheit) - wird bei Antwort "1" (nur Motor-
;; station) MIT reserviert, da vfs-vf-exit sie direkt danach anbaut. Bei
;; Antwort "3" (Kettenende definieren) NICHT reservieren: dort berechnet
;; vfl-body-abschluss ein eigenes, unabhaengiges ziel-gf2 (siehe dort) - hier
;; unbekannt und irrelevant.
;; Rueckgabe bei ziel-modus=T: (frame ist-endpunkt-antwort) - der Aufrufer
;; (vfl-vf-einheit) muss die Frage dann NICHT erneut stellen. Bei ziel-modus=
;; nil (Default/mid-chain-Fortsetzung): unveraendertes Verhalten, Rueckgabe
;; nur frame.
(defun vfl-baue-horizontal-koerper (frame hz dL ziel-modus gf2-laenge /
pt m1 sep-vor pt-vor-bogen sep-nach ist-ende-antwort)
(setq pt (car frame))
(princ (ssg-text "vfl-sep-vor-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-vor (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "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 (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "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 (getstring (ssg-text "vfl-prompt-wahl-1-3-def2")))
(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)
;; 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))
(setq hn (getreal (ssg-textf "vfl-prompt-hoehe-kettenende"
(list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame))))
(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"))
nil)
(progn
;; 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*)))
(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)
;; 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 (getstring (ssg-text "vfl-prompt-wahl-1-3-def2")))
)
)
(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 "\n\nES-Element setzen?")
(princ "\n 1 - Ja")
(princ "\n 2 - Nein (Kette endet direkt am Zielpunkt)")
(setq es-antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(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 (getstring (ssg-text "vfl-prompt-wahl-1-3-def3")))
(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
(setq hn (getreal (ssg-textf "vfl-prompt-hoehe-endpunkt"
(list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame))))
(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)))
;; 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))
(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))))
neuer-frame
)
;; Interaktiv (i18n): GF-Bogen-Winkel + Seite abfragen, dann Kern aufrufen.
(defun vfl-insert-gf-bogen (frame / bwinkel bseite antwort)
(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 antwort (getint (ssg-text "vfl-prompt-wahl-1-3-def3")))
(if (null antwort) (setq antwort 3))
(setq bwinkel (cond ((= antwort 1) 30) ((= antwort 2) 60) (t 90)))
(princ (ssg-text "vfl-gf-bogen-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(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.
;; Die Vario_Kurve-Bloecke fuehren KS_EIN/KS_AUS als KSYS_EIN/KSYS_AUS -
;; 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).
;; Die Vario_Kurve-Bloecke fuehren KS_EIN/KS_AUS als KSYS_EIN/KSYS_AUS -
;; extract-ks-from-block-raw normalisiert das (siehe ks-normalize-name).
;; Interaktiv (i18n): Vario-Kurve-Winkel + Seite + Variante abfragen, dann Kern.
(defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort)
(princ (ssg-text "vfl-variokurve-winkel-header"))
(princ (ssg-text "vfl-opt1-90grad"))
(princ (ssg-text "vfl-opt2-60grad"))
(princ (ssg-text "vfl-opt3-30grad"))
(setq antwort (getint (ssg-text "vfl-prompt-wahl-1-3-def1")))
(if (null antwort) (setq antwort 1))
(setq kwinkel (cond ((= antwort 1) 90) ((= antwort 2) 60) (t 30)))
(princ (ssg-text "vfl-variokurve-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(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 (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(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 aus dem tatsaechlichen KS_AUS neu berechnen (siehe
;; vfl-projiziere-distanz). 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).
(defun vfl-kettenanfang-baustein (p-aktuell hz-neu pick-punkt deltaL as-seite as-vorhanden / frame)
(if as-vorhanden
(progn
(setq frame (vfl-insert-as-element "GF" p-aktuell hz-neu 0.0 as-seite))
(setq deltaL (vfl-projiziere-distanz (car frame) pick-punkt hz-neu))
(princ (strcat "\n>>> AS-Element eingefuegt - reale Restlaenge: deltaL="
(rtos deltaL 2 1) " mm."))
)
(progn
(setq frame (make-frame-from-dir p-aktuell (hz-winkel->xu hz-neu 0.0)))
(princ "\n>>> Kein AS-Element - Kette beginnt direkt am Startpunkt.")
)
)
(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).
(defun vfl-frage-es-seite ( / antwort es-seite)
(setq *vfl-es-winkel* (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 (getstring (ssg-text "prompt-wahl-1-2")))
(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 (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(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 (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
)
)
)
(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 (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(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
gf-max-winkel gf-ok kettenanfang pick-punkt
as-vorhanden erg)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-modus1-header"))
(princ "\n=========================================")
(princ (ssg-text "vfl-modus1-beschreibung"))
;; 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 (strcat "Gefaellestrecke-Modul nicht geladen!\n"
"Der Linienzug-Typ benoetigt Gefaellestrecke.lsp\n"
"(GF-Segmente und GF-Boegen). Bitte Menue laden."))
(exit)
)
)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(setq startpunkt (vfl-getpoint nil "\n\nStartpunkt der Kette waehlen: "))
(if (null startpunkt) (progn (princ "\nAbgebrochen.") (exit)))
;; Hoehe (Z) des Startpunkts abfragen und in die Z-Koordinate uebernehmen.
(setq start-hoehe
(getreal (strcat "\nHoehe (Z) des Startpunkts [" (rtos (caddr startpunkt) 2 1) "]: ")))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(princ "\n\nAS-Element setzen?")
(princ "\n 1 - Ja")
(princ "\n 2 - Nein (Kette beginnt direkt mit GF/VF am Startpunkt)")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq as-vorhanden (/= antwort "2"))
(if as-vorhanden
(progn
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
(princ "\n\nAUS-Element (AS_Element_*) - Seite waehlen:")
(princ "\n 1 - Links\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(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 vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
(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 "\n\nNaechstes Element waehlen:")
(setq linie-ende-modus nil)
(if frame
(progn
(princ "\n 1 - GF-Bogen (horizontale Kurve)")
(princ "\n 2 - Neue Linie: GF (Gefaellestrecke)")
(princ "\n 3 - Neue Linie: Ab/Auf VF (VarioFoerderer-Einheit)")
(princ "\n 4 - Neue VF mit horizontalem Anfang (Horizontal-Stueck)")
(princ "\n 5 - Neue Linie BIS Kettenende (danach Separator + ES-Element)")
(setq antwort (getstring "\nIhre Wahl (1-5) [2]: "))
(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 "\n 1 - Neue Linie: GF (Gefaellestrecke)")
(princ "\n 2 - Neue Linie: Ab/Auf VF (VarioFoerderer-Einheit)")
(princ "\n 3 - Neue VF mit horizontalem Anfang (Horizontal-Stueck)")
(princ "\n 4 - Neue Linie BIS Kettenende (danach Separator + ES-Element)")
(setq antwort (getstring "\nIhre Wahl (1-4) [1]: "))
(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
)
)
(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 "\nAbgebrochen.") (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr 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 pick-punkt deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
(if (< deltaL 1000.0)
(princ "\nFEHLER: Horizontaler VF braucht >= 1000 mm (Umlenk + Motor) - laenger zeichnen.")
(progn
;; VF-Einheit mit horizontalem ersten Koerper (winkel=0, L_VF=deltaL,
;; L_GF = Mindestlaenge fuer den Einlauf-Anschluss).
(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))
)
)
)
;; --- 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 "\nAbgebrochen.") (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr linie-mess))
(setq kettenanfang (null frame))
(setq gf-max-winkel (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
(if (< deltaL 1.0)
(princ "\nFEHLER: Linie zu kurz (oder entgegen der Fahrtrichtung) - bitte erneut waehlen.")
(progn
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
;; (Richtung hz-neu jetzt bekannt) und die GF-Restlaenge aus dem
;; TATSAECHLICHEN KS_AUS nachrechnen (siehe vfl-kettenanfang-
;; baustein). Keine Fussabdruck-Schaetzung mehr: sowohl KS_EIN- als
;; auch Ursprung-basierte Vorab-Messung ignorieren die Dreh­teller-
;; Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
;; anwendet, und liefern daher einen falschen Wert (empirisch
;; bestaetigt: ~210mm Schaetzung vs. tatsaechlich ~420mm noetiger
;; Versatz).
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu pick-punkt deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
(setq gf-ok t)
(princ "\nGefaelle festlegen:")
(princ "\n 1 - Gegebene Hoehe (Zielhoehe)")
(princ "\n 2 - Neigungswinkel eingeben")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(if (= antwort "2")
(progn
;; Winkel direkt vorgeben - deltaH ergibt sich aus deltaL*tan(winkel).
(setq winkel
(getreal (strcat "\nNeigungswinkel (Grad, 0 < Winkel <= "
(rtos gf-max-winkel 2 1) ") [" (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 (strcat "Neigungswinkel ungueltig: " (rtos winkel 2 1)
" Grad. Erlaubt: 0 < Winkel <= " (rtos gf-max-winkel 2 1) " Grad."))
(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).
(setq hoehe-neu
(getreal (strcat "\nHoehe (Z) des Linienendpunkts [" (rtos (caddr p-aktuell) 2 1) "]: ")))
(if (null hoehe-neu) (setq hoehe-neu (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 "Gefaellestrecke (GF) kann nicht steigen - bitte tiefere Zielhoehe waehlen oder \"Ab/Auf VF\" benutzen.")
(setq gf-ok nil))
(t
(setq winkel (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
(if (> winkel gf-max-winkel)
(progn
(alert (strcat "Gefaelle zu steil fuer GF: " (rtos winkel 2 1)
" Grad (erlaubt max " (rtos gf-max-winkel 2 1)
" Grad).\nBitte kleinere Hoehendifferenz waehlen oder \"Ab/Auf VF\" benutzen."))
(setq gf-ok nil))
)
)
)
)
)
(if gf-ok
(progn
(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))
(princ "\nIst das das Kettenende?")
(princ "\n 1 - Ja (ES-Element setzen)")
(princ "\n 2 - Ja (ohne ES-Element setzen)")
(princ "\n 3 - Nein (weiterbauen)")
(setq antwort (getstring "\nIhre Wahl (1-3) [3]: "))
(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 "\nAbgebrochen.") (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr 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 pick-punkt deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
(if (< deltaL 1000.0)
(princ "\nFEHLER: VarioFoerderer braucht >= 1000 mm (Umlenk + Motor) - laenger zeichnen oder \"GF\" waehlen.")
(progn
(setq hoehe-neu
(getreal (strcat "\nHoehe (Z) des Linienendpunkts [" (rtos (caddr p-aktuell) 2 1) "]: ")))
(if (null hoehe-neu) (setq hoehe-neu (caddr p-aktuell)))
(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)
(alert (strcat "VF-Einheit geometrisch nicht baubar!\n"
"deltaL=" (rtos deltaL 2 0) " mm, deltaH=" (rtos deltaH 2 0)
" mm, Richtung=" richtung
"\nBitte anderen Endpunkt/Hoehe waehlen."))
(progn
(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))
)
)
)
)
)
((= 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 "\nAbgebrochen.") (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr linie-mess))
(setq kettenanfang (null frame))
(if (< deltaL 1.0)
(princ "\nFEHLER: Linie zu kurz (oder entgegen der Fahrtrichtung) - bitte erneut waehlen.")
(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 pick-punkt deltaL as-seite as-vorhanden))
(setq frame (nth 0 erg) deltaL (nth 1 erg) p-aktuell (car frame))
)
)
;; 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 (strcat "\n>>> Kurzes Segment (deltaL=" (rtos deltaL 2 0)
" mm < 1000): automatisch 3-Grad-Gefaellestrecke"
" (keine Hoehenabfrage, deltaH=" (rtos deltaH 2 1) " mm)."))
)
(progn
(setq hoehe-neu
(getreal (strcat "\nHoehe (Z) des Linienendpunkts [" (rtos (caddr p-aktuell) 2 1) "]: ")))
(if (null hoehe-neu) (setq hoehe-neu (caddr p-aktuell)))
(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 (strcat "\n>>> Kettenende-Modus: Footprint fuer Separator + ES"
" reserviert -> baubar deltaL=" (rtos deltaL 2 0)
" mm, deltaH=" (rtos deltaH 2 0) " mm."))
)
)
(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)
(alert (strcat "Segment geometrisch nicht baubar!\n"
"deltaL=" (rtos deltaL 2 0) " mm, deltaH=" (rtos deltaH 2 0)
" mm, Richtung=" richtung
"\nBitte anderen Endpunkt/Hoehe waehlen."))
(progn
(if (= typ "GF")
(progn
;; --- reine Gefaellestrecke ---
(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))
;; 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 "\nIst das das Kettenende?")
(princ "\n 1 - Ja (ES-Element setzen)")
(princ "\n 2 - Ja (ohne ES-Element setzen)")
(princ "\n 3 - Nein (weiterbauen)")
(setq antwort (getstring "\nIhre Wahl (1-3) [3]: "))
)
)
(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).
(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))
)
)
)
)
)
)
)
)
)
(setq hoehe-bis (caddr (car frame)))
;; DELTA_L: planare Gesamtdistanz Start -> Kettenende
(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)
(princ "\n\n=========================================")
(princ "\n>>> VF-Linienzug-Kette eingefuegt! <<<")
(princ "\n=========================================")
(princ)
)
;; ============================================================
;; 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 k 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)
(princ "\n\n=========================================")
(princ "\n VF-LINIENZUG - Modus 3: 3D-Objekte stueckweise (Vorwaerts-Nachbau, in Arbeit)")
(princ "\n=========================================")
;; Abhaengigkeit Gefaellestrecke-Modul (GF-Bausteine)
(if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED"))))
(progn (alert "Gefaellestrecke-Modul nicht geladen!") (exit)))
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
;; --- 1. Pfad-Objekte waehlen (LINE/ARC) ---
(princ "\n\nPfad-Objekte waehlen (Linien/Boegen):")
(setq ss (ssget '((0 . "LINE,ARC"))))
(if (null ss) (progn (princ "\nKeine Objekte gewaehlt - Abbruch.") (exit)))
(setq obj-liste '() k 0)
(repeat (sslength ss)
(setq obj-liste (cons (vlax-ename->vla-object (ssname ss k)) obj-liste))
(setq k (1+ k)))
;; --- 2. Startpunkt (hoehere Seite) + Hoehe + AS-Seite ---
(setq startpunkt (vfl-getpoint nil "\n\nStartpunkt der Kette (hoehere Seite) waehlen: "))
(if (null startpunkt) (progn (princ "\nAbgebrochen.") (exit)))
(setq start-hoehe (getreal (strcat "\nHoehe (Z) des Startpunkts ["
(rtos (caddr startpunkt) 2 1) "]: ")))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
(princ "\n\nAUS-Element - Seite waehlen:\n 1 - Links\n 2 - Rechts")
(setq as-seite (if (= (getstring "\nIhre Wahl (1/2) [1]: ") "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 "\nFEHLER: Pfad nicht sortierbar (haengt er lueckenlos zusammen?).") (exit)))
(setq segmente (gf-analysiere-kette kette))
;; --- 4. Eck-Winkel-Vorpruefung (vor dem Bau) ---
(setq ecke-bad (vfl2-pruefe-eckwinkel kette 5.0))
(if ecke-bad
(progn
(alert (strcat "Kein passender Bogen: Eck-Winkel " (rtos ecke-bad 2 1)
" Grad ist nicht ~30/60/90.\n"
"Bitte die Winkel der Linien anpassen."))
(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 "Pfad enthaelt keine Gerade - eine Kette muss mit einer Geraden beginnen.") (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 (strcat "\n\nSegment " (itoa (1+ i)) "/" (itoa n)
": Gerade L=" (rtos laenge 2 0) " mm hz=" (rtos hz 2 1)))
(princ "\n Typ? 1 = GF (<=3 Grad) 2 = VF-Ab 3 = VF-Auf 4 = VF-Horizontal")
(setq antwort (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
(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 (getreal "\n GF-Neigung in Grad [3]: "))
(if (null winkel) (setq winkel 3.0))
(if (> winkel 3.0)
(progn (princ "\n Hinweis: GF max. 3 Grad - auf 3 begrenzt.") (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 (getint "\n Vario-Winkel (3..51 Grad) [3]: "))
(if (null best-w) (setq best-w 3))
(setq best-w (vfl2-snap-vfwinkel best-w))))
(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 (strcat "\n\nSegment " (itoa (1+ i)) "/" (itoa n)
": Eck/Bogen " (itoa bwinkel) " Grad " bseite))
(princ "\n Typ? 1 = GF-Bogen 2 = Vario-Kurve")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(if (= antwort "2")
;; --- Vario-Kurve (nur im VF-Lauf) ---
(if (not (= run-typ "VF"))
(princ "\n >>> Vario-Kurve nur innerhalb eines VF-Laufs zulaessig - uebersprungen.")
(progn
(princ "\n Vario-Kurve - Variante? 1 = Aussen 2 = Innen")
(setq kvariante (if (= (getstring "\nIhre Wahl (1/2) [2]: ") "1") "aussen" "innen"))
(setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite kvariante))))
;; --- GF-Bogen ---
(progn
(if (null frame)
(progn (alert "Kette beginnt mit einem Bogen - bitte erst eine Gerade.") (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 "\nNichts gebaut - Abbruch.") (exit)))
(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 "\n>>> VF-Linienzug (Modus 2, GF+VF) eingefuegt! <<<")
(princ (strcat "\n Soll-Ende (Pfad): X=" (rtos (car soll-ende) 2 1)
" Y=" (rtos (cadr soll-ende) 2 1)))
(princ (strcat "\n Ist-Ende (ES): X=" (rtos (car ist-ende) 2 1)
" Y=" (rtos (cadr ist-ende) 2 1) " Z=" (rtos (caddr ist-ende) 2 1)))
(princ (strcat "\n Abweichung XY: dX=" (rtos (- (car ist-ende) (car soll-ende)) 2 1)
" dY=" (rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1) " mm"))
(princ "\n=========================================")
(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
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)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-m3-titel"))
(princ "\n=========================================")
;; 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 (ssget '((0 . "LINE,ARC"))))
(if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
(setq obj-liste '() k 0)
(repeat (sslength ss)
(setq obj-liste (cons (vlax-ename->vla-object (ssname ss k)) obj-liste))
(setq k (1+ k)))
;; --- 2. Startpunkt + Z + AS-Seite ---
(setq startpunkt (vfl-getpoint nil (ssg-text "vfl-m3-prompt-startpunkt")))
(if (null startpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit)))
(setq start-hoehe (getreal (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))
(princ "\n\nAS-Element setzen?")
(princ "\n 1 - Ja")
(princ "\n 2 - Nein (Kette beginnt direkt am Startpunkt)")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq as-vorhanden (/= antwort "2"))
(if as-vorhanden
(progn
(setq *vfl-as-winkel* (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 as-seite (if (= (getstring (ssg-text "prompt-wahl-1-2")) "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
)
)
;; --- 3. Endpunkt + Z + ES-Seite (NEU in Modus 3) ---
(setq endpunkt (vfl-getpoint nil (ssg-text "vfl-m3-prompt-endpunkt")))
(if (null endpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit)))
(setq end-hoehe (getreal (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))
(princ "\n\nES-Element setzen?")
(princ "\n 1 - Ja")
(princ "\n 2 - Nein (Kette endet direkt am Zielpunkt)")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq es-vorhanden (/= antwort "2"))
(if es-vorhanden
(progn
(setq *vfl-es-winkel* (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 es-seite (if (= (getstring (ssg-text "prompt-wahl-1-2")) "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 (getstring (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2")
(setq plan (cons (list "Linie" hz laenge "VF" nil) plan))
(progn
(setq winkel (getreal (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 (getstring (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2")
(progn
(princ (ssg-text "vfl-m3-variante-frage"))
(setq kv-variante (if (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "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)
;; 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 (= (getstring (ssg-text "prompt-wahl-1-2")) "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)))
(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 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=========================================")
(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.
;; 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 attribute-alist ist-wrapper)
(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-attribs (rec) (nth 4 rec))
(defun vfl-kette-rec-wrapper (rec) (nth 5 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 "_")))
(defun vfl-kette-split-komma (str)
(if (and str (> (strlen str) 0)) (vfl-kette-split str ",") '()))
;; 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 als Zahl/Text lesen (Default falls Tag fehlt/leer).
(defun vfl-kette-attrib-zahl (attribs tag / w)
(setq w (cdr (assoc tag attribs)))
(if w (atoi w) 0))
(defun vfl-kette-attrib-text (attribs tag default / w)
(setq w (cdr (assoc tag attribs)))
(if (and w (> (strlen w) 0)) w default))
;; 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
)
;; Gesamt-KS_EIN (erster Baustein) und Gesamt-KS_AUS (letzter Baustein) EINES
;; Bausteins ermitteln + Kennzeichen ob es sich um einen Wrapper handelt.
;; Zuerst DIREKT versucht (Leaf-Element - traegt selbst KS_EIN/KS_AUS als
;; Sub-Block, siehe vfl-kette-ks-ursprung). Liefert die direkte Suche NICHTS
;; (leer), wird block-obj als Wrapper (bereits gemergter VF_n) behandelt:
;; eine Ebene tiefer je Sub-Element gesucht, intern zusammenhaengende Punkte
;; herausgefiltert.
;; Rueckgabe: (list ks-ein ks-aus ist-wrapper).
(defun vfl-kette-block-ks-punkte (block-obj / direkt kinder kind sub-ks
ein-liste aus-liste ergebnis-ein ergebnis-aus p q match)
(setq direkt (vfl-kette-ks-ursprung block-obj))
(if direkt
(list
(cdr (assoc "KS_EIN" direkt))
(cdr (assoc "KS_AUS" direkt))
nil
)
(progn
(setq kinder (vlax-invoke block-obj 'Explode))
(setq ein-liste '() aus-liste '())
(foreach kind kinder
(if (and (not (vlax-erased-p kind))
(= (vla-get-ObjectName kind) "AcDbBlockReference"))
(progn
(setq sub-ks (vfl-kette-ks-ursprung kind))
(if (assoc "KS_EIN" sub-ks) (setq ein-liste (cons (cdr (assoc "KS_EIN" sub-ks)) ein-liste)))
(if (assoc "KS_AUS" sub-ks) (setq aus-liste (cons (cdr (assoc "KS_AUS" sub-ks)) aus-liste)))
)
)
)
(foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind)))
(setq ergebnis-ein nil)
(foreach p ein-liste
(setq match nil)
(foreach q aus-liste (if (< (distance p q) *vfl-kette-tol-eng*) (setq match T)))
(if (not match) (setq ergebnis-ein p))
)
(setq ergebnis-aus nil)
(foreach p aus-liste
(setq match nil)
(foreach q ein-liste (if (< (distance p q) *vfl-kette-tol-eng*) (setq match T)))
(if (not match) (setq ergebnis-aus p))
)
(list ergebnis-ein ergebnis-aus T)
)
)
)
;; Alle Vario-Kette-Bausteine der Zeichnung einsammeln (lose Einzelteile UND
;; bereits gewickelte VF_n - siehe vfl-kette-typ): Attribute (nur bei
;; Wrappern vorhanden, VOR jeder Veraenderung gelesen), Gesamt-KS_EIN/KS_AUS
;; und Wrapper-Kennzeichen je Baustein.
(defun vfl-kette-sammle-alle ( / ss i ename bname attribs obj ks-info 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))))
(if (/= (vfl-kette-typ bname) "UNBEKANNT")
(progn
(setq attribs (ssg-attrib-read ename))
(setq obj (vlax-ename->vla-object ename))
(setq ks-info (vfl-kette-block-ks-punkte obj))
(setq records (cons (list ename bname (car ks-info) (cadr ks-info) attribs (caddr ks-info)) 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).
(defun vfl-kette-verfolgen (start-rec alle-records / rest kette aktuell fund fertig warnung letzter-fund)
(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 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*)
(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)
)
;; 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. Bereits gewickelte VF_n-Bausteine werden mit ihren VORHANDENEN
;; Attributen eingespeist (Komma-Listen aufgeteilt/angehaengt, Zaehler
;; addiert) - so lassen sich lose Einzelteile und fertige VF_n 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 w-attribs tag n 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
;; --- Bereits gewickelter VF_n: fertige Attribute direkt einspeisen ---
((vfl-kette-rec-wrapper rec)
(setq w-attribs (vfl-kette-rec-attribs rec))
(setq *vfl-acc-lgf* (append *vfl-acc-lgf* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "L_GF_m" ""))))
(setq *vfl-acc-gfwinkel* (append *vfl-acc-gfwinkel* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "GF_WINKEL" ""))))
(setq *vfl-acc-lvf* (append *vfl-acc-lvf* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "L_VF_m" ""))))
(setq *vfl-acc-winkel* (append *vfl-acc-winkel* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "VF_WINKEL" ""))))
(setq *vfl-acc-richtung* (append *vfl-acc-richtung* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "ANTRIEBFAHRTRICHTUNG" ""))))
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "MOTORSEITE" ""))))
(foreach tag '("L_90" "L_60" "L_30" "R_90" "R_60" "R_30")
(setq n (vfl-kette-attrib-zahl w-attribs (strcat "GF_Bogen_" tag)))
(repeat n (setq *vfl-acc-gfbogen* (vfl-inc-count *vfl-acc-gfbogen* tag))))
(foreach tag '("A_90" "A_60" "A_30" "I_90" "I_60" "I_30")
(setq n (vfl-kette-attrib-zahl w-attribs (strcat "VF_Bogen_" tag)))
(repeat n (setq *vfl-acc-variokurve* (vfl-inc-count *vfl-acc-variokurve* tag))))
(setq *vfl-acc-separator* (+ *vfl-acc-separator* (vfl-kette-attrib-zahl w-attribs "ANZAHL_SEPARATOR")))
(setq anzahl-vf (+ anzahl-vf (vfl-kette-attrib-zahl w-attribs "ANZAHL_VF")))
(if (equal rec erster) (setq as-seite (vfl-kette-attrib-text w-attribs "SEITE_AS" "")))
(if (equal rec letzter) (setq es-seite (vfl-kette-attrib-text w-attribs "SEITE_ES" "")))
)
((= 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
lauf kette warnung naechster-fund merge-ss leaf-enames chain-start chain-end neuer-bname
rec kinder kind diag-obj diag-kinder erg aggregiert typ-str neuer-insert def
leaf-ename leaf-obj leaf-noch-da)
(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))
;; DIAGNOSE: fuer jede erfasste Staustrecke_SP_1000_mm* zeigen, ob KS_EIN/
;; KS_AUS gefunden wurden (Verdachtsfall aus vorherigen Tests).
(foreach rec alle-records
(if (= (vfl-kette-typ (vfl-kette-rec-bname rec)) "STRECKE")
(princ (strcat "\n [Diagnose] " (vfl-kette-rec-bname rec)
" KS_EIN=" (if (vfl-kette-rec-ein rec) "gefunden" "FEHLT")
" KS_AUS=" (if (vfl-kette-rec-aus rec) "gefunden" "FEHLT")
" wrapper=" (if (vfl-kette-rec-wrapper rec) "ja" "nein")))
)
)
(setq start-rec nil)
(foreach rec alle-records (if (equal (vfl-kette-rec-ename rec) start-ename) (setq start-rec rec)))
(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))
(if (< (length kette) 2)
(progn
(princ (strcat "\n [Diagnose] KS_AUS Startbaustein (" (vfl-kette-rec-bname start-rec) "): X="
(rtos (car (vfl-kette-rec-aus start-rec)) 2 1) " Y="
(rtos (cadr (vfl-kette-rec-aus start-rec)) 2 1) " Z="
(rtos (caddr (vfl-kette-rec-aus start-rec)) 2 1)))
(if naechster-fund
(princ (strcat "\n [Diagnose] Naechster Kandidat: " (vfl-kette-rec-bname (car naechster-fund))
" Abstand=" (rtos (cdr naechster-fund) 2 1)
" mm (Toleranz eng=" (rtos *vfl-kette-tol-eng* 2 1)
" mm, weit=" (rtos *vfl-kette-tol-weit* 2 1) " mm)"))
(princ (strcat "\n [Diagnose] Kein anderer Baustein mit KS_EIN gefunden (insgesamt "
(itoa (length alle-records)) " Bausteine erfasst).")))
(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)))))
;; Attribute + Kettenanfang/-ende VOR dem Explodieren sichern (Attribute
;; eines Wrappers gehen beim Explodieren verloren - werden zu wertlosem Text).
(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))
;; Wrapper (bereits gemergte VF_n) explodieren (Sub-Elemente bleiben als
;; Bloecke erhalten, ATTRIB-Textreste werden verworfen), Original loeschen.
;; 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 '())
(foreach rec kette
(if (vfl-kette-rec-wrapper rec)
(progn
(setq kinder (vlax-invoke (vlax-ename->vla-object (vfl-kette-rec-ename 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-ename rec)))
)
(progn
;; DIAGNOSE: Skalierung unmittelbar VOR dem Einwickeln pruefen (grenzt
;; ein, ob eine evtl. Verzerrung schon vor _.-BLOCK/_.INSERT entsteht).
(setq diag-obj (vlax-ename->vla-object (vfl-kette-rec-ename rec)))
(princ (strcat "\n [Diagnose] " (vfl-kette-rec-bname rec)
" vor dem Wickeln: XScale="
(rtos (vla-get-XScaleFactor diag-obj) 2 4)
" YScale=" (rtos (vla-get-YScaleFactor diag-obj) 2 4)
" ZScale=" (rtos (vla-get-ZScaleFactor diag-obj) 2 4)))
(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))
;; DIAGNOSE: Skalierung der verschachtelten Bausteine NACH dem Wickeln
;; pruefen (temporaerer Explode einer Kopie, sofort wieder geloescht -
;; neuer-insert selbst bleibt unveraendert). Grenzt ein, ob eine
;; Verzerrung erst durch _.-BLOCK/_.INSERT entsteht.
(setq diag-kinder (vlax-invoke (vlax-ename->vla-object neuer-insert) 'Explode))
(foreach diag-obj diag-kinder
(if (and (not (vlax-erased-p diag-obj)) (= (vla-get-ObjectName diag-obj) "AcDbBlockReference"))
(princ (strcat "\n [Diagnose] " (vla-get-Name diag-obj)
" nach dem Wickeln: XScale=" (rtos (vla-get-XScaleFactor diag-obj) 2 4)
" YScale=" (rtos (vla-get-YScaleFactor diag-obj) 2 4)
" ZScale=" (rtos (vla-get-ZScaleFactor diag-obj) 2 4)))
)
)
(foreach diag-obj diag-kinder (if (not (vlax-erased-p diag-obj)) (vla-Delete diag-obj)))
;; 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
"3D-Linienzug (gemischte GF/VF-Kette; Modus 1 manuell / Modus 2 Ziel-Hoehe fertig / Modus 3 stueckweise in Arbeit)")
(princ "\n>>> vf_linienzug.lsp geladen - Typ 'linienzug' registriert")
(princ)
Reference in New Issue View Git Blame Copy Permalink