3370 lines
170 KiB
Common Lisp
3370 lines
170 KiB
Common Lisp
;; ============================================================
|
||
;; VF_LINIENZUG - Gemischte Gefaellestrecke/VarioFoerderer-Kette
|
||
;; Typ "linienzug" fuer VarioFoerderer (3. Typ neben "standard"/"etage")
|
||
;; ============================================================
|
||
;; Kette: immer genau EIN AS_Element am Anfang, genau EIN ES_Element am Ende,
|
||
;; dazwischen beliebig viele Segmente. Jedes gerade Segment wird automatisch
|
||
;; klassifiziert:
|
||
;; - Endpunkt hoeher als Startpunkt -> immer VF (Gefaelle kann nicht steigen,
|
||
;; reine Schwerkraftstrecke)
|
||
;; - Endpunkt tiefer, Neigung >= 3 Grad -> reine Gefaellestrecke (GF), da 3
|
||
;; Grad im ganzen Projekt die kleinste
|
||
;; Neigung ist (Vario_Bogen_auf/ab_3)
|
||
;; - Endpunkt tiefer, Neigung < 3 Grad -> VF (zu flach fuer reine GF):
|
||
;; erst Horizontale Mitte pruefen
|
||
;; (berechne-horizontale-mitte), sonst
|
||
;; diskreten Winkel 3-51 Grad suchen
|
||
;; (berechne-alle-winkel)
|
||
;; Nach einem GF-Segment: naechstes Element nur GF-Bogen oder neue Linie.
|
||
;; Nach einem VF-Segment: naechstes Element nur Vario-Kurve oder neue Linie.
|
||
;;
|
||
;; Architektur-Entscheidung (mit Nutzer abgestimmt): eigener Befehlsablauf,
|
||
;; NICHT ueber die berechne-fn/einfuege-fn-Registry (die ist fuer ein einzelnes
|
||
;; durchgehendes Segment gedacht, nicht fuer eine interaktive Mehrsegment-Kette).
|
||
;; c:VarioFoerderer erkennt den Typ "linienzug" und dispatcht direkt hierher.
|
||
;;
|
||
;; BEKANNTE EINSCHRAENKUNGEN dieser ersten Version (bitte in BricsCAD pruefen):
|
||
;; - Vario_Kurve_*-Bloecke (data/ils/3D/) wurden bislang nirgends im Projekt
|
||
;; verwendet. Ob sie KS_EIN/KS_AUS enthalten (Voraussetzung fuer
|
||
;; insert-block-ks-to-ks) ist ungeklaert und muss beim ersten Testlauf
|
||
;; verifiziert werden.
|
||
;; - Am Uebergang GF-Segment -> VF-Segment (ueber "neue Linie", die
|
||
;; automatisch als VF eingestuft wird) kann ein sichtbarer Knick entstehen:
|
||
;; vfs-mitte-teil beginnt sein erstes Element (GF1) immer fest bei 3 Grad,
|
||
;; unabhaengig vom Neigungswinkel des vorangehenden GF-Segments.
|
||
;; - Die Fusspunkte von AS-/ES-Element (aus-dx/dz bzw. ein-dx/dz) werden vom
|
||
;; Erst- bzw. Letzt-Segment abgezogen (vfl-as-deltaL/H-korrigiert bzw. die
|
||
;; Separator+ES-Reservierung im Kettenende-Modus), damit der gepickte
|
||
;; Endpunkt vom gebauten GF/VF-Koerper exakt getroffen wird.
|
||
;; ============================================================
|
||
|
||
;; Attribut-Definitionen fuer den Linienzug-Block kommen aus dem gemeinsamen
|
||
;; Strecken-Schema in ssg_core.lsp (ssg-strecke-attrib-defs). Der TYP wird zur
|
||
;; Laufzeit bestimmt: einsegmentige GF ohne Bogen -> "Gefaellestrecke"
|
||
;; (reduziert), sonst -> "Streckengruppe" (voll, segmentweise Werte).
|
||
|
||
;; Toleranzband (Grad) um die feste 3-Grad-Neigung: liegt der natuerliche
|
||
;; Winkel eines fallenden Segments innerhalb 3+/-Toleranz, wird es als reine
|
||
;; 3-Grad-Gefaellestrecke gebaut. Steiler -> VF-ab, flacher -> VF (flach).
|
||
;; Grund: eine reine Gefaellestrecke ist nie steiler als 3 Grad.
|
||
;; Bei Bedarf empirisch anpassen.
|
||
(if (null *vfl-gf-winkel-toleranz*) (setq *vfl-gf-winkel-toleranz* 0.5))
|
||
|
||
;; Mindestlaenge (mm) fuer die 3-Grad-Gefaellestrecke GF1 am Einlauf (zwischen
|
||
;; AS und Umlenkstation). Im Linienzug sitzt die gesamte Staustrecke am Einlauf
|
||
;; (GF1 = komplettes L_GF), GF2 am Ausgang entfaellt. Faellt das berechnete
|
||
;; L_GF darunter, wird GF1 auf diesen Wert angehoben - damit der 3-Grad-
|
||
;; Anschluss immer physisch vorhanden ist.
|
||
(if (null *vfl-gf-min-laenge*) (setq *vfl-gf-min-laenge* 400.0))
|
||
|
||
;; Horizontales Budget der festen Elemente im Linienzug-VF:
|
||
;; Umlenkstation (500) + Motorstation (500) + EIN Separator am Einlauf (300)
|
||
;; = 1300 mm. Der Ausgangs-Separator entfaellt (anders als Standard-VF=1600).
|
||
(if (null *vfl-feste-horizontal*) (setq *vfl-feste-horizontal* 1300.0))
|
||
|
||
;; ============================================================
|
||
;; TEIL 0: ATTRIBUT-AKKUMULATOREN (werden waehrend des Baus gefuellt)
|
||
;; ============================================================
|
||
;; Segment-Listen werden in Bau-Reihenfolge angehaengt und spaeter
|
||
;; kommagetrennt in die Attribute geschrieben. Bogen-/Kurven-Zaehler als Alist.
|
||
(defun vfl-acc-reset ()
|
||
(setq *vfl-acc-lvf* '() ; L_VF je VF-Sub-Segment (m, String)
|
||
*vfl-acc-lgf* '() ; L_GF je GF-Segment (m, String) - inkl. GF1/GF2
|
||
*vfl-acc-gfwinkel* '() ; Neigungswinkel je GF-Segment (String, parallel zu lgf)
|
||
*vfl-acc-richtung* '() ; "Auf"/"Ab"/"horizontal" je VF-Sub-Segment
|
||
*vfl-acc-winkel* '() ; Winkel je VF-Sub-Segment (String, 0=horizontal)
|
||
*vfl-acc-motorseite* '() ; Seite ("rechts"/"links") je Motorstation
|
||
*vfl-acc-gfbogen* '() ; Alist ("L_90".n ...) GF-Boegen
|
||
*vfl-acc-variokurve* '() ; Alist ("A_90".n ...) Vario-Kurven
|
||
*vfl-ziel-punkt* nil ; Soll-ES-Punkt fuer Option-3-Ist-Ziel-Report
|
||
*vfl-acc-separator* 0)) ; Anzahl eingefuegter Separatoren (300 mm)
|
||
|
||
;; Alist-Zaehler erhoehen / lesen
|
||
(defun vfl-inc-count (al key / e)
|
||
(setq e (assoc key al))
|
||
(if e (subst (cons key (1+ (cdr e))) e al) (cons (cons key 1) al)))
|
||
(defun vfl-get-count (al key / e)
|
||
(if (setq e (assoc key al)) (cdr e) 0))
|
||
|
||
;; Ein VF-Sub-Segment (Koerper) erfassen. Winkel 0 => horizontal.
|
||
(defun vfl-acc-vf-seg (richtung winkel L_VF)
|
||
(setq *vfl-acc-lvf* (append *vfl-acc-lvf* (list (rtos (/ L_VF 1000.0) 2 3))))
|
||
(setq *vfl-acc-winkel* (append *vfl-acc-winkel* (list (itoa (fix winkel)))))
|
||
(setq *vfl-acc-richtung* (append *vfl-acc-richtung*
|
||
(list (if (= (fix winkel) 0) "horizontal" richtung)))))
|
||
|
||
;; Ein GF-Segment erfassen (Laenge = Schraeglaenge in m, winkel = Neigung).
|
||
;; Gilt fuer reine GF-Chain-Segmente UND die VF-internen GF1/GF2-Anschluesse.
|
||
(defun vfl-acc-gf-seg (L_GF winkel)
|
||
(setq *vfl-acc-lgf* (append *vfl-acc-lgf* (list (rtos (/ L_GF 1000.0) 2 3))))
|
||
(setq *vfl-acc-gfwinkel* (append *vfl-acc-gfwinkel* (list (rtos (float winkel) 2 1)))))
|
||
|
||
;; Liste kommagetrennt verketten ("" bei leer).
|
||
(defun vfl-join-komma (lst / s first)
|
||
(setq s "" first t)
|
||
(foreach x lst
|
||
(if first (progn (setq s x) (setq first nil)) (setq s (strcat s "," x))))
|
||
s)
|
||
|
||
;; Gewaehlte AS-/ES-Winkelvariante ("30"/"90"). Vorgabe "90", solange der Modus
|
||
;; nichts anderes gesetzt hat (Blocknamen AS_Element_<winkel>_<seite>).
|
||
(defun vfl-as-winkel () (if (boundp '*vfl-as-winkel*) *vfl-as-winkel* "90"))
|
||
(defun vfl-es-winkel () (if (boundp '*vfl-es-winkel*) *vfl-es-winkel* "90"))
|
||
|
||
;; ============================================================
|
||
;; TEIL 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 Drehteller-Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
|
||
;; anwendet, und liefern empirisch bestaetigt einen falschen Wert (~210mm
|
||
;; Schaetzung vs. ~420mm tatsaechlich noetiger Versatz bei AS_Element_30).
|
||
(defun vfl-projiziere-distanz (neu-basis ziel-punkt hz / rad)
|
||
(setq rad (* (float hz) (/ pi 180.0)))
|
||
(+ (* (- (car ziel-punkt) (car neu-basis)) (cos rad))
|
||
(* (- (cadr ziel-punkt) (cadr neu-basis)) (sin rad))))
|
||
|
||
;; Rahmen am Ende eines vfs-*-Bausteins: die Bausteine (Entry/Koerper/Exit)
|
||
;; enden IMMER auf der 3-Grad-Basisneigung (siehe Prinzipien-Dok Abschnitt 6).
|
||
(defun vfl-frame-3grad (punkt hz)
|
||
(make-frame-from-dir punkt (hz-winkel->xu hz (ssg-cfg-or "vario" "gefaelle_winkel" 3))))
|
||
|
||
;; 20-Meter-Regel: warnt, wenn die VF-Segmente seit der Umlenkstation 20 m
|
||
;; ueberschreiten (Prinzipien-Dok Abschnitt 7). v1: nur Hinweis, kein
|
||
;; automatisches Einfuegen einer Zwischen-Motorstation.
|
||
(defun vfl-20m-check (p-umlenk p-akt / laenge)
|
||
(setq laenge (vfl-planar-dist p-umlenk p-akt))
|
||
(if (> laenge 20000.0)
|
||
(princ (ssg-textf "vfl-20m-hinweis" (list (rtos (/ laenge 1000.0) 2 2))))
|
||
)
|
||
)
|
||
|
||
;; Baut EINE reine VarioFoerderer-Einheit als interaktive Sub-Kette:
|
||
;; genau EINE Umlenkstation (Eingang) ... beliebig viele Koerper-Sub-Segmente
|
||
;; und Vario-Kurven ... genau EINE Motorstation (Ausgang). Siehe Prinzipien-Dok
|
||
;; Abschnitt 2+4. Jedes Koerper-Sub-Segment beginnt/endet auf 3-Grad-Neigung.
|
||
;; frame: Eingangsrahmen (KS_AUS des Vorgaenger-Elements, i.d.R. AS-Element).
|
||
;; hz1/richtung1/winkel1/L_GF1/L_VF1: Daten des ersten (bereits klassifizierten)
|
||
;; VF-Linien-Sub-Segments aus vfl-segment-entscheidung.
|
||
;; gf-am-ausgang: T => halbe Staustrecke als GF2 am Ausgang (ohne Separator),
|
||
;; nil => gesamte Staustrecke am Einlauf (GF1), kein GF2.
|
||
;; Neigung des Frames aus der xu-Richtung ablesen: T => (nahezu) flach (0 Grad),
|
||
;; nil => auf 3-Grad-Basis. Damit wird der Uebergang auf_3/ab_3 nur dann gesetzt,
|
||
;; wenn wirklich ein Neigungswechsel noetig ist.
|
||
(defun vfl-frame-flach-p (frame)
|
||
(< (abs (cadr (frame->hz-winkel frame))) 1.5))
|
||
|
||
;; Separator (300 mm) HORIZONTAL (0 Grad) an einen Punkt anfuegen - fuer das
|
||
;; horizontale Stueck, wo der Separator in der 0-Grad-Ebene liegt (NICHT auf der
|
||
;; 3-Grad-Basis wie vfl-insert-separator). Rueckgabe: Endpunkt.
|
||
(defun vfl-sep-hz (pt hz / ep)
|
||
(princ (ssg-text "vfl-sep-horizontal-info"))
|
||
(setq ep (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" pt hz 0 300 0))
|
||
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
|
||
ep)
|
||
|
||
;; Uebergang zurueck auf die 3-Grad-Basis, FALLS der Frame gerade flach (0 Grad)
|
||
;; ist: fuegt einen Vario_Bogen_ab_3 ein. Wird vor jedem 3-Grad-Element
|
||
;; (gewinkeltes VF, Motorstation, ES) aufgerufen, damit der ab_3-Uebergang erst
|
||
;; DANN kommt, wenn er wirklich gebraucht wird (die flache Zone bleibt sonst
|
||
;; flach). Ist der Frame schon auf 3-Grad-Basis, bleibt er unveraendert.
|
||
(defun vfl-nach-3grad (frame / hz m pt)
|
||
(if (vfl-frame-flach-p frame)
|
||
(progn
|
||
(setq hz (car (frame->hz-winkel frame)))
|
||
(setq m (get-bogen-mass bogen-ab 3))
|
||
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
|
||
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" (car frame)
|
||
0 (car m) (caddr m) hz))
|
||
(vfl-frame-3grad pt hz))
|
||
frame))
|
||
|
||
;; Horizontales Sub-Segment bauen. Die flache Zone (0 Grad) wird NICHT mehr
|
||
;; automatisch mit ab_3 auf die 3-Grad-Basis zurueckgefuehrt - das Stueck ENDET
|
||
;; FLACH. Der ab_3-Uebergang kommt erst, wenn ein 3-Grad-Element folgt
|
||
;; (vfl-nach-3grad). Der auf_3-Eintritt wird nur gesetzt, wenn der Frame noch
|
||
;; NICHT flach ist (sonst bleibt die laufende flache Zone erhalten). Separatoren
|
||
;; VOR/NACH liegen in der 0-Grad-Ebene. Rueckgabe: neuer Frame (flach, 0 Grad).
|
||
;; ziel-modus=T: dL ist die GESAMT-Zielstrecke ab pt (der Nutzer hat einen
|
||
;; Endpunkt gepickt, den die Kette exakt treffen soll). In diesem Fall werden
|
||
;; ALLE Fragen, die die spaeter tatsaechlich gebaute Laenge beeinflussen
|
||
;; (Separator VOR/NACH, UND "Ist der Endpunkt der Foerderer?"), VOR der
|
||
;; Laengenberechnung gestellt - erst wenn wirklich alle Informationen da sind,
|
||
;; wird dL final berechnet und die horizontale Strecke gebaut. Das verhindert,
|
||
;; dass die Kette am Ende ueber den gepickten Punkt hinausragt, nur weil
|
||
;; nachtraeglich noch ein Separator oder eine Motorstation dazukommt.
|
||
;; gf2-laenge: die (schon feststehende) GF2-Laenge aus der GF-Verteilungs-
|
||
;; Frage (L_GF2-bau in vfl-vf-einheit) - wird bei Antwort "1" (nur Motor-
|
||
;; station) MIT reserviert, da vfs-vf-exit sie direkt danach anbaut. Bei
|
||
;; Antwort "3" (Kettenende definieren) NICHT reservieren: dort berechnet
|
||
;; vfl-body-abschluss ein eigenes, unabhaengiges ziel-gf2 (siehe dort) - hier
|
||
;; unbekannt und irrelevant.
|
||
;; Rueckgabe bei ziel-modus=T: (frame ist-endpunkt-antwort) - der Aufrufer
|
||
;; (vfl-vf-einheit) muss die Frage dann NICHT erneut stellen. Bei ziel-modus=
|
||
;; nil (Default/mid-chain-Fortsetzung): unveraendertes Verhalten, Rueckgabe
|
||
;; nur frame.
|
||
(defun vfl-baue-horizontal-koerper (frame hz dL ziel-modus gf2-laenge /
|
||
pt m1 sep-vor pt-vor-bogen sep-nach ist-ende-antwort)
|
||
(setq pt (car frame))
|
||
(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 Drehteller-
|
||
;; Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
|
||
;; anwendet, und liefern daher einen falschen Wert (empirisch
|
||
;; bestaetigt: ~210mm Schaetzung vs. tatsaechlich ~420mm noetiger
|
||
;; Versatz).
|
||
(if kettenanfang
|
||
(progn
|
||
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu 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.
|
||
;;
|
||
;; Ein angetroffener VF_n-Wrapper wird beim Erfassen SOFORT (temporaer) in
|
||
;; seine Sub-Elemente aufgeloest, die dann wie von Anfang an lose Bauteile
|
||
;; behandelt werden (vfl-kette-sammle-alle) - eine fruehere Fassung versuchte
|
||
;; stattdessen, fuer einen Wrapper EINEN Gesamt-KS_EIN/KS_AUS per "welcher
|
||
;; Punkt hat kein Gegenstueck"-Heuristik zu bestimmen; das schlug bei langen
|
||
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl (siehe
|
||
;; [[project_vario_kette_merge]] Update 6).
|
||
|
||
;; Toleranzen (mm) fuer die Nachbarschaftspruefung zwischen zwei Bausteinen:
|
||
;; <= tol-eng -> gilt als sauber verbunden, Kette geht weiter
|
||
;; <= tol-weit -> sieht verbunden aus, ist es aber nicht -> Warnung, Kettenende
|
||
;; > tol-weit -> kein Zusammenhang, normales (stilles) Kettenende
|
||
(if (null *vfl-kette-tol-eng*) (setq *vfl-kette-tol-eng* 2.0))
|
||
(if (null *vfl-kette-tol-weit*) (setq *vfl-kette-tol-weit* 100.0))
|
||
|
||
;; Kleine Feld-Zugriffe auf einen Ketten-Datensatz
|
||
;; (ename bname ks-ein-punkt ks-aus-punkt wrapper-ename)
|
||
;; ename = nil und wrapper-ename gesetzt: Sub-Element eines aufgeloesten
|
||
;; VF_n-Wrappers (wrapper-ename = dessen Original-Ename). Sonst: eigenstaen-
|
||
;; diges Bauteil (ename gesetzt, wrapper-ename nil).
|
||
(defun vfl-kette-rec-ename (rec) (nth 0 rec))
|
||
(defun vfl-kette-rec-bname (rec) (nth 1 rec))
|
||
(defun vfl-kette-rec-ein (rec) (nth 2 rec))
|
||
(defun vfl-kette-rec-aus (rec) (nth 3 rec))
|
||
(defun vfl-kette-rec-wrapper (rec) (nth 4 rec))
|
||
|
||
;; String an einem Trennzeichen aufteilen (reine Teilstring-Suche, keine
|
||
;; Wildcards). Bei "_"-Trennung eines Bausteinnamens liefert das die
|
||
;; Namensteile unabhaengig vom Dimensions-Suffix (_2D/_3D) - der steht immer
|
||
;; am Ende und wird von den (nur von vorne indizierenden) Zugriffen unten
|
||
;; ignoriert.
|
||
(defun vfl-kette-split (str delim / pos ergebnis rest)
|
||
(setq ergebnis '() rest str)
|
||
(while (setq pos (vl-string-search delim rest))
|
||
(setq ergebnis (append ergebnis (list (substr rest 1 pos))))
|
||
(setq rest (substr rest (+ pos 1 (strlen delim))))
|
||
)
|
||
(append ergebnis (list rest))
|
||
)
|
||
(defun vfl-kette-teil (bname idx) (nth idx (vfl-kette-split bname "_")))
|
||
|
||
;; Bausteintyp aus dem Blocknamen ableiten. Scanner/Separator_SP (manuelle
|
||
;; Sensor-Bloecke, siehe count_sep_scan.lsp) gehoeren NICHT zur Kette selbst
|
||
;; und tauchen hier bewusst nicht auf.
|
||
(defun vfl-kette-typ (bname)
|
||
(cond
|
||
((wcmatch bname "VF_*") "WRAPPER")
|
||
((wcmatch bname "AS_Element_*") "AS")
|
||
((wcmatch bname "ES_Element_*") "ES")
|
||
((wcmatch bname "Gefaellebogen_*") "GFBOGEN")
|
||
((wcmatch bname "Vario_Kurve_*") "KURVE")
|
||
((wcmatch bname "Vario_Umlenkstation_*") "UMLENK")
|
||
((wcmatch bname "Vario_Motorstation_*") "MOTOR")
|
||
((wcmatch bname "Vario_Bogen_auf_*") "BOGENAUF")
|
||
((wcmatch bname "Vario_Bogen_ab_*") "BOGENAB")
|
||
((wcmatch bname "Staustrecke_SP_1000_mm*") "STRECKE")
|
||
((wcmatch bname "Staustrecke_Separator_SP_300_mm*") "SEP")
|
||
(t "UNBEKANNT")
|
||
)
|
||
)
|
||
|
||
;; Gemessene Neigung (Grad, positiv=abwaerts wie frame->hz-winkel) zwischen
|
||
;; zwei Welt-Punkten.
|
||
(defun vfl-kette-neigung (ein aus / dx dy dz horiz)
|
||
(setq dx (- (car aus) (car ein)) dy (- (cadr aus) (cadr ein)) dz (- (caddr aus) (caddr ein)))
|
||
(setq horiz (sqrt (+ (* dx dx) (* dy dy))))
|
||
(if (> horiz 1e-6) (* (atan (- dz) horiz) (/ 180.0 pi)) 0.0)
|
||
)
|
||
(defun vfl-kette-round (x) (atoi (rtos x 2 0)))
|
||
|
||
;; Attribut-Wert auf "" erzwingen. ssg-attrib-set-on ueberspringt leere Werte
|
||
;; bewusst als "keine Ueberschreibung" (ATTDEF-Default bleibt stehen) - hier
|
||
;; soll das Feld aber ABSICHTLICH geleert werden (z.B. SEITE_AS/SEITE_ES,
|
||
;; wenn die Kette kein AS-/ES-Element hat und der ATTDEF-Default "rechts"
|
||
;; sonst faelschlich stehen bliebe).
|
||
(defun vfl-kette-attrib-leeren (ent tag / obj ed typ etag)
|
||
(setq obj (entnext ent))
|
||
(while obj
|
||
(setq ed (entget obj))
|
||
(setq typ (cdr (assoc 0 ed)))
|
||
(if (equal typ "SEQEND")
|
||
(setq obj nil)
|
||
(progn
|
||
(if (and (equal typ "ATTRIB") (equal (cdr (assoc 2 ed)) tag))
|
||
(progn (entmod (subst (cons 1 "") (assoc 1 ed) ed)) (entupd obj)))
|
||
(setq obj (entnext obj))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; KS_EIN/KS_AUS-URSPRUNGSPUNKTE (Welt-Koordinaten, keine Richtung) eines
|
||
;; Bausteins ermitteln - robust gegen NICHT-UNIFORME Skalierung (z.B.
|
||
;; Staustrecke_SP_1000_mm, das per insert-inclined-scaled-block auf die
|
||
;; reale Segmentlaenge gestreckt wird). extract-ks-from-block-raw
|
||
;; (vf_core.lsp) klassifiziert die 3 Achslinien im KS-Sub-Block ueber ihre
|
||
;; ABSOLUTE LAENGE (ks-line-axis, feste Baender ~1/~100 Einheiten) - wird die
|
||
;; Fahrtrichtungs-Achslinie mitgestreckt, faellt sie aus diesem Raster und
|
||
;; die Extraktion schlaegt still fehl (empirisch bestaetigt: bei den meisten
|
||
;; Staustrecke-Instanzen "KS_EIN/KS_AUS FEHLT"). Uebernimmt daher die in
|
||
;; ks_segmente.lsp (kseg-collect-lose) bereits bewaehrte Methode: an einer
|
||
;; KOPIE die Skalierung auf 1:1:1 zuruecksetzen (Marker wieder nominal lang,
|
||
;; Extraktion funktioniert normal), KS_EIN/KS_AUS dort lesen, danach den
|
||
;; KS_AUS-Versatz mit dem echten XScaleFactor zurueckrechnen (die Streckung
|
||
;; wirkt lokal rein auf der Block-X-Achse/Docking-Richtung; nach Rotation ins
|
||
;; Weltsystem hat der Versatzvektor i.A. X-/Y-/Z-Anteile, die Streckung wirkt
|
||
;; aber auf alle drei mit demselben Faktor sx - Y/Z-Skalierung bleibt bei
|
||
;; dieser Teilefamilie immer 1.0). Kopie wird sofort wieder geloescht -
|
||
;; block-obj selbst bleibt unveraendert.
|
||
;; Rueckgabe: (("KS_EIN" . punkt) ("KS_AUS" . punkt)) - je nur wenn gefunden.
|
||
(defun vfl-kette-ks-ursprung (block-obj / sx copyobj ksdata kez kaz ergebnis)
|
||
(setq sx (vla-get-XScaleFactor block-obj))
|
||
(setq copyobj (vla-Copy block-obj))
|
||
(vla-put-XScaleFactor copyobj 1.0)
|
||
(vla-put-YScaleFactor copyobj 1.0)
|
||
(vla-put-ZScaleFactor copyobj 1.0)
|
||
(setq ksdata (extract-ks-from-block-raw copyobj))
|
||
(if (not (vlax-erased-p copyobj)) (vl-catch-all-apply 'vla-Delete (list copyobj)))
|
||
(setq kez (if (assoc "KS_EIN" ksdata) (car (cadr (assoc "KS_EIN" ksdata))) nil))
|
||
(setq kaz (if (assoc "KS_AUS" ksdata) (car (cadr (assoc "KS_AUS" ksdata))) nil))
|
||
(if (and kez kaz (/= sx 1.0))
|
||
(setq kaz (list
|
||
(+ (car kez) (* sx (- (car kaz) (car kez))))
|
||
(+ (cadr kez) (* sx (- (cadr kaz) (cadr kez))))
|
||
(+ (caddr kez) (* sx (- (caddr kaz) (caddr kez))))
|
||
))
|
||
)
|
||
(setq ergebnis '())
|
||
(if kez (setq ergebnis (cons (cons "KS_EIN" kez) ergebnis)))
|
||
(if kaz (setq ergebnis (cons (cons "KS_AUS" kaz) ergebnis)))
|
||
ergebnis
|
||
)
|
||
|
||
;; Alle Vario-Kette-Bausteine der Zeichnung einsammeln (lose Einzelteile UND
|
||
;; die Sub-Elemente bereits gewickelter VF_n - siehe vfl-kette-typ). Ein
|
||
;; angetroffener VF_n-Wrapper wird SOFORT (temporaer) in seine Sub-Elemente
|
||
;; aufgeloest und JEDES Sub-Element als eigener Datensatz mit direkt lesbarem
|
||
;; KS_EIN/KS_AUS erfasst - keine "welcher Punkt hat kein Gegenstueck"-
|
||
;; Heuristik fuer einen Gesamt-Punkt mehr noetig (die schlug bei langen
|
||
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl, siehe
|
||
;; [[project_vario_kette_merge]]). Die Kettenverfolgung faedelt die
|
||
;; Sub-Elemente danach ueber ihre echten KS-Punkte in der richtigen
|
||
;; Reihenfolge auf - unabhaengig von der Explode-Reihenfolge.
|
||
;; ename = nil fuer ein Sub-Element eines Wrappers (die temporaere
|
||
;; Explode-Kopie wurde bereits wieder geloescht); wrapper-ename identifiziert
|
||
;; in diesem Fall den ORIGINAL-Wrapper (fuer den finalen Merge-Schritt).
|
||
;; Rueckgabe: Liste von (ename bname ein aus wrapper-ename).
|
||
(defun vfl-kette-sammle-alle ( / ss i ename bname typ obj kinder kind
|
||
sub-ks child-bname child-ks records)
|
||
(setq records '())
|
||
(setq ss (ssget "X" '((0 . "INSERT"))))
|
||
(if ss
|
||
(progn
|
||
(setq i 0)
|
||
(while (< i (sslength ss))
|
||
(setq ename (ssname ss i))
|
||
(setq bname (cdr (assoc 2 (entget ename))))
|
||
(setq typ (vfl-kette-typ bname))
|
||
(cond
|
||
((= typ "WRAPPER")
|
||
(setq obj (vlax-ename->vla-object ename))
|
||
(setq kinder (vlax-invoke obj 'Explode))
|
||
(foreach kind kinder
|
||
(if (and (not (vlax-erased-p kind))
|
||
(= (vla-get-ObjectName kind) "AcDbBlockReference"))
|
||
(progn
|
||
(setq child-bname (vla-get-Name kind))
|
||
(setq child-ks (vfl-kette-ks-ursprung kind))
|
||
(setq records
|
||
(cons (list nil child-bname
|
||
(cdr (assoc "KS_EIN" child-ks))
|
||
(cdr (assoc "KS_AUS" child-ks))
|
||
ename)
|
||
records))
|
||
)
|
||
)
|
||
)
|
||
(foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind)))
|
||
)
|
||
((/= typ "UNBEKANNT")
|
||
(setq obj (vlax-ename->vla-object ename))
|
||
(setq sub-ks (vfl-kette-ks-ursprung obj))
|
||
(setq records
|
||
(cons (list ename bname
|
||
(cdr (assoc "KS_EIN" sub-ks))
|
||
(cdr (assoc "KS_AUS" sub-ks))
|
||
nil)
|
||
records))
|
||
)
|
||
)
|
||
(setq i (1+ i))
|
||
)
|
||
)
|
||
)
|
||
records
|
||
)
|
||
|
||
;; Naechsten Datensatz in rest-liste suchen, dessen KS_EIN am naechsten am
|
||
;; gegebenen KS_AUS-Punkt liegt. Rueckgabe: (rec . abstand) oder nil.
|
||
(defun vfl-kette-naechster (aus-punkt rest-liste / rec bester bester-d d)
|
||
(setq bester nil bester-d nil)
|
||
(foreach rec rest-liste
|
||
(if (vfl-kette-rec-ein rec)
|
||
(progn
|
||
(setq d (distance aus-punkt (vfl-kette-rec-ein rec)))
|
||
(if (or (null bester-d) (< d bester-d))
|
||
(progn (setq bester rec) (setq bester-d d)))
|
||
)
|
||
)
|
||
)
|
||
(if bester (cons bester bester-d) nil)
|
||
)
|
||
|
||
;; Kette ab start-rec NUR VORWAERTS verfolgen. Rueckgabe: (list kette warnung)
|
||
;; kette = Liste der Datensaetze in Ketten-Reihenfolge (mind. start-rec)
|
||
;; warnung = (letzter-bname kandidat-bname abstand) wenn eine Luecke im
|
||
;; tol-weit-Band gefunden wurde, sonst nil.
|
||
;; letzter-fund = (rec . abstand) des zuletzt geprueften (aber verworfenen)
|
||
;; Kandidaten - Diagnose-Hilfe, wenn die Kette bei Laenge 1
|
||
;; endet (dann kein warnung, aber evtl. trotzdem ein Fund
|
||
;; ausserhalb von tol-weit).
|
||
;; verdaechtig = Liste (vorgaenger-bname naechster-bname abstand) fuer jeden
|
||
;; Anschluss, dessen Abstand > 0.5mm war - eine echte, absichtlich
|
||
;; gebaute KS-zu-KS-Verbindung sollte praktisch bei 0mm liegen;
|
||
;; ein spuerbarer (aber noch innerhalb tol-eng liegender)
|
||
;; Abstand deutet auf eine ZUFAELLIG nahe, aber NICHT wirklich
|
||
;; zusammengehoerige Stelle hin (z.B. zwei unabhaengige Linien,
|
||
;; die im Layout nahe beieinander liegen/sich kreuzen).
|
||
(defun vfl-kette-verfolgen (start-rec alle-records / rest kette aktuell fund fertig warnung letzter-fund verdaechtig)
|
||
(setq rest (vl-remove start-rec alle-records))
|
||
(setq kette (list start-rec))
|
||
(setq aktuell start-rec)
|
||
(setq warnung nil)
|
||
(setq letzter-fund nil)
|
||
(setq verdaechtig '())
|
||
(setq fertig nil)
|
||
(while (not fertig)
|
||
(setq fund (vfl-kette-naechster (vfl-kette-rec-aus aktuell) rest))
|
||
(setq letzter-fund fund)
|
||
(cond
|
||
((null fund) (setq fertig T))
|
||
((<= (cdr fund) *vfl-kette-tol-eng*)
|
||
(if (> (cdr fund) 0.5)
|
||
(setq verdaechtig (cons (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)) verdaechtig)))
|
||
(setq aktuell (car fund))
|
||
(setq kette (append kette (list aktuell)))
|
||
(setq rest (vl-remove aktuell rest))
|
||
(setq letzter-fund nil)
|
||
)
|
||
((<= (cdr fund) *vfl-kette-tol-weit*)
|
||
(setq warnung (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)))
|
||
(setq fertig T)
|
||
)
|
||
(t (setq fertig T))
|
||
)
|
||
)
|
||
(list kette warnung letzter-fund verdaechtig)
|
||
)
|
||
|
||
;; Attribute des neuen Gesamt-Blocks aus der gefundenen Bausteinfolge
|
||
;; herleiten: dieselben Akkumulatoren (vfl-acc-*) wie beim interaktiven Bau,
|
||
;; hier rueckwirkend anhand der Bausteinfolge gefuellt statt waehrend des
|
||
;; Bauens. Sub-Elemente eines bereits gewickelten VF_n wurden beim Erfassen
|
||
;; (vfl-kette-sammle-alle) bereits aufgeloest und durchlaufen hier dieselbe
|
||
;; Typ-Klassifikation wie von Anfang an lose Bauteile - lose Einzelteile und
|
||
;; fertige VF_n lassen sich dadurch beliebig mischen. chain-start/chain-end =
|
||
;; Gesamt-KS_EIN/KS_AUS der ganzen Kette (Welt-Z liefert Hoehe-von/-bis
|
||
;; direkt, kein erneutes Auslesen noetig).
|
||
;; Rueckgabe: (list attribut-alist typ-str).
|
||
(defun vfl-kette-baue-attribute (kette neuer-bname chain-start chain-end /
|
||
rec typ bname anzahl-vf phase entry-info gemessen betrag richtung
|
||
as-seite es-seite delta-l erster letzter ergebnis typ-str)
|
||
(vfl-acc-reset)
|
||
(setq anzahl-vf 0)
|
||
(setq phase "gf")
|
||
(setq entry-info nil)
|
||
(setq delta-l 0.0)
|
||
;; Leer (nicht "rechts") als Default: falls die Kette (Ausnahmefall) ohne
|
||
;; eigenes AS-/ES-Element beginnt/endet, soll das im Attribut auch als
|
||
;; "keins vorhanden" erkennbar bleiben statt eine falsche Seite vorzutaeuschen.
|
||
(setq as-seite "" es-seite "")
|
||
(setq erster (car kette))
|
||
(setq letzter (car (reverse kette)))
|
||
|
||
(foreach rec kette
|
||
(setq bname (vfl-kette-rec-bname rec))
|
||
(setq typ (vfl-kette-typ bname))
|
||
(if (and (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))
|
||
(setq delta-l (+ delta-l (distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec)))))
|
||
|
||
(cond
|
||
;; Wrapper-Records gibt es nicht mehr - ein angetroffener VF_n wurde
|
||
;; bereits beim Erfassen (vfl-kette-sammle-alle) in seine Sub-Elemente
|
||
;; aufgeloest; jedes davon durchlaeuft hier dieselbe Typ-Klassifikation
|
||
;; wie ein von Anfang an loses Bauteil.
|
||
((= typ "AS")
|
||
(if (equal rec erster) (setq as-seite (vfl-kette-teil bname 3))))
|
||
|
||
((= typ "ES")
|
||
(if (equal rec letzter) (setq es-seite (vfl-kette-teil bname 3))))
|
||
|
||
((= typ "GFBOGEN")
|
||
;; Gefaellebogen_<seite>_<winkel>_R500
|
||
(setq *vfl-acc-gfbogen*
|
||
(vfl-inc-count *vfl-acc-gfbogen*
|
||
(strcat (if (= (vfl-kette-teil bname 1) "rechts") "R" "L") "_" (vfl-kette-teil bname 2)))))
|
||
|
||
((= typ "KURVE")
|
||
;; Vario_Kurve_<seite>_<winkel>_TEF_<variante>
|
||
(setq *vfl-acc-variokurve*
|
||
(vfl-inc-count *vfl-acc-variokurve*
|
||
(strcat (if (= (vfl-kette-teil bname 5) "aussen") "A" "I") "_" (vfl-kette-teil bname 3)))))
|
||
|
||
((= typ "UMLENK")
|
||
(setq phase "vf")
|
||
(setq anzahl-vf (1+ anzahl-vf))
|
||
(setq entry-info nil))
|
||
|
||
((= typ "MOTOR")
|
||
;; Vario_Motorstation_500mm_<seite>
|
||
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list (vfl-kette-teil bname 3))))
|
||
(setq phase "gf")
|
||
(setq entry-info nil))
|
||
|
||
((or (= typ "BOGENAUF") (= typ "BOGENAB"))
|
||
(if (null entry-info)
|
||
(setq entry-info rec) ; erster Bogen des Koerper-Tripels
|
||
(progn
|
||
;; Zweiter Bogen schliesst das Tripel. Neigung/Richtung ueber die
|
||
;; ECHTE Geometrie messen (Anfang des ersten bis Ende des zweiten
|
||
;; Bogens) - die Blocknamen allein sind fuer den 3-Grad/horizontal-
|
||
;; Fall mehrdeutig (beide nutzen "auf_3"/"ab_3", vfs-vf-koerper).
|
||
(setq gemessen (vfl-kette-neigung (vfl-kette-rec-ein entry-info) (vfl-kette-rec-aus rec)))
|
||
(setq betrag (vfl-kette-round (abs gemessen)))
|
||
(setq richtung (if (< gemessen 0.0) "Auf" "Ab"))
|
||
(vfl-acc-vf-seg richtung betrag
|
||
(distance (vfl-kette-rec-aus entry-info) (vfl-kette-rec-ein rec)))
|
||
(setq entry-info nil)
|
||
)
|
||
)
|
||
)
|
||
|
||
((= typ "STRECKE")
|
||
(if (= phase "gf")
|
||
(vfl-acc-gf-seg
|
||
(distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))
|
||
(abs (vfl-kette-neigung (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))))
|
||
;; Innerhalb eines Koerper-Tripels traegt das Zwischenstueck selbst
|
||
;; nichts direkt bei - Laenge/Neigung werden beim schliessenden
|
||
;; Bogen (s.o.) aus der Gesamtspanne des Tripels gemessen.
|
||
)
|
||
)
|
||
|
||
((= typ "SEP")
|
||
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*)))
|
||
)
|
||
)
|
||
|
||
(setq typ-str
|
||
(if (or (> anzahl-vf 0) (> (length *vfl-acc-lgf*) 1)
|
||
(> (length *vfl-acc-gfbogen*) 0) (> (length *vfl-acc-variokurve*) 0))
|
||
"Streckengruppe" "Gefaellestrecke"))
|
||
|
||
(setq ergebnis
|
||
(list
|
||
(cons "Bezeichnung" neuer-bname)
|
||
(cons "ARTINR" "6220")
|
||
(cons "MONTAGEHOEHE_m" (rtos (/ (+ (caddr chain-start) (caddr chain-end)) 2000.0) 2 3))
|
||
(cons "HOEHE_VON_mm" (itoa (fix (caddr chain-start))))
|
||
(cons "HOEHE_BIS_mm" (itoa (fix (caddr chain-end))))
|
||
(cons "DELTA_H_mm" (itoa (fix (abs (- (caddr chain-end) (caddr chain-start))))))
|
||
(cons "DELTA_L_mm" (itoa (fix delta-l)))
|
||
(cons "TYP" typ-str)
|
||
(cons "SEITE_AS" as-seite)
|
||
(cons "SEITE_ES" es-seite)
|
||
(cons "ANZAHL_GF" (itoa (length *vfl-acc-lgf*)))
|
||
(cons "L_GF_m" (vfl-join-komma *vfl-acc-lgf*))
|
||
(cons "GF_WINKEL" (vfl-join-komma *vfl-acc-gfwinkel*))
|
||
(cons "GF_Bogen_L_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_90")))
|
||
(cons "GF_Bogen_L_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_60")))
|
||
(cons "GF_Bogen_L_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_30")))
|
||
(cons "GF_Bogen_R_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_90")))
|
||
(cons "GF_Bogen_R_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_60")))
|
||
(cons "GF_Bogen_R_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_30")))
|
||
(cons "ANZAHL_VF" (itoa anzahl-vf))
|
||
(cons "MOTORSEITE" (vfl-join-komma *vfl-acc-motorseite*))
|
||
(cons "L_VF_m" (vfl-join-komma *vfl-acc-lvf*))
|
||
(cons "ANTRIEBFAHRTRICHTUNG" (vfl-join-komma *vfl-acc-richtung*))
|
||
(cons "VF_WINKEL" (vfl-join-komma *vfl-acc-winkel*))
|
||
(cons "VF_Bogen_A_90" (itoa (vfl-get-count *vfl-acc-variokurve* "A_90")))
|
||
(cons "VF_Bogen_A_60" (itoa (vfl-get-count *vfl-acc-variokurve* "A_60")))
|
||
(cons "VF_Bogen_A_30" (itoa (vfl-get-count *vfl-acc-variokurve* "A_30")))
|
||
(cons "VF_Bogen_I_90" (itoa (vfl-get-count *vfl-acc-variokurve* "I_90")))
|
||
(cons "VF_Bogen_I_60" (itoa (vfl-get-count *vfl-acc-variokurve* "I_60")))
|
||
(cons "VF_Bogen_I_30" (itoa (vfl-get-count *vfl-acc-variokurve* "I_30")))
|
||
(cons "ANZAHL_SEPARATOR" (itoa *vfl-acc-separator*))
|
||
)
|
||
)
|
||
(list ergebnis typ-str)
|
||
)
|
||
|
||
(defun c:Vario_Kette_Merge ( / sel start-ename start-bname alle-records start-rec
|
||
start-obj start-ins kandidaten bester-d d r
|
||
lauf kette warnung naechster-fund merge-ss leaf-enames aufgeloeste-wrapper
|
||
chain-start chain-end neuer-bname
|
||
rec kinder kind erg aggregiert typ-str neuer-insert def
|
||
leaf-ename leaf-obj leaf-noch-da verdaechtig v)
|
||
(ssg-start "Vario_Kette_Merge" nil)
|
||
(princ (ssg-text "vfl-kette-titel"))
|
||
(setq sel (entsel (ssg-text "vfl-kette-start-waehlen")))
|
||
(if (null sel)
|
||
(progn (princ (ssg-text "vfl-kette-kein-objekt")) (ssg-end) (exit)))
|
||
(setq start-ename (car sel))
|
||
(setq start-bname (cdr (assoc 2 (entget start-ename))))
|
||
(if (= (vfl-kette-typ (if start-bname start-bname "")) "UNBEKANNT")
|
||
(progn
|
||
(princ (ssg-textf "vfl-kette-kein-vf-block" (list (if start-bname start-bname "?"))))
|
||
(ssg-end) (exit)))
|
||
|
||
(setq alle-records (vfl-kette-sammle-alle))
|
||
|
||
(setq start-rec nil)
|
||
(foreach rec alle-records (if (equal (vfl-kette-rec-ename rec) start-ename) (setq start-rec rec)))
|
||
(if (and (null start-rec) (= (vfl-kette-typ start-bname) "WRAPPER"))
|
||
(progn
|
||
;; Nutzer hat einen VF_n-Wrapper direkt gewaehlt - der wurde beim
|
||
;; Erfassen bereits in seine Sub-Elemente aufgeloest (keins davon
|
||
;; traegt mehr diesen ename). Das Sub-Element mit KS_EIN am naechsten
|
||
;; zum InsertionPoint des Wrappers gilt als dessen Kettenanfang - das
|
||
;; ist per Bauart (ssg-block-wrap-welt bekommt immer den Kettenanfang
|
||
;; als Basispunkt) exakt der richtige Punkt.
|
||
(setq start-obj (vlax-ename->vla-object start-ename))
|
||
(setq start-ins (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint start-obj))))
|
||
(setq kandidaten (vl-remove-if-not
|
||
(function (lambda (r) (and (equal (vfl-kette-rec-wrapper r) start-ename) (vfl-kette-rec-ein r))))
|
||
alle-records))
|
||
(setq bester-d nil)
|
||
(foreach r kandidaten
|
||
(setq d (distance start-ins (vfl-kette-rec-ein r)))
|
||
(if (or (null bester-d) (< d bester-d)) (progn (setq start-rec r) (setq bester-d d)))
|
||
)
|
||
)
|
||
)
|
||
(if (null start-rec)
|
||
(progn
|
||
(princ (ssg-textf "vfl-kette-start-nicht-gefunden-diag"
|
||
(list (itoa (length alle-records)) (if start-bname start-bname "?")
|
||
(itoa (length (vl-remove-if-not
|
||
(function (lambda (r) (equal (vfl-kette-rec-bname r) start-bname)))
|
||
alle-records))))))
|
||
(ssg-end) (exit)))
|
||
(if (null (vfl-kette-rec-ein start-rec))
|
||
(progn (princ (ssg-text "vfl-kette-start-ohne-ks-ein")) (ssg-end) (exit)))
|
||
|
||
(setq lauf (vfl-kette-verfolgen start-rec alle-records))
|
||
(setq kette (car lauf))
|
||
(setq warnung (cadr lauf))
|
||
(setq naechster-fund (caddr lauf))
|
||
(setq verdaechtig (nth 3 lauf))
|
||
|
||
(if (< (length kette) 2)
|
||
(progn
|
||
(princ (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)))))
|
||
;; DIAGNOSE: Anschluesse mit spuerbarem (>0.5mm), aber noch innerhalb
|
||
;; tol-eng liegendem Abstand - Verdacht auf zufaellig nahe, aber nicht
|
||
;; wirklich zusammengehoerige Bauteile (z.B. zwei unabhaengige Linien, die
|
||
;; im Layout nahe beieinander liegen).
|
||
(if verdaechtig
|
||
(foreach v verdaechtig
|
||
(princ (strcat "\n [Diagnose] VERDAECHTIG: '" (car v) "' -> '" (cadr v)
|
||
"' Abstand=" (rtos (caddr v) 2 3) " mm (innerhalb Toleranz, aber nicht ~0)")))
|
||
)
|
||
|
||
;; Attribute aus der Bausteinfolge herleiten, bevor irgendetwas an der
|
||
;; Zeichnung veraendert wird (chain-start/chain-end kommen aus dem ersten/
|
||
;; letzten Datensatz in kette).
|
||
(setq neuer-bname (strcat "VF_" (itoa (vf-next-number))))
|
||
(setq chain-start (vfl-kette-rec-ein (car kette)))
|
||
(setq chain-end (vfl-kette-rec-aus (car (reverse kette))))
|
||
(setq erg (vfl-kette-baue-attribute kette neuer-bname chain-start chain-end))
|
||
(setq aggregiert (car erg))
|
||
(setq typ-str (cadr erg))
|
||
|
||
;; Aufgeloeste Wrapper-Sub-Elemente: der ORIGINAL-Wrapper wird (einmal je
|
||
;; distinktem wrapper-ename, da er i.d.R. mehrere Sub-Element-Datensaetze
|
||
;; in kette beisteuert) jetzt fuer REAL explodiert - Sub-Elemente bleiben
|
||
;; als Bloecke erhalten, ATTRIB-Textreste werden verworfen, Original
|
||
;; geloescht. Lose Einzel-Bausteine werden unveraendert direkt uebernommen (_.-BLOCK
|
||
;; unten SOLLTE sie beim Wickeln konsumieren, wie bei frisch gebauter
|
||
;; Geometrie - leaf-enames wird trotzdem mitgefuehrt, um sie nach dem
|
||
;; Wickeln sicherheitshalber explizit zu entfernen, falls _.-BLOCK sie aus
|
||
;; irgendeinem Grund NICHT aus dem Modellraum nimmt (doppelte/ueberlappende
|
||
;; Geometrie waere sonst die Folge).
|
||
(setq merge-ss (ssadd))
|
||
(setq leaf-enames '())
|
||
(setq aufgeloeste-wrapper '())
|
||
(foreach rec kette
|
||
(if (vfl-kette-rec-wrapper rec)
|
||
(if (not (member (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
|
||
(progn
|
||
(setq aufgeloeste-wrapper (cons (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
|
||
(setq kinder (vlax-invoke (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)) 'Explode))
|
||
(foreach kind kinder
|
||
(if (not (vlax-erased-p kind))
|
||
(if (= (vla-get-ObjectName kind) "AcDbBlockReference")
|
||
(ssadd (vlax-vla-object->ename kind) merge-ss)
|
||
(vla-Delete kind)
|
||
)
|
||
)
|
||
)
|
||
(vla-Delete (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)))
|
||
)
|
||
)
|
||
(progn
|
||
(setq leaf-enames (cons (vfl-kette-rec-ename rec) leaf-enames))
|
||
(ssadd (vfl-kette-rec-ename rec) merge-ss)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Frische ATTDEFs am Kettenanfang (wie vfl-block-erstellen), neu wickeln.
|
||
(foreach def (ssg-strecke-attrib-defs typ-str)
|
||
(entmake
|
||
(list '(0 . "ATTDEF")
|
||
(cons 10 chain-start)
|
||
(cons 11 chain-start)
|
||
'(40 . 50.0)
|
||
(cons 1 (cadr def))
|
||
(cons 2 (car def))
|
||
(cons 3 (car def))
|
||
'(70 . 1)
|
||
'(72 . 0)
|
||
'(74 . 0)))
|
||
(ssadd (entlast) merge-ss)
|
||
)
|
||
(setq neuer-insert (ssg-block-wrap-welt neuer-bname chain-start merge-ss))
|
||
(ssg-attrib-set-on neuer-insert aggregiert)
|
||
;; SEITE_AS/SEITE_ES explizit leeren, wenn die Kette (Ausnahmefall) ohne
|
||
;; eigenes AS-/ES-Element beginnt/endet - ssg-attrib-set-on wuerde einen
|
||
;; leeren Wert sonst als "keine Ueberschreibung" behandeln und den
|
||
;; ATTDEF-Default "rechts" faelschlich stehen lassen.
|
||
(if (= (cdr (assoc "SEITE_AS" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_AS"))
|
||
(if (= (cdr (assoc "SEITE_ES" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_ES"))
|
||
(if (car (atoms-family 1 '("SSG-ID-GENERATE"))) (ssg-id-generate neuer-insert))
|
||
|
||
;; Sicherheitsnetz: lose Einzelteile, die _.-BLOCK aus irgendeinem Grund NICHT
|
||
;; aus dem Modellraum entfernt hat, jetzt explizit loeschen - verhindert
|
||
;; doppelte/ueberlappende Geometrie (altes Original + neuer Gesamt-Block).
|
||
(setq leaf-noch-da 0)
|
||
(foreach leaf-ename leaf-enames
|
||
(setq leaf-obj (vl-catch-all-apply 'vlax-ename->vla-object (list leaf-ename)))
|
||
(if (and (not (vl-catch-all-error-p leaf-obj)) leaf-obj (not (vlax-erased-p leaf-obj)))
|
||
(progn
|
||
(setq leaf-noch-da (1+ leaf-noch-da))
|
||
(vla-Delete leaf-obj)
|
||
)
|
||
)
|
||
)
|
||
(if (> leaf-noch-da 0)
|
||
(princ (strcat "\n [Diagnose] " (itoa leaf-noch-da)
|
||
" lose Einzelteil(e) waren nach _.-BLOCK noch im Modellraum vorhanden - jetzt nachtraeglich entfernt.")))
|
||
|
||
(princ (ssg-textf "vfl-kette-fertig" (list neuer-bname (itoa (length kette)))))
|
||
(ssg-end)
|
||
(princ)
|
||
)
|
||
|
||
(vf-typ-registrieren
|
||
"linienzug"
|
||
'vfl-berechne-platzhalter
|
||
'vfl-einfuege-platzhalter
|
||
"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)
|