Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d7cb17f53fe8b87a92bd0f23a1977120eff3f7b6
dxfmakros/Lisp/vf_linienzug.lsp
T
m.stangl d7cb17f53f vf_*.lsp: verbleibende deutsche Meldungen auf ssg-text/ssg-textf umgestellt 
Betrifft VarioFoerderer-Kern, Standard-/Etage-Aufbau und Linienzug (inkl.
altem Vorwaerts-Nachbau-Modus und Vario_Kette_Merge-Diagnose). Neue Keys in
lang/de_DE.json und lang/en_GB.json ergaenzt.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-08-25 23:34:32 +02:00

3731 lines
185 KiB
Common Lisp
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;; ============================================================
;; VF_LINIENZUG - Gemischte Gefaellestrecke/VarioFoerderer-Kette
;; Typ "linienzug" fuer VarioFoerderer (3. Typ neben "standard"/"etage")
;; ============================================================
;; Kette: immer genau EIN AS_Element am Anfang, genau EIN ES_Element am Ende,
;; dazwischen beliebig viele Segmente. Jedes gerade Segment wird automatisch
;; klassifiziert:
;; - Endpunkt hoeher als Startpunkt -> immer VF (Gefaelle kann nicht steigen,
;; reine Schwerkraftstrecke)
;; - Endpunkt tiefer, Neigung >= 3 Grad -> reine Gefaellestrecke (GF), da 3
;; Grad im ganzen Projekt die kleinste
;; Neigung ist (Vario_Bogen_auf/ab_3)
;; - Endpunkt tiefer, Neigung < 3 Grad -> VF (zu flach fuer reine GF):
;; erst Horizontale Mitte pruefen
;; (berechne-horizontale-mitte), sonst
;; diskreten Winkel 3-51 Grad suchen
;; (berechne-alle-winkel)
;; Nach einem GF-Segment: naechstes Element nur GF-Bogen oder neue Linie.
;; Nach einem VF-Segment: naechstes Element nur Vario-Kurve oder neue Linie.
;;
;; Architektur-Entscheidung (mit Nutzer abgestimmt): eigener Befehlsablauf,
;; NICHT ueber die berechne-fn/einfuege-fn-Registry (die ist fuer ein einzelnes
;; durchgehendes Segment gedacht, nicht fuer eine interaktive Mehrsegment-Kette).
;; c:VarioFoerderer erkennt den Typ "linienzug" und dispatcht direkt hierher.
;;
;; BEKANNTE EINSCHRAENKUNGEN dieser ersten Version (bitte in BricsCAD pruefen):
;; - Vario_Kurve_*-Bloecke (data/ils/3D/) wurden bislang nirgends im Projekt
;; verwendet. Ob sie KS_EIN/KS_AUS enthalten (Voraussetzung fuer
;; insert-block-ks-to-ks) ist ungeklaert und muss beim ersten Testlauf
;; verifiziert werden.
;; - Am Uebergang GF-Segment -> VF-Segment (ueber "neue Linie", die
;; automatisch als VF eingestuft wird) kann ein sichtbarer Knick entstehen:
;; vfs-mitte-teil beginnt sein erstes Element (GF1) immer fest bei 3 Grad,
;; unabhaengig vom Neigungswinkel des vorangehenden GF-Segments.
;; - Die Fusspunkte von AS-/ES-Element (aus-dx/dz bzw. ein-dx/dz) werden vom
;; Erst- bzw. Letzt-Segment abgezogen (vfl-as-deltaL/H-korrigiert bzw. die
;; Separator+ES-Reservierung im Kettenende-Modus), damit der gepickte
;; Endpunkt vom gebauten GF/VF-Koerper exakt getroffen wird.
;; ============================================================
;; Attribut-Definitionen fuer den Linienzug-Block kommen aus dem gemeinsamen
;; Strecken-Schema in ssg_core.lsp (ssg-strecke-attrib-defs). Der TYP wird zur
;; Laufzeit bestimmt: einsegmentige GF ohne Bogen -> "Gefaellestrecke"
;; (reduziert), sonst -> "Streckengruppe" (voll, segmentweise Werte).
;; Toleranzband (Grad) um die feste 3-Grad-Neigung: liegt der natuerliche
;; Winkel eines fallenden Segments innerhalb 3+/-Toleranz, wird es als reine
;; 3-Grad-Gefaellestrecke gebaut. Steiler -> VF-ab, flacher -> VF (flach).
;; Grund: eine reine Gefaellestrecke ist nie steiler als 3 Grad.
;; Bei Bedarf empirisch anpassen.
(if (null *vfl-gf-winkel-toleranz*) (setq *vfl-gf-winkel-toleranz* 0.5))
;; Mindestlaenge (mm) fuer die 3-Grad-Gefaellestrecke GF1 am Einlauf (zwischen
;; AS und Umlenkstation). Im Linienzug sitzt die gesamte Staustrecke am Einlauf
;; (GF1 = komplettes L_GF), GF2 am Ausgang entfaellt. Faellt das berechnete
;; L_GF darunter, wird GF1 auf diesen Wert angehoben - damit der 3-Grad-
;; Anschluss immer physisch vorhanden ist.
(if (null *vfl-gf-min-laenge*) (setq *vfl-gf-min-laenge* 400.0))
;; Horizontales Budget der festen Elemente im Linienzug-VF:
;; Umlenkstation (500) + Motorstation (500) + EIN Separator am Einlauf (300)
;; = 1300 mm. Der Ausgangs-Separator entfaellt (anders als Standard-VF=1600).
(if (null *vfl-feste-horizontal*) (setq *vfl-feste-horizontal* 1300.0))
;; ============================================================
;; TEIL 0: ATTRIBUT-AKKUMULATOREN (werden waehrend des Baus gefuellt)
;; ============================================================
;; Segment-Listen werden in Bau-Reihenfolge angehaengt und spaeter
;; kommagetrennt in die Attribute geschrieben. Bogen-/Kurven-Zaehler als Alist.
(defun vfl-acc-reset ()
(setq *vfl-acc-lvf* '() ; L_VF je VF-Sub-Segment (m, String)
*vfl-acc-lgf* '() ; L_GF je GF-Segment (m, String) - inkl. GF1/GF2
*vfl-acc-gfwinkel* '() ; Neigungswinkel je GF-Segment (String, parallel zu lgf)
*vfl-acc-richtung* '() ; "Auf"/"Ab"/"horizontal" je VF-Sub-Segment
*vfl-acc-winkel* '() ; Winkel je VF-Sub-Segment (String, 0=horizontal)
*vfl-acc-motorseite* '() ; Seite ("rechts"/"links") je Motorstation
*vfl-acc-gfbogen* '() ; Alist ("L_90".n ...) GF-Boegen
*vfl-acc-variokurve* '() ; Alist ("A_90".n ...) Vario-Kurven
*vfl-ziel-punkt* nil ; Soll-ES-Punkt fuer Option-3-Ist-Ziel-Report
*vfl-acc-separator* 0)) ; Anzahl eingefuegter Separatoren (300 mm)
;; Alist-Zaehler erhoehen / lesen
(defun vfl-inc-count (al key / e)
(setq e (assoc key al))
(if e (subst (cons key (1+ (cdr e))) e al) (cons (cons key 1) al)))
(defun vfl-get-count (al key / e)
(if (setq e (assoc key al)) (cdr e) 0))
;; Ein VF-Sub-Segment (Koerper) erfassen. Winkel 0 => horizontal.
(defun vfl-acc-vf-seg (richtung winkel L_VF)
(setq *vfl-acc-lvf* (append *vfl-acc-lvf* (list (rtos (/ L_VF 1000.0) 2 3))))
(setq *vfl-acc-winkel* (append *vfl-acc-winkel* (list (itoa (fix winkel)))))
(setq *vfl-acc-richtung* (append *vfl-acc-richtung*
(list (if (= (fix winkel) 0) "horizontal" richtung)))))
;; Ein GF-Segment erfassen (Laenge = Schraeglaenge in m, winkel = Neigung).
;; Gilt fuer reine GF-Chain-Segmente UND die VF-internen GF1/GF2-Anschluesse.
(defun vfl-acc-gf-seg (L_GF winkel)
(setq *vfl-acc-lgf* (append *vfl-acc-lgf* (list (rtos (/ L_GF 1000.0) 2 3))))
(setq *vfl-acc-gfwinkel* (append *vfl-acc-gfwinkel* (list (rtos (float winkel) 2 1)))))
;; Liste kommagetrennt verketten ("" bei leer).
(defun vfl-join-komma (lst / s first)
(setq s "" first t)
(foreach x lst
(if first (progn (setq s x) (setq first nil)) (setq s (strcat s "," x))))
s)
;; Gewaehlte AS-/ES-Winkelvariante ("30"/"90"). Vorgabe "90", solange der Modus
;; nichts anderes gesetzt hat (Blocknamen AS_Element_<winkel>_<seite>).
(defun vfl-as-winkel () (if (boundp '*vfl-as-winkel*) *vfl-as-winkel* "90"))
(defun vfl-es-winkel () (if (boundp '*vfl-es-winkel*) *vfl-es-winkel* "90"))
;; ============================================================
;; TEIL 0b: EINGABE-JOURNAL (RECORD & REPLAY)
;; ============================================================
;; Jede interaktive Eingabe im Modus-1-Aufrufbaum laeuft ueber die Wrapper
;; vfl-in-point/-string/-real/-int. Diese arbeiten in zwei Modi:
;; Record (*vfl-replay-queue* = nil): normal fragen + in *vfl-journal* anhaengen.
;; Replay (*vfl-replay-queue* gesetzt): naechsten gespeicherten Wert liefern
;; (nicht fragen) und ebenfalls in *vfl-journal* anhaengen. Laeuft die
;; Queue leer, wird ab hier wieder live gefragt (nahtloser Uebergang).
;; Weil der Builder deterministisch bzgl. seiner Eingaben ist, reproduziert das
;; Abspielen desselben Journals exakt dieselbe Kette. *vfl-journal* wird beim
;; Replay komplett neu aufgebaut (durch die erneute Ausfuehrung), die Queue ist
;; nur Lesequelle.
;;
;; Journal-Eintrag: (kind . value) mit kind aus
;; "PT" Punkt (Liste x y z) "STR" String (auch "")
;; "REAL" Realzahl "INT" Ganzzahl
;; "NIL" Abbruch/Default (value nil) "STEP" Glied-Checkpoint (value = Label)
;; *vfl-journal* wird in UMGEKEHRTER Reihenfolge gehalten (neuestes zuerst, cons).
(defun vfl-journal-reset ()
(setq *vfl-journal* '() *vfl-replay-queue* nil))
;; Eintrag anhaengen (vorn, da Reverse-Reihenfolge).
(defun vfl-journal-record (kind val)
(setq *vfl-journal* (cons (cons kind val) *vfl-journal*)))
;; Glied-Checkpoint setzen (Label spaeter via vfl-journal-steplabel setzbar).
(defun vfl-journal-mark (label)
(vfl-journal-record "STEP" label))
;; Label des JUENGSTEN STEP-Eintrags nachtraeglich setzen (der Segmenttyp steht
;; erst nach der Menue-Auswahl fest, der Marker sitzt aber am Iterationskopf).
(defun vfl-journal-steplabel (label / found)
(setq found nil)
(setq *vfl-journal*
(mapcar
(function (lambda (e)
(if (and (not found) (= (car e) "STEP"))
(progn (setq found t) (cons "STEP" label))
e)))
*vfl-journal*))
label)
;; Naechsten Eingabe-Eintrag aus der Replay-Queue poppen (STEP-Marker dabei
;; ueberspringen - die werden bei der erneuten Ausfuehrung neu erzeugt).
;; Rueckgabe: (value) als 1-elementige Liste, falls ein Eintrag da war
;; (unterscheidet einen echten nil-Wert von einer leeren Queue); nil, wenn die
;; Queue erschoepft ist (danach faellt der Wrapper auf Live-Eingabe zurueck).
(defun vfl-replay-pop ( / e)
(while (and *vfl-replay-queue* (= (car (car *vfl-replay-queue*)) "STEP"))
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*)))
(if *vfl-replay-queue*
(progn
(setq e (car *vfl-replay-queue*))
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*))
(list (cdr e)))
nil))
;; --- Eingabe-Wrapper ---
;; kind steuert nur, wie ein FRISCH live erfasster Wert typisiert wird; beim
;; Replay wird der gespeicherte Wert unveraendert durchgereicht.
(defun vfl-in-point (base prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (vfl-getpoint base prompt)))
(vfl-journal-record (if v "PT" "NIL") v)
v)
(defun vfl-in-string (prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (getstring prompt)))
;; "" (Enter) ist ein gueltiger String, kein Abbruch -> "STR".
(vfl-journal-record (if (eq (type v) 'STR) "STR" "NIL") v)
v)
(defun vfl-in-real (prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (getreal prompt)))
(vfl-journal-record (if v "REAL" "NIL") v)
v)
(defun vfl-in-int (prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (getint prompt)))
(vfl-journal-record (if v "INT" "NIL") v)
v)
;; Generischer Wrapper fuer eine Eingabe, die nicht direkt ein getXXX ist,
;; sondern das Ergebnis einer fragenden Hilfsfunktion (z.B. die gemeinsame
;; vf-frage-element-winkel). livefn ist ein aufrufbares Objekt ohne Argumente;
;; sein Rueckgabewert wird mit dem angegebenen kind journalisiert bzw. beim
;; Replay aus der Queue geliefert (livefn wird dann NICHT aufgerufen).
(defun vfl-in-value (kind livefn / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (apply livefn nil)))
(vfl-journal-record (if v kind "NIL") v)
v)
;; --- String-Hilfen (generisch, Trenner beliebig) ---
(defun vfl-strjoin (lst sep / s first)
(setq s "" first t)
(foreach x lst
(if first (progn (setq s x) (setq first nil)) (setq s (strcat s sep x))))
s)
(defun vfl-strsplit (s sep / pos out)
(setq out '())
(while (setq pos (vl-string-search sep s))
(setq out (cons (substr s 1 pos) out))
(setq s (substr s (+ pos 1 (strlen sep)))))
(reverse (cons s out)))
;; --- Serialisierung (tagged, selbstbeschreibend) ---
;; Zeilenformat "kind:payload", Eintraege per "\n" verkettet. getstring/getreal
;; liefern nie ein Newline, daher ist "\n" ein sicherer Record-Trenner.
(defun vfl-entry->string (e / k v)
(setq k (car e) v (cdr e))
(cond
((= k "PT") (strcat "PT:" (rtos (car v) 2 6) "," (rtos (cadr v) 2 6) ","
(rtos (caddr v) 2 6)))
((= k "REAL") (strcat "REAL:" (rtos v 2 6)))
((= k "INT") (strcat "INT:" (itoa v)))
((= k "STR") (strcat "STR:" v))
((= k "STEP") (strcat "STEP:" v))
(t "NIL:")))
(defun vfl-string->entry (ln / p kind pay c)
(setq p (vl-string-search ":" ln))
(if (null p)
(cons "NIL" nil)
(progn
(setq kind (substr ln 1 p) pay (substr ln (+ p 2)))
(cond
((= kind "PT")
(setq c (vfl-strsplit pay ","))
(cons "PT" (list (atof (nth 0 c)) (atof (nth 1 c)) (atof (nth 2 c)))))
((= kind "REAL") (cons "REAL" (atof pay)))
((= kind "INT") (cons "INT" (atoi pay)))
((= kind "STR") (cons "STR" pay))
((= kind "STEP") (cons "STEP" pay))
(t (cons "NIL" nil))))))
(defun vfl-journal->string ()
(vfl-strjoin (mapcar 'vfl-entry->string (reverse *vfl-journal*)) "\n"))
(defun vfl-string->journal (s / out)
(setq out '())
(foreach ln (vfl-strsplit s "\n")
(if (> (strlen ln) 0) (setq out (cons (vfl-string->entry ln) out))))
(reverse out))
;; --- Persistenz am VF_n-Block ueber die SSG_VF_EDIT-XDATA-App ---
;; Layout der 1000-Gruppen: [0]="linienzug" (Marker), [1..]=Journal-String in
;; 250-Byte-Chunks (DXF-Limit 255). Rueckwaertskompatibel zum Standard/Etage-
;; Reader vfs-xdata-lesen, der alle 1000-Werte als Liste liefert.
(defun vfl-chunk-string (s n / out len)
(setq out '())
(while (> (setq len (strlen s)) n)
(setq out (cons (substr s 1 n) out))
(setq s (substr s (1+ n))))
(if (> (strlen s) 0) (setq out (cons s out)))
(reverse out))
(defun vfl-journal-xdata-schreiben (ent / chunks appentry)
(if (null *vf-xdata-app*) (setq *vf-xdata-app* "SSG_VF_EDIT"))
(regapp *vf-xdata-app*)
(setq chunks (vfl-chunk-string (vfl-journal->string) 250))
(setq appentry
(cons *vf-xdata-app*
(cons (cons 1000 "linienzug")
(mapcar (function (lambda (c) (cons 1000 c))) chunks))))
(entmod (append (entget ent) (list (list -3 appentry))))
ent)
(defun vfl-journal-xdata-lesen (ent / xd)
(setq xd (vfs-xdata-lesen ent))
(if (and xd (= (car xd) "linienzug"))
(vfl-string->journal (apply 'strcat (cdr xd)))
nil))
;; --- Abbruch-Sicherung ---
;; Alle nach lastEnt erzeugten Entities werden NICHT geloescht, sondern
;; GENAUSO wie beim erfolgreichen Abschluss (vfl-block-erstellen) zu einem
;; neuen VF_n-Block gewickelt, mit dem VOLLEN aktuellen Eingabe-Journal
;; (inkl. des angefangenen, noch unfertigen letzten Gliedes) als XDATA. Die
;; Geometrie bleibt in der Zeichnung stehen und ist sofort per Doppelklick
;; weiter editierbar/fortsetzbar (vfl-edit-ent) - unabhaengig davon, ob es
;; sich um einen frischen Bau oder einen Editier-Neuaufbau handelte (kein
;; Sonderfall mehr noetig). Aufgerufen aus dem *error*-Handler von
;; vf-linienzug-modus.
(defun vfl-modus-abbruch-sichern (lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite /
e cnt vfl-ins wickel-erg)
(setq cnt 0 e (if lastEnt (entnext lastEnt) (entnext)))
(while e (setq cnt (1+ cnt)) (setq e (entnext e)))
(cond
((or (= cnt 0) (null frame))
(princ (ssg-text "vfl-abbruch-nichts-gebaut")))
(t
;; vfl-block-erstellen nutzt intern (command "_.UCS" ...) fuer den
;; BKS-Wechsel (ssg-block-wrap-welt) - im *error*-Handler-Kontext
;; riskanter als eine einfache Loesch-Schleife, daher abgesichert.
(setq wickel-erg
(vl-catch-all-apply
(function (lambda ()
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf
(caddr startpunkt) (caddr (car frame))
(vfl-planar-dist startpunkt (car frame))
as-seite es-seite startpunkt lastEnt))
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins))))
nil))
(if (vl-catch-all-error-p wickel-erg)
(princ (ssg-textf "vfl-abbruch-wickeln-fehler"
(list (vl-catch-all-error-message wickel-erg))))
(princ (ssg-textf "vfl-abbruch-gesichert" (list (itoa cnt)))))
)
)
(princ))
;; Replay-Modus scharf schalten: die uebergebene (Vorwaerts-)Journalliste wird
;; zur Lesequelle, *vfl-journal* startet leer und wird bei der erneuten
;; Ausfuehrung neu aufgebaut. Genutzt von vfl-edit-ent und der Wiederaufnahme.
(defun vfl-journal-replay-start (forward-journal)
(setq *vfl-replay-queue* forward-journal *vfl-journal* '()))
;; --- Glied-Zerlegung fuer den Editier-Dialog ---
;; Labels der Glieder (STEP-Marker) in Bau-Reihenfolge.
(defun vfl-journal-glieder (forward-journal / out)
(setq out '())
(foreach e forward-journal
(if (= (car e) "STEP") (setq out (cons (cdr e) out))))
(reverse out))
;; Journal auf die ersten (keep) Glieder kuerzen: Praeambel (vor dem 1. STEP)
;; bleibt immer erhalten; ab dem (keep+1)-ten STEP wird alles verworfen.
(defun vfl-journal-truncate (forward-journal keep / seen out done)
(setq seen 0 out '() done nil)
(foreach e forward-journal
(if (not done)
(if (= (car e) "STEP")
(if (< seen keep)
(progn (setq seen (1+ seen)) (setq out (cons e out)))
(setq done t))
(setq out (cons e out)))))
(reverse out))
;; Internes (sprachneutrales) Glied-Token in lesbaren Text der AKTUELLEN Sprache
;; uebersetzen. Da im Journal nur das Token steht, folgt die Anzeige immer der
;; aktiven Sprache - ein in Deutsch aufgezeichnetes Journal zeigt in englischer
;; UI englische Labels (und umgekehrt).
(defun vfl-glied-label-text (w)
(cond ((= w "GF-Bogen") (ssg-text "vfl-glied-gf-bogen"))
((= w "Linie-GF") (ssg-text "vfl-glied-gf"))
((= w "Linie-VF") (ssg-text "vfl-glied-vf"))
((= w "Horizontal-VF") (ssg-text "vfl-glied-horizontal-vf"))
((= w "Linie") (ssg-text "vfl-glied-linie"))
((= w "?") (ssg-text "vfl-glied-offen"))
(t w)))
;; ============================================================
;; TEIL 1: SEGMENT-ENTSCHEIDUNG (GF oder VF)
;; ============================================================
;; Aus der Ergebnisliste von berechne-alle-winkel die GUELTIGEN Winkel filtern
;; und - bei mehreren - den Nutzer waehlen lassen. Rueckgabe: (winkel L_GF L_VF)
;; oder nil, wenn kein gueltiger Winkel existiert.
(defun vfl-waehle-winkel (ergebnis-liste / gueltige idx antwort e)
(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 (vfl-in-int (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-in-point p-akt
(if hz-vorgabe
(ssg-text "vfl-prompt-endpunkt-fahrtrichtung")
(ssg-text "vfl-prompt-endpunkt-frei"))))
(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 (ssg-textf "vfl-fehler-laenge-max" (list (rtos (/ deltaL 1000.0) 2 2))))
(progn
(setq ergebnis (list deltaL hz-aktuell p2))
(setq fertig t)
)
)
)
)
)
ergebnis
)
;; Planare Projektionsdistanz von neu-basis zu ziel-punkt entlang der
;; Fahrtrichtung hz (Grad) - wird genutzt, um nach dem AS-Element-Insert die
;; tatsaechlich noetige Restlaenge (vom echten KS_AUS zum urspruenglich
;; gepickten Punkt) direkt zu berechnen. Bewusst KEINE Fussabdruck-Schaetzung
;; (weder aus KS_EIN->KS_AUS noch aus Block-Ursprung->KS_AUS): beide ignorieren
;; die Dreh­teller-Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
;; anwendet, und liefern empirisch bestaetigt einen falschen Wert (~210mm
;; Schaetzung vs. ~420mm tatsaechlich noetiger Versatz bei AS_Element_30).
(defun vfl-projiziere-distanz (neu-basis ziel-punkt hz / rad)
(setq rad (* (float hz) (/ pi 180.0)))
(+ (* (- (car ziel-punkt) (car neu-basis)) (cos rad))
(* (- (cadr ziel-punkt) (cadr neu-basis)) (sin rad))))
;; Rahmen am Ende eines vfs-*-Bausteins: die Bausteine (Entry/Koerper/Exit)
;; enden IMMER auf der 3-Grad-Basisneigung (siehe Prinzipien-Dok Abschnitt 6).
(defun vfl-frame-3grad (punkt hz)
(make-frame-from-dir punkt (hz-winkel->xu hz (ssg-cfg-or "vario" "gefaelle_winkel" 3))))
;; 20-Meter-Regel: warnt, wenn die VF-Segmente seit der Umlenkstation 20 m
;; ueberschreiten (Prinzipien-Dok Abschnitt 7). v1: nur Hinweis, kein
;; automatisches Einfuegen einer Zwischen-Motorstation.
(defun vfl-20m-check (p-umlenk p-akt / laenge)
(setq laenge (vfl-planar-dist p-umlenk p-akt))
(if (> laenge 20000.0)
(princ (ssg-textf "vfl-20m-hinweis" (list (rtos (/ laenge 1000.0) 2 2))))
)
)
;; Baut EINE reine VarioFoerderer-Einheit als interaktive Sub-Kette:
;; genau EINE Umlenkstation (Eingang) ... beliebig viele Koerper-Sub-Segmente
;; und Vario-Kurven ... genau EINE Motorstation (Ausgang). Siehe Prinzipien-Dok
;; Abschnitt 2+4. Jedes Koerper-Sub-Segment beginnt/endet auf 3-Grad-Neigung.
;; frame: Eingangsrahmen (KS_AUS des Vorgaenger-Elements, i.d.R. AS-Element).
;; hz1/richtung1/winkel1/L_GF1/L_VF1: Daten des ersten (bereits klassifizierten)
;; VF-Linien-Sub-Segments aus vfl-segment-entscheidung.
;; gf-am-ausgang: T => halbe Staustrecke als GF2 am Ausgang (ohne Separator),
;; nil => gesamte Staustrecke am Einlauf (GF1), kein GF2.
;; Neigung des Frames aus der xu-Richtung ablesen: T => (nahezu) flach (0 Grad),
;; nil => auf 3-Grad-Basis. Damit wird der Uebergang auf_3/ab_3 nur dann gesetzt,
;; wenn wirklich ein Neigungswechsel noetig ist.
(defun vfl-frame-flach-p (frame)
(< (abs (cadr (frame->hz-winkel frame))) 1.5))
;; Separator (300 mm) HORIZONTAL (0 Grad) an einen Punkt anfuegen - fuer das
;; horizontale Stueck, wo der Separator in der 0-Grad-Ebene liegt (NICHT auf der
;; 3-Grad-Basis wie vfl-insert-separator). Rueckgabe: Endpunkt.
(defun vfl-sep-hz (pt hz / ep)
(princ (ssg-text "vfl-sep-horizontal-info"))
(setq ep (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" pt hz 0 300 0))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
ep)
;; Uebergang zurueck auf die 3-Grad-Basis, FALLS der Frame gerade flach (0 Grad)
;; ist: fuegt einen Vario_Bogen_ab_3 ein. Wird vor jedem 3-Grad-Element
;; (gewinkeltes VF, Motorstation, ES) aufgerufen, damit der ab_3-Uebergang erst
;; DANN kommt, wenn er wirklich gebraucht wird (die flache Zone bleibt sonst
;; flach). Ist der Frame schon auf 3-Grad-Basis, bleibt er unveraendert.
(defun vfl-nach-3grad (frame / hz m pt)
(if (vfl-frame-flach-p frame)
(progn
(setq hz (car (frame->hz-winkel frame)))
(setq m (get-bogen-mass bogen-ab 3))
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" (car frame)
0 (car m) (caddr m) hz))
(vfl-frame-3grad pt hz))
frame))
;; Horizontales Sub-Segment bauen. Die flache Zone (0 Grad) wird NICHT mehr
;; automatisch mit ab_3 auf die 3-Grad-Basis zurueckgefuehrt - das Stueck ENDET
;; FLACH. Der ab_3-Uebergang kommt erst, wenn ein 3-Grad-Element folgt
;; (vfl-nach-3grad). Der auf_3-Eintritt wird nur gesetzt, wenn der Frame noch
;; NICHT flach ist (sonst bleibt die laufende flache Zone erhalten). Separatoren
;; VOR/NACH liegen in der 0-Grad-Ebene. Rueckgabe: neuer Frame (flach, 0 Grad).
;; ziel-modus=T: dL ist die GESAMT-Zielstrecke ab pt (der Nutzer hat einen
;; Endpunkt gepickt, den die Kette exakt treffen soll). In diesem Fall werden
;; ALLE Fragen, die die spaeter tatsaechlich gebaute Laenge beeinflussen
;; (Separator VOR/NACH, UND "Ist der Endpunkt der Foerderer?"), VOR der
;; Laengenberechnung gestellt - erst wenn wirklich alle Informationen da sind,
;; wird dL final berechnet und die horizontale Strecke gebaut. Das verhindert,
;; dass die Kette am Ende ueber den gepickten Punkt hinausragt, nur weil
;; nachtraeglich noch ein Separator oder eine Motorstation dazukommt.
;; gf2-laenge: die (schon feststehende) GF2-Laenge aus der GF-Verteilungs-
;; Frage (L_GF2-bau in vfl-vf-einheit) - wird bei Antwort "1" (nur Motor-
;; station) MIT reserviert, da vfs-vf-exit sie direkt danach anbaut. Bei
;; Antwort "3" (Kettenende definieren) NICHT reservieren: dort berechnet
;; vfl-body-abschluss ein eigenes, unabhaengiges ziel-gf2 (siehe dort) - hier
;; unbekannt und irrelevant.
;; Rueckgabe bei ziel-modus=T: (frame ist-endpunkt-antwort) - der Aufrufer
;; (vfl-vf-einheit) muss die Frage dann NICHT erneut stellen. Bei ziel-modus=
;; nil (Default/mid-chain-Fortsetzung): unveraendertes Verhalten, Rueckgabe
;; nur frame.
(defun vfl-baue-horizontal-koerper (frame hz dL ziel-modus gf2-laenge /
pt m1 sep-vor pt-vor-bogen sep-nach ist-ende-antwort)
(setq pt (car frame))
(princ (ssg-text "vfl-sep-vor-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-vor (= (vfl-in-string (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 (= (vfl-in-string (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 (vfl-in-string (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 (vfl-in-real (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 (vfl-in-string (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 (ssg-text "vfl-es-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-es-nein-zielpunkt"))
(setq es-antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq es-gewuenscht (/= es-antwort "2"))
(if (not es-gewuenscht)
(progn (setq save-eindx ein-dx save-eindz ein-dz)
(setq ein-dx 0.0 ein-dz 0.0)))
(setq res3 (vfl-body-abschluss frame letzt-hz p-umlenk))
(if (not es-gewuenscht)
(setq ein-dx save-eindx ein-dz save-eindz))
(if res3
(setq frame (nth 0 res3)
vf-count (+ vf-count (nth 1 res3))
letzt-hz (nth 2 res3)
ziel-gf2 (nth 3 res3)
ziel-ende t
fertig t)))
(progn
(princ (ssg-text "vfl-naechstes-element-vf"))
(princ (ssg-text "vfl-opt-horizontaler-foerderer"))
(princ (ssg-text "vfl-opt-vario-kurve"))
(princ (ssg-text "vfl-opt-auf-ab-foerderer"))
(setq antwort (vfl-in-string (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 (vfl-in-real (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 (vfl-in-int (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 (vfl-in-string (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.
;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch
;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das
;; (siehe ks-normalize-name).
(defun vfl-insert-vario-kurve-block (frame kwinkel kseite kvariante /
blockname hz flach-frame neuer-frame
hz-gemessen hz-gesnappt)
(setq blockname (vfl-kurve-blockname kwinkel kseite kvariante))
(princ (ssg-textf "vfl-fuege-block-ein" (list blockname)))
;; Vario-Kurve zaehlen (Variante A=aussen/I=innen + Winkel) -> VF_Bogen_A/I_xx
(setq *vfl-acc-variokurve*
(vfl-inc-count *vfl-acc-variokurve*
(strcat (if (= kvariante "aussen") "A" "I") "_" (itoa kwinkel))))
;; Vario-Kurve ist ein HORIZONTALER Richtungswechsel (KEINE Neigung).
;; Der aktuelle Frame traegt die 3-Grad-Basisneigung - fuer die Kurve wird er
;; daher auf 0 Grad abgeflacht (Position + Fahrtrichtung bleiben erhalten).
(setq hz (car (frame->hz-winkel frame)))
(setq flach-frame (make-frame-from-dir (car frame) (hz-winkel->xu hz 0.0)))
(setq neuer-frame (insert-block-ks-to-ks blockname flach-frame))
;; Auf den absoluten 30-Grad-Raster snappen (siehe vfl-hz-snappen-absolut) -
;; gleiche Zeichnungsungenauigkeit wie bei GF-Bogen moeglich. Reine Z-Drehung
;; statt make-frame-from-dir-Neuaufbau: erhaelt die aus dem Block gemessene
;; Rollung (yu/zu) - siehe Kommentar bei vfl-frame-um-z-drehen. Ein Neuaufbau
;; ueber make-frame-from-dir fuehrte hier empirisch zu einer um 90 Grad
;; verdrehten Motorstation NACH der Vario-Kurve.
(setq hz-gemessen (car (frame->hz-winkel neuer-frame)))
(setq hz-gesnappt (vfl-hz-snappen-absolut hz-gemessen))
(if (> (abs (- hz-gemessen hz-gesnappt)) 0.0001)
(setq neuer-frame (vfl-frame-um-z-drehen neuer-frame (- hz-gesnappt hz-gemessen))))
neuer-frame
)
;; Vario-Kurve (horizontale Kurve, Neigung bleibt wie im aktuellen Frame).
;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch
;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das
;; (siehe ks-normalize-name).
;; Interaktiv (i18n): Vario-Kurve-Winkel + Seite + Variante abfragen, dann Kern.
(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 (vfl-in-int (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 (vfl-in-string (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 (vfl-in-string (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 (ssg-textf "vfl-info-as-eingefuegt" (list (rtos deltaL 2 1))))
)
(progn
(setq frame (make-frame-from-dir p-aktuell (hz-winkel->xu hz-neu 0.0)))
(princ (ssg-text "vfl-info-kein-as"))
)
)
(list frame deltaL)
)
;; ES-Winkel (30/90) + Seite erst am Kettenende abfragen. Setzt *vfl-es-winkel*
;; und die ES-Masse (ein-dx/dz) fuer die Variante. Rueckgabe: Seite (links/rechts).
(defun vfl-frage-es-seite ( / antwort es-seite)
(setq *vfl-es-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-in-string (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 (vfl-in-string (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 (vfl-in-string (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 (vfl-in-string (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 old-error vfl-ins)
(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 (ssg-text "vfl-alert-gf-modul-fehlt"))
(exit)
)
)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
;; --- Abbruch-Sicherung scharf schalten (VOR dem ersten Prompt!) ---
;; Ab hier kann jederzeit Geometrie entstehen. Ein *error*-Handler faengt
;; jeden Abbruch (ESC / (exit) / Laufzeitfehler) ab und WICKELT die bereits
;; eingefuegte Teil-Geometrie (alles nach lastEnt) zu einem VF_n-Block mit
;; dem vollen aktuellen Eingabe-Journal als XDATA (vfl-modus-abbruch-sichern)
;; - die Geometrie bleibt stehen und ist per Doppelklick sofort weiter
;; editierbar/fortsetzbar (kein Rollback mehr, kein separater
;; "Fortsetzen"-Mechanismus noetig).
;; Die Installation MUSS vor dem allerersten vfl-in-*-Aufruf erfolgen: ein
;; echtes ESC (nicht ein leeres Enter) loest bei JEDEM get*-Aufruf sofort
;; *error* aus (nicht nil) - ohne den Handler wuerde ein ESC in diesem
;; Fenster auf den vorherigen Handler zurueckfallen (im Editier-Pfad: der
;; ssg-start-Handler ohne Wickeln - der bereits geloeschte Original-Block
;; waere dann ersatzlos weg). lastEnt/old-error/vfl-nummer/anzahl-gf/
;; anzahl-vf/startpunkt/frame/as-seite/es-seite sind zur Aufrufzeit
;; dynamisch gebunden und daher im Handler-Lambda sichtbar (AutoLISP
;; dynamic scoping, gilt fuer die gesamte Laufzeit dieses Aufrufs, auch
;; tief verschachtelt z.B. in vfl-vf-einheit).
(setq vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
(setq old-error *error*)
;; Abbruch-Handler: zuerst *error* zuruecksetzen (kein rekursiver
;; Wiedereintritt bei einem Fehler waehrend des Wickelns), dann wickeln.
;; Laeuft der Aufruf innerhalb einer ssg-start-Sitzung (Editier-Pfad via
;; c:VARIOFOERDERER_EDIT -> vfl-edit-ent), wird diese mit ssg-end sauber
;; geschlossen (Undo-Gruppe, gesicherte Systemvariablen, *error* aus dem
;; Sitzungs-Frame) - sonst bliebe die von ssg-start geoeffnete Undo-Gruppe
;; offen.
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite)
(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
(princ))))
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-prompt-startpunkt-kette")))
(if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
;; Hoehe (Z) des Startpunkts abfragen und in die Z-Koordinate uebernehmen.
(setq start-hoehe
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt-kette" (list (rtos (caddr startpunkt) 2 1)))))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(princ (ssg-text "vfl-as-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-as-nein"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq as-vorhanden (/= antwort "2"))
(if as-vorhanden
(progn
(setq *vfl-as-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
(princ (ssg-text "vfl-aus-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
)
)
;; ES-Seite wird erst am Kettenende abgefragt (siehe vfl-frage-es-seite),
;; da das ES-Element erst dort eingefuegt wird.
(setq p-aktuell startpunkt)
(setq letzter-typ nil fertig nil frame nil)
(setq anzahl-gf 0 anzahl-vf 0)
(vfl-acc-reset)
(while (not fertig)
;; --- Naechstes Element bestimmen ---
;; Nach einem GF-Segment ODER einer geschlossenen VF-Einheit (beide enden
;; auf 3-Grad-Neigung) darf ein GF-Bogen oder eine neue Linie folgen. Nur
;; am Kettenanfang folgt direkt eine neue Linie. Vario-Kurven werden
;; INNERHALB der VF-Einheit behandelt (vfl-vf-einheit).
;; Menue immer anzeigen; GF-Bogen nur, wenn bereits ein Frame existiert
;; (am Kettenanfang gibt es keinen Vorgaenger-Rahmen fuer einen Bogen).
;; Lueckenlose Nummerierung: GF-Bogen (nur mit Frame) ist immer Option 1;
;; ohne Frame ruecken die uebrigen Optionen auf 1..4 auf.
;; "Neue Linie" ist in zwei explizite Zweige aufgeteilt (GF / Ab-Auf-VF) -
;; der Nutzer legt den Segmenttyp direkt fest, keine Geometrie-Automatik
;; mehr wie bei "Neue Linie BIS Kettenende" (die bleibt unveraendert und
;; nutzt weiterhin vfl-segment-entscheidung).
(princ (ssg-text "vfl-naechstes-element-header"))
(setq linie-ende-modus nil)
;; Glied-Checkpoint am Iterationskopf setzen; Label wird nach der Auswahl
;; nachgetragen (vfl-journal-steplabel), damit jedes Glied seine eigene
;; Menue-Auswahl + Segment-Eingaben vollstaendig umschliesst (fuer den
;; gliedweisen Ruecksprung beim Editieren).
(vfl-journal-mark "?")
(if frame
(progn
(princ (ssg-text "vfl-menu-gf-bogen-1"))
(princ (ssg-text "vfl-menu-linie-gf-2"))
(princ (ssg-text "vfl-menu-linie-vf-3"))
(princ (ssg-text "vfl-menu-horizontal-vf-4"))
(princ (ssg-text "vfl-menu-linie-ende-5"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-5-def2")))
(setq wahl (cond ((= antwort "1") "GF-Bogen")
((= antwort "3") "Linie-VF")
((= antwort "4") "Horizontal-VF")
((= antwort "5") (setq linie-ende-modus t) "Linie")
(t "Linie-GF"))) ; "2" oder leer
)
(progn
(princ (ssg-text "vfl-menu-linie-gf-1"))
(princ (ssg-text "vfl-menu-linie-vf-2"))
(princ (ssg-text "vfl-menu-horizontal-vf-3"))
(princ (ssg-text "vfl-menu-linie-ende-4"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-4-def1")))
(setq wahl (cond ((= antwort "2") "Linie-VF")
((= antwort "3") "Horizontal-VF")
((= antwort "4") (setq linie-ende-modus t) "Linie")
(t "Linie-GF"))) ; "1" oder leer
)
)
;; Segmenttyp steht fest -> Glied-Label nachtragen (fuer die Edit-Liste).
(vfl-journal-steplabel wahl)
(cond
((= wahl "GF-Bogen")
(setq frame (vfl-insert-gf-bogen frame))
(setq p-aktuell (car frame))
)
;; --- Neue horizontal VF: VF-Einheit mit horizontalem Anfangs-Koerper ---
((= wahl "Horizontal-VF")
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) 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 (ssg-text "vfl-fehler-horizontal-vf-kurz"))
(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 (ssg-text "vfl-abgebrochen")) (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 (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
;; (Richtung hz-neu jetzt bekannt) und die GF-Restlaenge aus dem
;; TATSAECHLICHEN KS_AUS nachrechnen (siehe vfl-kettenanfang-
;; baustein). Keine Fussabdruck-Schaetzung mehr: sowohl KS_EIN- als
;; auch Ursprung-basierte Vorab-Messung ignorieren die Dreh­teller-
;; Rotation, die insert-block-mixed-to-ks beim echten Einfuegen
;; anwendet, und liefern daher einen falschen Wert (empirisch
;; bestaetigt: ~210mm Schaetzung vs. tatsaechlich ~420mm noetiger
;; Versatz).
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu 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 (ssg-text "vfl-gefaelle-festlegen-header"))
(princ (ssg-text "vfl-gefaelle-opt-hoehe"))
(princ (ssg-text "vfl-gefaelle-opt-winkel"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2")
(progn
;; Winkel direkt vorgeben - deltaH ergibt sich aus deltaL*tan(winkel).
(setq winkel
(vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel" (list (rtos gf-max-winkel 2 1)))))
(if (null winkel) (setq winkel gf-max-winkel))
(if (or (<= winkel 0.0) (> winkel gf-max-winkel))
(progn
(alert (ssg-textf "vfl-alert-winkel-ungueltig"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
(progn
(setq richtung "Ab")
(setq deltaH (* deltaL (/ (sin (* winkel (/ pi 180.0)))
(cos (* winkel (/ pi 180.0))))))
)
)
)
(progn
;; Gegebene Hoehe - wie bisher, aber Winkel wird daraus abgeleitet
;; und gegen den GF-Maximalwinkel geprueft (GF kann nicht steigen).
;; p-aktuell ist ab hier immer der reale Referenzpunkt (bei
;; Kettenanfang das echte KS_AUS des AS-Elements).
(setq hoehe-neu
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (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 (ssg-text "vfl-alert-gf-kann-nicht-steigen"))
(setq gf-ok nil))
(t
(setq winkel (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
(if (> winkel gf-max-winkel)
(progn
(alert (ssg-textf "vfl-alert-gefaelle-zu-steil"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(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 (ssg-text "vfl-ist-kettenende-header"))
(princ (ssg-text "vfl-kettenende-opt-ja-es"))
(princ (ssg-text "vfl-kettenende-opt-ja-ohne-es"))
(princ (ssg-text "vfl-kettenende-opt-nein"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-3-def3")))
(cond
((= antwort "1")
(setq es-seite (vfl-frage-es-seite))
(setq frame (vfl-insert-es-element "GF" frame hz-neu winkel
(caddr (car frame)) es-seite))
(setq fertig t))
((= antwort "2") (setq fertig t))
)
)
)
)
)
)
;; --- Neue Linie: Ab/Auf VF (Nutzer legt den Typ explizit fest) ---
((= wahl "Linie-VF")
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) 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 (ssg-text "vfl-fehler-vf-kurz"))
(progn
(setq hoehe-neu
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (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 (ssg-textf "vfl-alert-vf-nicht-baubar"
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(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 (ssg-text "vfl-abgebrochen")) (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 (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
;; (immer flach, typ-unabhaengig - siehe vfl-insert-as-element;
;; welcher Segmenttyp folgt, steht hier noch nicht fest), reale
;; Restlaenge aus dem tatsaechlichen KS_AUS nachrechnen (siehe
;; vfl-kettenanfang-baustein).
(if kettenanfang
(progn
(setq erg (vfl-kettenanfang-baustein p-aktuell hz-neu 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 (ssg-textf "vfl-info-kurzes-segment"
(list (rtos deltaL 2 0) (rtos deltaH 2 1))))
)
(progn
(setq hoehe-neu
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (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 (ssg-textf "vfl-info-kettenende-footprint"
(list (rtos deltaL 2 0) (rtos deltaH 2 0))))
)
)
(setq entscheidung (vfl-segment-entscheidung deltaL deltaH richtung))
(setq typ (nth 0 entscheidung) winkel (nth 1 entscheidung)
L_GF (nth 2 entscheidung) L_VF (nth 3 entscheidung))
)
)
(if (null typ)
(alert (ssg-textf "vfl-alert-segment-nicht-baubar"
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(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 (ssg-text "vfl-ist-kettenende-header"))
(princ (ssg-text "vfl-kettenende-opt-ja-es"))
(princ (ssg-text "vfl-kettenende-opt-ja-ohne-es"))
(princ (ssg-text "vfl-kettenende-opt-nein"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-3-def3")))
)
)
(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
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite
startpunkt lastEnt))
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug" +
;; Chunks) -> spaeter per Doppelklick editierbar (vfl-edit-ent).
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins))
;; Erfolgreicher Abschluss: *error* zuruecksetzen.
(setq *error* old-error)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-kette-eingefuegt"))
(princ "\n=========================================")
(princ)
)
;; ============================================================
;; EDITIEREN: gliedweise zuruecknehmen + Neuaufbau per Replay
;; ============================================================
;; Aufgerufen aus c:VARIOFOERDERER_EDIT (Doppelklick auf VF_n mit XDATA-Marker
;; "linienzug", egal ob fertiggestellt oder durch einen Abbruch gewickelt).
;; Liest das Eingabe-Journal vom Block, listet die Glieder, laesst per
;; DCL-Dialog (vfl-dlg-position) eine Sektion waehlen, auf die zurueckgesetzt
;; wird, loescht den alten Block und baut die Kette neu: die behaltenen
;; Glieder werden stumm abgespielt, danach laeuft die Eingabe interaktiv fuer
;; die geaenderten/neuen Glieder weiter. Vorbelegung im Dialog = voller Stand
;; -> Doppelklick + sofort OK setzt einen abgebrochenen Bau nahtlos fort.
(defun vfl-edit-ent (ent / journal glieder n i pos trunc)
(setq journal (vfl-journal-xdata-lesen ent))
(if (null journal)
(progn (alert (ssg-text "vfl-edit-kein-journal")) (exit)))
(setq glieder (vfl-journal-glieder journal))
(setq n (length glieder))
(princ (ssg-textf "vfl-edit-kette-header" (list (itoa n))))
(setq i 1)
(foreach g glieder
(princ (strcat "\n " (itoa i) ") " (vfl-glied-label-text g)))
(setq i (1+ i)))
(setq pos (vfl-dlg-position glieder))
(if (null pos)
(progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit)))
(setq trunc (vfl-journal-truncate journal pos))
;; Alten Block entfernen (wie Standard/Etage: entdel + kompletter Neuaufbau).
;; Bricht der Neuaufbau selbst ab, wickelt vfl-modus-abbruch-sichern den
;; Zwischenstand automatisch zu einem neuen Block - kein Sonderfall noetig.
(entdel ent)
(princ (ssg-textf "vfl-edit-abgespielt" (list (itoa pos) (itoa (- n pos)))))
;; Behaltene Glieder abspielen, dann live weiterbauen.
(vfl-journal-replay-start trunc)
(vf-linienzug-modus)
(princ))
;; DCL-Dialog: Sektion waehlen, auf die die Kette zurueckgesetzt wird.
;; glieder = Liste der Glied-Labels (interne Tokens, vfl-journal-glieder), in
;; Bau-Reihenfolge. Vorbelegung auf den letzten Eintrag (voller Stand = reines
;; Fortsetzen ohne Kuerzung). Rueckgabe: gewaehlte Position (1-basiert) oder
;; nil bei Abbrechen/Escape.
(defun vfl-dlg-position (glieder / n dcl-pfad dat idx ergebnis i)
(setq n (length glieder))
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "vfl_edit" dat))
(progn (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil)
(progn
(set_tile "kopf" (ssg-textf "vfl-dlg-kopf-sektionen" (list (itoa n))))
(start_list "position")
(setq i 1)
(foreach g glieder
(add_list (strcat (itoa i) " - " (vfl-glied-label-text g)))
(setq i (1+ i)))
(end_list)
(set_tile "position" (itoa (1- n))) ; letzter Eintrag vorbelegt (0-basierter Index)
(action_tile "accept" "(setq idx (atoi (get_tile \"position\"))) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1) (1+ idx) nil)
)
)
)
;; ============================================================
;; DIAGNOSE: Blockstruktur (KS_EIN/KS_AUS) untersuchen
;; ============================================================
;; Zeigt, wie ein Block intern aufgebaut ist - insbesondere, ob KS_EIN/KS_AUS
;; auf der ersten Explode-Ebene als Unterbloecke liegen und welche Laengen ihre
;; Achslinien haben (ks-line-axis erwartet X~1/~100, Y~2, Z~3). Damit laesst
;; sich klaeren, warum extract-ks-from-block bei den Vario_Kurve-Bloecken
;; "KS_EIN/KS_AUS fehlen" meldet.
;; Aufruf in BricsCAD: VFL_KS_DIAG -> Blockname eingeben.
(defun c:VFL_KS_DIAG ( / bname obj subs s nm inner il ilnm ps pe len)
(setq bname (getstring "\nBlockname fuer KS-Diagnose: "))
(setq bname (ensure-block-loaded bname))
(if (not (tblsearch "BLOCK" bname))
(progn (princ (strcat "\nBlock '" bname "' nicht gefunden.")) (exit)))
(setq obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) bname 1.0 1.0 1.0 0))
(princ (strcat "\n=================================================="))
(princ (strcat "\n=== Struktur von '" bname "' (Ebene 1) ==="))
(setq subs (vlax-invoke obj 'Explode))
(foreach s subs
(if (not (vlax-erased-p s))
(progn
(setq nm (vla-get-ObjectName s))
(if (= nm "AcDbBlockReference")
(progn
(princ (strcat "\n BlockRef: '" (vla-get-Name s) "' (Ebene 2:)"))
(setq inner (vlax-invoke s 'Explode))
(foreach il inner
(if (not (vlax-erased-p il))
(progn
(setq ilnm (vla-get-ObjectName il))
(cond
((= ilnm "AcDbLine")
(setq ps (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint il))))
(setq pe (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint il))))
(setq len (vec-length (list (- (car pe)(car ps))
(- (cadr pe)(cadr ps))
(- (caddr pe)(caddr ps)))))
(princ (strcat "\n Line len=" (rtos len 2 3)
" axis=" (if (ks-line-axis len) (ks-line-axis len) "?"))))
((= ilnm "AcDbBlockReference")
(princ (strcat "\n BlockRef(verschachtelt): '" (vla-get-Name il) "'")))
(t (princ (strcat "\n " ilnm)))
)
(vla-Delete il)
)
)
)
)
(princ (strcat "\n " nm))
)
(vla-Delete s)
)
)
)
(princ "\n=== Ende Diagnose ===")
(princ "\n==================================================")
(princ)
)
;; ============================================================
;; REGISTRIERUNG
;; ============================================================
;; berechne-fn/einfuege-fn werden fuer "linienzug" NICHT im normalen Schema
;; verwendet (eigener Befehlsablauf, siehe Kommentar am Dateianfang) - beide
;; sind daher nur Platzhalter, die c:VarioFoerderer nie aufruft (Dispatch
;; erfolgt dort direkt auf vf-linienzug-modus).
(defun vfl-berechne-platzhalter (deltaL deltaH richtung seite)
(princ "\n[vf_linienzug] FEHLER: berechne-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.")
(list nil nil nil nil)
)
(defun vfl-einfuege-platzhalter (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz)
(princ "\n[vf_linienzug] FEHLER: einfuege-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.")
startpunkt
)
;; ============================================================
;; MODUS 2: 3D-OBJEKTE WAEHLEN (Meilenstein 1 - GF-Teil)
;; ============================================================
;; Baut die Kette aus einem GEZEICHNETEN Pfad (LINE/ARC). Ablauf:
;; Objekte waehlen -> gf-sortiere-objekte -> gf-analysiere-kette
;; -> Eck-Winkel-Vorpruefung -> segmentweise (Variante B) live bauen -> ES.
;; In diesem Meilenstein ist NUR der GF-Teil aktiv (GF-Gerade mit eigener
;; Neigung <=3 Grad, GF-Bogen). Die VF-Zweige sind als TODO (Meilenstein 2)
;; markiert und werden uebersprungen.
;; Bekannte Naeherungen (in BricsCAD verifizieren):
;; - Eck-Trimmung nur an erster/letzter Geraden (-aus-dx bzw. -300-ein-dx,
;; wie gf-linienzug-modus); Separatoren VOR GF-Boegen noch NICHT gesetzt.
;; - GF-Bogen hat feste Eigen-Neigung -> bei unterschiedlichen Nachbar-
;; Neigungen entsteht ein (akzeptierter) Knick.
;; Alle Eck-Winkel des Pfades gegen 30/60/90 Grad pruefen (Toleranz tol).
;; Rueckgabe: nil (alle ok) oder der erste abweichende Winkel (Grad).
(defun vfl2-pruefe-eckwinkel (kette tol / item obj sa ea sweep bad)
(setq bad nil)
(foreach item kette
(setq obj (car item))
(if (and (null bad) (= (vla-get-ObjectName obj) "AcDbArc"))
(progn
(setq sa (vla-get-StartAngle obj) ea (vla-get-EndAngle obj))
(setq sweep (if (>= ea sa) (- ea sa) (+ (- ea sa) (* 2.0 pi))))
(setq sweep (* sweep (/ 180.0 pi)))
(if (not (or (< (abs (- sweep 30.0)) tol)
(< (abs (- sweep 60.0)) tol)
(< (abs (- sweep 90.0)) tol)))
(setq bad sweep))
)
)
)
bad
)
;; AS-Element fuer Modus 2 (GF): gemischte Verankerung.
;; - Laengsrichtung (entlang hz): KS_EIN auf den Startpunkt (Laengsposition)
;; - Querrichtung (senkrecht hz): KS_AUS auf den Pfad (Kettenmittellinie)
;; Umsetzung: (1) AS mit KS_EIN am Startpunkt platzieren, (2) Querversatz des
;; KS_AUS zum Pfad messen, (3) AS senkrecht zu hz um -Versatz verschieben.
;; Ergebnis: KS_EIN.X = Startpunkt.X, KS_EIN quer um das AS-Y-Mass versetzt,
;; KS_AUS liegt exakt auf dem Pfad -> die ganze Kette folgt der Mittellinie.
;; Rueckgabe: (korrigierter) Frame am KS_AUS.
;; winkel-Parameter bleibt aus Call-Kompatibilitaet bestehen (vfl2-insert-as-vf
;; ruft mit 0.0), wird aber NICHT mehr fuer eine Kippung verwendet: das AS-
;; Element hat keine eigene Neigung (per Einzel-Insert-Test in BricsCAD
;; bestaetigt, siehe vfl-insert-as-element in Modus 1) - unabhaengig vom
;; folgenden Segmenttyp (GF/VF) wird es IMMER flach eingefuegt.
(defun vfl2-insert-as-gf (startpunkt hz winkel as-seite /
ein-hz-as rad-h xu-ein frame blk ks-aus
rad-hz perp-x perp-y d-perp sx sy as-turn
rad-ein de-x de-y de-dot-np t-shift)
;; Schwenk aus dem AS-Block MESSEN (30/90/gerade), KS_EIN so drehen, dass
;; KS_AUS entlang hz zeigt: ein-hz = hz - plan-turn.
(setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)))
(setq ein-hz-as (- hz as-turn))
(setq rad-h (* (float ein-hz-as) (/ pi 180.0)))
(setq xu-ein (list (cos rad-h) (sin rad-h) 0.0))
;; (1) KS_EIN auf den Startpunkt (Laengsposition korrekt)
(setq frame (insert-block-mixed-to-ks
(strcat "AS_Element_" (vfl-as-winkel) "_" as-seite)
(make-frame-from-dir startpunkt xu-ein)
(caddr startpunkt) "KS_EIN" "KS_EIN"))
(setq blk (entlast))
;; (2) Querversatz des KS_AUS zum Pfad (Einheits-Querrichtung senkrecht zu hz)
(setq ks-aus (car frame))
(setq rad-hz (* (float hz) (/ pi 180.0)))
(setq perp-x (- (sin rad-hz)) perp-y (cos rad-hz)) ; Normale zum Pfad
(setq d-perp (+ (* (- (car ks-aus) (car startpunkt)) perp-x)
(* (- (cadr ks-aus) (cadr startpunkt)) perp-y)))
;; (3) AS ENTLANG der KS_EIN-Achse verschieben (nicht senkrecht zum Pfad):
;; damit landet KS_AUS auf dem Pfad UND der Startpunkt bleibt auf der KS_EIN-
;; Achse. Beim 90-Grad-Element ist die KS_EIN-Achse senkrecht zum Pfad -> das
;; ist identisch zum bisherigen Querschub.
(setq rad-ein (* (float ein-hz-as) (/ pi 180.0)))
(setq de-x (cos rad-ein) de-y (sin rad-ein)) ; KS_EIN-Achsrichtung
(setq de-dot-np (+ (* de-x perp-x) (* de-y perp-y)))
(setq t-shift (if (> (abs de-dot-np) 1e-6) (/ d-perp de-dot-np) 0.0))
(setq sx (* (- t-shift) de-x) sy (* (- t-shift) de-y))
(if (> (abs t-shift) 1e-6)
(vla-Move (vlax-ename->vla-object blk)
(vlax-3D-point '(0.0 0.0 0.0)) (vlax-3D-point (list sx sy 0.0))))
;; (4) korrigierten KS_AUS-Frame zurueckgeben (Richtung unveraendert)
(list (list (+ (car ks-aus) sx) (+ (cadr ks-aus) sy) (caddr ks-aus))
(cadr frame) (caddr frame) (cadddr frame))
)
;; VF-Start-AS (Modus 2): identische Platzierung wie beim GF-Start, aber FLACH
;; (0 Grad Neigung). Das AS wird mit KS_EIN auf den Startpunkt gesetzt und dann
;; senkrecht zu hz auf den Pfad geschoben (reine KS-Kettung, KS_AUS auf Pfad).
;; Damit liegt auch eine mit VF beginnende Kette auf dem gezeichneten Pfad.
(defun vfl2-insert-as-vf (startpunkt hz as-seite)
(vfl2-insert-as-gf startpunkt hz 0.0 as-seite))
;; VF-Einheit OEFFNEN (Modus 2): GF1 (Basis-Staustrecke) + Separator +
;; Umlenkstation. Rueckgabe: Frame nach der Umlenkstation (Beginn reiner VF).
(defun vfl2-vf-open (frame hz / f)
(setq f (vfl-frame-3grad (vfs-vf-entry (car frame) *vfl-gf-min-laenge* hz) hz))
(if (> *vfl-gf-min-laenge* 0.1)
(vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
f)
;; VF-Einheit SCHLIESSEN (Modus 2): Motorstation + GF2 (Basis), KEIN Separator
;; (der sitzt erst am Kettenende bzw. optional zwischen Foerderern). Rueckgabe:
;; Frame nach GF2.
(defun vfl2-vf-close (frame hz / f)
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts")))
(setq f (vfl-frame-3grad (vfs-vf-exit (car frame) *vfl-gf-min-laenge* hz nil) hz))
(if (> *vfl-gf-min-laenge* 0.1)
(vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
f)
;; Vario-Winkel (Vertikalbogen) auf die verfuegbaren Werte 3..51 einrasten.
(defun vfl2-snap-vfwinkel (w / liste best bd d)
(setq liste (ssg-cfg-or "vario" "bogen_winkel" '(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq best (car liste) bd 1e9)
(foreach x liste (setq d (abs (- x w))) (if (< d bd) (setq bd d best x)))
best)
(defun vf-linienzug-modus3 ( / ss 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 (ssg-text "vfl-vwnb-titel"))
(princ "\n=========================================")
;; Abhaengigkeit Gefaellestrecke-Modul (GF-Bausteine)
(if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED"))))
(progn (alert (ssg-text "vfl-m3-alert-gf-modul")) (exit)))
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
;; --- 1. Pfad-Objekte waehlen (LINE/ARC) ---
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq ss (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 (hoehere Seite) + Hoehe + AS-Seite ---
(setq startpunkt (vfl-getpoint nil (ssg-text "vfl-m3-prompt-startpunkt")))
(if (null startpunkt) (progn (princ (ssg-text "vfl-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))
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
(princ (ssg-text "vfl-vwnb-aus-seite-menu"))
(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. Sortieren + Analysieren ---
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
(if (null kette)
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit)))
(setq segmente (gf-analysiere-kette kette))
;; --- 4. Eck-Winkel-Vorpruefung (vor dem Bau) ---
(setq ecke-bad (vfl2-pruefe-eckwinkel kette 5.0))
(if ecke-bad
(progn
(alert (ssg-textf "vfl-vwnb-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
(exit)))
;; --- 5. Setup ---
(setq aus (if aus-dx aus-dx 576.0) ein (if ein-dx ein-dx 576.0))
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
;; Entry-Fussabdruck (planar) einer VF-Einheit: GF1(Basis)+Separator(300)+Umlenk(500)
(setq ent-fp (* (+ *vfl-gf-min-laenge* 300.0 500.0) (cos rad3)))
(setq run-typ nil)
(setq vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
(vfl-acc-reset)
(setq anzahl-gf 0 anzahl-vf 0 frame nil n (length segmente))
;; erste/letzte "Linie" fuer die Trimmung bestimmen
(setq first-line -1 last-line -1 i 0)
(while (< i n)
(if (= (car (nth i segmente)) "Linie")
(progn (if (< first-line 0) (setq first-line i)) (setq last-line i)))
(setq i (1+ i)))
(if (< first-line 0)
(progn (alert (ssg-text "vfl-vwnb-alert-keine-gerade")) (exit)))
;; --- 6. Bau-Schleife (Meilenstein 2: GF + VF-Laeufe, Run-State-Machine) ---
;; run-typ: nil / "GF" / "VF". Beim Wechsel GF<->VF wird die VF-Einheit
;; geoeffnet (GF1+Separator+Umlenk) bzw. geschlossen (Motor+GF2).
;; v1-Naeherung Laenge: Entry-Fussabdruck wird vom ersten VF-Koerper abgezogen;
;; der Exit (Motor+GF2) wird beim Schliessen ANGEHAENGT (verlaengert den VF-Lauf
;; ggue. dem gezeichneten Pfad; feinere Laengen-Reservierung -> spaeter).
(setq i 0)
(while (< i n)
(setq seg (nth i segmente) typ (car seg) hz (cadr seg))
(cond
;; ===================== GERADE =====================
((= typ "Linie")
(setq laenge (caddr seg))
(princ (ssg-textf "vfl-m3-seg-gerade"
(list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1))))
(princ (ssg-text "vfl-vwnb-typ-gerade"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(cond
;; --- GF-Gerade ---
((or (= antwort "") (= antwort "1"))
(if (= run-typ "VF") ; offenen VF-Lauf schliessen
(progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
(setq run-typ nil)))
(setq winkel (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)))
(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 (ssg-text "vfl-vwnb-prompt-vario-winkel")))
(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 (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")
;; --- Vario-Kurve (nur im VF-Lauf) ---
(if (not (= run-typ "VF"))
(princ (ssg-text "vfl-vwnb-kurve-nur-vf"))
(progn
(princ (ssg-text "vfl-m3-variante-frage"))
(setq kvariante (if (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "1") "aussen" "innen"))
(setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite kvariante))))
;; --- GF-Bogen ---
(progn
(if (null frame)
(progn (alert (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit)))
(if (= run-typ "VF") ; VF-Lauf vor GF-Bogen schliessen
(progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
(setq run-typ nil)))
(setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite))
(setq run-typ "GF"))))
)
(setq i (1+ i)))
;; --- 7. Kettenende: offenen VF-Lauf schliessen, dann Separator + ES ---
(if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit)))
(setq es-seite (vfl-frage-es-seite))
(if (= run-typ "VF")
(progn
(setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame))))
(setq frame (vfl-insert-es-element "VF" frame (car (frame->hz-winkel frame))
0.0 (caddr (car frame)) es-seite)))
(setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame))
(if letzt-winkel letzt-winkel 3.0) (caddr (car frame)) es-seite)))
;; --- 8. Block + Ist-Ziel-Report ---
(setq hoehe-bis (caddr (car frame)))
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt)
(setq soll-ende (caddr (last kette))) ; Endpunkt des letzten gezeichneten Segments
(setq ist-ende (car frame)) ; ES-KS_AUS
(princ "\n\n=========================================")
(princ (ssg-text "vfl-vwnb-eingefuegt"))
(princ (ssg-textf "vfl-vwnb-soll-ende"
(list (rtos (car soll-ende) 2 1) (rtos (cadr soll-ende) 2 1))))
(princ (ssg-textf "vfl-vwnb-ist-ende"
(list (rtos (car ist-ende) 2 1) (rtos (cadr ist-ende) 2 1) (rtos (caddr ist-ende) 2 1))))
(princ (ssg-textf "vfl-vwnb-abweichung-xy"
(list (rtos (- (car ist-ende) (car soll-ende)) 2 1)
(rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1))))
(princ "\n=========================================")
(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 (ssg-text "vfl-as-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-m3-as-nein"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(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 (ssg-text "vfl-es-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-es-nein-zielpunkt"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(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 (ssg-textf "vfl-kette-diag-startbaustein"
(list (vfl-kette-rec-bname start-rec)
(rtos (car (vfl-kette-rec-aus start-rec)) 2 1)
(rtos (cadr (vfl-kette-rec-aus start-rec)) 2 1)
(rtos (caddr (vfl-kette-rec-aus start-rec)) 2 1))))
(if naechster-fund
(princ (ssg-textf "vfl-kette-diag-naechster-kandidat"
(list (vfl-kette-rec-bname (car naechster-fund))
(rtos (cdr naechster-fund) 2 1)
(rtos *vfl-kette-tol-eng* 2 1)
(rtos *vfl-kette-tol-weit* 2 1))))
(princ (ssg-textf "vfl-kette-diag-kein-anderer" (list (itoa (length alle-records))))))
(princ (ssg-text "vfl-kette-nur-ein-baustein")) (ssg-end) (exit)))
(princ (ssg-textf "vfl-kette-gefunden" (list (itoa (length kette)))))
(foreach rec kette (princ (strcat "\n " (vfl-kette-rec-bname rec))))
(if warnung
(princ (ssg-textf "vfl-kette-luecke-warnung"
(list (car warnung) (cadr warnung) (rtos (caddr warnung) 2 1)))))
;; DIAGNOSE: Anschluesse mit spuerbarem (>0.5mm), aber noch innerhalb
;; tol-eng liegendem Abstand - Verdacht auf zufaellig nahe, aber nicht
;; wirklich zusammengehoerige Bauteile (z.B. zwei unabhaengige Linien, die
;; im Layout nahe beieinander liegen).
(if verdaechtig
(foreach v verdaechtig
(princ (ssg-textf "vfl-kette-diag-verdaechtig"
(list (car v) (cadr v) (rtos (caddr v) 2 3)))))
)
;; Attribute aus der Bausteinfolge herleiten, bevor irgendetwas an der
;; Zeichnung veraendert wird (chain-start/chain-end kommen aus dem ersten/
;; letzten Datensatz in kette).
(setq neuer-bname (strcat "VF_" (itoa (vf-next-number))))
(setq chain-start (vfl-kette-rec-ein (car kette)))
(setq chain-end (vfl-kette-rec-aus (car (reverse kette))))
(setq erg (vfl-kette-baue-attribute kette neuer-bname chain-start chain-end))
(setq aggregiert (car erg))
(setq typ-str (cadr erg))
;; Aufgeloeste Wrapper-Sub-Elemente: der ORIGINAL-Wrapper wird (einmal je
;; distinktem wrapper-ename, da er i.d.R. mehrere Sub-Element-Datensaetze
;; in kette beisteuert) jetzt fuer REAL explodiert - Sub-Elemente bleiben
;; als Bloecke erhalten, ATTRIB-Textreste werden verworfen, Original
;; geloescht. Lose Einzel-Bausteine werden unveraendert direkt uebernommen (_.-BLOCK
;; unten SOLLTE sie beim Wickeln konsumieren, wie bei frisch gebauter
;; Geometrie - leaf-enames wird trotzdem mitgefuehrt, um sie nach dem
;; Wickeln sicherheitshalber explizit zu entfernen, falls _.-BLOCK sie aus
;; irgendeinem Grund NICHT aus dem Modellraum nimmt (doppelte/ueberlappende
;; Geometrie waere sonst die Folge).
(setq merge-ss (ssadd))
(setq leaf-enames '())
(setq aufgeloeste-wrapper '())
(foreach rec kette
(if (vfl-kette-rec-wrapper rec)
(if (not (member (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
(progn
(setq aufgeloeste-wrapper (cons (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
(setq kinder (vlax-invoke (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)) 'Explode))
(foreach kind kinder
(if (not (vlax-erased-p kind))
(if (= (vla-get-ObjectName kind) "AcDbBlockReference")
(ssadd (vlax-vla-object->ename kind) merge-ss)
(vla-Delete kind)
)
)
)
(vla-Delete (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)))
)
)
(progn
(setq leaf-enames (cons (vfl-kette-rec-ename rec) leaf-enames))
(ssadd (vfl-kette-rec-ename rec) merge-ss)
)
)
)
;; Frische ATTDEFs am Kettenanfang (wie vfl-block-erstellen), neu wickeln.
(foreach def (ssg-strecke-attrib-defs typ-str)
(entmake
(list '(0 . "ATTDEF")
(cons 10 chain-start)
(cons 11 chain-start)
'(40 . 50.0)
(cons 1 (cadr def))
(cons 2 (car def))
(cons 3 (car def))
'(70 . 1)
'(72 . 0)
'(74 . 0)))
(ssadd (entlast) merge-ss)
)
(setq neuer-insert (ssg-block-wrap-welt neuer-bname chain-start merge-ss))
(ssg-attrib-set-on neuer-insert aggregiert)
;; SEITE_AS/SEITE_ES explizit leeren, wenn die Kette (Ausnahmefall) ohne
;; eigenes AS-/ES-Element beginnt/endet - ssg-attrib-set-on wuerde einen
;; leeren Wert sonst als "keine Ueberschreibung" behandeln und den
;; ATTDEF-Default "rechts" faelschlich stehen lassen.
(if (= (cdr (assoc "SEITE_AS" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_AS"))
(if (= (cdr (assoc "SEITE_ES" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_ES"))
(if (car (atoms-family 1 '("SSG-ID-GENERATE"))) (ssg-id-generate neuer-insert))
;; Sicherheitsnetz: lose Einzelteile, die _.-BLOCK aus irgendeinem Grund NICHT
;; aus dem Modellraum entfernt hat, jetzt explizit loeschen - verhindert
;; doppelte/ueberlappende Geometrie (altes Original + neuer Gesamt-Block).
(setq leaf-noch-da 0)
(foreach leaf-ename leaf-enames
(setq leaf-obj (vl-catch-all-apply 'vlax-ename->vla-object (list leaf-ename)))
(if (and (not (vl-catch-all-error-p leaf-obj)) leaf-obj (not (vlax-erased-p leaf-obj)))
(progn
(setq leaf-noch-da (1+ leaf-noch-da))
(vla-Delete leaf-obj)
)
)
)
(if (> leaf-noch-da 0)
(princ (strcat "\n [Diagnose] " (itoa leaf-noch-da)
" lose Einzelteil(e) waren nach _.-BLOCK noch im Modellraum vorhanden - jetzt nachtraeglich entfernt.")))
(princ (ssg-textf "vfl-kette-fertig" (list neuer-bname (itoa (length kette)))))
(ssg-end)
(princ)
)
(vf-typ-registrieren
"linienzug"
'vfl-berechne-platzhalter
'vfl-einfuege-platzhalter
(ssg-text "vfc-typ-linienzug-beschreibung"))
(princ "\n>>> vf_linienzug.lsp geladen - Typ 'linienzug' registriert")
(princ)
Reference in New Issue View Git Blame Copy Permalink