;; ============================================================ ;; 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__). (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). ;; Zusaetzlich (falls ein Debug-Schalter fuer die aktuelle Sitzung eine .dbg- ;; Datei geoeffnet hat, siehe ssg_dbg.lsp/dbg-schalter-open) wird jeder ;; Eintrag als FRAGE/ANTWORT-Paar mitgeloggt - da ALLE interaktiven Eingaben ;; von Modus 1 UND Modus 2 durch diesen einen Punkt laufen (vfl-in-point/ ;; -string/-real/-int/-value/-selection), deckt das beide Modi komplett ab, ;; ohne jede einzelne Aufrufstelle im Bau-Ablauf separat instrumentieren zu ;; muessen. Modus 3 nutzt bewusst rohe getstring/getreal/getint (reine ;; Konsole, kein Journal) und wird stattdessen direkt in vf-linienzug-modus3 ;; mit eigenen dbgmsg-Aufrufen geloggt. dbgmsg/dbg sind von sich aus No-Ops, ;; solange keine .dbg-Datei offen ist (*dbg-path* nil) - daher hier bewusst ;; UNBEDINGT aufgerufen, kein eigener An/Aus-Check noetig. (defun vfl-journal-record (kind val) (setq *vfl-journal* (cons (cons kind val) *vfl-journal*)) (if (= kind "STEP") (dbgmsg (strcat "--- GLIED: " (if val (vl-princ-to-string val) "?") " ---")) (progn (dbgmsg (strcat "EINGABE [" kind "]:")) (dbg val) (dbgflush)))) ;; Glied-Checkpoint setzen (Label spaeter via vfl-journal-steplabel setzbar). (defun vfl-journal-mark (label) (vfl-journal-record "STEP" label)) ;; Label des JUENGSTEN STEP-Eintrags nachtraeglich setzen (der Segmenttyp steht ;; erst nach der Menue-Auswahl fest, der Marker sitzt aber am Iterationskopf). (defun vfl-journal-steplabel (label / found) (setq found nil) (setq *vfl-journal* (mapcar (function (lambda (e) (if (and (not found) (= (car e) "STEP")) (progn (setq found t) (cons "STEP" label)) e))) *vfl-journal*)) (dbgmsg (strcat "--- GLIED-LABEL: " (if label label "?") " ---")) (dbgflush) label) ;; Naechsten Eingabe-Eintrag aus der Replay-Queue poppen (STEP-Marker dabei ;; ueberspringen - die werden bei der erneuten Ausfuehrung neu erzeugt). ;; Rueckgabe: (value) als 1-elementige Liste, falls ein Eintrag da war ;; (unterscheidet einen echten nil-Wert von einer leeren Queue); nil, wenn die ;; Queue erschoepft ist (danach faellt der Wrapper auf Live-Eingabe zurueck). (defun vfl-replay-pop ( / e) (while (and *vfl-replay-queue* (= (car (car *vfl-replay-queue*)) "STEP")) (setq *vfl-replay-queue* (cdr *vfl-replay-queue*))) (if *vfl-replay-queue* (progn (setq e (car *vfl-replay-queue*)) (setq *vfl-replay-queue* (cdr *vfl-replay-queue*)) (list (cdr e))) nil)) ;; ============================================================ ;; TEIL 0b-2: WIZARD-EINGABE (DCL statt Konsole) ;; ============================================================ ;; Ersetzt NUR die LIVE-Eingabe (frischer Bau) durch DCL-Dialoge ;; (dcl/vf_linienzug_wizard.dcl). Journal-Replay (Editieren bestehender ;; Ketten, vfl-edit-ent) ist UNVERAENDERT: er liefert seinen Wert ueber ;; "popped" und erreicht den Wizard-Zweig unten gar nicht erst. ;; Die ORIGINALEN Konsolen-Fragen (princ + getstring/getreal/getint an jeder ;; Aufrufstelle) bleiben vollstaendig im Code stehen (weiterhin de/en ueber ;; ssg-text/lang/*.json) - sie laufen bei *vfl-wizard-mode* = nil unveraendert ;; wie bisher. Schnell zurueckschalten: Befehl VF_WIZARD_AUS bzw. ;; (setq *vfl-wizard-mode* nil). ;; Sicherheitsnetz: jeder Wizard-Aufruf ist per vl-catch-all-apply ;; abgesichert - jeder Fehler (fehlendes DCL, kaputtes Tile etc.) faellt ;; automatisch und lautlos auf die alte Konsolen-Eingabe zurueck, es gibt ;; also keinen Abbruch-Pfad, der NUR durch den Wizard entsteht. (if (not (boundp '*vfl-wizard-mode*)) (setq *vfl-wizard-mode* T)) (if (not (boundp '*vflw-menu-optionen*)) (setq *vflw-menu-optionen* nil)) (if (not (boundp '*vflw-menu-default*)) (setq *vflw-menu-default* 1)) (if (not (boundp '*vflw-menu-frage*)) (setq *vflw-menu-frage* nil)) (defun c:VF_WIZARD_AN () (setq *vfl-wizard-mode* T) (princ "\nVF-Linienzug-Assistent: EIN (DCL-Dialoge)") (princ)) (defun c:VF_WIZARD_AUS () (setq *vfl-wizard-mode* nil) (princ "\nVF-Linienzug-Assistent: AUS (Konsolen-Fragen)") (princ)) (defun vflw-dcl-pfad () (strcat (vl-string-translate "\\" "/" (getenv "DXFM_DCL")) "/vf_linienzug_wizard.dcl")) ;; Text fuer Dialog-Anzeige (Kopfzeile ODER Popup-Listen-Option) saeubern: ;; fuehrende Newlines/Leerzeichen entfernen, DANACH ein fuehrendes ;; Konsolen-Ziffernpraefix wie "1 - " (aus "1 - 90 Grad", "2 - Links" usw.) ;; abschneiden - im Dialog klickt der Nutzer die Option, die Ziffer braucht ;; er nur an der Kommandozeile. Die Ziffer/der Index selbst wird davon nicht ;; beruehrt: Popup-Auswahl und Pending-Queue arbeiten weiterhin ueber die ;; Listenposition (get_tile "..." liefert einen 0-basierten Index), nicht ;; ueber diesen Anzeigetext. Kopfzeilen-Texte beginnen nie mit einer Ziffer ;; und sind von diesem zweiten Schritt daher unberuehrt. (defun vflw-clean (s / i n) (while (and (> (strlen s) 0) (member (substr s 1 1) (list "\n" " "))) (setq s (substr s 2))) (setq n (strlen s) i 1) (while (and (<= i n) (wcmatch (substr s i 1) "#")) (setq i (1+ i))) (if (> i 1) (progn (while (and (<= i n) (= (substr s i 1) " ")) (setq i (1+ i))) (if (and (<= i n) (= (substr s i 1) "-")) (progn (setq i (1+ i)) (while (and (<= i n) (= (substr s i 1) " ")) (setq i (1+ i))) (setq s (substr s i)))))) s) ;; Generischer Zahlen-Dialog (ersetzt getreal). Rueckgabe: reale Zahl oder ;; nil (Abbruch/leer - wie getreal bei blossem Enter, von den Aufrufern ;; bereits ueberall mit einem Default abgefangen). (defun vflw-zahl-impl (prompt / dat dcl-pfad dlg-wert ergebnis) (setq dcl-pfad (vflw-dcl-pfad)) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog "vflw_zahl" dat)) (progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil) (progn (set_tile "kopf" (vflw-clean prompt)) (action_tile "accept" "(setq dlg-wert (get_tile \"wert\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (and (= ergebnis 1) dlg-wert (> (strlen dlg-wert) 0)) (atof dlg-wert) nil)))) (defun vflw-zahl (prompt / r) (setq r (vl-catch-all-apply 'vflw-zahl-impl (list prompt))) (if (vl-catch-all-error-p r) (getreal prompt) r)) ;; Generischer Auswahl-Dialog (ersetzt eine princ-Menue-Liste + getstring/ ;; getint). optionen = Liste bereits lokalisierter Options-Texte, ;; default-idx = 1-basiert vorselektiert. Rueckgabe: "1".."N" (String, wie ;; getstring) oder "" (Abbruch/leer - faellt bei den Aufrufern ueberall auf ;; den bestehenden Default-Zweig zurueck, genau wie ein leeres Enter heute). (defun vflw-wahl-impl (prompt optionen default-idx / dat dcl-pfad dlg-opt ergebnis opt) (setq dcl-pfad (vflw-dcl-pfad)) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog "vflw_wahl" dat)) (progn (if (and dat (>= dat 0)) (unload_dialog dat)) "") (progn (set_tile "kopf" (vflw-clean prompt)) (start_list "opts") (foreach opt optionen (add_list (vflw-clean opt))) (end_list) (set_tile "opts" (itoa (max 0 (1- (if default-idx default-idx 1))))) (action_tile "accept" "(setq dlg-opt (get_tile \"opts\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (itoa (1+ (atoi dlg-opt))) "")))) (defun vflw-wahl (prompt optionen default-idx / r) (setq r (vl-catch-all-apply 'vflw-wahl-impl (list prompt optionen default-idx))) (if (vl-catch-all-error-p r) "" r)) ;; ============================================================ ;; TEIL 0b-4: GRUPPEN-DIALOGE - GEMEINSAME PUNKTWAHL-BAUSTEINE ;; ============================================================ ;; Punktwahl aus einem offenen Dialog heraus: (getpoint) direkt aus einem ;; action_tile-Callback funktioniert in BricsCAD NICHT zuverlaessig (der ;; Dialog behaelt den Fokus, die Zeichnung reagiert nicht auf Klicks - per ;; Test bestaetigt). Stattdessen das robuste "Schliessen-Picken-Neu-Zeigen"- ;; Muster: der Pick-Button beendet den Dialog ueber einen eigenen ;; done_dialog-Code (2), NACH dem unload_dialog laeuft (getpoint) ganz ;; normal auf der Kommandozeile, danach wird der Dialog mit dem Ergebnis neu ;; aufgebaut (new_dialog erneut) - eine (while ...)-Schleife um new_dialog/ ;; start_dialog statt eines einmaligen Aufrufs. (defun vflw-g-punkt-str (pt) (strcat "X=" (rtos (car pt) 2 1) " Y=" (rtos (cadr pt) 2 1) " Z=" (rtos (caddr pt) 2 1))) ;; ------------------------------------------------------------ ;; Gruppe "Punkt+Hoehe": ein Punkt gefolgt von einer davon abhaengigen ;; Hoehen-Zahl (Default = Z des gepickten Punkts, wie im Original-Prompt). ;; Wiederverwendet fuer Modus 1 "Kettenstart" (Startpunkt+Starthoehe) UND ;; Modus 2 "Startpunkt/Endpunkt" (jeweils +Hoehe) - kopf-key/wlabel-text pro ;; Aufruf. Original-Reihenfolge/-Journal an jeder Aufrufstelle: vfl-in-point, ;; dann vfl-in-real - bleibt unveraendert, nur die Werte kommen aus der ;; Pending-Queue. (defun vflw-gruppe-punkt-hoehe-impl (kopf-key wlabel-text / dat dcl-pfad ergebnis gpunkt gwert wert-akt fertig) (setq wert-akt "0" fertig nil) (while (not fertig) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_punkt_zahl" dat)) (progn (if (and dat (>= dat 0)) (unload_dialog dat)) (setq fertig t)) (progn (set_tile "kopf" (vflw-clean (ssg-text kopf-key))) (set_tile "wlabel" wlabel-text) (set_tile "wert" wert-akt) (if gpunkt (set_tile "pt_anzeige" (vflw-g-punkt-str gpunkt))) (action_tile "pick" "(done_dialog 2)") (action_tile "accept" "(setq gwert (get_tile \"wert\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (cond ((= ergebnis 2) ;; Dialog ist jetzt zu - Zeichnung hat den Fokus, getpoint geht normal. (setq gpunkt (vfl-getpoint nil "\nPunkt waehlen: ")) (if gpunkt (setq wert-akt (rtos (caddr gpunkt) 2 1))) ;; fertig bleibt nil -> Schleife zeigt den Dialog mit dem Ergebnis erneut. ) ((= ergebnis 1) (setq fertig t) (if (and gpunkt gwert (> (strlen gwert) 0)) (vflw-pending-push-all (list gpunkt (atof gwert))))) (t (setq fertig t))) ) ) ) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "AS-/ES-Element": Ja/Nein + [wenn Ja] Winkel(30/90) + Seite. ;; Wiederverwendet fuer Modus 1 UND Modus 2, jeweils fuer AS (Kettenanfang) ;; UND ES (Kettenende) - kopf-key pro Aufruf traegt die konkrete Frage; die ;; Winkel/Seite-Optionen sind in allen vier Faellen identisch (90/30 bzw. ;; links/rechts), "Nein" ist journalseitig immer "2" (identischer Vergleich ;; im Aufrufer-Code) - beides braucht daher keinen eigenen Parameter. ;; Original-Reihenfolge/-Journal: vfl-in-string (Ja/Nein), dann bei Ja ;; vfl-in-value (Winkel) + vfl-in-string (Seite) - bleibt unveraendert. (defun vflw-gruppe-as-impl (kopf-key / dat dcl-pfad ergebnis gsetzen gwinkel gseite) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_as" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean (ssg-text kopf-key))) (set_tile "setzen" "1") (start_list "winkel") (add_list (vflw-clean (ssg-text "vf-winkel-90"))) (add_list (vflw-clean (ssg-text "vf-winkel-30"))) (end_list) (set_tile "winkel" "0") (start_list "seite") (add_list (vflw-clean (ssg-text "gf-seite-links"))) (add_list (vflw-clean (ssg-text "gf-seite-rechts"))) (end_list) (set_tile "seite" "0") (action_tile "setzen" "(mode_tile \"winkel\" (if (= (get_tile \"setzen\") \"1\") 0 1)) (mode_tile \"seite\" (if (= (get_tile \"setzen\") \"1\") 0 1))") (action_tile "accept" "(setq gsetzen (get_tile \"setzen\")) (setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (if (= gsetzen "1") ;; Winkel-Slot wird von vfl-in-value (AS-Winkel, ueber ;; vf-frage-element-winkel) konsumiert - der erwartet direkt ;; "30"/"90", NICHT den Auswahl-Index wie beim Seite-Slot. (vflw-pending-push-all (list "1" (if (= gwinkel "1") "30" "90") (if (= gseite "1") "2" "1"))) (vflw-pending-push-all (list "2")))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Winkel+Seite": GF-Bogen (3 Winkel-Optionen) ODER ES-Element am ;; Kettenende (2 Winkel-Optionen). Original-Reihenfolge/-Journal: ;; vfl-in-int/vfl-in-value (Winkel), dann vfl-in-string (Seite). ;; winkel-kind: "INT" (GF-Bogen, vfl-in-int liefert Zahl) oder "STR" ;; (ES-Element, vfl-in-value liefert "30"/"90" als String). (defun vflw-gruppe-winkel-seite-impl (kopf-key winkel-optionen winkel-kind / dat dcl-pfad ergebnis gwinkel gseite) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_winkel_seite" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean (ssg-text kopf-key))) (start_list "winkel") (foreach o winkel-optionen (add_list (vflw-clean o))) (end_list) (set_tile "winkel" "0") (start_list "seite") (add_list (vflw-clean (ssg-text "gf-seite-links"))) (add_list (vflw-clean (ssg-text "gf-seite-rechts"))) (end_list) (set_tile "seite" "0") (action_tile "accept" "(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (list (if (= winkel-kind "INT") (1+ (atoi gwinkel)) (nth (atoi gwinkel) '("90" "30"))) (if (= gseite "1") "2" "1")))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Vario-Kurve": Winkel(90/60/30) + Seite + Variante(aussen/innen). ;; Original-Reihenfolge/-Journal: vfl-in-int (Winkel), vfl-in-string ;; (Seite), vfl-in-string (Variante). (defun vflw-gruppe-variokurve-impl ( / dat dcl-pfad ergebnis gwinkel gseite gvariante) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_variokurve" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean (ssg-text "vfl-variokurve-winkel-header"))) (start_list "winkel") (add_list (vflw-clean (ssg-text "vfl-opt1-90grad"))) (add_list (vflw-clean (ssg-text "vfl-opt2-60grad"))) (add_list (vflw-clean (ssg-text "vfl-opt3-30grad"))) (end_list) (set_tile "winkel" "0") (start_list "seite") (add_list (vflw-clean (ssg-text "gf-seite-links"))) (add_list (vflw-clean (ssg-text "gf-seite-rechts"))) (end_list) (set_tile "seite" "0") (start_list "variante") (add_list (vflw-clean (ssg-text "vfl-variante-aussen"))) (add_list (vflw-clean (ssg-text "vfl-variante-innen"))) (end_list) (set_tile "variante" "1") (action_tile "accept" "(setq gwinkel (get_tile \"winkel\")) (setq gseite (get_tile \"seite\")) (setq gvariante (get_tile \"variante\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (list (1+ (atoi gwinkel)) (if (= gseite "1") "2" "1") (if (= gvariante "1") "2" "1")))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Gefaelle festlegen" (Linie GF): Modus(Hoehe/Winkel) + EIN ;; Wertfeld (Beschriftung wechselt mit dem Modus). KEIN Punkt-Feld: der ;; Endpunkt (X/Y, fuer die Fahrtrichtung/Laengenberechnung) ist an der ;; Aufrufstelle bereits VOR dieser Gruppe ueber vfl-neue-linie-messen/ ;; vfl-in-point gepickt - dessen Z wird nie gelesen, "Hoehe" hier ist ein ;; davon unabhaengiger Zahlenwert (siehe Kommentar bei ;; vfl-neue-linie-messen). Original-Reihenfolge/-Journal ab hier: ;; vfl-in-string (Modus), danach vfl-in-real (Winkel ODER Hoehe). (defun vflw-gruppe-gefaelle-impl (hoehe-default / dat dcl-pfad ergebnis gmodus gwert winkel-default) (setq winkel-default (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_gefaelle" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean (ssg-text "vfl-gefaelle-festlegen-header"))) (start_list "modus") (add_list (vflw-clean (ssg-text "vfl-gefaelle-opt-hoehe"))) (add_list (vflw-clean (ssg-text "vfl-gefaelle-opt-winkel"))) (end_list) (set_tile "modus" "0") (set_tile "wlabel" "Zielhoehe (Z, mm):") (set_tile "wert" (rtos hoehe-default 2 1)) ;; Wertfeld MUSS beim Moduswechsel mit umschalten - sonst steht dort ;; nach dem Wechsel noch der Wert des vorherigen Modus (Hoehe/Winkel ;; sind nicht dieselbe Groesse, ein stehengebliebener Hoehenwert waere ;; als Neigungswinkel unsinnig). (action_tile "modus" "(if (= (get_tile \"modus\") \"0\") (progn (set_tile \"wlabel\" \"Zielhoehe (Z, mm):\") (set_tile \"wert\" (rtos hoehe-default 2 1))) (progn (set_tile \"wlabel\" \"Neigungswinkel (Grad):\") (set_tile \"wert\" (rtos (float winkel-default) 2 1))))") (action_tile "accept" "(setq gmodus (get_tile \"modus\")) (setq gwert (get_tile \"wert\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (list (if (= gmodus "1") "2" "1") (atof gwert)))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Ziel-Hoehe": NUR die Hoehen-Zahl (kein Punkt-Feld). Wiederverwendet ;; an mehreren Stellen (Linie-VF, VF-Einheit-Fortsetzung "Auf/Ab", ;; vfl-body-abschluss). Der Endpunkt (X/Y, fuer die Segmentlaenge) ist an der ;; Aufrufstelle bereits separat ueber vfl-neue-linie-messen gepickt - dessen ;; Z wird nirgends verwendet, die Hoehe hier ist eine davon unabhaengige ;; Zahl (Default = aktuelle Kettenhoehe, wie im Original-Prompt). Nutzt ;; bewusst den generischen Einzel-Dialog vflw_zahl (kein Punkt-Button, der ;; faelschlich eine hier moegliche Punktwahl suggerieren wuerde). ;; hoehe-default: aktuelle Kettenhoehe (Vorbelegung, wie im Original-Prompt). (defun vflw-gruppe-ziel-hoehe-impl (hoehe-default / dat dcl-pfad ergebnis dlg-wert) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_zahl" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" (vflw-clean (ssg-textf "vfl-prompt-hoehe-endpunkt" (list (rtos hoehe-default 2 1))))) (set_tile "wert" (rtos hoehe-default 2 1)) (action_tile "accept" "(setq dlg-wert (get_tile \"wert\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (and (= ergebnis 1) dlg-wert (> (strlen dlg-wert) 0)) (vflw-pending-push-all (list (atof dlg-wert)))))) (princ)) ;; ------------------------------------------------------------ ;; Gruppe "Horizontales Stueck": Separator VOR + Separator NACH + ;; Foerderer-Ende (3 Optionen). Original-Reihenfolge/-Journal (alle in ;; vfl-baue-horizontal-koerper): vfl-in-string (Sep-vor), vfl-in-string ;; (Sep-nach), [nur im Ziel-Modus] vfl-in-string (Ist-Ende). Der Endpunkt ;; wird an der Aufrufstelle bereits separat ueber vfl-neue-linie-messen ;; gemessen - kein Punkt-Button hier (analog Gefaelle-/Ziel-Hoehe-Gruppe). ;; mit-ende: T, wenn (im Ziel-Modus) zusaetzlich die Ist-Ende-Frage ;; mitgestellt werden soll (siehe vfl-baue-horizontal-koerper). (defun vflw-gruppe-horizontal-impl (mit-ende / dat dcl-pfad ergebnis gsepvor gsepnach gende) (setq dat (load_dialog (vflw-dcl-pfad))) (if (not (new_dialog "vflw_horizontal" dat)) (if (and dat (>= dat 0)) (unload_dialog dat)) (progn (set_tile "kopf" "Horizontales Stueck") (set_tile "sepvor" "0") (set_tile "sepnach" "0") (start_list "istende") (add_list (vflw-clean (ssg-text "vfl-ja-nur-motorstation"))) (add_list (vflw-clean (ssg-text "vfl-nein-weiterbauen"))) (add_list (vflw-clean (ssg-text "vfl-ja-motorstation-kettenende"))) (end_list) (set_tile "istende" "1") (mode_tile "istende" (if mit-ende 0 1)) (action_tile "accept" "(setq gsepvor (get_tile \"sepvor\")) (setq gsepnach (get_tile \"sepnach\")) (setq gende (get_tile \"istende\")) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (vflw-pending-push-all (append (list (if (= gsepvor "1") "1" "2") (if (= gsepnach "1") "1" "2")) (if mit-ende (list (itoa (1+ (atoi gende)))) nil)))))) (princ)) ;; ============================================================ ;; TEIL 0b-3: GRUPPEN-DIALOGE (PENDING-QUEUE) ;; ============================================================ ;; Mehrere Fragen, die im Ablauf IMMER unmittelbar hintereinander kommen ;; (kein Zwischenschritt, keine Verzweigung dazwischen), werden im Wizard in ;; EINEM Dialog gemeinsam erfasst (siehe vflw-gruppe-* unten). Die ;; darunterliegende Aufruf-Reihenfolge in vf-linienzug-modus/vfl-* bleibt ;; dabei WOERTLICH UNVERAENDERT (weiterhin ein vfl-in-point/-string/-real/ ;; -int/-value-Aufruf pro Wert, in derselben Reihenfolge) - nur die HERKUNFT ;; des Werts aendert sich: statt live zu fragen (oder einen Einzel-Dialog zu ;; zeigen) wird der naechste Wert aus *vflw-pending* entnommen, den der ;; Gruppen-Dialog vorher dort abgelegt hat. Journal-Aufzeichnung passiert ;; weiterhin in JEDEM einzelnen vfl-in-*-Aufruf selbst - Editieren/Replay ;; bestehender Ketten ist dadurch unveraendert (siehe TEIL 0b-2). ;; Bricht der Nutzer den Gruppen-Dialog ab, bleibt *vflw-pending* leer - ;; die nachfolgenden vfl-in-*-Aufrufe fallen dann automatisch auf ihre ;; EINZEL-Dialoge zurueck (kein Sonderfall noetig). (if (not (boundp '*vflw-pending*)) (setq *vflw-pending* nil)) (defun vflw-pending-pop ( / v) (if *vflw-pending* (progn (setq v (car *vflw-pending*)) (setq *vflw-pending* (cdr *vflw-pending*)) (list v)) nil)) (defun vflw-pending-push-all (vals) (setq *vflw-pending* (append *vflw-pending* vals)) nil) ;; --- Eingabe-Wrapper --- ;; kind steuert nur, wie ein FRISCH live erfasster Wert typisiert wird; beim ;; Replay wird der gespeicherte Wert unveraendert durchgereicht. (defun vfl-in-point (base prompt / popped v) (setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil)) (if popped (setq v (car popped)) (progn (setq popped (vflw-pending-pop)) (if popped (setq v (car popped)) (setq v (vfl-getpoint base prompt))))) (vfl-journal-record (if v "PT" "NIL") v) v) ;; Objektauswahl (Modus 2: Pfad-Objekte). Wie die anderen Wrapper repliziert ;; bzw. journalisiert - aber KEIN Wizard-Dialog (Objektwahl braucht wie ;; Punktwahl die Zeichnung, kein DCL-Fenster wuerde hier helfen). Beim Replay ;; werden die gespeicherten Handles zurueck in Enames aufgeloest; Handles ;; sind - anders als Enames - ueber Sitzungen hinweg stabil und damit fuer ;; die XDATA-Persistenz geeignet. Loest sich ein Handle nicht mehr auf (z.B. ;; weil der Nutzer die urspruengliche Pfad-Geometrie zwischenzeitlich ;; geloescht hat), wird das klar gemeldet statt eine unvollstaendige Auswahl ;; stillschweigend weiterzureichen. (defun vfl-in-selection (filter / popped v handles h en k ss fehlt) (setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil)) (if popped (progn (setq handles (car popped) v nil fehlt 0) (foreach h handles (setq en (vl-catch-all-apply 'handent (list h))) (if (or (vl-catch-all-error-p en) (null en)) (setq fehlt (1+ fehlt)) (setq v (cons en v)))) (setq v (reverse v)) (if (> fehlt 0) (alert (ssg-textf "vfl-m3-alert-objekte-fehlen" (list (itoa fehlt)))))) (progn (setq ss (ssget filter)) (setq v nil) (if ss (progn (setq k 0) (while (< k (sslength ss)) (setq v (cons (ssname ss k) v)) (setq k (1+ k))) (setq v (reverse v)))))) (setq handles (mapcar (function (lambda (e) (cdr (assoc 5 (entget e))))) v)) (vfl-journal-record (if v "OBJS" "NIL") handles) v) (defun vfl-in-string (prompt / popped v) (setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil)) (if popped (setq v (car popped)) (progn (setq popped (vflw-pending-pop)) (if popped (setq v (car popped)) (setq v (if (and *vfl-wizard-mode* *vflw-menu-optionen*) (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt) *vflw-menu-optionen* *vflw-menu-default*) (getstring prompt)))))) ;; "" (Enter/Abbruch) 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)) (progn (setq popped (vflw-pending-pop)) (if popped (setq v (car popped)) (setq v (if *vfl-wizard-mode* (vflw-zahl prompt) (getreal prompt)))))) (vfl-journal-record (if v "REAL" "NIL") v) v) (defun vfl-in-int (prompt / popped v vs) (setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil)) (if popped (setq v (car popped)) (progn (setq popped (vflw-pending-pop)) (if popped (setq v (car popped)) (setq v (if (and *vfl-wizard-mode* *vflw-menu-optionen*) (progn (setq vs (vflw-wahl (if *vflw-menu-frage* (ssg-text *vflw-menu-frage*) prompt) *vflw-menu-optionen* *vflw-menu-default*)) (if (and vs (> (strlen vs) 0)) (atoi vs) nil)) (getint prompt)))))) (vfl-journal-record (if v "INT" "NIL") v) v) ;; Menue-Wrapper: princ-Ausgabe der Optionen bleibt beim Aufrufer unveraendert ;; stehen (Konsolen-Fallback, de/en via ssg-text) - hier wird nur die ;; ABSCHLIESSENDE Eingabe-Zeile ersetzt. frage-key: ssg-text-Schluessel der ;; eigentlichen Frage (die Kopfzeile, die vorher separat per princ ausgegeben ;; wurde, z.B. "vfl-ist-endpunkt-frage") - OHNE das wuerde der Wizard-Dialog ;; nur die generische "Ihre Wahl (1/2/3)..."-Zeile zeigen und die eigentliche ;; Frage bliebe unsichtbar (nur auf der Konsole hinter dem Dialog). Die ;; Lokalvariablen sind ueber die '/'-Deklaration dynamisch nur waehrend ;; dieses Aufrufs sichtbar (AutoLISP dynamic scoping) und wirken daher ;; ausschliesslich auf den EINEN vfl-in-string/-int-Aufruf im Rumpf. (defun vfl-menu (prompt option-labels default-idx frage-key / *vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*) (setq *vflw-menu-optionen* option-labels) (setq *vflw-menu-default* default-idx) (setq *vflw-menu-frage* frage-key) (vfl-in-string prompt)) (defun vfl-menu-int (prompt option-labels default-idx frage-key / *vflw-menu-optionen* *vflw-menu-default* *vflw-menu-frage*) (setq *vflw-menu-optionen* option-labels) (setq *vflw-menu-default* default-idx) (setq *vflw-menu-frage* frage-key) (vfl-in-int prompt)) ;; 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)) (progn (setq popped (vflw-pending-pop)) (if popped (setq v (car popped)) (setq v (apply livefn nil))))) (vfl-journal-record (if v kind "NIL") v) v) ;; --- String-Hilfen (generisch, Trenner beliebig) --- (defun vfl-strjoin (lst sep / s first) (setq s "" first t) (foreach x lst (if first (progn (setq s x) (setq first nil)) (setq s (strcat s sep x)))) s) (defun vfl-strsplit (s sep / pos out) (setq out '()) (while (setq pos (vl-string-search sep s)) (setq out (cons (substr s 1 pos) out)) (setq s (substr s (+ pos 1 (strlen sep))))) (reverse (cons s out))) ;; --- Serialisierung (tagged, selbstbeschreibend) --- ;; Zeilenformat "kind:payload", Eintraege per "\n" verkettet. getstring/getreal ;; liefern nie ein Newline, daher ist "\n" ein sicherer Record-Trenner. ;; "OBJS" (Objektauswahl, Modus 2): Payload = kommagetrennte Liste von ;; Entity-Handles (Hex-Strings, kollidieren nie mit dem Komma-Trenner). ;; Handles bleiben - anders als Enames - ueber Sitzungen/Undo hinweg stabil ;; und sind damit die richtige Persistenzform fuer ssget-Ergebnisse. (defun vfl-entry->string (e / k v) (setq k (car e) v (cdr e)) (cond ((= k "PT") (strcat "PT:" (rtos (car v) 2 6) "," (rtos (cadr v) 2 6) "," (rtos (caddr v) 2 6))) ((= k "REAL") (strcat "REAL:" (rtos v 2 6))) ((= k "INT") (strcat "INT:" (itoa v))) ((= k "STR") (strcat "STR:" v)) ((= k "STEP") (strcat "STEP:" v)) ((= k "OBJS") (strcat "OBJS:" (vfl-strjoin v ","))) (t "NIL:"))) (defun vfl-string->entry (ln / p kind pay c) (setq p (vl-string-search ":" ln)) (if (null p) (cons "NIL" nil) (progn (setq kind (substr ln 1 p) pay (substr ln (+ p 2))) (cond ((= kind "PT") (setq c (vfl-strsplit pay ",")) (cons "PT" (list (atof (nth 0 c)) (atof (nth 1 c)) (atof (nth 2 c))))) ((= kind "REAL") (cons "REAL" (atof pay))) ((= kind "INT") (cons "INT" (atoi pay))) ((= kind "STR") (cons "STR" pay)) ((= kind "STEP") (cons "STEP" pay)) ((= kind "OBJS") (cons "OBJS" (if (> (strlen pay) 0) (vfl-strsplit pay ",") nil))) (t (cons "NIL" nil)))))) (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)) ;; marker: "linienzug" (Modus 1, Sektions-Editieren via vfl-edit-ent) oder ;; "linienzug2" (Modus 2, vfl-edit-ent2 - voller Reset ohne Sektionswahl, ;; siehe dortiger Kommentar). Der Marker steht in der ersten 1000-Gruppe und ;; entscheidet beim Lesen (vfl-journal-xdata-lesen), welcher Editier-Pfad ;; greift. (defun vfl-journal-xdata-schreiben (ent marker / chunks appentry) (if (null *vf-xdata-app*) (setq *vf-xdata-app* "SSG_VF_EDIT")) (regapp *vf-xdata-app*) (setq chunks (vfl-chunk-string (vfl-journal->string) 250)) (setq appentry (cons *vf-xdata-app* (cons (cons 1000 marker) (mapcar (function (lambda (c) (cons 1000 c))) chunks)))) (entmod (append (entget ent) (list (list -3 appentry)))) ent) ;; Rueckgabe: (marker . journal) oder nil (kein/unbekanntes Journal). (defun vfl-journal-xdata-lesen (ent / xd) (setq xd (vfs-xdata-lesen ent)) (if (and xd (member (car xd) '("linienzug" "linienzug2"))) (cons (car xd) (vfl-string->journal (apply 'strcat (cdr xd)))) nil)) ;; --- Abbruch-Sicherung --- ;; Alle nach lastEnt erzeugten Entities werden NICHT geloescht, sondern ;; GENAUSO wie beim erfolgreichen Abschluss (vfl-block-erstellen) zu einem ;; neuen VF_n-Block gewickelt, mit dem VOLLEN aktuellen Eingabe-Journal ;; (inkl. des angefangenen, noch unfertigen letzten Gliedes) als XDATA. Die ;; Geometrie bleibt in der Zeichnung stehen und ist sofort per Doppelklick ;; weiter editierbar/fortsetzbar (vfl-edit-ent) - unabhaengig davon, ob es ;; sich um einen frischen Bau oder einen Editier-Neuaufbau handelte (kein ;; Sonderfall mehr noetig). Aufgerufen aus dem *error*-Handler von ;; vf-linienzug-modus. (defun vfl-modus-abbruch-sichern (lastEnt vfl-nummer anzahl-gf anzahl-vf startpunkt frame as-seite es-seite marker / e cnt vfl-ins wickel-erg) (setq cnt 0 e (if lastEnt (entnext lastEnt) (entnext))) (while e (setq cnt (1+ cnt)) (setq e (entnext e))) (cond ((or (= cnt 0) (null frame)) (princ (ssg-text "vfl-abbruch-nichts-gebaut"))) (t ;; vfl-block-erstellen nutzt intern (command "_.UCS" ...) fuer den ;; BKS-Wechsel (ssg-block-wrap-welt) - im *error*-Handler-Kontext ;; riskanter als eine einfache Loesch-Schleife, daher abgesichert. (setq wickel-erg (vl-catch-all-apply (function (lambda () (setq vfl-ins (vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) (caddr (car frame)) (vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt)) (if vfl-ins (vfl-journal-xdata-schreiben vfl-ins marker)))) nil)) (if (vl-catch-all-error-p wickel-erg) (princ (ssg-textf "vfl-abbruch-wickeln-fehler" (list (vl-catch-all-error-message wickel-erg)))) (princ (ssg-textf "vfl-abbruch-gesichert" (list (itoa cnt))))) ) ) (princ)) ;; Replay-Modus scharf schalten: die uebergebene (Vorwaerts-)Journalliste wird ;; zur Lesequelle, *vfl-journal* startet leer und wird bei der erneuten ;; Ausfuehrung neu aufgebaut. Genutzt von vfl-edit-ent und der Wiederaufnahme. (defun vfl-journal-replay-start (forward-journal) (setq *vfl-replay-queue* forward-journal *vfl-journal* '())) ;; --- 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 labels) (setq gueltige '()) (foreach e ergebnis-liste (if (and (cadddr e) (numberp (cadr e)) (numberp (caddr e)) (> (cadr e) 0) (> (caddr e) 0)) (setq gueltige (append gueltige (list e))))) (cond ((null gueltige) nil) ((= (length gueltige) 1) (setq e (car gueltige)) (list (nth 0 e) (nth 1 e) (nth 2 e))) (t (princ (ssg-text "vfl-mehrere-winkel-header")) (setq idx 1 labels '()) (foreach e gueltige (princ (ssg-textf "vfl-winkel-option" (list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1)))) (setq labels (append labels (list (ssg-textf "vfl-winkel-option" (list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1)))))) (setq idx (1+ idx))) (setq antwort (vfl-menu-int (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige))) labels 1 "vfl-mehrere-winkel-header")) (if (or (null antwort) (< antwort 1) (> antwort (length gueltige))) (setq antwort 1)) (setq e (nth (1- antwort) gueltige)) (list (nth 0 e) (nth 1 e) (nth 2 e))))) ;; berechne-alle-winkel ausfuehren (mit Linienzug-FESTE_HORIZONTAL = 1300) und ;; den Winkel waehlen lassen. Rueckgabe: (winkel L_GF L_VF) oder nil. ;; aus-dx/aus-dz temporaer nullen: an jeder Aufrufstelle (ueber vfl-vf- ;; entscheidung) ist ein evtl. vorhandenes AS-Element bereits real eingefuegt ;; und deltaL bereits aus dessen echtem KS_AUS neu berechnet (vfl-projiziere- ;; distanz) - der Platzbedarf ist also schon "verbraucht" und darf nicht ;; nochmal in berechne-alle-winkel abgezogen werden (sonst fehlt am Ende ;; systematisch genau dieser Betrag, aus-dx typischerweise mehrere hundert mm). ;; ein-dx/ein-dz bleiben unangetastet: das ES-Element ist an dieser Stelle noch ;; nicht gebaut (folgt erst nach der "Kettenende?"-Frage) - konsistent mit ;; vfl-body-zerlegung, die ebenfalls nur aus-dx/aus-dz nullt. (defun vfl-vf-winkel (deltaL deltaH richtung / save-ausdx save-ausdz res) (setq save-ausdx aus-dx save-ausdz aus-dz) (setq aus-dx 0.0 aus-dz 0.0) (setq res (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH richtung *vfl-feste-horizontal*)))) (setq aus-dx save-ausdx aus-dz save-ausdz) res) ;; Rueckgabe: (typ winkel L_GF L_VF) - erzwingt IMMER eine VF-Einheit (nie GF), ;; genutzt sowohl von vfl-segment-entscheidung (automatische Zweig-Auswahl) als ;; auch direkt vom expliziten "Ab/Auf VF"-Menuepunkt in Modus 1 (vf-linienzug-modus). ;; typ="VF": winkel = best-winkel (0 = Horizontale Mitte), L_GF/L_VF wie ;; berechne-alle-winkel bzw. berechne-horizontale-mitte ;; typ=nil : keine VF-Einheit fuer dieses deltaL/deltaH geometrisch moeglich (defun vfl-vf-entscheidung (deltaL deltaH richtung / winkel-natuerlich wahl horizontal-info) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) (cond ;; Zu kurz fuer eine VF-Einheit: Umlenkstation (500 mm) + Motorstation ;; (500 mm) belegen zusammen 1000 mm deltaL. ((< deltaL 1000.0) (list nil nil nil nil)) ;; Segment ohne messbare Hoehenaenderung: kein sinnvolles VF ((< deltaH 1.0) (list nil nil nil nil)) ;; Steigend: bei mehreren gueltigen Winkeln waehlt der Nutzer (vfl-vf-winkel). ((= richtung "Auf") (setq wahl (vfl-vf-winkel deltaL deltaH "Auf")) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))) ;; Fallend: natuerlichen Neigungswinkel bestimmen (atan der Schraege). ;; steiler als 3 Grad -> absteigender VarioFoerderer (VF-ab) ;; sonst -> VF (Horizontale Mitte oder diskreter Winkel) (t (setq winkel-natuerlich (* (atan (/ deltaH deltaL)) (/ 180.0 pi))) (if (> winkel-natuerlich 3.0) (progn (setq wahl (vfl-vf-winkel deltaL deltaH "Ab")) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))) (progn (setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab")) (if (and horizontal-info (caddr horizontal-info)) (list "VF" 0 (car horizontal-info) (cadr horizontal-info)) (progn (setq wahl (vfl-vf-winkel deltaL deltaH "Ab")) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))))) ) ) ) ) ;; Rueckgabe: (typ winkel L_GF L_VF) ;; typ="GF": winkel = kontinuierlicher Neigungswinkel, L_GF/L_VF ungenutzt (nil) ;; typ="VF": winkel = best-winkel (0 = Horizontale Mitte), L_GF/L_VF wie ;; berechne-alle-winkel bzw. berechne-horizontale-mitte ;; typ=nil : weder GF noch VF fuer dieses deltaL/deltaH geometrisch moeglich (defun vfl-segment-entscheidung (deltaL deltaH richtung / winkel-natuerlich) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) (cond ;; Zu kurz fuer eine VF-Einheit: Umlenkstation (500 mm) + Motorstation ;; (500 mm) belegen zusammen 1000 mm deltaL - darunter ist kein VF baubar. ;; Also nur GF moeglich, und GF ist mindestens 3 Grad geneigt -> fest 3 Grad. ;; Steigend geht mit einer Gefaellestrecke nicht -> nicht baubar. ((< deltaL 1000.0) (if (= richtung "Auf") (list nil nil nil nil) (list "GF" 3.0 nil nil))) ;; Segment ohne messbare Hoehenaenderung: weder Gefaelle noch sinnvolles VF ((< deltaH 1.0) (list nil nil nil nil)) ;; Steigend: Gefaelle kann nicht steigen -> nur VF moeglich. ((= richtung "Auf") (vfl-vf-entscheidung deltaL deltaH richtung)) ;; Fallend: natuerlichen Neigungswinkel bestimmen (atan der Schraege). ;; Eine reine Gefaellestrecke ist nie steiler als 3 Grad, daher: ;; ~3 Grad (Toleranzband) -> reine GF (fest 3 Grad) ;; sonst -> VF (vfl-vf-entscheidung) (t (setq winkel-natuerlich (* (atan (/ deltaH deltaL)) (/ 180.0 pi))) (if (<= (abs (- winkel-natuerlich 3.0)) *vfl-gf-winkel-toleranz*) (list "GF" 3.0 nil nil) (vfl-vf-entscheidung deltaL deltaH richtung)) ) ) ) ;; ============================================================ ;; TEIL 2: SEGMENT-EINFUEGUNG (ohne AS/ES - reine Kettenmitte) ;; ============================================================ ;; Reine, kontinuierlich skalierte Gefaelleschraege (kein AS/ES, kein Bogen). ;; punkt: Startpunkt (3D), hz: Horizontalrichtung, deltaL: horizontaler ;; Fussabdruck, winkel: Neigungswinkel (aus vfl-segment-entscheidung). ;; Die Schraeglaenge wird aus deltaL/cos(winkel) abgeleitet, damit der ;; horizontale Fussabdruck exakt deltaL entspricht (deltaH = deltaL*tan(winkel) ;; ergibt sich damit konsistent). Rueckgabe: neuer Frame am Segmentende. (defun vfl-insert-gf-segment (punkt hz deltaL winkel / l-schraeg endpunkt) (setq l-schraeg (/ deltaL (cos (* (float winkel) (/ pi 180.0))))) (setq endpunkt (gf-insert-hz-incl-scaled "Staustrecke_SP_1000_mm" punkt l-schraeg hz winkel)) (make-frame-from-dir endpunkt (hz-winkel->xu hz winkel)) ) ;; Ansicht auf Grundriss (Draufsicht, Welt-UCS) zoomen: nach jedem ;; Kettenglied mit Geometrieerzeugung wird die neu entstandene Strecke sonst ;; leicht aus dem sichtbaren Bereich oder in eine schraege 3D-Ansicht ;; hinauslaufen - der naechste Punkt (vfl-neue-linie-messen, siehe unten) ;; waere dann schwer/ungenau anzuwaehlen. _PLAN "_World" aendert nur die ;; ANSICHT, nicht das aktuell aktive BKS. Rein kosmetisch (per ;; vl-catch-all-apply abgesichert) - ein Fehler hier darf den eigentlichen ;; Kettenbau nie unterbrechen. (defun vfl-view-refresh ( / ) (vl-catch-all-apply (function (lambda () (command "_.PLAN" "_World") (command "_.ZOOM" "_Extents"))) nil) (princ)) ;; --- Hilfsfunktionen fuer die VF-Einheit --- ;; Planare (XY-)Distanz und Richtung zwischen zwei Punkten. (defun vfl-planar-dist (p1 p2) (sqrt (+ (expt (- (car p2) (car p1)) 2) (expt (- (cadr p2) (cadr p1)) 2)))) (defun vfl-planar-hz (p1 p2) (* (atan (- (cadr p2) (cadr p1)) (- (car p2) (car p1))) (/ 180.0 pi))) ;; Neue Linie ausmessen: Laenge (deltaL) und Fahrtrichtung (hz) bestimmen. ;; Ist hz-vorgabe gesetzt (Fahrtrichtung durch das vorherige Element - z.B. ;; einen GF-Bogen oder eine Vario-Kurve - bereits festgelegt), wird der ;; gewaehlte Punkt auf diese Richtung PROJIZIERT: die Linie folgt exakt der ;; Fahrtrichtung, der Nutzer gibt praktisch nur die Laenge vor (eine gerade ;; Foerderstrecke kann die Richtung nicht aendern). Nur beim allerersten ;; Segment (hz-vorgabe=nil) definiert der gewaehlte Punkt die Richtung frei. ;; Punkt-Abfrage mit FESTER 2-Arity (Basispunkt + Prompt). Verhaltensneutraler ;; Wrapper um das variadische Built-in getpoint: mit Basispunkt (base) wird die ;; 2-Argument-Form genutzt (Gummiband), ohne (base=nil) die reine Prompt-Form. ;; Zweck: ein Testmock kann diese feste Signatur ersetzen (getpoint selbst kann ;; als defun nicht 1- UND 2-argumentig gemockt werden). ;; DYNMODE waehrend des Picks auf 3 (Pointer- + Dimensions-Input) setzen, damit ;; BricsCAD Distanz/Winkel dynamisch am Cursor anzeigt (Laengen-Feedback beim ;; Picken) - danach den Nutzer-Wert wiederherstellen. (defun vfl-getpoint (base prompt / old-dynmode pt) (setq old-dynmode (vl-catch-all-apply 'getvar (list "DYNMODE"))) (if (vl-catch-all-error-p old-dynmode) (setq old-dynmode nil)) (if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" 3))) (setq pt (if base (getpoint base prompt) (getpoint prompt))) (if old-dynmode (vl-catch-all-apply 'setvar (list "DYNMODE" old-dynmode))) pt ) ;; Vorschlagswert fuer die GF-Zielhoehe: die aktuelle Kettenhoehe (ist-hoehe) ;; UNVERAENDERT als Default anzubieten fuehrt in eine Falle - ein GF-Segment ;; MUSS fallen (0 Grad Gefaelle gibt es nicht), ein direkt uebernommener ;; Vorschlag mit deltaH=0 wird also immer als "kann nicht steigen" abgelehnt. ;; Deshalb hier auf volle mm ABGERUNDET (truncate, nicht rtos-Rundung - die ;; koennte sonst aufrunden und ueber die Ist-Hoehe hinausgehen) und bei ;; bereits ganzzahligen Werten zusaetzlich 1mm abgezogen, damit der Vorschlag ;; immer echt unterhalb der Ist-Hoehe liegt und direkt uebernehmbar ist. (defun vfl-gf-hoehe-vorschlag (ist-hoehe / gekappt) (setq gekappt (float (fix ist-hoehe))) (if (>= gekappt ist-hoehe) (- gekappt 1.0) gekappt)) ;; 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) (vfl-view-refresh) (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)) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-horizontal-impl (list ziel-modus))) (princ (ssg-text "vfl-sep-vor-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-nein")) (setq sep-vor (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2 "vfl-sep-vor-frage") "1")) (if (and ziel-modus sep-vor) (setq dL (max 100.0 (- dL 300.0)))) ;; auf_3-Eintritt nur, wenn noch NICHT flach (sonst flache Zone fortsetzen). ;; dL ist die gewuenschte Reststrecke AB HIER (pt) - der reale Bogen- ;; Fussabdruck (gemessen, nicht aus der Tabellen-Masse geschaetzt - die ;; stimmt nach der Rotation nicht mehr exakt) wird von dL abgezogen, damit ;; das horizontale Stueck am gewuenschten Zielpunkt endet. (if (not (vfl-frame-flach-p frame)) (progn (setq pt-vor-bogen pt) (setq m1 (get-bogen-mass bogen-auf 3)) (princ (ssg-text "vfl-bogen-auf3-uebergang")) (setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt (ssg-cfg-or "vario" "gefaelle_winkel" 3) (car m1) (caddr m1) hz)) (setq dL (max 100.0 (- dL (vfl-projiziere-distanz pt-vor-bogen pt hz)))))) ;; Separator NACH abfragen (noch nicht bauen) - im Ziel-Modus VOR der ;; Laengenberechnung, damit der Fussabdruck feststeht. (princ (ssg-text "vfl-sep-nach-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-nein")) (setq sep-nach (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2 "vfl-sep-nach-frage") "1")) (if (and ziel-modus sep-nach) (setq dL (max 100.0 (- dL 300.0)))) ;; Im Ziel-Modus: "Ist der Endpunkt der Foerderer?" JETZT abfragen (statt ;; erst danach in der Aufruferschleife) - der Ausgangs-Fussabdruck ;; (Vario_Bogen_ab_3 + Motorstation) wird nur reserviert, wenn tatsaechlich ;; sofort geschlossen wird (Antwort 1 oder 3). (if ziel-modus (progn (princ (ssg-text "vfl-ist-endpunkt-frage")) (princ (ssg-text "vfl-ja-nur-motorstation")) (princ (ssg-text "vfl-nein-weiterbauen")) (princ (ssg-text "vfl-ja-motorstation-kettenende")) (setq ist-ende-antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def2") (list (ssg-text "vfl-ja-nur-motorstation") (ssg-text "vfl-nein-weiterbauen") (ssg-text "vfl-ja-motorstation-kettenende")) 2 "vfl-ist-endpunkt-frage")) (cond ((= ist-ende-antwort "1") (setq dL (max 100.0 (- dL (car (get-bogen-mass bogen-ab 3)) 500.0 (* (if gf2-laenge gf2-laenge 0.0) (cos (* 3.0 (/ pi 180.0)))))))) ((= ist-ende-antwort "3") (setq dL (max 100.0 (- dL (car (get-bogen-mass bogen-ab 3)) 500.0)))) ) ) ) ;; optionaler Separator VOR - in der horizontalen Ebene (0 Grad) (if sep-vor (setq pt (vfl-sep-hz pt hz))) ;; horizontale Zwischenstrecke (0 Grad) (princ (ssg-textf "vfl-horizontale-zwischenstrecke" (list (rtos dL 2 2)))) (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt dL 0 hz)) (vfl-acc-vf-seg "horizontal" 0 dL) ;; optionaler Separator NACH (jetzt tatsaechlich bauen) (if sep-nach (setq pt (vfl-sep-hz pt hz))) ;; KEIN ab_3 mehr -> das Stueck ENDET FLACH (0 Grad) (setq frame (make-frame-from-dir pt (hz-winkel->xu hz 0.0))) (if ziel-modus (list frame ist-ende-antwort) frame) ) ;; ============================================================ ;; OPTION 3: KETTENENDE AUS LAUFENDER VF-EINHEIT (ein Motor) ;; ============================================================ ;; Zerlegt den verbleibenden GERADEN Lauf bis zum Ziel-ES mit der bewaehrten ;; STANDARD-Logik (wie aussen), aber fuer den Mid-Body-Fall: ;; - Der Einlauf (AS + GF1 + Separator + Umlenk) ist bereits gebaut und wird ;; NICHT beruecksichtigt -> aus-dx/aus-dz = 0. ;; - Fest vor dem ES stehen nur Motor(500) + Auslauf-Separator(300) ;; -> FESTE_HORIZONTAL = 800. ;; Ergebnis der Standard-Logik (GF2 = GF, VARIIERT mit dem Winkel): ;; steiler als 3 Grad / steigend -> gewinkeltes VF + GF2 (Winkeltabelle), ;; flacher als 3 Grad -> horizontales VF + GF2 (Rest-Laenge ueber ;; das horizontale Stueck ausgeglichen). ;; Die Hoehe kommt also aus VF-Winkel/horizontal + GF2, die ueberschuessige ;; Laenge aus dem horizontalen VF - genau die zweistufige Logik. ;; Rueckgabe: (typ winkel L_GF2 L_VF) - typ "GF"/"VF"/nil (wie ;; vfl-segment-entscheidung; L_GF2 varriert, Mindestwert siehe vfl-body-abschluss). (defun vfl-body-zerlegung (deltaL deltaH richtung / save-ausdx save-ausdz save-feste winkel-natuerlich wahl horizontal-info res) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) ;; Budget-Globals temporaer auf den Mid-Body-Fall umbiegen (mit Restore). (setq save-ausdx aus-dx save-ausdz aus-dz save-feste FESTE_HORIZONTAL) (setq aus-dx 0.0 aus-dz 0.0 FESTE_HORIZONTAL 800.0) (setq res (cond ;; kuerzer als Motor(500)+Separator(300): kein Abschluss baubar ((< deltaL 800.0) (list nil nil nil nil)) ;; praktisch flach: horizontales VF + GF2 ((< deltaH 1.0) (setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab")) (if (and horizontal-info (caddr horizontal-info)) (list "VF" 0 (car horizontal-info) (cadr horizontal-info)) (list nil nil nil nil))) ;; steigend: nur gewinkeltes VF + GF2 moeglich ((= richtung "Auf") (setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Auf" 800.0)))) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))) ;; fallend: natuerlichen Neigungswinkel gegen die 3-Grad-Eigenneigung pruefen (t (setq winkel-natuerlich (* (atan (/ deltaH deltaL)) (/ 180.0 pi))) (cond ;; ~3 Grad -> reine GF2 (kein Koerper, GF2 traegt Laenge + 3-Grad-Absenkung) ((<= (abs (- winkel-natuerlich 3.0)) *vfl-gf-winkel-toleranz*) (list "GF" 3.0 nil nil)) ;; steiler als 3 Grad -> Stufe 1: gewinkeltes VF + GF2 (GF2 variiert mit Winkel) ((> winkel-natuerlich 3.0) (setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Ab" 800.0)))) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))) ;; flacher als 3 Grad -> Stufe 2: horizontales VF + GF2 (t (setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab")) (if (and horizontal-info (caddr horizontal-info)) (list "VF" 0 (car horizontal-info) (cadr horizontal-info)) (progn (setq wahl (vfl-waehle-winkel (nth 3 (berechne-alle-winkel deltaL deltaH "Ab" 800.0)))) (if wahl (list "VF" (nth 0 wahl) (nth 1 wahl) (nth 2 wahl)) (list nil nil nil nil))))))))) ;; Budget-Globals zuruecksetzen (setq aus-dx save-ausdx aus-dz save-ausdz FESTE_HORIZONTAL save-feste) res) ;; Fragt Zielpunkt (XY) + Zielhoehe (Z) ab, zerlegt den Rest (vfl-body- ;; zerlegung, Standard-Logik) und baut den Koerper VOR dem Motor: gewinkeltes ;; VF (winkel>0) oder horizontales VF (winkel=0). GF2 (variiert mit dem Winkel, ;; Mindestwert *vfl-gf-min-laenge*=400) sitzt hinter dem Motor und wird als ;; Laenge zurueckgegeben (der Aufrufer setzt sie beim Auslauf ein und schliesst ;; mit Motor -> GF2 -> Separator -> ES ab). Speichert den Soll-Zielpunkt in ;; *vfl-ziel-punkt* fuer den Ist-Ziel-Report. ;; Rueckgabe: (frame anzahl-koerper letzt-hz gf2-laenge) oder nil. (defun vfl-body-abschluss (frame letzt-hz p-umlenk / linie-mess dL hzn hn dH richtn rad3 dec typ w lgf lvf gf2 cnt p0 tx ty) ;; 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)) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl (list (caddr (car frame))))) (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-menu (ssg-text "vfl-prompt-wahl-1-3-def2") (list (ssg-text "vfl-ja-nur-motorstation") (ssg-text "vfl-nein-weiterbauen") (ssg-text "vfl-ja-motorstation-kettenende")) 2 "vfl-ist-endpunkt-frage")) ) ) (if (= antwort "1") (setq fertig t) (if (= antwort "3") ;; --- Option 3: Kettenende exakt am Zielpunkt (nur EIN Motor) --- (progn ;; ES-Element hier gewuenscht? Falls nein, ein-dx/ein-dz waehrend der ;; Zerlegung (vfl-body-abschluss -> vfl-body-zerlegung -> berechne- ;; alle-winkel) temporaer nullen, damit KEIN ES-Fussabdruck reserviert ;; wird - die Kette endet dann direkt am Zielpunkt ohne Separator+ES. (princ (ssg-text "vfl-es-setzen-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-es-nein-zielpunkt")) (setq es-antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "vfl-ja") (ssg-text "vfl-es-nein-zielpunkt")) 1 "vfl-es-setzen-frage")) (setq es-gewuenscht (/= es-antwort "2")) (if (not es-gewuenscht) (progn (setq save-eindx ein-dx save-eindz ein-dz) (setq ein-dx 0.0 ein-dz 0.0))) (setq res3 (vfl-body-abschluss frame letzt-hz p-umlenk)) (if (not es-gewuenscht) (setq ein-dx save-eindx ein-dz save-eindz)) (if res3 (setq frame (nth 0 res3) vf-count (+ vf-count (nth 1 res3)) letzt-hz (nth 2 res3) ziel-gf2 (nth 3 res3) ziel-ende t fertig t))) (progn (princ (ssg-text "vfl-naechstes-element-vf")) (princ (ssg-text "vfl-opt-horizontaler-foerderer")) (princ (ssg-text "vfl-opt-vario-kurve")) (princ (ssg-text "vfl-opt-auf-ab-foerderer")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-3-def3") (list (ssg-text "vfl-opt-horizontaler-foerderer") (ssg-text "vfl-opt-vario-kurve") (ssg-text "vfl-opt-auf-ab-foerderer")) 3 "vfl-naechstes-element-vf")) (cond ;; --- Vario-Kurve (aendert hz) --- ((= antwort "2") (setq frame (vfl-insert-vario-kurve frame)) (setq letzt-hz (car (frame->hz-winkel frame))) ) ;; --- Horizontaler Foerderer (folgt der aktuellen Fahrtrichtung) --- ((= antwort "1") (setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz)) (if linie-mess (progn (setq dL (car linie-mess) hzn (cadr linie-mess)) (if (> dL 1.0) (progn ;; ziel-modus=T: Separator VOR/NACH + "Ist der Endpunkt der ;; Foerderer?" werden VOR der Laengenberechnung gestellt ;; (siehe vfl-baue-horizontal-koerper) - Antwort kommt hier ;; zurueck und wird in der naechsten Schleifen-Runde ;; verwendet, statt erneut zu fragen. (setq res-h (vfl-baue-horizontal-koerper frame hzn dL t L_GF2-bau)) (setq frame (car res-h) vor-antwort (cadr res-h)) (setq vf-count (1+ vf-count) letzt-hz hzn) (vfl-20m-check p-umlenk (car frame)) ) (princ (ssg-text "vfl-linie-zu-kurz-uebersprungen")) ) ) ) ) ;; --- Auf/Ab-Foerderer (folgt der aktuellen Fahrtrichtung) --- (t ;; gewinkeltes VF braucht 3-Grad-Basis -> flache Zone ggf. mit ab_3 beenden (setq frame (vfl-nach-3grad frame)) (setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz)) (if linie-mess (progn (setq dL (car linie-mess) hzn (cadr linie-mess)) (if (> dL 1.0) (progn (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl (list (caddr (car frame))))) (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) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-winkel-seite-impl (list "vfl-gf-bogen-winkel-header" (list (ssg-text "vfl-winkel-30") (ssg-text "vfl-winkel-60") (ssg-text "vfl-winkel-90")) "INT"))) (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-menu-int (ssg-text "vfl-prompt-wahl-1-3-def3") (list (ssg-text "vfl-winkel-30") (ssg-text "vfl-winkel-60") (ssg-text "vfl-winkel-90")) 3 "vfl-gf-bogen-winkel-header")) (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-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "vfl-gf-bogen-seite-header")) (setq bseite (if (= antwort "2") "rechts" "links")) (vfl-insert-gf-bogen-block frame bwinkel bseite) ) ;; Vario-Kurve-Blockname (links/rechts x 30/60/90 x TEF aussen/innen). (defun vfl-kurve-blockname (kwinkel kseite kvariante) (strcat "Vario_Kurve_" kseite "_" (itoa kwinkel) "_TEF_" kvariante) ) ;; Nicht-interaktiver Kern: Vario-Kurve mit gegebenem Winkel/Seite/Variante ;; einfuegen. Genutzt von der interaktiven Abfrage UND von den Pfad-Modi ;; (Winkel/Seite aus der Geometrie, Variante abgefragt). Rueckgabe: neuer Frame. ;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch ;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das ;; (siehe ks-normalize-name). (defun vfl-insert-vario-kurve-block (frame kwinkel kseite kvariante / blockname hz flach-frame neuer-frame hz-gemessen hz-gesnappt) (setq blockname (vfl-kurve-blockname kwinkel kseite kvariante)) (princ (ssg-textf "vfl-fuege-block-ein" (list blockname))) ;; Vario-Kurve zaehlen (Variante A=aussen/I=innen + Winkel) -> VF_Bogen_A/I_xx (setq *vfl-acc-variokurve* (vfl-inc-count *vfl-acc-variokurve* (strcat (if (= kvariante "aussen") "A" "I") "_" (itoa kwinkel)))) ;; Vario-Kurve ist ein HORIZONTALER Richtungswechsel (KEINE Neigung). ;; Der aktuelle Frame traegt die 3-Grad-Basisneigung - fuer die Kurve wird er ;; daher auf 0 Grad abgeflacht (Position + Fahrtrichtung bleiben erhalten). (setq hz (car (frame->hz-winkel frame))) (setq flach-frame (make-frame-from-dir (car frame) (hz-winkel->xu hz 0.0))) (setq neuer-frame (insert-block-ks-to-ks blockname flach-frame)) ;; Auf den absoluten 30-Grad-Raster snappen (siehe vfl-hz-snappen-absolut) - ;; gleiche Zeichnungsungenauigkeit wie bei GF-Bogen moeglich. Reine Z-Drehung ;; statt make-frame-from-dir-Neuaufbau: erhaelt die aus dem Block gemessene ;; Rollung (yu/zu) - siehe Kommentar bei vfl-frame-um-z-drehen. Ein Neuaufbau ;; ueber make-frame-from-dir fuehrte hier empirisch zu einer um 90 Grad ;; verdrehten Motorstation NACH der Vario-Kurve. (setq hz-gemessen (car (frame->hz-winkel neuer-frame))) (setq hz-gesnappt (vfl-hz-snappen-absolut hz-gemessen)) (if (> (abs (- hz-gemessen hz-gesnappt)) 0.0001) (setq neuer-frame (vfl-frame-um-z-drehen neuer-frame (- hz-gesnappt hz-gemessen)))) neuer-frame ) ;; Vario-Kurve (horizontale Kurve, Neigung bleibt wie im aktuellen Frame). ;; Standard sind KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch ;; KSYS_EIN/KSYS_AUS fuehren - extract-ks-from-block-raw normalisiert das ;; (siehe ks-normalize-name). ;; Interaktiv (i18n): Vario-Kurve-Winkel + Seite + Variante abfragen, dann Kern. (defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-variokurve-impl nil)) (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-menu-int (ssg-text "vfl-prompt-wahl-1-3-def1") (list (ssg-text "vfl-opt1-90grad") (ssg-text "vfl-opt2-60grad") (ssg-text "vfl-opt3-30grad")) 1 "vfl-variokurve-winkel-header")) (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-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "vfl-variokurve-seite-header")) (setq kseite (if (= antwort "2") "rechts" "links")) (princ (ssg-text "vfl-variokurve-variante-header")) (princ (ssg-text "vfl-variante-aussen")) (princ (ssg-text "vfl-variante-innen")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-variante-aussen") (ssg-text "vfl-variante-innen")) 2 "vfl-variokurve-variante-header")) (setq kvariante (if (= antwort "1") "aussen" "innen")) (vfl-insert-vario-kurve-block frame kwinkel kseite kvariante) ) ;; ============================================================ ;; TEIL 3: KETTENANFANG (AS) / KETTENENDE (ES) ;; ============================================================ ;; AS-Element am Kettenanfang. Wird IMMER FLACH eingefuegt (KS_EIN ohne ;; Neigung) - per Einzel-Insert-Test in BricsCAD bestaetigt (2026-07-24): ;; das AS-Element selbst hat keine Neigung, die Neigung beginnt erst im ;; nachfolgenden GF-Koerper (vfl-insert-gf-segment). typ/winkel sind aus ;; Call-Kompatibilitaet weiterhin Parameter, werden aber fuer die AS-eigene ;; Ausrichtung nicht mehr verwendet (KEIN vertikaler Tilt mehr, unabhaengig ;; vom folgenden Segmenttyp). ;; Rueckgabe: Frame am AS-Ausgang (KS_AUS). (defun vfl-insert-as-element (typ startpunkt hz winkel as-seite / ein-hz-as rad-h xu-ein as-turn) ;; Schwenk aus dem Block messen -> KS_EIN so drehen, dass KS_AUS entlang hz ;; zeigt (Grundriss-Versatz des 30-Grad-Elements bleibt beruecksichtigt). (setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite))) (setq ein-hz-as (- hz as-turn)) (setq rad-h (* (float ein-hz-as) (/ pi 180.0))) (setq xu-ein (list (cos rad-h) (sin rad-h) 0.0)) (insert-block-mixed-to-ks (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite) (make-frame-from-dir startpunkt xu-ein) (caddr startpunkt) nil "KS_EIN") ) ;; Kettenanfang-Baustein: falls as-vorhanden, AS-Element einfuegen und die ;; GF/VF-Restlaenge 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) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-winkel-seite-impl (list "vf-winkel-ein-header" (list (ssg-text "vf-winkel-90") (ssg-text "vf-winkel-30")) "STR"))) (setq *vfl-es-winkel* (vfl-in-value "STR" (function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite (princ (ssg-text "gf-seite-ein-header")) (princ (ssg-text "gf-seite-links")) (princ (ssg-text "gf-seite-rechts")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "gf-seite-ein-header")) (setq es-seite (if (= antwort "2") "rechts" "links")) (vf-set-es-masse *vfl-es-winkel* es-seite) es-seite ) ;; Separator (300mm) an der aktuellen Stelle einfuegen (bei 3-Grad-Neigung, ;; Frame-Kettung ueber KS). Rueckgabe: neuer Frame am Separator-Ausgang. ;; Genutzt fuer den optionalen Zwischen-Separator zwischen zwei Foerderern. (defun vfl-insert-separator (frame / hz w sep-endpunkt) (setq hz (car (frame->hz-winkel frame))) (setq w (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (setq sep-endpunkt (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" (car frame) hz w 300 0)) (setq *vfl-acc-separator* (1+ *vfl-acc-separator*)) (make-frame-from-dir sep-endpunkt (hz-winkel->xu hz w)) ) ;; ES-Element am Kettenende: Separator (300mm) + ES-Element. ;; typ="GF": Neigung = winkel des GF-Segments. ;; typ="VF": Neigung = 3 Grad (Auslauf einer VF-Einheit endet auf 3 Grad). ;; Das ES-Element wird rein per KS-zu-KS an den Separator angekettet ;; (`insert-block-ks-to-ks`) - sein KS_EIN folgt exakt dem Separator-Ausgang ;; (Position + Neigung). KEIN Z-Ziel (anders als im Standalone-Gefaelle, wo eine ;; feste Endhoehe erzwungen wird): der Linienzug laeuft frei aus, ein Z-Ziel ;; wuerde die ES-Hoehe kuenstlich verschieben -> Versatz. hoehe-ziel wird daher ;; hier nicht mehr verwendet (bleibt fuer Signatur-Kompatibilitaet). (defun vfl-insert-es-element (typ frame hz winkel hoehe-ziel es-seite / w-eff sep-endpunkt sep-frame) (setq w-eff (if (= typ "GF") winkel (ssg-cfg-or "vario" "gefaelle_winkel" 3))) (setq sep-endpunkt (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" (car frame) hz w-eff 300 0)) (setq sep-frame (make-frame-from-dir sep-endpunkt (hz-winkel->xu hz w-eff))) (if (boundp '*vfl-acc-separator*) (setq *vfl-acc-separator* (1+ *vfl-acc-separator*))) ; Separator vor ES (insert-block-ks-to-ks (strcat "ES_Element_" (vfl-es-winkel) "_" es-seite) sep-frame) ) ;; ============================================================ ;; TEIL 4: BLOCK-ERSTELLUNG (Nummerierung + Attribute) ;; ============================================================ (defun vfl-block-erstellen (vfl-nummer anzahl-gf anzahl-vf hoehe-von hoehe-bis delta-l-total as-seite es-seite startpunkt lastEnt / vfl-bname vfl-ss ent vfl-insert typ-str) ;; TYP: einsegmentige Gefaellestrecke ohne Bogen -> "Gefaellestrecke"; ;; mit VF, Bogen oder mehreren GF-Segmenten -> "Streckengruppe". (setq typ-str (if (or (> anzahl-vf 0) (> anzahl-gf 1) (> (length *vfl-acc-gfbogen*) 0) (> (length *vfl-acc-variokurve*) 0)) "Streckengruppe" "Gefaellestrecke")) (setq vfl-bname (strcat "VF_" (itoa vfl-nummer))) ;; ATTDEFs nach gemeinsamem Strecken-Schema (Reihenfolge!) (foreach def (ssg-strecke-attrib-defs typ-str) (entmake (list '(0 . "ATTDEF") (cons 10 startpunkt) (cons 11 startpunkt) '(40 . 50.0) (cons 1 (cadr def)) (cons 2 (car def)) (cons 3 (car def)) '(70 . 1) '(72 . 0) '(74 . 0))) ) (setq vfl-ss (ssadd)) (setq ent (if lastEnt (entnext lastEnt) (entnext))) (while ent (ssadd ent vfl-ss) (setq ent (entnext ent)) ) ;; Block definieren und einfuegen mit garantiert weltparallelem BKS. ;; startpunkt ist ein Welt-Punkt; ssg-block-wrap-welt setzt das BKS ;; temporaer auf Welt (verhindert den 31.95mm-Z-Versatz bei abweichendem ;; BKS, siehe Kommentar dort) und stellt es danach wieder her. (setq vfl-insert (ssg-block-wrap-welt vfl-bname startpunkt vfl-ss)) ;; Werte (volle Liste; nicht vorhandene Tags ignoriert ssg-attrib-set-on) (ssg-attrib-set-on vfl-insert (list (cons "Bezeichnung" vfl-bname) (cons "MONTAGEHOEHE_m" (rtos (/ (+ hoehe-von hoehe-bis) 2000.0) 2 3)) (cons "HOEHE_VON_mm" (itoa (fix hoehe-von))) (cons "HOEHE_BIS_mm" (itoa (fix hoehe-bis))) (cons "DELTA_H_mm" (itoa (fix (abs (- hoehe-bis hoehe-von))))) (cons "DELTA_L_mm" (itoa (fix delta-l-total))) (cons "TYP" typ-str) (cons "SEITE_AS" as-seite) (cons "SEITE_ES" es-seite) ;; ANZAHL_GF = alle GF-Stuecke: eigenstaendige GF-Segmente UND die GF1/GF2 ;; jeder VF-Einheit (alle ueber vfl-acc-gf-seg in *vfl-acc-lgf* gesammelt). (cons "ANZAHL_GF" (itoa (length *vfl-acc-lgf*))) (cons "L_GF_m" (vfl-join-komma *vfl-acc-lgf*)) (cons "GF_WINKEL" (vfl-join-komma *vfl-acc-gfwinkel*)) ;; GF-Boegen (Richtungswechsel im GF-Teil), gezaehlt nach Seite+Winkel (cons "GF_Bogen_L_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_90"))) (cons "GF_Bogen_L_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_60"))) (cons "GF_Bogen_L_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "L_30"))) (cons "GF_Bogen_R_90" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_90"))) (cons "GF_Bogen_R_60" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_60"))) (cons "GF_Bogen_R_30" (itoa (vfl-get-count *vfl-acc-gfbogen* "R_30"))) (cons "ANZAHL_VF" (itoa anzahl-vf)) (cons "MOTORSEITE" (vfl-join-komma *vfl-acc-motorseite*)) (cons "L_VF_m" (vfl-join-komma *vfl-acc-lvf*)) (cons "ANTRIEBFAHRTRICHTUNG" (vfl-join-komma *vfl-acc-richtung*)) (cons "VF_WINKEL" (vfl-join-komma *vfl-acc-winkel*)) ;; Vario-Kurven (Richtungswechsel im VF-Teil), A=aussen / I=innen (cons "VF_Bogen_A_90" (itoa (vfl-get-count *vfl-acc-variokurve* "A_90"))) (cons "VF_Bogen_A_60" (itoa (vfl-get-count *vfl-acc-variokurve* "A_60"))) (cons "VF_Bogen_A_30" (itoa (vfl-get-count *vfl-acc-variokurve* "A_30"))) (cons "VF_Bogen_I_90" (itoa (vfl-get-count *vfl-acc-variokurve* "I_90"))) (cons "VF_Bogen_I_60" (itoa (vfl-get-count *vfl-acc-variokurve* "I_60"))) (cons "VF_Bogen_I_30" (itoa (vfl-get-count *vfl-acc-variokurve* "I_30"))) (cons "ANZAHL_SEPARATOR" (itoa *vfl-acc-separator*)) ) ) ;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar. (if (car (atoms-family 1 '("SSG-ID-GENERATE"))) (ssg-id-generate vfl-insert)) (princ (ssg-textf "vfl-block-erstellt" (list vfl-bname typ-str))) vfl-insert ) ;; Baut eine komplette VarioFoerderer-Einheit und schliesst sie ab: ;; GF-Verteilung fragen -> vfl-vf-einheit (Umlenk..Motor, mehrsegmentig) ;; -> Kettenende? Ja: Separator+ES (Ende); Nein: optionaler Zwischen-Separator. ;; winkel1=0 => horizontaler Anfangs-Koerper (Option "Neue horizontal VF"). ;; auto-ende: T => keine Kettenende-Frage, es wird direkt Separator + ES ;; gesetzt (Option "Neue Linie BIS Kettenende"). ;; Rueckgabe: (frame anzahl-koerper ende-flag es-seite-oder-nil). (defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF auto-ende / antwort res es-s ende es-gewuenscht) ;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf. (princ (ssg-text "vfl-gf-verteilung-header")) (princ (ssg-text "vfl-gf-verteilung-haelfte")) (princ (ssg-text "vfl-gf-verteilung-ganz-einlauf")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-gf-verteilung-haelfte") (ssg-text "vfl-gf-verteilung-ganz-einlauf")) 2 "vfl-gf-verteilung-header")) (setq res (vfl-vf-einheit frame hz richtung winkel L_GF L_VF (= antwort "1"))) (setq frame (nth 0 res) es-gewuenscht (nth 3 res)) ;; Kettenende? Bei auto-ende (Kettenende-Modus) ohne Frage direkt ES setzen. ;; ziel-ende (Option 3 IN der VF-Einheit) OHNE ES-Wunsch (dort abgefragt, ;; siehe vfl-vf-einheit): Kette endet direkt hier, kein Separator+ES, keine ;; weitere Frage. ziel-ende MIT ES-Wunsch ODER auto-ende (Option 4): ohne ;; Frage direkt Separator + ES. Sonst normal fragen - zwischen einem AS und ;; ES koennen mehrere Foerderer liegen. (if (and (nth 2 res) (not es-gewuenscht)) (setq antwort "kein-es") (if (or auto-ende (nth 2 res)) (setq antwort "1") (progn (princ (ssg-text "vfl-ist-kettenende-frage")) (princ (ssg-text "vfl-ja-separator-es")) (princ (ssg-text "vfl-nein-weiterbauen")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-ja-separator-es") (ssg-text "vfl-nein-weiterbauen")) 2 "vfl-ist-kettenende-frage")) ) ) ) (cond ((= antwort "kein-es") (setq ende t) ;; Ist-Ziel-Report auch ohne ES (Vergleich Soll-Zielpunkt vs. tatsaechliches ;; Kettenende nach GF2/Motor). (if *vfl-ziel-punkt* (progn (princ (ssg-text "vfl-ist-ziel-vergleich-header")) (princ (ssg-textf "vfl-soll-xyz" (list (rtos (car *vfl-ziel-punkt*) 2 1) (rtos (cadr *vfl-ziel-punkt*) 2 1) (rtos (caddr *vfl-ziel-punkt*) 2 1)))) (princ (ssg-textf "vfl-ist-xyz" (list (rtos (car (car frame)) 2 1) (rtos (cadr (car frame)) 2 1) (rtos (caddr (car frame)) 2 1)))) (princ (ssg-textf "vfl-abweichung-xyz" (list (rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1) (rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1) (rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1)))) (setq *vfl-ziel-punkt* nil) ) ) ) ((= antwort "1") (setq es-s (vfl-frage-es-seite)) (setq frame (vfl-insert-es-element "VF" frame (car (frame->hz-winkel frame)) 0.0 (caddr (car frame)) es-s)) (setq ende t) ;; Ist-Ziel-Report (Option 3): Soll-ES (aus vfl-body-abschluss) vs. Ist-ES. (if *vfl-ziel-punkt* (progn (princ (ssg-text "vfl-ist-ziel-vergleich-header")) (princ (ssg-textf "vfl-soll-xyz" (list (rtos (car *vfl-ziel-punkt*) 2 1) (rtos (cadr *vfl-ziel-punkt*) 2 1) (rtos (caddr *vfl-ziel-punkt*) 2 1)))) (princ (ssg-textf "vfl-ist-xyz" (list (rtos (car (car frame)) 2 1) (rtos (cadr (car frame)) 2 1) (rtos (caddr (car frame)) 2 1)))) (princ (ssg-textf "vfl-abweichung-xyz" (list (rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1) (rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1) (rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1)))) (setq *vfl-ziel-punkt* nil) ) ) ) (t (princ (ssg-text "vfl-sep-an-stelle-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-nein")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-ja") (ssg-text "vfl-nein")) 2 "vfl-sep-an-stelle-frage")) (if (= antwort "1") (setq frame (vfl-insert-separator frame))) ) ) (list frame (nth 1 res) ende es-s) ) ;; ============================================================ ;; TEIL 5: HAUPTBEFEHL - MODUS 1 (MANUELLE EINGABE) ;; ============================================================ (defun vf-linienzug-modus ( / startpunkt start-hoehe as-seite es-seite antwort wahl p-aktuell linie-mess hoehe-neu hoehe-bis deltaL deltaH richtung hz-neu entscheidung typ winkel L_GF L_VF vf-einheit-res frame letzter-typ fertig linie-ende-modus rad3 anzahl-gf anzahl-vf vfl-nummer lastEnt gf-max-winkel gf-ok kettenanfang pick-punkt as-vorhanden erg old-error vfl-ins dbg-an) (princ "\n\n=========================================") (princ (ssg-text "vfl-modus1-header")) (princ "\n=========================================") (princ (ssg-text "vfl-modus1-beschreibung")) ;; --- Debug-Session (Schalter "vfl-modus1", DEFAULT AN) ------------------ ;; (dbg-schalter-off "vfl-modus1") deaktiviert bei Bedarf das Loggen. ;; Geloggt wird ueber vfl-journal-record/-mark/-steplabel (siehe dort) - ;; das erfasst automatisch JEDE interaktive Eingabe dieses Modus (Punkte, ;; Hoehen, Winkel, Menue-Auswahlen) samt Glied-Uebergaengen, ohne dass jede ;; einzelne Aufrufstelle im Bau-Ablauf separat instrumentiert werden muss. (setq dbg-an (dbg-schalter-open "vfl-modus1" "vfl_modus1.dbg" "DXFM_LOG")) (if dbg-an (progn (dbgf "vf-linienzug-modus") (dbgmsg "=== SESSION Modus 1 (Manuelle Eingabe) START ===") (dbgflush))) ;; Abhaengigkeit: die GF-Segmente/-Boegen nutzen Funktionen aus ;; Gefaellestrecke.lsp (gf-insert-hz-incl-scaled, gf-bogen-blockname, ...). ;; Bei reiner VarioFoerderer-Ladung ohne Gefaellestrecke wuerde der GF-Zweig ;; fehlschlagen - deshalb hier pruefen. (if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED")))) (progn (alert (ssg-text "vfl-alert-gf-modul-fehlt")) (exit) ) ) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) ;; --- Abbruch-Sicherung scharf schalten (VOR dem ersten Prompt!) --- ;; Ab hier kann jederzeit Geometrie entstehen. Ein *error*-Handler faengt ;; jeden Abbruch (ESC / (exit) / Laufzeitfehler) ab und WICKELT die bereits ;; eingefuegte Teil-Geometrie (alles nach lastEnt) zu einem VF_n-Block mit ;; dem vollen aktuellen Eingabe-Journal als XDATA (vfl-modus-abbruch-sichern) ;; - die Geometrie bleibt stehen und ist per Doppelklick sofort weiter ;; editierbar/fortsetzbar (kein Rollback mehr, kein separater ;; "Fortsetzen"-Mechanismus noetig). ;; Die Installation MUSS vor dem allerersten vfl-in-*-Aufruf erfolgen: ein ;; echtes ESC (nicht ein leeres Enter) loest bei JEDEM get*-Aufruf sofort ;; *error* aus (nicht nil) - ohne den Handler wuerde ein ESC in diesem ;; Fenster auf den vorherigen Handler zurueckfallen (im Editier-Pfad: der ;; ssg-start-Handler ohne Wickeln - der bereits geloeschte Original-Block ;; waere dann ersatzlos weg). lastEnt/old-error/vfl-nummer/anzahl-gf/ ;; anzahl-vf/startpunkt/frame/as-seite/es-seite sind zur Aufrufzeit ;; dynamisch gebunden und daher im Handler-Lambda sichtbar (AutoLISP ;; dynamic scoping, gilt fuer die gesamte Laufzeit dieses Aufrufs, auch ;; tief verschachtelt z.B. in vfl-vf-einheit). (setq vfl-nummer (vf-next-number)) (setq lastEnt (vf-lastent-ohne-attribute)) (setq anzahl-gf 0 anzahl-vf 0 frame nil) (setq old-error *error*) ;; Abbruch-Handler: zuerst *error* zuruecksetzen (kein rekursiver ;; Wiedereintritt bei einem Fehler waehrend des Wickelns), dann wickeln. ;; Laeuft der Aufruf innerhalb einer ssg-start-Sitzung (Editier-Pfad via ;; c:VARIOFOERDERER_EDIT -> vfl-edit-ent), wird diese mit ssg-end sauber ;; geschlossen (Undo-Gruppe, gesicherte Systemvariablen, *error* aus dem ;; Sitzungs-Frame) - sonst bliebe die von ssg-start geoeffnete Undo-Gruppe ;; offen. (setq *error* (function (lambda (msg) (setq *error* old-error) (vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf startpunkt frame as-seite es-seite "linienzug") (if dbg-an (progn (dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ===")) (dbgreturn nil) (dbgclose))) (if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end)) (princ)))) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl (list "vfl-prompt-startpunkt-kette" "Starthoehe (Z, mm):"))) (setq startpunkt (vfl-in-point nil (ssg-text "vfl-prompt-startpunkt-kette"))) (if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit))) ;; Hoehe (Z) des Startpunkts abfragen und in die Z-Koordinate uebernehmen. (setq start-hoehe (vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt-kette" (list (rtos (caddr startpunkt) 2 1))))) (if (null start-hoehe) (setq start-hoehe (caddr startpunkt))) (setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe)) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-as-setzen-frage"))) (princ (ssg-text "vfl-as-setzen-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-as-nein")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "vfl-ja") (ssg-text "vfl-as-nein")) 1 "vfl-as-setzen-frage")) (setq as-vorhanden (/= antwort "2")) (if as-vorhanden (progn (setq *vfl-as-winkel* (vfl-in-value "STR" (function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite (princ (ssg-text "vfl-aus-seite-header")) (princ (ssg-text "gf-seite-links")) (princ (ssg-text "gf-seite-rechts")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "vfl-aus-seite-header")) (setq as-seite (if (= antwort "2") "rechts" "links")) (vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante ) ) ;; ES-Seite wird erst am Kettenende abgefragt (siehe vfl-frage-es-seite), ;; da das ES-Element erst dort eingefuegt wird. (setq p-aktuell startpunkt) (setq letzter-typ nil fertig nil frame nil) (setq anzahl-gf 0 anzahl-vf 0) (vfl-acc-reset) (while (not fertig) ;; --- Naechstes Element bestimmen --- ;; Nach einem GF-Segment ODER einer geschlossenen VF-Einheit (beide enden ;; auf 3-Grad-Neigung) darf ein GF-Bogen oder eine neue Linie folgen. Nur ;; am Kettenanfang folgt direkt eine neue Linie. Vario-Kurven werden ;; INNERHALB der VF-Einheit behandelt (vfl-vf-einheit). ;; Menue immer anzeigen; GF-Bogen nur, wenn bereits ein Frame existiert ;; (am Kettenanfang gibt es keinen Vorgaenger-Rahmen fuer einen Bogen). ;; Lueckenlose Nummerierung: GF-Bogen (nur mit Frame) ist immer Option 1; ;; ohne Frame ruecken die uebrigen Optionen auf 1..4 auf. ;; "Neue Linie" ist in zwei explizite Zweige aufgeteilt (GF / Ab-Auf-VF) - ;; der Nutzer legt den Segmenttyp direkt fest, keine Geometrie-Automatik ;; mehr wie bei "Neue Linie BIS Kettenende" (die bleibt unveraendert und ;; nutzt weiterhin vfl-segment-entscheidung). (princ (ssg-text "vfl-naechstes-element-header")) (setq linie-ende-modus nil) ;; Glied-Checkpoint am Iterationskopf setzen; Label wird nach der Auswahl ;; nachgetragen (vfl-journal-steplabel), damit jedes Glied seine eigene ;; Menue-Auswahl + Segment-Eingaben vollstaendig umschliesst (fuer den ;; gliedweisen Ruecksprung beim Editieren). (vfl-journal-mark "?") (if frame (progn (princ (ssg-text "vfl-menu-gf-bogen-1")) (princ (ssg-text "vfl-menu-linie-gf-2")) (princ (ssg-text "vfl-menu-linie-vf-3")) (princ (ssg-text "vfl-menu-horizontal-vf-4")) (princ (ssg-text "vfl-menu-linie-ende-5")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-5-def2") (list (ssg-text "vfl-menu-gf-bogen-1") (ssg-text "vfl-menu-linie-gf-2") (ssg-text "vfl-menu-linie-vf-3") (ssg-text "vfl-menu-horizontal-vf-4") (ssg-text "vfl-menu-linie-ende-5")) 2 "vfl-naechstes-element-header")) (setq wahl (cond ((= antwort "1") "GF-Bogen") ((= antwort "3") "Linie-VF") ((= antwort "4") "Horizontal-VF") ((= antwort "5") (setq linie-ende-modus t) "Linie") (t "Linie-GF"))) ; "2" oder leer ) (progn (princ (ssg-text "vfl-menu-linie-gf-1")) (princ (ssg-text "vfl-menu-linie-vf-2")) (princ (ssg-text "vfl-menu-horizontal-vf-3")) (princ (ssg-text "vfl-menu-linie-ende-4")) (setq antwort (vfl-menu (ssg-text "vfl-prompt-wahl-1-4-def1") (list (ssg-text "vfl-menu-linie-gf-1") (ssg-text "vfl-menu-linie-vf-2") (ssg-text "vfl-menu-horizontal-vf-3") (ssg-text "vfl-menu-linie-ende-4")) 1 "vfl-naechstes-element-header")) (setq wahl (cond ((= antwort "2") "Linie-VF") ((= antwort "3") "Horizontal-VF") ((= antwort "4") (setq linie-ende-modus t) "Linie") (t "Linie-GF"))) ; "1" oder leer ) ) ;; Segmenttyp steht fest -> Glied-Label nachtragen (fuer die Edit-Liste). (vfl-journal-steplabel wahl) (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) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-gefaelle-impl (list (vfl-gf-hoehe-vorschlag (caddr p-aktuell))))) (princ (ssg-text "vfl-gefaelle-festlegen-header")) (princ (ssg-text "vfl-gefaelle-opt-hoehe")) (princ (ssg-text "vfl-gefaelle-opt-winkel")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "vfl-gefaelle-opt-hoehe") (ssg-text "vfl-gefaelle-opt-winkel")) 1 "vfl-gefaelle-festlegen-header")) (if (= antwort "2") (progn ;; Winkel direkt vorgeben - deltaH ergibt sich aus deltaL*tan(winkel). (setq winkel (vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel" (list (rtos gf-max-winkel 2 1))))) (if (null winkel) (setq winkel gf-max-winkel)) (if (or (<= winkel 0.0) (> winkel gf-max-winkel)) (progn (alert (ssg-textf "vfl-alert-winkel-ungueltig" (list (rtos winkel 2 1) (rtos gf-max-winkel 2 1)))) (setq gf-ok nil)) (progn (setq richtung "Ab") (setq deltaH (* deltaL (/ (sin (* winkel (/ pi 180.0))) (cos (* winkel (/ pi 180.0)))))) ) ) ) (progn ;; Gegebene Hoehe - wie bisher, aber Winkel wird daraus abgeleitet ;; und gegen den GF-Maximalwinkel geprueft (GF kann nicht steigen). ;; p-aktuell ist ab hier immer der reale Referenzpunkt (bei ;; Kettenanfang das echte KS_AUS des AS-Elements). Vorschlag/ ;; Enter-Default = vfl-gf-hoehe-vorschlag (siehe dort), NICHT ;; die unveraenderte Ist-Hoehe - sonst waere deltaH=0 und die ;; GF-Pruefung wiese den Wert als "kann nicht steigen" ab. (setq hoehe-neu (vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos (vfl-gf-hoehe-vorschlag (caddr p-aktuell)) 2 1))))) (if (null hoehe-neu) (setq hoehe-neu (vfl-gf-hoehe-vorschlag (caddr p-aktuell)))) (setq deltaH (- hoehe-neu (caddr p-aktuell))) (setq richtung (if (>= deltaH 0.0) "Auf" "Ab")) (setq deltaH (abs deltaH)) (cond ((= richtung "Auf") (alert (ssg-text "vfl-alert-gf-kann-nicht-steigen")) (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-menu (ssg-text "vfl-prompt-wahl-1-3-def3") (list (ssg-text "vfl-kettenende-opt-ja-es") (ssg-text "vfl-kettenende-opt-ja-ohne-es") (ssg-text "vfl-kettenende-opt-nein")) 3 "vfl-ist-kettenende-header")) (cond ((= antwort "1") (setq es-seite (vfl-frage-es-seite)) (setq frame (vfl-insert-es-element "GF" frame hz-neu winkel (caddr (car frame)) es-seite)) (setq fertig t)) ((= antwort "2") (setq fertig t)) ) ) ) ) ) ) ;; --- Neue Linie: Ab/Auf VF (Nutzer legt den Typ explizit fest) --- ((= wahl "Linie-VF") (setq linie-mess (vfl-neue-linie-messen p-aktuell (if frame (car (frame->hz-winkel frame)) nil))) (if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit))) (setq deltaL (car linie-mess) hz-neu (cadr linie-mess) 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 (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl (list (caddr p-aktuell)))) (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 (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-ziel-hoehe-impl (list (caddr p-aktuell)))) (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-menu (ssg-text "vfl-prompt-wahl-1-3-def3") (list (ssg-text "vfl-kettenende-opt-ja-es") (ssg-text "vfl-kettenende-opt-ja-ohne-es") (ssg-text "vfl-kettenende-opt-nein")) 3 "vfl-ist-kettenende-header")) ) ) (cond ((= antwort "1") (setq es-seite (vfl-frage-es-seite)) (setq frame (vfl-insert-es-element "GF" frame hz-neu winkel (caddr (car frame)) es-seite)) (setq fertig t)) ((= antwort "2") (setq fertig t)) ) ) (progn ;; --- VarioFoerderer-Einheit (Umlenk..Motor, mehrsegmentig) --- ;; linie-ende-modus=T -> direkt Kettenende (Separator + ES). (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 "linienzug")) ;; Erfolgreicher Abschluss: *error* zuruecksetzen. (setq *error* old-error) (princ "\n\n=========================================") (princ (ssg-text "vfl-kette-eingefuegt")) (princ "\n=========================================") (if dbg-an (progn (dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer) " (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")")) (dbgmsg "=== SESSION Modus 1 ENDE ===") (dbgreturn (list "VF" vfl-nummer)) (dbgclose))) (princ) ) ;; ============================================================ ;; EDITIEREN: gliedweise zuruecknehmen + Neuaufbau per Replay ;; ============================================================ ;; Aufgerufen aus c:VARIOFOERDERER_EDIT (Doppelklick auf VF_n mit XDATA-Marker ;; "linienzug", egal ob fertiggestellt oder durch einen Abbruch gewickelt). ;; Liest das Eingabe-Journal vom Block, listet die Glieder, laesst per ;; DCL-Dialog (vfl-dlg-position) eine Sektion waehlen, auf die zurueckgesetzt ;; wird, loescht den alten Block und baut die Kette neu: die behaltenen ;; Glieder werden stumm abgespielt, danach laeuft die Eingabe interaktiv fuer ;; die geaenderten/neuen Glieder weiter. Vorbelegung im Dialog = voller Stand ;; -> Doppelklick + sofort OK setzt einen abgebrochenen Bau nahtlos fort. ;; Marker-Dispatch: "linienzug" (Modus 1) -> abschnittsweises Zuruecksetzen ;; wie bisher; "linienzug2" (Modus 2) -> voller Reset ohne Sektionswahl ;; (vfl-edit-ent2) - Modus 2s Klassifizierungs-Schleife traegt keine ;; Glied-Marker, ein Sektions-Dialog wie bei Modus 1 ist dafuer (noch) nicht ;; vorgesehen. (defun vfl-edit-ent (ent / xd marker journal glieder n i pos trunc) (setq xd (vfl-journal-xdata-lesen ent)) (if (null xd) (progn (alert (ssg-text "vfl-edit-kein-journal")) (exit))) (setq marker (car xd) journal (cdr xd)) (if (= marker "linienzug2") (vfl-edit-ent2 ent journal) (progn (setq glieder (vfl-journal-glieder journal)) (setq n (length glieder)) (princ (ssg-textf "vfl-edit-kette-header" (list (itoa n)))) (setq i 1) (foreach g glieder (princ (strcat "\n " (itoa i) ") " (vfl-glied-label-text g))) (setq i (1+ i))) (setq pos (vfl-dlg-position glieder)) (if (null pos) (progn (princ (ssg-text "vfl-edit-abgebrochen")) (exit))) (setq trunc (vfl-journal-truncate journal pos)) ;; Alten Block entfernen (wie Standard/Etage: entdel + kompletter Neuaufbau). ;; Bricht der Neuaufbau selbst ab, wickelt vfl-modus-abbruch-sichern den ;; Zwischenstand automatisch zu einem neuen Block - kein Sonderfall noetig. (entdel ent) (princ (ssg-textf "vfl-edit-abgespielt" (list (itoa pos) (itoa (- n pos))))) ;; Behaltene Glieder abspielen, dann live weiterbauen. (vfl-journal-replay-start trunc) (vf-linienzug-modus))) (princ)) ;; Modus-2-Block per Doppelklick zuruecksetzen: voller Reset - die komplette ;; gespeicherte Eingabe (inkl. der gewaehlten Pfad-Objekte, siehe ;; vfl-in-selection) wird 1:1 stumm abgespielt, identischer Neuaufbau. Kein ;; Sektions-Dialog; der Nutzer kann den neu entstandenen Block danach ganz ;; normal weiterbearbeiten oder loeschen. (defun vfl-edit-ent2 (ent journal) (entdel ent) (princ (ssg-text "vfl-edit2-reset-info")) (vfl-journal-replay-start journal) (vf-linienzug-modus2) (princ)) ;; DCL-Dialog: Sektion waehlen, auf die die Kette zurueckgesetzt wird. ;; glieder = Liste der Glied-Labels (interne Tokens, vfl-journal-glieder), in ;; Bau-Reihenfolge. Vorbelegung auf den letzten Eintrag (voller Stand = reines ;; Fortsetzen ohne Kuerzung). Rueckgabe: gewaehlte Position (1-basiert) oder ;; nil bei Abbrechen/Escape. (defun vfl-dlg-position (glieder / n dcl-pfad dat idx ergebnis i) (setq n (length glieder)) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/vfl_edit.dcl")) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog "vfl_edit" dat)) (progn (alert (ssg-textf "vfl-edit-dialog-fehlt" (list dcl-pfad))) nil) (progn (set_tile "kopf" (ssg-textf "vfl-dlg-kopf-sektionen" (list (itoa n)))) (start_list "position") (setq i 1) (foreach g glieder (add_list (strcat (itoa i) " - " (vfl-glied-label-text g))) (setq i (1+ i))) (end_list) (set_tile "position" (itoa (1- n))) ; letzter Eintrag vorbelegt (0-basierter Index) (action_tile "accept" "(setq idx (atoi (get_tile \"position\"))) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq ergebnis (start_dialog)) (unload_dialog dat) (if (= ergebnis 1) (1+ idx) nil) ) ) ) ;; ============================================================ ;; DIAGNOSE: Blockstruktur (KS_EIN/KS_AUS) untersuchen ;; ============================================================ ;; Zeigt, wie ein Block intern aufgebaut ist - insbesondere, ob KS_EIN/KS_AUS ;; auf der ersten Explode-Ebene als Unterbloecke liegen und welche Laengen ihre ;; Achslinien haben (ks-line-axis erwartet X~1/~100, Y~2, Z~3). Damit laesst ;; sich klaeren, warum extract-ks-from-block bei den Vario_Kurve-Bloecken ;; "KS_EIN/KS_AUS fehlen" meldet. ;; Aufruf in BricsCAD: VFL_KS_DIAG -> Blockname eingeben. (defun c:VFL_KS_DIAG ( / bname obj subs s nm inner il ilnm ps pe len) (setq bname (getstring "\nBlockname fuer KS-Diagnose: ")) (setq bname (ensure-block-loaded bname)) (if (not (tblsearch "BLOCK" bname)) (progn (princ (strcat "\nBlock '" bname "' nicht gefunden.")) (exit))) (setq obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) bname 1.0 1.0 1.0 0)) (princ (strcat "\n==================================================")) (princ (strcat "\n=== Struktur von '" bname "' (Ebene 1) ===")) (setq subs (vlax-invoke obj 'Explode)) (foreach s subs (if (not (vlax-erased-p s)) (progn (setq nm (vla-get-ObjectName s)) (if (= nm "AcDbBlockReference") (progn (princ (strcat "\n BlockRef: '" (vla-get-Name s) "' (Ebene 2:)")) (setq inner (vlax-invoke s 'Explode)) (foreach il inner (if (not (vlax-erased-p il)) (progn (setq ilnm (vla-get-ObjectName il)) (cond ((= ilnm "AcDbLine") (setq ps (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint il)))) (setq pe (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint il)))) (setq len (vec-length (list (- (car pe)(car ps)) (- (cadr pe)(cadr ps)) (- (caddr pe)(caddr ps))))) (princ (strcat "\n Line len=" (rtos len 2 3) " axis=" (if (ks-line-axis len) (ks-line-axis len) "?")))) ((= ilnm "AcDbBlockReference") (princ (strcat "\n BlockRef(verschachtelt): '" (vla-get-Name il) "'"))) (t (princ (strcat "\n " ilnm))) ) (vla-Delete il) ) ) ) ) (princ (strcat "\n " nm)) ) (vla-Delete s) ) ) ) (princ "\n=== Ende Diagnose ===") (princ "\n==================================================") (princ) ) ;; ============================================================ ;; REGISTRIERUNG ;; ============================================================ ;; berechne-fn/einfuege-fn werden fuer "linienzug" NICHT im normalen Schema ;; verwendet (eigener Befehlsablauf, siehe Kommentar am Dateianfang) - beide ;; sind daher nur Platzhalter, die c:VarioFoerderer nie aufruft (Dispatch ;; erfolgt dort direkt auf vf-linienzug-modus). (defun vfl-berechne-platzhalter (deltaL deltaH richtung seite) (princ "\n[vf_linienzug] FEHLER: berechne-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.") (list nil nil nil nil) ) (defun vfl-einfuege-platzhalter (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz) (princ "\n[vf_linienzug] FEHLER: einfuege-fn sollte fuer Typ 'linienzug' nie aufgerufen werden.") startpunkt ) ;; ============================================================ ;; MODUS 2: 3D-OBJEKTE WAEHLEN (Meilenstein 1 - GF-Teil) ;; ============================================================ ;; Baut die Kette aus einem GEZEICHNETEN Pfad (LINE/ARC). Ablauf: ;; Objekte waehlen -> gf-sortiere-objekte -> gf-analysiere-kette ;; -> Eck-Winkel-Vorpruefung -> segmentweise (Variante B) live bauen -> ES. ;; In diesem Meilenstein ist NUR der GF-Teil aktiv (GF-Gerade mit eigener ;; Neigung <=3 Grad, GF-Bogen). Die VF-Zweige sind als TODO (Meilenstein 2) ;; markiert und werden uebersprungen. ;; Bekannte Naeherungen (in BricsCAD verifizieren): ;; - Eck-Trimmung nur an erster/letzter Geraden (-aus-dx bzw. -300-ein-dx, ;; wie gf-linienzug-modus); Separatoren VOR GF-Boegen noch NICHT gesetzt. ;; - GF-Bogen hat feste Eigen-Neigung -> bei unterschiedlichen Nachbar- ;; Neigungen entsteht ein (akzeptierter) Knick. ;; Alle Eck-Winkel des Pfades gegen 30/60/90 Grad pruefen (Toleranz tol). ;; Rueckgabe: nil (alle ok) oder der erste abweichende Winkel (Grad). (defun vfl2-pruefe-eckwinkel (kette tol / item obj sa ea sweep bad) (setq bad nil) (foreach item kette (setq obj (car item)) (if (and (null bad) (= (vla-get-ObjectName obj) "AcDbArc")) (progn (setq sa (vla-get-StartAngle obj) ea (vla-get-EndAngle obj)) (setq sweep (if (>= ea sa) (- ea sa) (+ (- ea sa) (* 2.0 pi)))) (setq sweep (* sweep (/ 180.0 pi))) (if (not (or (< (abs (- sweep 30.0)) tol) (< (abs (- sweep 60.0)) tol) (< (abs (- sweep 90.0)) tol))) (setq bad sweep)) ) ) ) bad ) ;; AS-Element fuer Modus 2 (GF): gemischte Verankerung. ;; - Laengsrichtung (entlang hz): KS_EIN auf den Startpunkt (Laengsposition) ;; - Querrichtung (senkrecht hz): KS_AUS auf den Pfad (Kettenmittellinie) ;; Umsetzung: (1) AS mit KS_EIN am Startpunkt platzieren, (2) Querversatz des ;; KS_AUS zum Pfad messen, (3) AS senkrecht zu hz um -Versatz verschieben. ;; Ergebnis: KS_EIN.X = Startpunkt.X, KS_EIN quer um das AS-Y-Mass versetzt, ;; KS_AUS liegt exakt auf dem Pfad -> die ganze Kette folgt der Mittellinie. ;; Rueckgabe: (korrigierter) Frame am KS_AUS. ;; winkel-Parameter bleibt aus Call-Kompatibilitaet bestehen (vfl2-insert-as-vf ;; ruft mit 0.0), wird aber NICHT mehr fuer eine Kippung verwendet: das AS- ;; Element hat keine eigene Neigung (per Einzel-Insert-Test in BricsCAD ;; bestaetigt, siehe vfl-insert-as-element in Modus 1) - unabhaengig vom ;; folgenden Segmenttyp (GF/VF) wird es IMMER flach eingefuegt. (defun vfl2-insert-as-gf (startpunkt hz winkel as-seite / ein-hz-as rad-h xu-ein frame blk ks-aus rad-hz perp-x perp-y d-perp sx sy as-turn rad-ein de-x de-y de-dot-np t-shift) ;; Schwenk aus dem AS-Block MESSEN (30/90/gerade), KS_EIN so drehen, dass ;; KS_AUS entlang hz zeigt: ein-hz = hz - plan-turn. (setq as-turn (vf-element-plan-turn (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite))) (setq ein-hz-as (- hz as-turn)) (setq rad-h (* (float ein-hz-as) (/ pi 180.0))) (setq xu-ein (list (cos rad-h) (sin rad-h) 0.0)) ;; (1) KS_EIN auf den Startpunkt (Laengsposition korrekt) (setq frame (insert-block-mixed-to-ks (strcat "AS_Element_" (vfl-as-winkel) "_" as-seite) (make-frame-from-dir startpunkt xu-ein) (caddr startpunkt) "KS_EIN" "KS_EIN")) (setq blk (entlast)) ;; (2) Querversatz des KS_AUS zum Pfad (Einheits-Querrichtung senkrecht zu hz) (setq ks-aus (car frame)) (setq rad-hz (* (float hz) (/ pi 180.0))) (setq perp-x (- (sin rad-hz)) perp-y (cos rad-hz)) ; Normale zum Pfad (setq d-perp (+ (* (- (car ks-aus) (car startpunkt)) perp-x) (* (- (cadr ks-aus) (cadr startpunkt)) perp-y))) ;; (3) AS ENTLANG der KS_EIN-Achse verschieben (nicht senkrecht zum Pfad): ;; damit landet KS_AUS auf dem Pfad UND der Startpunkt bleibt auf der KS_EIN- ;; Achse. Beim 90-Grad-Element ist die KS_EIN-Achse senkrecht zum Pfad -> das ;; ist identisch zum bisherigen Querschub. (setq rad-ein (* (float ein-hz-as) (/ pi 180.0))) (setq de-x (cos rad-ein) de-y (sin rad-ein)) ; KS_EIN-Achsrichtung (setq de-dot-np (+ (* de-x perp-x) (* de-y perp-y))) (setq t-shift (if (> (abs de-dot-np) 1e-6) (/ d-perp de-dot-np) 0.0)) (setq sx (* (- t-shift) de-x) sy (* (- t-shift) de-y)) (if (> (abs t-shift) 1e-6) (vla-Move (vlax-ename->vla-object blk) (vlax-3D-point '(0.0 0.0 0.0)) (vlax-3D-point (list sx sy 0.0)))) ;; (4) korrigierten KS_AUS-Frame zurueckgeben (Richtung unveraendert) (list (list (+ (car ks-aus) sx) (+ (cadr ks-aus) sy) (caddr ks-aus)) (cadr frame) (caddr frame) (cadddr frame)) ) ;; VF-Start-AS (Modus 2): identische Platzierung wie beim GF-Start, aber FLACH ;; (0 Grad Neigung). Das AS wird mit KS_EIN auf den Startpunkt gesetzt und dann ;; senkrecht zu hz auf den Pfad geschoben (reine KS-Kettung, KS_AUS auf Pfad). ;; Damit liegt auch eine mit VF beginnende Kette auf dem gezeichneten Pfad. (defun vfl2-insert-as-vf (startpunkt hz as-seite) (vfl2-insert-as-gf startpunkt hz 0.0 as-seite)) ;; VF-Einheit OEFFNEN (Modus 2): GF1 (Basis-Staustrecke) + Separator + ;; Umlenkstation. Rueckgabe: Frame nach der Umlenkstation (Beginn reiner VF). (defun vfl2-vf-open (frame hz / f) (setq f (vfl-frame-3grad (vfs-vf-entry (car frame) *vfl-gf-min-laenge* hz) hz)) (if (> *vfl-gf-min-laenge* 0.1) (vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3))) f) ;; VF-Einheit SCHLIESSEN (Modus 2): Motorstation + GF2 (Basis), KEIN Separator ;; (der sitzt erst am Kettenende bzw. optional zwischen Foerderern). Rueckgabe: ;; Frame nach GF2. (defun vfl2-vf-close (frame hz / f) (setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts"))) (setq f (vfl-frame-3grad (vfs-vf-exit (car frame) *vfl-gf-min-laenge* hz nil) hz)) (if (> *vfl-gf-min-laenge* 0.1) (vfl-acc-gf-seg *vfl-gf-min-laenge* (ssg-cfg-or "vario" "gefaelle_winkel" 3))) f) ;; Vario-Winkel (Vertikalbogen) auf die verfuegbaren Werte 3..51 einrasten. (defun vfl2-snap-vfwinkel (w / liste best bd d) (setq liste (ssg-cfg-or "vario" "bogen_winkel" '(3 6 9 12 15 18 21 27 33 39 45 51))) (setq best (car liste) bd 1e9) (foreach x liste (setq d (abs (- x w))) (if (< d bd) (setq bd d best x))) best) (defun vf-linienzug-modus3 ( / ss obj-liste startpunkt start-hoehe as-seite es-seite kette segmente n i seg typ hz laenge bwinkel bseite frame antwort winkel deltaL anzahl-gf anzahl-vf vfl-nummer lastEnt hoehe-bis ecke-bad first-line last-line letzt-winkel aus ein soll-ende ist-ende run-typ richtn best-w kvariante L_VF ent-fp rad3 just-open dbg-an old-error) (princ "\n\n=========================================") (princ (ssg-text "vfl-vwnb-titel")) (princ "\n=========================================") ;; --- Debug-Session (Schalter "vfl-modus3", DEFAULT AN) ------------------- ;; Bei Bedarf abschaltbar: (dbg-schalter-off "vfl-modus3") in der Konsole. ;; Alle interaktiven Eingaben (Punkte, Hoehen, Seiten, Winkel, Menue- ;; Auswahlen) laufen ueber die vfl-in-*-Wrapper und werden dadurch ;; automatisch ueber vfl-journal-record mitgeloggt (siehe dort) - hier nur ;; noch Session-Start/-Ende + Zwischenergebnisse, die NICHT direkt aus einer ;; Nutzereingabe stammen (Analyse-Ergebnis, Segment-Header, Bau-Ergebnis). ;; *vfl-journal*/*vflw-pending* werden dabei nebenbei mitbefuellt, aber von ;; Modus 3 nirgends gelesen/persistiert (kein Replay/XDATA wie bei Modus 1/2 ;; - das ist hier bewusst NICHT mit umgebaut, nur das Logging). ;; Der *error*-Handler schliesst die Datei bei Abbruch sauber. (setq dbg-an (dbg-schalter-open "vfl-modus3" "vfl_modus3.dbg" "DXFM_LOG")) (if dbg-an (progn (dbgf "vf-linienzug-modus3") (dbgmsg "=== SESSION Modus 3 (Vorwaerts-Nachbau) START ===") (dbgflush))) (setq old-error *error*) (setq *error* (function (lambda (msg) (setq *error* old-error) (if dbg-an (progn (dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ===")) (dbgreturn nil) (dbgclose))) (if old-error (old-error msg) (princ))))) ;; Abhaengigkeit Gefaellestrecke-Modul (GF-Bausteine) (if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED")))) (progn (alert (ssg-text "vfl-m3-alert-gf-modul")) (exit))) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) ;; --- 1. Pfad-Objekte waehlen (LINE/ARC) --- (princ (ssg-text "vfl-m3-pfad-waehlen")) (setq ss (vfl-in-selection '((0 . "LINE,ARC")))) (if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit))) (setq obj-liste (mapcar 'vlax-ename->vla-object ss)) ;; --- 2. Startpunkt (hoehere Seite) + Hoehe + AS-Seite --- (setq startpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-startpunkt"))) (if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit))) (setq start-hoehe (vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt" (list (rtos (caddr startpunkt) 2 1))))) (if (null start-hoehe) (setq start-hoehe (caddr startpunkt))) (setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe)) ;; vf-frage-element-winkel ruft direkt getstring/vflw-wahl auf (kein ;; vfl-in-*-Wrapper darin) - manuell mitloggen, sonst wuerde diese eine ;; Eingabe durchrutschen. (setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite (if dbg-an (progn (dbgmsg "AS-Winkel:") (dbg '*vfl-as-winkel*) (dbgflush))) (princ (ssg-text "vfl-vwnb-aus-seite-menu")) (setq as-seite (if (= (vfl-in-string (ssg-text "prompt-wahl-1-2")) "2") "rechts" "links")) (vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante ;; --- 3. Sortieren + Analysieren --- (setq kette (gf-sortiere-objekte obj-liste startpunkt)) (if (null kette) (progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit))) (setq segmente (gf-analysiere-kette kette)) (if dbg-an (progn (dbgmsg (strcat "ANALYSE: " (itoa (length segmente)) " Segment(e) erkannt")) (dbg 'segmente) (dbgflush))) ;; --- 4. Eck-Winkel-Vorpruefung (vor dem Bau) --- (setq ecke-bad (vfl2-pruefe-eckwinkel kette 5.0)) (if ecke-bad (progn (alert (ssg-textf "vfl-vwnb-alert-eckwinkel" (list (rtos ecke-bad 2 1)))) (exit))) ;; --- 5. Setup --- (setq aus (if aus-dx aus-dx 576.0) ein (if ein-dx ein-dx 576.0)) (setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0))) ;; Entry-Fussabdruck (planar) einer VF-Einheit: GF1(Basis)+Separator(300)+Umlenk(500) (setq ent-fp (* (+ *vfl-gf-min-laenge* 300.0 500.0) (cos rad3))) (setq run-typ nil) (setq vfl-nummer (vf-next-number)) (setq lastEnt (vf-lastent-ohne-attribute)) (vfl-acc-reset) (setq anzahl-gf 0 anzahl-vf 0 frame nil n (length segmente)) ;; erste/letzte "Linie" fuer die Trimmung bestimmen (setq first-line -1 last-line -1 i 0) (while (< i n) (if (= (car (nth i segmente)) "Linie") (progn (if (< first-line 0) (setq first-line i)) (setq last-line i))) (setq i (1+ i))) (if (< first-line 0) (progn (alert (ssg-text "vfl-vwnb-alert-keine-gerade")) (exit))) ;; --- 6. Bau-Schleife (Meilenstein 2: GF + VF-Laeufe, Run-State-Machine) --- ;; run-typ: nil / "GF" / "VF". Beim Wechsel GF<->VF wird die VF-Einheit ;; geoeffnet (GF1+Separator+Umlenk) bzw. geschlossen (Motor+GF2). ;; v1-Naeherung Laenge: Entry-Fussabdruck wird vom ersten VF-Koerper abgezogen; ;; der Exit (Motor+GF2) wird beim Schliessen ANGEHAENGT (verlaengert den VF-Lauf ;; ggue. dem gezeichneten Pfad; feinere Laengen-Reservierung -> spaeter). (setq i 0) (while (< i n) (setq seg (nth i segmente) typ (car seg) hz (cadr seg)) (cond ;; ===================== GERADE ===================== ((= typ "Linie") (setq laenge (caddr seg)) (princ (ssg-textf "vfl-m3-seg-gerade" (list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1)))) (if dbg-an (dbgmsg (strcat "SEGMENT " (itoa (1+ i)) "/" (itoa n) " GERADE (laenge=" (rtos laenge 2 0) " hz=" (rtos hz 2 1) ")"))) (princ (ssg-text "vfl-vwnb-typ-gerade")) (setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2-3-4"))) (cond ;; --- GF-Gerade --- ((or (= antwort "") (= antwort "1")) (if (= run-typ "VF") ; offenen VF-Lauf schliessen (progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame)))) (setq run-typ nil))) (setq winkel (vfl-in-real (ssg-text "vfl-m3-prompt-gf-neigung"))) (if (null winkel) (setq winkel 3.0)) (if (> winkel 3.0) (progn (princ (ssg-text "vfl-m3-hinweis-gf-max")) (setq winkel 3.0))) (if (null frame) (setq frame (vfl2-insert-as-gf startpunkt hz winkel as-seite))) (setq deltaL laenge) ;; erste Gerade: AS-Fussabdruck ENTLANG des Pfads exakt aus KS_AUS abziehen (if (= i first-line) (setq deltaL (- deltaL (+ (* (- (car (car frame)) (car startpunkt)) (cos (* hz (/ pi 180.0)))) (* (- (cadr (car frame)) (cadr startpunkt)) (sin (* hz (/ pi 180.0)))))))) (if (= i last-line) (setq deltaL (- deltaL 300.0 ein))) (setq deltaL (max 100.0 deltaL)) (setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel)) (vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel) (setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel run-typ "GF")) ;; --- VF-Gerade (Ab / Auf / Horizontal) --- (t (setq richtn (cond ((= antwort "3") "Auf") ((= antwort "4") "horizontal") (t "Ab"))) (setq just-open nil) (if (null frame) ; AS (flach) am Kettenanfang, KS_AUS auf Pfad (setq frame (vfl2-insert-as-vf startpunkt hz as-seite))) (if (not (= run-typ "VF")) ; VF-Einheit oeffnen (progn (setq frame (vfl2-vf-open frame hz)) (setq run-typ "VF" just-open t))) (if (= richtn "horizontal") (setq best-w 0) (progn (setq best-w (vfl-in-int (ssg-text "vfl-vwnb-prompt-vario-winkel"))) (if (null best-w) (setq best-w 3)) (setq best-w (vfl2-snap-vfwinkel best-w)) (if dbg-an (progn (dbgmsg "Vario-Winkel (gesnapt):") (dbg 'best-w) (dbgflush))))) (setq L_VF laenge) (if just-open (setq L_VF (- L_VF ent-fp))) ; Entry-Fussabdruck reservieren (setq L_VF (max 100.0 L_VF)) (setq frame (vfl-frame-3grad (vfs-vf-koerper (car frame) richtn best-w L_VF hz) hz)) (vfl-acc-vf-seg richtn best-w L_VF) (setq anzahl-vf (1+ anzahl-vf) run-typ "VF")))) ;; ===================== ECK / BOGEN ===================== ((= typ "Bogen") (setq bwinkel (nth 3 seg) bseite (nth 4 seg)) (princ (ssg-textf "vfl-m3-seg-bogen" (list (itoa (1+ i)) (itoa n) (itoa bwinkel) bseite))) (if dbg-an (dbgmsg (strcat "SEGMENT " (itoa (1+ i)) "/" (itoa n) " BOGEN (bwinkel=" (itoa bwinkel) " bseite=" bseite ")"))) (princ (ssg-text "vfl-m3-typ-bogen")) (setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2"))) (if (= antwort "2") ;; --- Vario-Kurve (nur im VF-Lauf) --- (if (not (= run-typ "VF")) (princ (ssg-text "vfl-vwnb-kurve-nur-vf")) (progn (princ (ssg-text "vfl-m3-variante-frage")) (setq kvariante (if (= (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")) "1") "aussen" "innen")) (setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite kvariante)))) ;; --- GF-Bogen --- (progn (if (null frame) (progn (alert (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit))) (if (= run-typ "VF") ; VF-Lauf vor GF-Bogen schliessen (progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame)))) (setq run-typ nil))) (setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite)) (setq run-typ "GF")))) ) (setq i (1+ i))) ;; --- 7. Kettenende: offenen VF-Lauf schliessen, dann Separator + ES --- (if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit))) ;; vfl-frage-es-seite nutzt intern bereits vfl-in-value/vfl-menu - wird also ;; automatisch mitgeloggt, kein manueller dbgmsg noetig. (setq es-seite (vfl-frage-es-seite)) (if (= run-typ "VF") (progn (setq frame (vfl2-vf-close frame (car (frame->hz-winkel frame)))) (setq frame (vfl-insert-es-element "VF" frame (car (frame->hz-winkel frame)) 0.0 (caddr (car frame)) es-seite))) (setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame)) (if letzt-winkel letzt-winkel 3.0) (caddr (car frame)) es-seite))) ;; --- 8. Block + Ist-Ziel-Report --- (setq hoehe-bis (caddr (car frame))) (vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis (vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt) (setq soll-ende (caddr (last kette))) ; Endpunkt des letzten gezeichneten Segments (setq ist-ende (car frame)) ; ES-KS_AUS (princ "\n\n=========================================") (princ (ssg-text "vfl-vwnb-eingefuegt")) (princ (ssg-textf "vfl-vwnb-soll-ende" (list (rtos (car soll-ende) 2 1) (rtos (cadr soll-ende) 2 1)))) (princ (ssg-textf "vfl-vwnb-ist-ende" (list (rtos (car ist-ende) 2 1) (rtos (cadr ist-ende) 2 1) (rtos (caddr ist-ende) 2 1)))) (princ (ssg-textf "vfl-vwnb-abweichung-xy" (list (rtos (- (car ist-ende) (car soll-ende)) 2 1) (rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1)))) (princ "\n=========================================") ;; --- Debug-Session sauber abschliessen --- (setq *error* old-error) (if dbg-an (progn (dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer) " (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")")) (dbg 'soll-ende) (dbg 'ist-ende) (dbgmsg "=== SESSION Modus 3 ENDE ===") (dbgreturn (list "VF" vfl-nummer)) (dbgclose))) (princ) ) ;; ============================================================ ;; MODUS 3: Pfad + Ziel-Hoehe (Randwert-Solver) - M3a ;; Schritt 1+2: Geruest + Klassifizierung + Anker-Report. NOCH KEIN Bauen. ;; Details siehe doc/VarioFoerderer_Linienzug_Prinzipien.md, Abschnitt 14. ;; ============================================================ ;; Signierte Z-Aenderung (mm) einer GF-Geraden: negativ = Abfall. ;; l-planar = XY-Planlaenge (aus Pfad), winkel = Neigung in Grad (fallend). ;; Ueber die Planlaenge gilt dz = -L * tan(winkel) (Fussabdruck bleibt L, ;; die 3D-Laenge waechst mit L/cos, siehe Doc 14.1). (defun vfl3-gf-dz (l-planar winkel / rad) (setq rad (* (float winkel) (/ pi 180.0))) (- (* (float l-planar) (/ (sin rad) (cos rad))))) ;; Signierte Z-Aenderung eines Plan-Eintrags. ;; GF-Gerade -> -L*tan(winkel) ;; GF-Bogen -> dz aus gf-bogen-masse (Block-KS) ;; Vario-Kurve -> 0 (auf 0 Grad geflacht) ;; VF-Gerade -> nil (unbekannt = Teil der Bruecke) (defun vfl3-seg-dz (e) (cond ((= (car e) "Linie") (if (= (nth 3 e) "GF") (vfl3-gf-dz (caddr e) (nth 4 e)) nil)) ((= (car e) "Bogen") (if (= (nth 5 e) "Vario-Kurve") 0.0 (cadr (gf-bogen-masse (nth 3 e) (nth 4 e))))) (t 0.0))) ;; Loest die VF-Bruecke ueber den Modus-1-Solver berechne-alle-winkel. ;; Die Bruecke sitzt MITTIG in der Kette -> KEIN terminales AS/ES ;; (aus-dx/aus-dz/ein-dx/ein-dz = 0), feste-hz = *vfl-feste-horizontal* (1300: ;; Umlenk 500 + Motor 500 + Einlauf-Separator 300). GF1/GF2 bleiben fest 3 Grad, ;; ihre Laenge variiert (das ist der Ausgleich, siehe Doc 14.3). ;; dH-signiert: negativ = Auf (steigt), positiv = Ab (faellt). ;; Rueckgabe: (winkel L_GF L_VF richtung) oder nil (kein passender Winkel). (defun vfl3-solve-bruecke (span dH-signiert extra-fest / o-adx o-adz o-eix o-eiz richtung fh res winkel) (setq richtung (if (< dH-signiert 0) "Auf" "Ab")) (setq fh (+ (if (boundp '*vfl-feste-horizontal*) *vfl-feste-horizontal* 1300.0) (if extra-fest extra-fest 0.0))) ;; terminale AS/ES-Masse fuer die mittige Bruecke ausblenden (Save/Restore) (setq o-adx aus-dx o-adz aus-dz o-eix ein-dx o-eiz ein-dz) (setq aus-dx 0.0 aus-dz 0.0 ein-dx 0.0 ein-dz 0.0) (setq res (berechne-alle-winkel span (abs dH-signiert) richtung fh)) (setq aus-dx o-adx aus-dz o-adz ein-dx o-eix ein-dz o-eiz) (setq winkel (car res)) (if winkel (list winkel (cadr res) (caddr res) richtung) nil)) ;; GF-Bogen-dz, wenn der Bogen bei Neigung theta (Grad) KS-gekettet wird: ;; der lokale (dx,dz) des Blocks wird um theta gekippt. ;; Z-Anteil = -dx*sin(theta) + dz*cos(theta) (negativ = Abfall) (defun vfl3-bogen-dz-incl (bwinkel bseite theta / m dx dz rad) (setq m (gf-bogen-masse bwinkel bseite) dx (car m) dz (cadr m)) (setq rad (* (float theta) (/ pi 180.0))) (+ (* (- dx) (sin rad)) (* dz (cos rad)))) ;; Exakter Gesamt-Abstieg (positiv, mm) des BACK-Laufs (Plan-Segmente ab ;; start-idx bis n-1) PLUS Auslauf-Separator (300 mm, bei aktueller Neigung) + ;; ES-Eigen-dz. Spiegelt den tatsaechlichen Bau (Trimmung der letzten Geraden um ;; 300+ein-fp, GF-Bogen bei Neigung). Eintritts-Neigung = 3 Grad (die Bruecke ;; endet mit GF2 auf 3 Grad). So wird die Junction-Hoehe exakt statt geschaetzt. (defun vfl3-dback (plan start-idx n last-idx ein-fp / i seg drop inc w dL rad) (setq drop 0.0 inc 3.0 i start-idx) (while (< i n) (setq seg (nth i plan)) (cond ((= (car seg) "Linie") (setq w (nth 4 seg) dL (caddr seg)) (if (= i last-idx) (setq dL (- dL 300.0 ein-fp))) (setq dL (max 100.0 dL)) (setq rad (* (float w) (/ pi 180.0))) (setq drop (+ drop (* dL (/ (sin rad) (cos rad))))) (setq inc w)) ((= (car seg) "Bogen") (if (= (nth 5 seg) "GF-Bogen") (setq drop (- drop (vfl3-bogen-dz-incl (nth 3 seg) (nth 4 seg) inc)))))) (setq i (1+ i))) ;; Auslauf-Separator (300 mm bei aktueller Neigung inc) + ES-Eigen-dz (setq rad (* (float inc) (/ pi 180.0))) (setq drop (+ drop (* 300.0 (/ (sin rad) (cos rad))))) (setq drop (+ drop (abs (if ein-dz ein-dz 65.0)))) drop) ;; Feste (von der Kletterlaenge UNABHAENGIGE) Z-Aenderung einer VF-Einheit bei ;; Kletterwinkel w (ohne GF2, das wird gemessen): GF1+Sep(300)+Umlenk(500)+ ;; Motor(500) (alle 3 Grad, senkend) + je Kletterer zwei Boegen + je ;; Horizontal-Mitte-Koerper zwei 3-Grad-Uebergangsboegen. Einbau-Rotationen wie ;; in vfs-vf-koerper; Bogen-dz_eff = -dx*sin(rot) + dz_roh*cos(rot) (am Log ;; verifiziert). So ist die Hoehe rein rechnerisch bestimmt -> Kletterlaenge folgt. (defun vfl3-einheit-fix-dz (w n-climb n-hor gf1 richtung / pi180 rad3 s3 tot m1 m2 r1 r2 dz1 dz2) (setq pi180 (/ pi 180.0) rad3 (* 3.0 pi180) s3 (sin rad3) tot 0.0) ;; feste 3-Grad-Teile senken immer ab (GF1 + Separator + Umlenk + Motor) (setq tot (- tot (* (+ (float gf1) 300.0 500.0 500.0) s3))) ;; Kletterer-Boegen (Rotationen wie vfs-vf-koerper: 1. Bogen @3, 2. Bogen @(3-w)/(w+3)) (if (= richtung "Auf") (setq m1 (get-bogen-mass bogen-auf w) r1 rad3 m2 (get-bogen-mass bogen-ab w) r2 (* (- 3 w) pi180)) (setq m1 (get-bogen-mass bogen-ab w) r1 rad3 m2 (get-bogen-mass bogen-auf w) r2 (* (+ w 3) pi180))) (setq dz1 (+ (* (- (car m1)) (sin r1)) (* (caddr m1) (cos r1)))) (setq dz2 (+ (* (- (car m2)) (sin r2)) (* (caddr m2) (cos r2)))) (setq tot (+ tot (* n-climb (+ dz1 dz2)))) ;; Horizontal-Mitte-Koerper: auf_3@3 + ab_3@0 (setq m1 (get-bogen-mass bogen-auf 3) m2 (get-bogen-mass bogen-ab 3)) (setq dz1 (+ (* (- (car m1)) (sin rad3)) (* (caddr m1) (cos rad3)))) (setq dz2 (caddr m2)) (setq tot (+ tot (* n-hor (+ dz1 dz2)))) tot) ;; Fester PLANARER (XY-)Fussabdruck einer VF-Einheit bei Kletterwinkel w ;; (ohne die Kletter-Strecken selbst): Stationen (GF1+Sep+Umlenk+Motor, @3 Grad) ;; + je Kletterer die zwei Boegen + je Horizontal-Mitte-Koerper die zwei ;; 3-Grad-Boegen. dx_eff = dx*cos(rot) + dz_roh*sin(rot) (am Log verifiziert). ;; Dient der Winkelwahl: Fussabdruck + Kletter-Planlaenge soll die Lauflaenge treffen. (defun vfl3-einheit-fix-dx (w n-climb n-hor gf1 richtung / pi180 rad3 tot m1 m2 r1 r2 dx1 dx2) (setq pi180 (/ pi 180.0) rad3 (* 3.0 pi180) tot 0.0) (setq tot (* (+ (float gf1) 300.0 500.0 500.0) (cos rad3))) ; Stationen planar (if (= richtung "Auf") (setq m1 (get-bogen-mass bogen-auf w) r1 rad3 m2 (get-bogen-mass bogen-ab w) r2 (* (- 3 w) pi180)) (setq m1 (get-bogen-mass bogen-ab w) r1 rad3 m2 (get-bogen-mass bogen-auf w) r2 (* (+ w 3) pi180))) (setq dx1 (+ (* (car m1) (cos r1)) (* (caddr m1) (sin r1)))) (setq dx2 (+ (* (car m2) (cos r2)) (* (caddr m2) (sin r2)))) (setq tot (+ tot (* n-climb (+ dx1 dx2)))) (setq m1 (get-bogen-mass bogen-auf 3) m2 (get-bogen-mass bogen-ab 3)) (setq dx1 (+ (* (car m1) (cos rad3)) (* (caddr m1) (sin rad3)))) ; auf_3 @ 3 (setq dx2 (car m2)) ; ab_3 @ 0 (setq tot (+ tot (* n-hor (+ dx1 dx2)))) tot) ;; Uebergang von der 3-Grad-Kletterbasis in die FLACHE Zone (0 Grad): EIN auf_3-Bogen ;; (Rotation 3 Grad). Rueckgabe: neuer Punkt. (defun vfl3-flach-ein (pt hz / m) (setq m (get-bogen-mass bogen-auf 3)) (insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt 3 (car m) (caddr m) hz)) ;; Uebergang aus der flachen Zone (0 Grad) zurueck auf 3-Grad-Basis: EIN ab_3-Bogen ;; (Rotation 0 Grad). Rueckgabe: neuer Punkt. (defun vfl3-flach-aus (pt hz / m) (setq m (get-bogen-mass bogen-ab 3)) (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" pt 0 (car m) (caddr m) hz)) ;; Kletter-Segment loesen und Winkel WAEHLEN LASSEN (Modus-1-Solver + vfl-waehle-winkel). ;; Mittige Bruecke -> KEIN terminales AS/ES (Masse auf 0, Save/Restore). feste = fester ;; Horizontal-Anteil des Kletter-Segments (Umlenk+Separator = 800; Motor sitzt spaeter ;; am Kettenende). Rueckgabe: (winkel L_GF L_VF richtung) oder nil. (defun vfl3-waehle-winkel (span dH-signiert feste / o-adx o-adz o-eix o-eiz richtung res wahl) (setq richtung (if (< dH-signiert 0) "Auf" "Ab")) (setq o-adx aus-dx o-adz aus-dz o-eix ein-dx o-eiz ein-dz) (setq aus-dx 0.0 aus-dz 0.0 ein-dx 0.0 ein-dz 0.0) (setq res (berechne-alle-winkel span (abs dH-signiert) richtung feste)) (setq aus-dx o-adx aus-dz o-adz ein-dx o-eix ein-dz o-eiz) (setq wahl (vfl-waehle-winkel (nth 3 res))) (if wahl (list (car wahl) (cadr wahl) (caddr wahl) richtung) nil)) ;; Letzte Fueller-Laenge so, dass der Endpunkt auf der ES-KS_AUS-Achse liegt. ;; pt = Fueller-Start (flach 0 Grad), seg-hz = letzte Richtung, es-block = ES-Block, ;; gf2 = erwartete GF2-Laenge, rad3 = 3 Grad (rad). Modell: der Schwanz (Fueller + ;; ab_3 + Motor + GF2 + Separator + ES) verschiebt sich starr entlang seg-hz. ;; KS_AUS = pt + (fill + C)*dp + perp-es*np ;; C = 196 (ab_3) + (Motor 500 + GF2 + Sep 300)*cos3 + along-es ;; Achse u_a = seg-hz + (KS_AUS.xu - KS_EIN.xu)_Block ; (Endpunkt-KS_AUS)*n_a=0 -> fill (defun vfl3-es-fueller (pt endp seg-hz es-block gf2 rad3 / info theta dpx dpy npx npy phi vx vy vwx vwy along-es perp-es ua na-x na-y cc dp-na np-na ep-na) (setq info (vf-element-ks-info es-block)) (if (null info) (- (+ (* (- (car endp) (car pt)) (cos (* seg-hz (/ pi 180.0)))) (* (- (cadr endp) (cadr pt)) (sin (* seg-hz (/ pi 180.0))))) (+ 196.0 (* (+ 800.0 gf2) (cos rad3)))) ; Fallback: Along-Naeherung (progn (setq theta (* seg-hz (/ pi 180.0))) (setq dpx (cos theta) dpy (sin theta)) ; seg-hz Richtung (setq npx (- (sin theta)) npy (cos theta)) ; senkrecht zu seg-hz (setq phi (* (- seg-hz (car info)) (/ pi 180.0))) ; Block -> Welt (setq vx (caddr info) vy (cadddr info)) (setq vwx (- (* vx (cos phi)) (* vy (sin phi)))) ; V_es (Welt) (setq vwy (+ (* vx (sin phi)) (* vy (cos phi)))) (setq along-es (+ (* vwx dpx) (* vwy dpy))) (setq perp-es (+ (* vwx npx) (* vwy npy))) (setq ua (* (+ seg-hz (- (cadr info) (car info))) (/ pi 180.0))) ; KS_AUS-Achse (setq na-x (- (sin ua)) na-y (cos ua)) ; senkrecht zur KS_AUS-Achse (setq cc (+ 196.0 (* (+ 800.0 gf2) (cos rad3)) along-es)) (setq dp-na (+ (* dpx na-x) (* dpy na-y))) (setq np-na (+ (* npx na-x) (* npy na-y))) (setq ep-na (+ (* (- (car endp) (car pt)) na-x) (* (- (cadr endp) (cadr pt)) na-y))) (if (> (abs dp-na) 1e-6) (- (/ (- ep-na (* perp-es np-na)) dp-na) cc) 100.0)))) (defun vf-linienzug-modus2 ( / ss k obj-liste startpunkt start-hoehe as-seite endpunkt end-hoehe es-seite kette segmente n i seg typ hz laenge bwinkel bseite antwort winkel klass plan e ecke-bad vf-start vf-ende dz z-front z-junction dH-bruecke span-bruecke dH-gesamt vf-count in-vf richtn req-w loesung aus ein first-line last-line frame deltaL br-winkel br-gf1 br-gf2 br-lvf br-richtn pt letzt-winkel vfl-nummer lastEnt anzahl-gf anzahl-vf hoehe-bis soll-ende ist-ende old-error vfl-ins member carrier-idx kv-variante seg-hz letzt-koerper-hz vf-first-line vf-last-line climber-span mid-hor z-aftermotor gf2-drop gf2-planar br-lvf this-lvf nach-kurve n-climb n-hor target-climb winkel-list fdz fdx wslope lvf planar-len ang-diff best-diff w climb-thresh longest-idx climbers nonclimber-len nonclimber-cnt nkurve kurve-chords run-span hor-koerper-len hor-pairs flat-p fill-len wahl3 rad3v feste-vf dH-adj dir-x dir-y fill-D end-hz gf-total br-gf-mode br-gf2-exp filler-A-len filler-a-done as-vorhanden es-vorhanden dbg-an dbg-old-error) (princ "\n\n=========================================") (princ (ssg-text "vfl-m3-titel")) (princ "\n=========================================") ;; --- Debug-Session (Schalter "vfl-modus2", DEFAULT AN) ------------------ ;; (dbg-schalter-off "vfl-modus2") deaktiviert bei Bedarf. Alle Eingaben ;; laufen bereits durchgehend ueber die vfl-in-*-Wrapper (siehe unten) und ;; werden dadurch automatisch ueber vfl-journal-record mitgeloggt (analog ;; Modus 1). Ein FRUEHER, duenner *error*-Hook schliesst die Datei bereits ;; sauber, falls waehrend Phase A (Klassifizierungsfragen, noch keine ;; Geometrie) abgebrochen wird - die eigentliche Abbruch-Sicherung (Wickeln ;; der Teil-Geometrie) wird erst spaeter zu Beginn von Phase B installiert ;; (siehe dortiger Kommentar) und uebernimmt das Schliessen dann von hier. (setq dbg-an (dbg-schalter-open "vfl-modus2" "vfl_modus2.dbg" "DXFM_LOG")) (if dbg-an (progn (dbgf "vf-linienzug-modus2") (dbgmsg "=== SESSION Modus 2 (3D-Objekte + Ziel-Hoehe) START ===") (dbgflush))) (setq dbg-old-error *error*) (setq *error* (function (lambda (msg) (setq *error* dbg-old-error) (if dbg-an (progn (dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ===")) (dbgreturn nil) (dbgclose))) (if dbg-old-error (dbg-old-error msg) (princ))))) ;; Abhaengigkeit Gefaellestrecke-Modul (if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED")))) (progn (alert (ssg-text "vfl-m3-alert-gf-modul")) (exit))) (if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek)) ;; --- 1. Pfad-Objekte waehlen --- (princ (ssg-text "vfl-m3-pfad-waehlen")) (setq ss (vfl-in-selection '((0 . "LINE,ARC")))) (if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit))) (setq obj-liste (mapcar 'vlax-ename->vla-object ss)) ;; --- 2. Startpunkt + Z + AS-Seite --- (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl (list "vfl-m3-prompt-startpunkt" "Starthoehe (Z, mm):"))) (setq startpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-startpunkt"))) (if (null startpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit))) (setq start-hoehe (vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt" (list (rtos (caddr startpunkt) 2 1))))) (if (null start-hoehe) (setq start-hoehe (caddr startpunkt))) (setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe)) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-as-setzen-frage"))) (princ (ssg-text "vfl-as-setzen-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-m3-as-nein")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "vfl-ja") (ssg-text "vfl-m3-as-nein")) 1 "vfl-as-setzen-frage")) (setq as-vorhanden (/= antwort "2")) (if as-vorhanden (progn (setq *vfl-as-winkel* (vfl-in-value "STR" (function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite (princ (ssg-text "gf-seite-aus-header")) (princ (ssg-text "gf-seite-links")) (princ (ssg-text "gf-seite-rechts")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "gf-seite-aus-header")) (setq as-seite (if (= antwort "2") "rechts" "links")) (vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante ) ) ;; --- 3. Endpunkt + Z + ES-Seite (NEU in Modus 3) --- (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl (list "vfl-m3-prompt-endpunkt" "Zielhoehe (Z, mm):"))) (setq endpunkt (vfl-in-point nil (ssg-text "vfl-m3-prompt-endpunkt"))) (if (null endpunkt) (progn (princ (ssg-text "gf-status-abgebrochen")) (exit))) (setq end-hoehe (vfl-in-real (ssg-textf "vfl-m3-prompt-zielhoehe" (list (rtos (caddr endpunkt) 2 1))))) (if (null end-hoehe) (setq end-hoehe (caddr endpunkt))) (setq endpunkt (list (car endpunkt) (cadr endpunkt) end-hoehe)) (if *vfl-wizard-mode* (vl-catch-all-apply 'vflw-gruppe-as-impl (list "vfl-es-setzen-frage"))) (princ (ssg-text "vfl-es-setzen-frage")) (princ (ssg-text "vfl-ja")) (princ (ssg-text "vfl-es-nein-zielpunkt")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "vfl-ja") (ssg-text "vfl-es-nein-zielpunkt")) 1 "vfl-es-setzen-frage")) (setq es-vorhanden (/= antwort "2")) (if es-vorhanden (progn (setq *vfl-es-winkel* (vfl-in-value "STR" (function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite (princ (ssg-text "gf-seite-ein-header")) (princ (ssg-text "gf-seite-links")) (princ (ssg-text "gf-seite-rechts")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1 "gf-seite-ein-header")) (setq es-seite (if (= antwort "2") "rechts" "links")) (vf-set-es-masse *vfl-es-winkel* es-seite) ; Masse fuer Variante ) ) ;; --- 4. Sortieren + Analysieren + Eck-Vorpruefung --- (setq kette (gf-sortiere-objekte obj-liste startpunkt)) (if (null kette) (progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit))) (setq segmente (gf-analysiere-kette kette)) (setq ecke-bad (vfl2-pruefe-eckwinkel kette 5.0)) (if ecke-bad (progn (alert (ssg-textf "vfl-m3-alert-eckwinkel" (list (rtos ecke-bad 2 1)))) (exit))) ;; --- 5. Klassifizierung (Phase A: nur speichern, nichts bauen) --- ;; Plan-Eintrag Gerade: ("Linie" hz laenge klass winkel) klass=GF/VF ;; Plan-Eintrag Bogen : ("Bogen" hz chord bwinkel bseite klass) (setq n (length segmente) i 0 plan '()) (while (< i n) (setq seg (nth i segmente) typ (car seg) hz (cadr seg) laenge (caddr seg)) (cond ((= typ "Linie") (princ (ssg-textf "vfl-m3-seg-gerade" (list (itoa (1+ i)) (itoa n) (rtos laenge 2 0) (rtos hz 2 1)))) (cond ;; Direkt nach einer Vario-Kurve: automatisch VF (keine Abfrage) - ;; die Kurve sitzt mitten in der VF-Einheit, es MUSS VF folgen. (nach-kurve (princ (ssg-text "vfl-m3-auto-vf")) (setq plan (cons (list "Linie" hz laenge "VF" nil) plan)) (setq nach-kurve nil)) (t (princ (ssg-text "vfl-m3-typ-gerade")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list "GF (Neigungswinkel)" "VF (Bruecke)") 1 "vfl-m3-typ-gerade")) (if (= antwort "2") (setq plan (cons (list "Linie" hz laenge "VF" nil) plan)) (progn (setq winkel (vfl-in-real (ssg-text "vfl-m3-prompt-gf-neigung"))) (if (null winkel) (setq winkel 3.0)) (if (> winkel 3.0) (progn (princ (ssg-text "vfl-m3-hinweis-gf-max")) (setq winkel 3.0))) (setq plan (cons (list "Linie" hz laenge "GF" winkel) plan))))))) ((= typ "Bogen") (setq bwinkel (nth 3 seg) bseite (nth 4 seg)) (princ (ssg-textf "vfl-m3-seg-bogen" (list (itoa (1+ i)) (itoa n) (itoa bwinkel) bseite))) (princ (ssg-text "vfl-m3-typ-bogen")) (setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2") (list "GF-Bogen" "Vario-Kurve") 1 "vfl-m3-typ-bogen")) (if (= antwort "2") (progn (princ (ssg-text "vfl-m3-variante-frage")) (setq kv-variante (if (= (vfl-menu (ssg-text "vfl-prompt-wahl-1-2-def2") (list (ssg-text "vfl-variante-aussen") (ssg-text "vfl-variante-innen")) 2 "vfl-m3-variante-frage") "1") "aussen" "innen")) (setq plan (cons (list "Bogen" hz laenge bwinkel bseite "Vario-Kurve" kv-variante) plan)) (setq nach-kurve t)) ; naechste Gerade automatisch VF (progn (setq plan (cons (list "Bogen" hz laenge bwinkel bseite "GF-Bogen" nil) plan)) (setq nach-kurve nil))))) (setq i (1+ i))) (setq plan (reverse plan)) ;; --- 6. VF-Lauf finden: VF-Geraden UND Vario-Kurven bilden EINEN Lauf --- ;; (Vario-Kurve gehoert in die VF-Einheit, unterbricht den Lauf also NICHT). (setq vf-start -1 vf-ende -1 vf-count 0 in-vf nil i 0) (foreach e plan (setq member (or (and (= (car e) "Linie") (= (nth 3 e) "VF")) (and (= (car e) "Bogen") (= (nth 5 e) "Vario-Kurve")))) (if member (progn (if (not in-vf) (setq vf-count (1+ vf-count) vf-start i in-vf t)) (setq vf-ende i)) (setq in-vf nil)) (setq i (1+ i))) (if (/= vf-count 1) (progn (princ (ssg-textf "vfl-m3-vf-laeufe" (list (itoa vf-count)))) (princ (ssg-text "vfl-m3-vf-lauf-noetig")) (princ (ssg-text "vfl-m3-vf-lauf-m3b")) (exit))) ;; Traeger-Stueck = laengste VF-Gerade im Lauf (traegt die ganze Hoehe). (setq carrier-idx -1 i vf-start) (while (<= i vf-ende) (setq seg (nth i plan)) (if (and (= (car seg) "Linie") (= (nth 3 seg) "VF")) (if (or (< carrier-idx 0) (> (caddr seg) (caddr (nth carrier-idx plan)))) (setq carrier-idx i))) (setq i (1+ i))) (if (< carrier-idx 0) (progn (princ (ssg-text "vfl-m3-vf-lauf-ohne-gerade")) (exit))) ;; --- 7. Anker rechnen --- ;; Vorwaerts: Start-Z durch alle Front-Segmente (Index < vf-start). (setq z-front (float start-hoehe) i 0) (while (< i vf-start) (setq dz (vfl3-seg-dz (nth i plan))) (if dz (setq z-front (+ z-front dz))) (setq i (1+ i))) ;; Rueckwaerts: Ziel-Z durch alle Back-Segmente (Index > vf-ende). ;; Vorwaerts gilt Z_next = Z_prev + dz -> rueckwaerts Z_prev = Z_next - dz. (setq z-junction (float end-hoehe) i (1- n)) (while (> i vf-ende) (setq dz (vfl3-seg-dz (nth i plan))) (if dz (setq z-junction (- z-junction dz))) (setq i (1- i))) ;; Bruecken-Spannweite = Summe der VF-Geraden-Planlaengen im Lauf. (setq span-bruecke 0.0 i vf-start) (while (<= i vf-ende) (setq seg (nth i plan)) (if (= (car seg) "Linie") (setq span-bruecke (+ span-bruecke (caddr seg)))) (setq i (1+ i))) (setq dH-bruecke (- z-front z-junction)) (setq dH-gesamt (- (float start-hoehe) (float end-hoehe))) ;; --- 8. Anker-Report (noch kein Bauen) --- (princ "\n\n=========================================") (princ (ssg-text "vfl-m3-anker-vorschau-header")) (princ "\n=========================================") (princ (ssg-textf "vfl-m3-start-hoehe" (list (rtos (float start-hoehe) 2 1)))) (princ (ssg-textf "vfl-m3-ziel-hoehe" (list (rtos (float end-hoehe) 2 1)))) (princ (ssg-textf "vfl-m3-delta-h-gesamt" (list (rtos dH-gesamt 2 1)))) (princ (ssg-textf "vfl-m3-vf-lauf-segmente" (list (itoa (1+ vf-start)) (itoa (1+ vf-ende))))) (princ (ssg-textf "vfl-m3-front-anker-vorschau" (list (rtos z-front 2 1)))) (princ (ssg-textf "vfl-m3-junction-anker-vorschau" (list (rtos z-junction 2 1)))) ;; Vorzeichen = Richtung (VF ist angetrieben, kann steigen UND fallen). (setq richtn (cond ((< dH-bruecke -0.1) (ssg-text "vfl-m3-richtung-auf")) ((> dH-bruecke 0.1) (ssg-text "vfl-m3-richtung-ab")) (t (ssg-text "vfl-m3-richtung-horizontal")))) (setq req-w (if (> span-bruecke 1.0) (* (atan (/ (abs dH-bruecke) span-bruecke)) (/ 180.0 pi)) 0.0)) (princ (ssg-textf "vfl-m3-bruecke-dh" (list (rtos dH-bruecke 2 1) (rtos span-bruecke 2 0)))) (princ (ssg-textf "vfl-m3-bruecke-richtung" (list richtn))) (princ (ssg-text "vfl-m3-vf-angetrieben")) (princ (ssg-textf "vfl-m3-mittlere-neigung" (list (rtos req-w 2 1)))) (if (> req-w 51.0) (princ (ssg-text "vfl-m3-warnung-zu-steil")) (princ (ssg-text "vfl-m3-vario-bereich-ok"))) (princ (ssg-text "vfl-m3-anker-hinweis")) (princ "\n=========================================") ;; ================= PHASE B: BAUEN (messen statt schaetzen) ================= ;; VF-Lauf darf mehrsegmentig sein (VF-Geraden + Vario-Kurven, EINE VF-Einheit). ;; Nummerierung + Akkumulatoren + AS/ES-Fussabdruecke. Ohne AS-Element (aus- ;; vorhanden=nil) faellt der Fussabdruck weg - die Kette beginnt direkt am ;; Startpunkt, also 0 statt Block-/Fallback-Mass. (setq aus (if as-vorhanden (if aus-dx aus-dx 576.0) 0.0) ein (if es-vorhanden (if ein-dx ein-dx 576.0) 0.0)) (setq vfl-nummer (vf-next-number)) (setq lastEnt (vf-lastent-ohne-attribute)) (vfl-acc-reset) (setq anzahl-gf 0 anzahl-vf 0 frame nil) ;; --- Abbruch-Sicherung ab hier scharf (analog Modus 1, siehe dortiger ;; Kommentar) - Phase A (oben) baut noch keine Geometrie, ein Abbruch ;; waehrend der Klassifizierungsfragen haette also ohnehin nichts zu ;; wickeln. Ab Phase B kann jederzeit Geometrie entstehen. ;; *error* ist hier bereits der fruehe dbg-Hook vom Funktionsanfang - wir ;; loesen ihn komplett ab (Ruecksprungziel ist dbg-old-error, NICHT der ;; dbg-Hook selbst) und uebernehmen das dbgclose gleich mit, sonst wuerde ;; bei einem Abbruch ab hier doppelt geschlossen. (setq old-error dbg-old-error) (setq *error* (function (lambda (msg) (setq *error* old-error) (vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf startpunkt frame as-seite es-seite "linienzug2") (if dbg-an (progn (dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ===")) (dbgreturn nil) (dbgclose))) (if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end)) (princ)))) ;; erste/letzte Gerade fuer AS/ES-Trimmung bestimmen (setq first-line -1 last-line -1 i 0) (while (< i n) (if (= (car (nth i plan)) "Linie") (progn (if (< first-line 0) (setq first-line i)) (setq last-line i))) (setq i (1+ i))) ;; --- B1: FRONT-Lauf bauen (Segmente 0 .. vf-start-1) -> Front-Anker MESSEN --- (princ (ssg-text "vfl-m3-phase-b1")) (setq i 0) (while (< i vf-start) (setq seg (nth i plan) typ (car seg) hz (cadr seg)) (cond ((= typ "Linie") (setq winkel (nth 4 seg)) ;; AS zuerst platzieren (falls gewuenscht), damit der echte KS_AUS bekannt ;; ist. Ohne AS-Element beginnt die Kette direkt am Startpunkt (flach) - ;; die nachfolgende Fussabdruck-Trimmung wird dann automatisch zu 0, da ;; (car frame) bereits gleich startpunkt ist. (if (null frame) (setq frame (if as-vorhanden (vfl2-insert-as-gf startpunkt hz winkel as-seite) (make-frame-from-dir startpunkt (hz-winkel->xu hz 0.0))))) (setq deltaL (caddr seg)) ;; erste Gerade: AS-Fussabdruck ENTLANG des Pfads exakt aus KS_AUS abziehen ;; (das Block-Maß aus-dx stimmt nach dem Achs-Versatz nicht mehr). (if (= i first-line) (setq deltaL (- deltaL (+ (* (- (car (car frame)) (car startpunkt)) (cos (* hz (/ pi 180.0)))) (* (- (cadr (car frame)) (cadr startpunkt)) (sin (* hz (/ pi 180.0)))))))) (setq deltaL (max 100.0 deltaL)) (setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel)) (vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel) (setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel)) ((= typ "Bogen") (setq bwinkel (nth 3 seg) bseite (nth 4 seg) klass (nth 5 seg)) (if (= klass "GF-Bogen") (progn (if (null frame) (progn (alert (ssg-text "vfl-m3-alert-beginnt-bogen")) (exit))) (setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite))) (princ (ssg-text "vfl-m3-kurve-front-uebersprungen"))))) (setq i (1+ i))) ;; Front-Anker (gemessen). Falls die VF-Bruecke ganz vorne liegt: AS (falls ;; gewuenscht) jetzt setzen. (setq hz (cadr (nth vf-start plan))) (if (null frame) (setq frame (if as-vorhanden (vfl2-insert-as-vf startpunkt hz as-seite) (make-frame-from-dir startpunkt (hz-winkel->xu hz 0.0))))) (setq z-front (caddr (car frame))) ;; --- B2: Back-Abstieg -> Junction; Kletterer + Horizontal-Mitte bestimmen --- (setq z-junction (+ (float end-hoehe) (vfl3-dback plan (1+ vf-ende) n last-line ein))) (setq dH-bruecke (- z-front z-junction)) ;; Modell: EIN Vario mit Horizontal-Mitte. Nur VF-Geraden, die LANG GENUG sind ;; (Vertikalboegen brauchen viel Platz), tragen die Hoehe (Kletterer, gleicher ;; Winkel). Zu kurze VF-Geraden werden horizontal (nur Anschluss/Motor). ;; Mindestens die laengste VF-Gerade klettert immer. (setq climb-thresh (if (boundp '*vfl-min-climber-laenge*) *vfl-min-climber-laenge* 3000.0)) (setq longest-idx -1 i vf-start) (while (<= i vf-ende) (setq seg (nth i plan)) (if (and (= (car seg) "Linie") (= (nth 3 seg) "VF")) (if (or (< longest-idx 0) (> (caddr seg) (caddr (nth longest-idx plan)))) (setq longest-idx i))) (setq i (1+ i))) (setq climbers '() climber-span 0.0 nonclimber-len 0.0 nonclimber-cnt 0 nkurve 0 kurve-chords 0.0 i vf-start) (while (<= i vf-ende) (setq seg (nth i plan)) (cond ((and (= (car seg) "Linie") (= (nth 3 seg) "VF")) (if (or (= i longest-idx) (>= (caddr seg) climb-thresh)) (setq climbers (cons i climbers) climber-span (+ climber-span (caddr seg))) (setq nonclimber-len (+ nonclimber-len (caddr seg)) nonclimber-cnt (1+ nonclimber-cnt)))) ((= (car seg) "Bogen") (setq nkurve (1+ nkurve) kurve-chords (+ kurve-chords (caddr seg))))) (setq i (1+ i))) (setq climbers (reverse climbers) n-climb (length climbers)) ;; Flache Zone (Kurve + horizontale Fueller) hat GENAU EIN Uebergangspaar ;; (ein auf_3 rein, ein ab_3 raus), unabhaengig von der Zahl der Fueller/Kurven. (setq hor-pairs (if (or (> nkurve 0) (> nonclimber-cnt 0)) 1 0)) (setq run-span (+ climber-span nonclimber-len kurve-chords)) (setq br-gf1 400.0) ; feste kleine GF1 (setq br-richtn (if (< dH-bruecke 0) "Auf" "Ab")) (setq target-climb (- z-junction z-front)) ; noetige Netto-Hoehe (Auf>0) ;; Kletter-Segment als Standard-Vario loesen; GF wird BERECHNET (L_GF) und der ;; Winkel WAEHLBAR (mehrere gueltige -> Nutzer waehlt). feste = 800 (Umlenk+Sep; ;; Motor sitzt am Kettenende). Die flache Zone gleicht danach die Laenge aus. (princ (ssg-text "vfl-m3-standard-vario-header")) (princ (ssg-textf "vfl-m3-front-anker-gemessen" (list (rtos z-front 2 1)))) (princ (ssg-textf "vfl-m3-junction-exakt" (list (rtos z-junction 2 1)))) (princ (ssg-textf "vfl-m3-kletter-info" (list (rtos target-climb 2 1) (itoa n-climb) (itoa nkurve) (itoa nonclimber-cnt)))) ;; feste-Horizontal + Hoehen-Anpassung fuer den Solver: ;; - Mit flacher Zone: Motor sitzt am Kettenende (nicht im Kletter-Segment) -> ;; feste = 800 (Umlenk+Sep). berechne rechnet Motor-/Uebergangs-Abstieg NICHT, ;; daher Kletterhoehe um diese Abstiege anpassen (GF2 bleibt ~0). ;; - Ohne flache Zone (Einzel-Bruecke): feste = 1300 (inkl. Motor), keine Anpassung. (setq rad3v (* 3.0 (/ pi 180.0))) (if (> hor-pairs 0) (setq feste-vf 800.0 dH-adj (- dH-bruecke (+ (* 500.0 (sin rad3v)) 10.48))) ; Motor + auf_3/ab_3 (setq feste-vf 1300.0 dH-adj dH-bruecke)) (setq wahl3 (vfl3-waehle-winkel climber-span dH-adj feste-vf)) (if (null wahl3) (progn (princ (ssg-text "vfl-m3-kein-winkel")) (princ) (exit))) (setq br-winkel (car wahl3) gf-total (cadr wahl3) br-lvf (caddr wahl3) br-richtn (cadddr wahl3)) ;; GF-Verteilung: 1 = alles am Einlauf (GF1); 2 = 1/2 GF1 + 1/2 GF2. Bei 1/2/1/2 ;; wird der im Kletter-Segment durch das halbe GF1 frei werdende Platz mit einem ;; horizontalen Fueller-A gefuellt; GF2 (~1/2 L_GF) sitzt hinter dem Motor, der ;; ES-Laengen-Abschluss zieht seinen Fussabdruck ab (Fueller-B wird kuerzer). (princ (ssg-text "vfl-m3-gf-verteilung")) (setq br-gf-mode (if (= (vfl-menu (ssg-text "prompt-wahl-1-2") (list "Alles am Einlauf (GF1)" "1/2 GF1 + 1/2 GF2") 1 "vfl-m3-gf-verteilung") "2") 2 1)) (if (= br-gf-mode 2) (setq br-gf1 (/ gf-total 2.0) br-gf2-exp (/ gf-total 2.0) filler-A-len (* (/ gf-total 2.0) (cos rad3v))) (setq br-gf1 gf-total br-gf2-exp 0.0 filler-A-len 0.0)) (setq filler-a-done nil) (princ (ssg-textf "vfl-m3-vario-ergebnis" (list (itoa br-winkel) (if (= br-richtn "Auf") (ssg-text "vfl-m3-richtung-auf-kurz") (ssg-text "vfl-m3-richtung-ab-kurz")) (rtos br-lvf 2 0) (rtos gf-total 2 0) (if (= br-gf-mode 2) (ssg-text "vfl-m3-vert-halb") (ssg-text "vfl-m3-vert-ganz"))))) ;; --- B3: Standard-Vario (Klettern, 3-Grad-Basis) + flache Zone (0 Grad) --- ;; Die flache Zone (Vario-Kurve + horizontaler Fueller) haengt EINMAL ueber auf_3 ;; ein und EINMAL ueber ab_3 aus; Kurve und Fueller sind bei 0 Grad DIREKT ;; verbunden (keine Zwischen-Boegen). Der horizontale Fueller gleicht die ;; Restlaenge aus (letztes Stueck vor dem Motor getrimmt). (setq pt (car frame) letzt-koerper-hz (cadr (nth vf-start plan)) flat-p nil) (setq pt (vfs-vf-entry pt br-gf1 letzt-koerper-hz)) ; GF1 + Separator + Umlenk (3 Grad) (vfl-acc-gf-seg br-gf1 3) (setq i vf-start) (while (<= i vf-ende) (setq seg (nth i plan) seg-hz (cadr seg)) (cond ;; --- Kletterer (geneigt, 3-Grad-Basis) --- ((and (= (car seg) "Linie") (member i climbers)) (if flat-p (progn (setq pt (vfl3-flach-aus pt seg-hz)) (setq flat-p nil))) (setq this-lvf (max 100.0 (* br-lvf (/ (caddr seg) climber-span)))) (setq pt (vfs-vf-koerper pt br-richtn br-winkel this-lvf seg-hz)) (vfl-acc-vf-seg br-richtn br-winkel this-lvf) (setq anzahl-vf (1+ anzahl-vf) letzt-koerper-hz seg-hz)) ;; --- kurze VF-Gerade -> horizontaler Fueller (0 Grad) --- ((= (car seg) "Linie") (if (not flat-p) (progn (setq pt (vfl3-flach-ein pt letzt-koerper-hz)) (setq flat-p t) ;; Fueller-A: der im Kletter-Segment durch 1/2 GF1 frei werdende Platz (if (and (> filler-A-len 0.1) (not filler-a-done)) (progn (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt filler-A-len 0 letzt-koerper-hz)) (vfl-acc-vf-seg "horizontal" 0 filler-A-len) (setq anzahl-vf (1+ anzahl-vf) filler-a-done t))))) (if (= i vf-ende) ;; letzter Fueller, MIT ES-Element (unveraendert): Laenge so, dass der ;; ENDPUNKT auf der ES-KS_AUS-ACHSE liegt (Spiegel der AS-Regel). Der ;; Schwanz (Fueller + ab_3 + Motor + GF2 + Separator + ES) verschiebt ;; sich starr entlang seg-hz mit dem Fueller; KS_AUS = pt + (fill + C)* ;; dp + perp-es*np, Achse u_a = seg-hz + ES-Turn. Aus (Endpunkt - ;; KS_AUS)*n_a = 0 folgt fill (n_a senkrecht zu u_a). OHNE ES-Element ;; (Nutzerwunsch): keine Achsen-Korrektur noetig, da nach Motor+GF2 ;; nichts mehr gebaut wird - Fueller zielt direkt auf den Endpunkt. (setq fill-len (if es-vorhanden (vfl3-es-fueller pt endpunkt seg-hz (strcat "ES_Element_" (vfl-es-winkel) "_" es-seite) br-gf2-exp rad3v) (- (+ (* (- (car endpunkt) (car pt)) (cos (* seg-hz (/ pi 180.0)))) (* (- (cadr endpunkt) (cadr pt)) (sin (* seg-hz (/ pi 180.0))))) (* (+ 500.0 br-gf2-exp) (cos rad3v))) ) ) (setq fill-len (caddr seg))) (setq fill-len (max 100.0 fill-len)) (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt fill-len 0 seg-hz)) (vfl-acc-vf-seg "horizontal" 0 fill-len) (setq anzahl-vf (1+ anzahl-vf)) (setq letzt-koerper-hz seg-hz)) ;; --- Vario-Kurve (flach, direkt bei 0 Grad) --- ((= (car seg) "Bogen") (if (not flat-p) (progn (setq pt (vfl3-flach-ein pt letzt-koerper-hz)) (setq flat-p t) ;; Fueller-A: der im Kletter-Segment durch 1/2 GF1 frei werdende Platz (if (and (> filler-A-len 0.1) (not filler-a-done)) (progn (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt filler-A-len 0 letzt-koerper-hz)) (vfl-acc-vf-seg "horizontal" 0 filler-A-len) (setq anzahl-vf (1+ anzahl-vf) filler-a-done t))))) (setq bwinkel (nth 3 seg) bseite (nth 4 seg) kv-variante (nth 6 seg)) (setq frame (make-frame-from-dir pt (hz-winkel->xu letzt-koerper-hz 0.0))) (setq frame (vfl-insert-vario-kurve-block frame bwinkel bseite (if kv-variante kv-variante "innen"))) (setq pt (car frame)) (if (< i vf-ende) (setq letzt-koerper-hz (cadr (nth (1+ i) plan)))))) (setq i (1+ i))) (if flat-p (progn (setq pt (vfl3-flach-aus pt letzt-koerper-hz)) (setq flat-p nil))) ; zurueck 3 Grad ;; Motorstation (ohne GF2) (setq pt (vfs-vf-exit pt 0.0 letzt-koerper-hz nil)) (setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (list "rechts"))) ;; GF2 = gemessener exakter Hoehen-Ausgleich (Abstieg bis zur Junction) (setq z-aftermotor (caddr pt)) (setq gf2-drop (- z-aftermotor z-junction)) (if (< gf2-drop 0.0) (progn (princ (ssg-textf "vfl-m3-warnung-gf2-negativ" (list (rtos (- gf2-drop) 2 1)))) (setq gf2-drop 0.0))) (setq gf2-planar (/ gf2-drop (/ (sin (* 3.0 (/ pi 180.0))) (cos (* 3.0 (/ pi 180.0)))))) (if (> gf2-planar 0.1) (progn (princ (ssg-textf "vfl-m3-gf2-ausgleich" (list (rtos gf2-planar 2 1)))) (setq frame (vfl-insert-gf-segment pt letzt-koerper-hz gf2-planar 3)) (vfl-acc-gf-seg (/ gf2-planar (cos (* 3.0 (/ pi 180.0)))) 3)) (setq frame (vfl-frame-3grad pt letzt-koerper-hz))) (setq hz letzt-koerper-hz) ;; --- B4: BACK-Lauf bauen (Segmente vf-ende+1 .. n-1) --- (setq i (1+ vf-ende)) (while (< i n) (setq seg (nth i plan) typ (car seg) hz (cadr seg)) (cond ((= typ "Linie") (setq winkel (nth 4 seg) deltaL (caddr seg)) ;; Footprint fuer Separator(300)+ES nur reservieren, wenn ES-Element ;; gewuenscht ist (ein=0 sonst, siehe oben) - ohne ES entfaellt auch ;; der abschliessende Separator. (if (= i last-line) (setq deltaL (- deltaL (if es-vorhanden 300.0 0.0) ein))) (setq deltaL (max 100.0 deltaL)) (setq frame (vfl-insert-gf-segment (car frame) hz deltaL winkel)) (vfl-acc-gf-seg (/ deltaL (cos (* winkel (/ pi 180.0)))) winkel) (setq anzahl-gf (1+ anzahl-gf) letzt-winkel winkel)) ((= typ "Bogen") (setq bwinkel (nth 3 seg) bseite (nth 4 seg) klass (nth 5 seg)) (if (= klass "GF-Bogen") (setq frame (vfl-insert-gf-bogen-block frame bwinkel bseite)) (princ (ssg-text "vfl-m3-kurve-back-uebersprungen"))))) (setq i (1+ i))) ;; --- B5: Kettenende Separator + ES (nur falls gewuenscht) --- (if (null frame) (progn (princ (ssg-text "vfl-m3-nichts-gebaut")) (exit))) (if es-vorhanden (setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame)) (if letzt-winkel letzt-winkel 3.0) (caddr (car frame)) es-seite))) ;; ---------- Block + Ist-Ziel-Report ---------- (setq hoehe-bis (caddr (car frame))) (setq vfl-ins (vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis (vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt)) ;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug2") -> ;; spaeter per Doppelklick editierbar (vfl-edit-ent2: voller Reset, kein ;; Sektions-Dialog wie bei Modus 1 - siehe dortiger Kommentar). (if vfl-ins (vfl-journal-xdata-schreiben vfl-ins "linienzug2")) ;; Erfolgreicher Abschluss: *error* zuruecksetzen. (setq *error* old-error) (setq soll-ende endpunkt ist-ende (car frame)) (princ "\n\n=========================================") (princ (ssg-text "vfl-m3-fertig-header")) (princ (ssg-textf "vfl-m3-ziel-soll" (list (rtos (car soll-ende) 2 1) (rtos (cadr soll-ende) 2 1) (rtos (caddr soll-ende) 2 1)))) (princ (ssg-textf "vfl-m3-es-ist" (list (rtos (car ist-ende) 2 1) (rtos (cadr ist-ende) 2 1) (rtos (caddr ist-ende) 2 1)))) (princ (ssg-textf "vfl-m3-abweichung" (list (rtos (- (car ist-ende) (car soll-ende)) 2 1) (rtos (- (cadr ist-ende) (cadr soll-ende)) 2 1) (rtos (- (caddr ist-ende) (caddr soll-ende)) 2 1)))) ;; Zerlegung bezogen auf die ES-KS_AUS-ACHSE: Quer (senkrecht zur Achse) soll ;; ~0 sein (Endpunkt liegt auf der KS_AUS-Achse), Laengs = ES-Ausladung. (setq end-hz (car (frame->hz-winkel frame))) ; KS_AUS-Achsrichtung (setq dir-x (cos (* end-hz (/ pi 180.0))) dir-y (sin (* end-hz (/ pi 180.0)))) (princ (ssg-textf "vfl-m3-laengs-quer" (list (rtos (+ (* (- (car ist-ende) (car soll-ende)) dir-x) (* (- (cadr ist-ende) (cadr soll-ende)) dir-y)) 2 1) (rtos (+ (* (- (car ist-ende) (car soll-ende)) (- dir-y)) (* (- (cadr ist-ende) (cadr soll-ende)) dir-x)) 2 1)))) (princ (ssg-text "vfl-m3-achse-hinweis")) (princ "\n=========================================") (if dbg-an (progn (dbgmsg (strcat "ERGEBNIS: VF_" (itoa vfl-nummer) " (GF=" (itoa anzahl-gf) " VF=" (itoa anzahl-vf) ")")) (dbg 'soll-ende) (dbg 'ist-ende) (dbgmsg "=== SESSION Modus 2 ENDE ===") (dbgreturn (list "VF" vfl-nummer)) (dbgclose))) (princ) ) ;; ============================================================ ;; TEIL 5: KETTE ZUSAMMENFUEHREN ;; ============================================================ ;; Vario_Kette_Merge: eine Kette aus bereits in der Zeichnung liegenden ;; Vario-Foerderer-Bausteinen (lose Einzelteile WIE AUCH bereits fertig ;; gewickelte VF_n-Bloecke, in beliebiger Mischung) wird ab einem gewaehlten ;; Start-Baustein ueber die reale KS_AUS->KS_EIN-Nachbarschaft verfolgt und zu ;; EINEM neuen Gesamt-VF_n-Block verschmolzen. Die Attribute werden dabei aus ;; der gefundenen Bausteinfolge NEU hergeleitet (dieselben Akkumulatoren/ ;; Formeln wie beim interaktiven Bau in Modus 1/2 - vfl-acc-*, ;; ssg-strecke-attrib-defs -, nur rueckwirkend nach dem Auffinden statt ;; waehrend des Bauens gefuellt). Nur VORWAERTS ab dem gewaehlten ;; Start-Baustein (keine Rueckwaerts-Suche). ;; ;; Alle beteiligten Bausteintypen tragen laut Nutzerbestaetigung ein eigenes ;; KS_EIN/KS_AUS (auch Umlenk-/Motorstation, Vertikalboegen, das gestreckte ;; Zwischenstueck und der Separator) - die Verkettung laeuft daher komplett ;; ueber KS-Nachbarschaft, keine Bounding-Box-Geometrie noetig. ;; ;; Ein angetroffener VF_n-Wrapper wird beim Erfassen SOFORT (temporaer) in ;; seine Sub-Elemente aufgeloest, die dann wie von Anfang an lose Bauteile ;; behandelt werden (vfl-kette-sammle-alle) - eine fruehere Fassung versuchte ;; stattdessen, fuer einen Wrapper EINEN Gesamt-KS_EIN/KS_AUS per "welcher ;; Punkt hat kein Gegenstueck"-Heuristik zu bestimmen; das schlug bei langen ;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl (siehe ;; [[project_vario_kette_merge]] Update 6). ;; Toleranzen (mm) fuer die Nachbarschaftspruefung zwischen zwei Bausteinen: ;; <= tol-eng -> gilt als sauber verbunden, Kette geht weiter ;; <= tol-weit -> sieht verbunden aus, ist es aber nicht -> Warnung, Kettenende ;; > tol-weit -> kein Zusammenhang, normales (stilles) Kettenende (if (null *vfl-kette-tol-eng*) (setq *vfl-kette-tol-eng* 2.0)) (if (null *vfl-kette-tol-weit*) (setq *vfl-kette-tol-weit* 100.0)) ;; Kleine Feld-Zugriffe auf einen Ketten-Datensatz ;; (ename bname ks-ein-punkt ks-aus-punkt wrapper-ename) ;; ename = nil und wrapper-ename gesetzt: Sub-Element eines aufgeloesten ;; VF_n-Wrappers (wrapper-ename = dessen Original-Ename). Sonst: eigenstaen- ;; diges Bauteil (ename gesetzt, wrapper-ename nil). (defun vfl-kette-rec-ename (rec) (nth 0 rec)) (defun vfl-kette-rec-bname (rec) (nth 1 rec)) (defun vfl-kette-rec-ein (rec) (nth 2 rec)) (defun vfl-kette-rec-aus (rec) (nth 3 rec)) (defun vfl-kette-rec-wrapper (rec) (nth 4 rec)) ;; String an einem Trennzeichen aufteilen (reine Teilstring-Suche, keine ;; Wildcards). Bei "_"-Trennung eines Bausteinnamens liefert das die ;; Namensteile unabhaengig vom Dimensions-Suffix (_2D/_3D) - der steht immer ;; am Ende und wird von den (nur von vorne indizierenden) Zugriffen unten ;; ignoriert. (defun vfl-kette-split (str delim / pos ergebnis rest) (setq ergebnis '() rest str) (while (setq pos (vl-string-search delim rest)) (setq ergebnis (append ergebnis (list (substr rest 1 pos)))) (setq rest (substr rest (+ pos 1 (strlen delim)))) ) (append ergebnis (list rest)) ) (defun vfl-kette-teil (bname idx) (nth idx (vfl-kette-split bname "_"))) ;; Bausteintyp aus dem Blocknamen ableiten. Scanner/Separator_SP (manuelle ;; Sensor-Bloecke, siehe count_sep_scan.lsp) gehoeren NICHT zur Kette selbst ;; und tauchen hier bewusst nicht auf. (defun vfl-kette-typ (bname) (cond ((wcmatch bname "VF_*") "WRAPPER") ((wcmatch bname "AS_Element_*") "AS") ((wcmatch bname "ES_Element_*") "ES") ((wcmatch bname "Gefaellebogen_*") "GFBOGEN") ((wcmatch bname "Vario_Kurve_*") "KURVE") ((wcmatch bname "Vario_Umlenkstation_*") "UMLENK") ((wcmatch bname "Vario_Motorstation_*") "MOTOR") ((wcmatch bname "Vario_Bogen_auf_*") "BOGENAUF") ((wcmatch bname "Vario_Bogen_ab_*") "BOGENAB") ((wcmatch bname "Staustrecke_SP_1000_mm*") "STRECKE") ((wcmatch bname "Staustrecke_Separator_SP_300_mm*") "SEP") (t "UNBEKANNT") ) ) ;; Gemessene Neigung (Grad, positiv=abwaerts wie frame->hz-winkel) zwischen ;; zwei Welt-Punkten. (defun vfl-kette-neigung (ein aus / dx dy dz horiz) (setq dx (- (car aus) (car ein)) dy (- (cadr aus) (cadr ein)) dz (- (caddr aus) (caddr ein))) (setq horiz (sqrt (+ (* dx dx) (* dy dy)))) (if (> horiz 1e-6) (* (atan (- dz) horiz) (/ 180.0 pi)) 0.0) ) (defun vfl-kette-round (x) (atoi (rtos x 2 0))) ;; Attribut-Wert auf "" erzwingen. ssg-attrib-set-on ueberspringt leere Werte ;; bewusst als "keine Ueberschreibung" (ATTDEF-Default bleibt stehen) - hier ;; soll das Feld aber ABSICHTLICH geleert werden (z.B. SEITE_AS/SEITE_ES, ;; wenn die Kette kein AS-/ES-Element hat und der ATTDEF-Default "rechts" ;; sonst faelschlich stehen bliebe). (defun vfl-kette-attrib-leeren (ent tag / obj ed typ etag) (setq obj (entnext ent)) (while obj (setq ed (entget obj)) (setq typ (cdr (assoc 0 ed))) (if (equal typ "SEQEND") (setq obj nil) (progn (if (and (equal typ "ATTRIB") (equal (cdr (assoc 2 ed)) tag)) (progn (entmod (subst (cons 1 "") (assoc 1 ed) ed)) (entupd obj))) (setq obj (entnext obj)) ) ) ) ) ;; KS_EIN/KS_AUS-URSPRUNGSPUNKTE (Welt-Koordinaten, keine Richtung) eines ;; Bausteins ermitteln - robust gegen NICHT-UNIFORME Skalierung (z.B. ;; Staustrecke_SP_1000_mm, das per insert-inclined-scaled-block auf die ;; reale Segmentlaenge gestreckt wird). extract-ks-from-block-raw ;; (vf_core.lsp) klassifiziert die 3 Achslinien im KS-Sub-Block ueber ihre ;; ABSOLUTE LAENGE (ks-line-axis, feste Baender ~1/~100 Einheiten) - wird die ;; Fahrtrichtungs-Achslinie mitgestreckt, faellt sie aus diesem Raster und ;; die Extraktion schlaegt still fehl (empirisch bestaetigt: bei den meisten ;; Staustrecke-Instanzen "KS_EIN/KS_AUS FEHLT"). Uebernimmt daher die in ;; ks_segmente.lsp (kseg-collect-lose) bereits bewaehrte Methode: an einer ;; KOPIE die Skalierung auf 1:1:1 zuruecksetzen (Marker wieder nominal lang, ;; Extraktion funktioniert normal), KS_EIN/KS_AUS dort lesen, danach den ;; KS_AUS-Versatz mit dem echten XScaleFactor zurueckrechnen (die Streckung ;; wirkt lokal rein auf der Block-X-Achse/Docking-Richtung; nach Rotation ins ;; Weltsystem hat der Versatzvektor i.A. X-/Y-/Z-Anteile, die Streckung wirkt ;; aber auf alle drei mit demselben Faktor sx - Y/Z-Skalierung bleibt bei ;; dieser Teilefamilie immer 1.0). Kopie wird sofort wieder geloescht - ;; block-obj selbst bleibt unveraendert. ;; Rueckgabe: (("KS_EIN" . punkt) ("KS_AUS" . punkt)) - je nur wenn gefunden. (defun vfl-kette-ks-ursprung (block-obj / sx copyobj ksdata kez kaz ergebnis) (setq sx (vla-get-XScaleFactor block-obj)) (setq copyobj (vla-Copy block-obj)) (vla-put-XScaleFactor copyobj 1.0) (vla-put-YScaleFactor copyobj 1.0) (vla-put-ZScaleFactor copyobj 1.0) (setq ksdata (extract-ks-from-block-raw copyobj)) (if (not (vlax-erased-p copyobj)) (vl-catch-all-apply 'vla-Delete (list copyobj))) (setq kez (if (assoc "KS_EIN" ksdata) (car (cadr (assoc "KS_EIN" ksdata))) nil)) (setq kaz (if (assoc "KS_AUS" ksdata) (car (cadr (assoc "KS_AUS" ksdata))) nil)) (if (and kez kaz (/= sx 1.0)) (setq kaz (list (+ (car kez) (* sx (- (car kaz) (car kez)))) (+ (cadr kez) (* sx (- (cadr kaz) (cadr kez)))) (+ (caddr kez) (* sx (- (caddr kaz) (caddr kez)))) )) ) (setq ergebnis '()) (if kez (setq ergebnis (cons (cons "KS_EIN" kez) ergebnis))) (if kaz (setq ergebnis (cons (cons "KS_AUS" kaz) ergebnis))) ergebnis ) ;; Alle Vario-Kette-Bausteine der Zeichnung einsammeln (lose Einzelteile UND ;; die Sub-Elemente bereits gewickelter VF_n - siehe vfl-kette-typ). Ein ;; angetroffener VF_n-Wrapper wird SOFORT (temporaer) in seine Sub-Elemente ;; aufgeloest und JEDES Sub-Element als eigener Datensatz mit direkt lesbarem ;; KS_EIN/KS_AUS erfasst - keine "welcher Punkt hat kein Gegenstueck"- ;; Heuristik fuer einen Gesamt-Punkt mehr noetig (die schlug bei langen ;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl, siehe ;; [[project_vario_kette_merge]]). Die Kettenverfolgung faedelt die ;; Sub-Elemente danach ueber ihre echten KS-Punkte in der richtigen ;; Reihenfolge auf - unabhaengig von der Explode-Reihenfolge. ;; ename = nil fuer ein Sub-Element eines Wrappers (die temporaere ;; Explode-Kopie wurde bereits wieder geloescht); wrapper-ename identifiziert ;; in diesem Fall den ORIGINAL-Wrapper (fuer den finalen Merge-Schritt). ;; Rueckgabe: Liste von (ename bname ein aus wrapper-ename). (defun vfl-kette-sammle-alle ( / ss i ename bname typ obj kinder kind sub-ks child-bname child-ks records) (setq records '()) (setq ss (ssget "X" '((0 . "INSERT")))) (if ss (progn (setq i 0) (while (< i (sslength ss)) (setq ename (ssname ss i)) (setq bname (cdr (assoc 2 (entget ename)))) (setq typ (vfl-kette-typ bname)) (cond ((= typ "WRAPPER") (setq obj (vlax-ename->vla-object ename)) (setq kinder (vlax-invoke obj 'Explode)) (foreach kind kinder (if (and (not (vlax-erased-p kind)) (= (vla-get-ObjectName kind) "AcDbBlockReference")) (progn (setq child-bname (vla-get-Name kind)) (setq child-ks (vfl-kette-ks-ursprung kind)) (setq records (cons (list nil child-bname (cdr (assoc "KS_EIN" child-ks)) (cdr (assoc "KS_AUS" child-ks)) ename) records)) ) ) ) (foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind))) ) ((/= typ "UNBEKANNT") (setq obj (vlax-ename->vla-object ename)) (setq sub-ks (vfl-kette-ks-ursprung obj)) (setq records (cons (list ename bname (cdr (assoc "KS_EIN" sub-ks)) (cdr (assoc "KS_AUS" sub-ks)) nil) records)) ) ) (setq i (1+ i)) ) ) ) records ) ;; Naechsten Datensatz in rest-liste suchen, dessen KS_EIN am naechsten am ;; gegebenen KS_AUS-Punkt liegt. Rueckgabe: (rec . abstand) oder nil. (defun vfl-kette-naechster (aus-punkt rest-liste / rec bester bester-d d) (setq bester nil bester-d nil) (foreach rec rest-liste (if (vfl-kette-rec-ein rec) (progn (setq d (distance aus-punkt (vfl-kette-rec-ein rec))) (if (or (null bester-d) (< d bester-d)) (progn (setq bester rec) (setq bester-d d))) ) ) ) (if bester (cons bester bester-d) nil) ) ;; Kette ab start-rec NUR VORWAERTS verfolgen. Rueckgabe: (list kette warnung) ;; kette = Liste der Datensaetze in Ketten-Reihenfolge (mind. start-rec) ;; warnung = (letzter-bname kandidat-bname abstand) wenn eine Luecke im ;; tol-weit-Band gefunden wurde, sonst nil. ;; letzter-fund = (rec . abstand) des zuletzt geprueften (aber verworfenen) ;; Kandidaten - Diagnose-Hilfe, wenn die Kette bei Laenge 1 ;; endet (dann kein warnung, aber evtl. trotzdem ein Fund ;; ausserhalb von tol-weit). ;; verdaechtig = Liste (vorgaenger-bname naechster-bname abstand) fuer jeden ;; Anschluss, dessen Abstand > 0.5mm war - eine echte, absichtlich ;; gebaute KS-zu-KS-Verbindung sollte praktisch bei 0mm liegen; ;; ein spuerbarer (aber noch innerhalb tol-eng liegender) ;; Abstand deutet auf eine ZUFAELLIG nahe, aber NICHT wirklich ;; zusammengehoerige Stelle hin (z.B. zwei unabhaengige Linien, ;; die im Layout nahe beieinander liegen/sich kreuzen). (defun vfl-kette-verfolgen (start-rec alle-records / rest kette aktuell fund fertig warnung letzter-fund verdaechtig) (setq rest (vl-remove start-rec alle-records)) (setq kette (list start-rec)) (setq aktuell start-rec) (setq warnung nil) (setq letzter-fund nil) (setq verdaechtig '()) (setq fertig nil) (while (not fertig) (setq fund (vfl-kette-naechster (vfl-kette-rec-aus aktuell) rest)) (setq letzter-fund fund) (cond ((null fund) (setq fertig T)) ((<= (cdr fund) *vfl-kette-tol-eng*) (if (> (cdr fund) 0.5) (setq verdaechtig (cons (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)) verdaechtig))) (setq aktuell (car fund)) (setq kette (append kette (list aktuell))) (setq rest (vl-remove aktuell rest)) (setq letzter-fund nil) ) ((<= (cdr fund) *vfl-kette-tol-weit*) (setq warnung (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund))) (setq fertig T) ) (t (setq fertig T)) ) ) (list kette warnung letzter-fund verdaechtig) ) ;; Attribute des neuen Gesamt-Blocks aus der gefundenen Bausteinfolge ;; herleiten: dieselben Akkumulatoren (vfl-acc-*) wie beim interaktiven Bau, ;; hier rueckwirkend anhand der Bausteinfolge gefuellt statt waehrend des ;; Bauens. Sub-Elemente eines bereits gewickelten VF_n wurden beim Erfassen ;; (vfl-kette-sammle-alle) bereits aufgeloest und durchlaufen hier dieselbe ;; Typ-Klassifikation wie von Anfang an lose Bauteile - lose Einzelteile und ;; fertige VF_n lassen sich dadurch beliebig mischen. chain-start/chain-end = ;; Gesamt-KS_EIN/KS_AUS der ganzen Kette (Welt-Z liefert Hoehe-von/-bis ;; direkt, kein erneutes Auslesen noetig). ;; Rueckgabe: (list attribut-alist typ-str). (defun vfl-kette-baue-attribute (kette neuer-bname chain-start chain-end / rec typ bname anzahl-vf phase entry-info gemessen betrag richtung as-seite es-seite delta-l erster letzter ergebnis typ-str) (vfl-acc-reset) (setq anzahl-vf 0) (setq phase "gf") (setq entry-info nil) (setq delta-l 0.0) ;; Leer (nicht "rechts") als Default: falls die Kette (Ausnahmefall) ohne ;; eigenes AS-/ES-Element beginnt/endet, soll das im Attribut auch als ;; "keins vorhanden" erkennbar bleiben statt eine falsche Seite vorzutaeuschen. (setq as-seite "" es-seite "") (setq erster (car kette)) (setq letzter (car (reverse kette))) (foreach rec kette (setq bname (vfl-kette-rec-bname rec)) (setq typ (vfl-kette-typ bname)) (if (and (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec)) (setq delta-l (+ delta-l (distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec))))) (cond ;; Wrapper-Records gibt es nicht mehr - ein angetroffener VF_n wurde ;; bereits beim Erfassen (vfl-kette-sammle-alle) in seine Sub-Elemente ;; aufgeloest; jedes davon durchlaeuft hier dieselbe Typ-Klassifikation ;; wie ein von Anfang an loses Bauteil. ((= typ "AS") (if (equal rec erster) (setq as-seite (vfl-kette-teil bname 3)))) ((= typ "ES") (if (equal rec letzter) (setq es-seite (vfl-kette-teil bname 3)))) ((= typ "GFBOGEN") ;; Gefaellebogen___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___TEF_ (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_ (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)