;; ============================================================ ;; export.lsp - Export-Funktionen fuer INSERT-Bloecke ;; ;; Enthaelt: ;; - JSON-Sammler (csv:collect-export-blocks, csv:run-export) ;; - Python-basierter Export: EXPORTSIVAS, EXPORTCSV ;; ;; Alle Blockname-Muster dieses Moduls sind zentral in cfg/export.cfg ;; (INI-Style, Abschnitt [blockpattern]) deklariert und werden beim ;; Laden des Moduls einmalig eingelesen (export:load-cfg). ;; Datei-/Skriptnamen sind fest im Code hinterlegt (*export-filenames*). ;; ============================================================ (vl-load-com) ;; --- Export-Konfiguration aus cfg/export.cfg laden --- ;; Nutzt den zentralen INI-Parser aus ssg_core.lsp (ssg-load-ini / ssg-ini-get / ;; ssg-ini-list), damit fuer alle Module derselbe .cfg-Standard gilt. (defun export:load-cfg ( / cfg-pfad) (setq cfg-pfad (strcat (getenv "DXFM_CFG") "/export.cfg")) (setq *export-cfg* (ssg-load-ini cfg-pfad)) (if (null *export-cfg*) (princ (ssg-textf "exp-cfg-not-found" (list cfg-pfad))) ) (princ) ) ;; --- Einzelwert aus *export-cfg* lesen, mit Fallback --- ;; section = "blockpattern" (defun export:cfg (section key default) (ssg-ini-get *export-cfg* section key default) ) ;; --- Muster aus [blockpattern] als normalisierter wcmatch-String --- ;; key = Config-Key, z.B. "pattern_kreisel" ;; default-str = Fallback-Wert als kommagetrennter String, falls Config fehlt ;; Rueckgabe: kommagetrennter String ohne Leerzeichen, z.B. "KR_*,KREISEL_*" (defun export:pattern (key default-str) (ssg-ini-list *export-cfg* "blockpattern" key default-str) ) ;; Beim Laden des Moduls einmalig einlesen (Lazy-Loading via ssg-ensure "export") (export:load-cfg) ;; --- Test-Override fuer den Ausgabeordner (nur Lisp-Sitzungsspeicher) --- ;; Wird ausschliesslich von TEST_EXPORT_ALL (tests/test_export_all.lsp) ;; waehrend des Testlaufs auf DXFM_TESTOUT gesetzt und danach garantiert ;; wieder auf nil zurueckgesetzt. Bewusst KEIN (setenv "DXFM_RESULTS" ...): ;; (setenv ...) schreibt in BricsCAD dauerhaft in die Profil-Registry und ;; ueberlebt damit jeden Neustart. (setq *export-test-override* nil) ;; --- Export-Modus: wie granular VF_n/GF_n-Ketten exportiert werden --- ;; Drei sich gegenseitig ausschliessende Werte (String, ueber CSV_EXPORT_ ;; KONFIG/dcl/csv_export_konfig.dcl bedienbar, siehe c:CSV_EXPORT_KONFIG ;; weiter unten): ;; "group_vf_gf" - Default. csv:unitmark-aktualisieren fasst Boegen/ ;; Streckenelemente/Umlenk-/Motorstation zu je einer ;; Zeile pro Foerdereinheit/Gefaelleeinheit zusammen, ;; die pattern_nested_*-Einzelteil-Zeilen bleiben aus ;; dem Export ausgeschlossen. ;; "all_elements" - Verhalten wie vor der Gruppierung: jedes Einzelteil ;; (Bogen/Streckenelement/Umlenk-/Motorstation) ;; bekommt seine eigene Export-Zeile ;; (csv:collect-export-blocks laesst die ;; pattern_nested_*-Klauseln durch, csv:unitmark- ;; aktualisieren legt keine neuen Marker an). ;; "separator_track" - Klassisches Verhalten vor beiden Erweiterungen: ;; nur AS/ES/Separator, keine Einzelteile UND keine ;; Foerdereinheit/Gefaelleeinheit-Marker (weder ;; csv:element-proxies-erzeugen noch csv:unitmark- ;; aktualisieren legen dafuer etwas Neues an - siehe ;; csv:export-vorbereiten). ;; Ein ungueltiger Wert wird von csv:export-modus-setzen ignoriert (Modus ;; bleibt unveraendert) statt die Zeichnung in einen unbekannten Zustand zu ;; versetzen. (if (not (boundp '*csv-export-modus*)) (setq *csv-export-modus* "group_vf_gf")) (defun csv:export-modus () *csv-export-modus*) (defun csv:export-modus-setzen (modus) (if (member modus '("all_elements" "group_vf_gf" "separator_track")) (setq *csv-export-modus* modus)) (princ) ) ;; Abgeleitete Boolean-Abfragen - bestehende Aufrufstellen (csv:collect- ;; export-blocks/csv:unitmark-aktualisieren) bleiben dadurch unveraendert. (defun csv:export-alle-elemente-p () (= *csv-export-modus* "all_elements")) (defun csv:export-separator-track-p () (= *csv-export-modus* "separator_track")) ;; Kurzformen, die die frueheren csv:export-alle-elemente-an/-aus 1:1 ;; ersetzen (z.B. fuer Testcode/Kommandozeile). (defun csv:export-alle-elemente-an () (csv:export-modus-setzen "all_elements")) (defun csv:export-alle-elemente-aus () (csv:export-modus-setzen "group_vf_gf")) ;; --- Zwei unabhaengige Sichtbarkeits-Haken fuer die temporaeren Element- ;; Proxy-Kopien (siehe csv:element-proxies-loeschen/csv:unitmark- ;; aktualisieren) - ebenfalls ueber CSV_EXPORT_KONFIG bedienbar --- ;; *csv-export-pruef-zuordnung* - laesst die den Foerdereinheit-/ ;; Gefaelleeinheit-Markern zugeordneten Element-Kopien zusaetzlich ;; sichtbar, damit in BricsCAD optisch nachvollziehbar ist, welche ;; Einzelteile zu welchem ZZ_UNIT_MARKER-Rechteck zusammengefasst ;; wurden (die Marker selbst bleiben ohnehin immer stehen, persistent ;; wie ZZ_ASES_MARKER). ;; *csv-export-elemente-behalten* - laesst die Element-Proxy-Kopien ;; grundsaetzlich stehen, unabhaengig vom Gruppierungs-Debugging oben. ;; Beide unabhaengig vom bestehenden, als TEMPORAER dokumentierten Debug- ;; Schalter "csv_leave_proxies" (ssg_dbg.lsp) - der bleibt unveraendert und ;; steuert weiterhin zusaetzlich (ODER-verknuepft) sowohl Separator- als ;; auch Element-Proxies. (if (not (boundp '*csv-export-pruef-zuordnung*)) (setq *csv-export-pruef-zuordnung* nil)) (if (not (boundp '*csv-export-elemente-behalten*)) (setq *csv-export-elemente-behalten* nil)) ;; --- Feste Datei-/Skriptnamen dieses Moduls (keine Config, direkt im Code) --- (setq *export-filenames* (list (cons "raw_json_datei" "export_raw.json") (cons "sivas_script" "export_sivas.py") (cons "sivas_csv" "sivas.csv") (cons "csv_script" "export_csv.py") (cons "csv_csv" "export.csv") ) ) ;; --- Dateinamen aus *export-filenames* lesen --- (defun export:filename (key) (cdr (assoc key *export-filenames*)) ) ;; --- Zeichnungsname als Dateiname-Praefix ermitteln --- ;; Liefert "_" oder "" (leer), wenn die Zeichnung noch nie ;; gespeichert wurde (DWGTITLED=0, Name z.B. "Zeichnung1"/"Drawing1"). ;; So heisst die Export-CSV bei einer benannten Zeichnung "_export.csv" ;; bzw. "_sivas.csv" statt nur "export.csv"/"export_sivas.csv" - bei ;; mehreren offenen/parallel bearbeiteten Zeichnungen sonst nicht unterscheidbar. (defun export:dwg-praefix ( / dwgname) (if (= (getvar "DWGTITLED") 0) "" (progn (setq dwgname (getvar "DWGNAME")) (if (and dwgname (/= dwgname "")) (strcat (vl-filename-base dwgname) "_") "" ) ) ) ) ;; ============================================================ ;; PYTHON-INTERPRETER ERMITTELN ;; ============================================================ ;; BricsCAD erbt seine Umgebung von start_briscad.bat/setenv.bat - dort wird ;; das Projekt-venv NICHT aktiviert. Ein blankes "python" trifft unter Windows ;; 11 daher den WindowsApps-Platzhalter ;; (%LOCALAPPDATA%\Microsoft\WindowsApps\python.exe), der kein Interpreter ist, ;; sondern nur auf den Microsoft Store verweist und mit Exitcode 49 abbricht. ;; Der Export schrieb dann zwar die JSON, aber nie eine CSV. ;; ;; Aufloesungsreihenfolge (erster Treffer gewinnt): ;; 1. cfg/export.cfg [python] interpreter= (explizite Vorgabe) ;; 2. Umgebungsvariable DXFM_PYTHON (von setenv.bat gesetzt) ;; 3. /.venv/Scripts/python.exe (Projekt-venv, siehe install_py.bat) ;; 4. "py" (Python-Launcher, C:\Windows\py.exe) - kein Store-Platzhalter ;; 5. "python" (PATH) als letzter Ausweg (defun export:python-store-stub-p (pfad / p) (setq p (strcase (vl-string-translate "\\" "/" pfad))) (and (vl-string-search "/WINDOWSAPPS/" p) T) ) ;; --- Kandidat pruefen: existierende Datei und kein Store-Platzhalter --- (defun export:python-kandidat-ok-p (pfad) (and pfad (/= pfad "") (findfile pfad) (not (export:python-store-stub-p pfad))) ) (defun export:python-exe ( / cfg-wert env-wert venv-pfad launcher-pfad) (cond ;; 1. Explizite Vorgabe aus der Config ((export:python-kandidat-ok-p (setq cfg-wert (export:cfg "python" "interpreter" ""))) cfg-wert) ;; 2. Umgebungsvariable ((export:python-kandidat-ok-p (setq env-wert (getenv "DXFM_PYTHON"))) env-wert) ;; 3. Projekt-venv ((export:python-kandidat-ok-p (setq venv-pfad (strcat (cond ((getenv "DXFMAKRO")) (".")) "/.venv/Scripts/python.exe"))) venv-pfad) ;; 4. Python-Launcher (liegt in C:\Windows, daher kein Store-Platzhalter). ;; Voller Pfad statt nur "py.exe": findfile durchsucht die BricsCAD- ;; Suchpfade, nicht zwangslaeufig den System-PATH. ((export:python-kandidat-ok-p (setq launcher-pfad (strcat (cond ((getenv "SystemRoot")) ("C:/Windows")) "/py.exe"))) launcher-pfad) ;; 5. Letzter Ausweg - kann der Store-Platzhalter sein, deshalb wird der ;; Exitcode nach dem Aufruf geprueft (siehe export:run-python). (t "python") ) ) ;; --- Python-Skript synchron ausfuehren, Ausgabe in Logdatei --- ;; Ersetzt das frueherer "fire and forget" (startapp "cmd" "/c ..."): das ;; cmd-Fenster schloss sich sofort wieder, jede Python-Fehlermeldung (fehlender ;; Interpreter, Traceback) war unsichtbar und der Befehl meldete trotzdem ;; "Export gestartet". Jetzt wird ueber WScript.Shell.Run mit bWaitOnReturn=T ;; gewartet, stdout/stderr nach DXFM_LOG/export_python.log umgeleitet und der ;; Exitcode ausgewertet. ;; Rueckgabe: Exitcode (0 = ok) oder nil, wenn der Aufruf selbst scheiterte. (defun export:run-python (py-exe py-skript args log-pfad / cmd sh rc code) ;; Aeussere Anfuehrungszeichen um die gesamte /c-Zeile: sonst verschluckt ;; cmd.exe die Quotes um den Interpreterpfad (Leerzeichen in "Program Files"). (setq cmd (strcat "cmd.exe /c \"\"" py-exe "\"")) (setq cmd (strcat cmd " \"" py-skript "\"")) (foreach a args (setq cmd (strcat cmd " \"" a "\""))) (setq cmd (strcat cmd " > \"" log-pfad "\" 2>&1\"")) ;; Run(cmd, 0, T): 0 = kein Fenster, T = warten und Exitcode liefern. (setq rc (vl-catch-all-apply '(lambda () (setq sh (vlax-create-object "WScript.Shell")) (setq code (vlax-invoke sh 'Run cmd 0 :vlax-true)) (vlax-release-object sh) (setq sh nil) code))) (if (vl-catch-all-error-p rc) (progn (if sh (vl-catch-all-apply 'vlax-release-object (list sh))) nil) rc ) ) ;; --- Erste Zeilen der Python-Logdatei in die Kommandozeile spiegeln --- ;; Damit steht die eigentliche Fehlerursache direkt in BricsCAD und nicht nur ;; in der Logdatei. max-zeilen begrenzt die Ausgabe (Tracebacks koennen lang sein). (defun export:log-ausgeben (log-pfad max-zeilen / fh zeile n) (if (setq fh (open log-pfad "r")) (progn (setq n 0) (while (and (setq zeile (read-line fh)) (< n max-zeilen)) (if (/= zeile "") (progn (princ (strcat "\n | " zeile)) (setq n (1+ n))) ) ) (close fh) ) ) (princ) ) ;; --- String fuer JSON escapen (Anfuehrungszeichen/Backslash) --- ;; Konvertiert nicht-String-Werte (z.B. T, nil, Zahlen) defensiv in String. ;; ssg-str-replace-all (ssg_lang.lsp) statt vl-string-subst: vl-string-subst ;; ersetzt nur das ERSTE Vorkommen, nicht alle - bei einem Attributwert mit ;; MEHREREN Anfuehrungszeichen (z.B. BEZEICHNUNG einer Geruest-Baugruppe mit ;; zwei Zoll-Angaben wie 'F. 2" UND 1" ROHR') blieb das zweite Vorkommen ;; unescaped stehen und brach die JSON-Struktur beim Python-Parsen (realer ;; Bug, behoben) - export_raw.json/EXPORTCSV. (defun csv:json-escape (s) (if (not (= (type s) 'STR)) (setq s (if s (vl-princ-to-string s) "")) ) (setq s (ssg-str-replace-all "\\\\" "\\" s)) (ssg-str-replace-all "\\\"" "\"" s) ) ;; --- Safearray/Variant-Rueckgabe von vla-getboundingbox in Liste wandeln --- ;; BricsCAD liefert ein Safearray, AutoCAD ein Variant mit Safearray. (defun csv:pt->list (v) (cond ((= (type v) 'variant) (vlax-safearray->list (vlax-variant-value v))) ((= (type v) 'safearray) (vlax-safearray->list v)) ((listp v) v) (t nil) ) ) ;; ============================================================ ;; KOS-KOMPRIMIERUNG (Position + Rotation als 24-Zeichen Base64-String) ;; ============================================================ ;; Kodiert Position (x,y,z in mm) und Rotation (als Quaternion qx,qy,qz,qw) ;; verlustarm (24 Bit Fixed-Point je Wert) in einen 24-Zeichen Base64-String. ;; Ported aus einer interaktiven Referenz-Routine (c:ExportKOS), hier als ;; reine Funktion fuer den automatischen Export nutzbar. Alle Elemente in ;; diesem Projekt werden ausschliesslich um die Z-Achse gedreht (siehe ;; DREHUNG-Konvention weiter unten), daher genuegt eine Halbwinkel-Quaternion ;; fuer eine reine Z-Rotation (csv:z-angle-to-quat) -- keine vollstaendige ;; Rotationsmatrix/Quaternion-Extraktion noetig. (setq *csv-b64-chars* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") ;; --- Wert auf [min-val, max-val] begrenzen --- (defun csv:clamp (val min-val max-val) (max min-val (min val max-val)) ) ;; --- Rotationswinkel (Grad, reine Z-Drehung) -> Quaternion (qx qy qz qw) --- (defun csv:z-angle-to-quat (deg / rad) (setq rad (/ (* deg pi) 180.0)) (list 0.0 0.0 (sin (/ rad 2.0)) (cos (/ rad 2.0))) ) ;; --- Liste vorzeichenbehafteter 24-Bit-Integer -> Base64 (je 4 Zeichen) --- ;; Gemeinsamer Kodierer fuer csv:kos-encode und csv:trans-encode. (defun csv:b64-encode-ints (int-list / b64-str val) (setq b64-str "") (foreach val int-list (if (< val 0) (setq val (+ val 16777216))) ; Zweierkomplement (24 Bit) (setq b64-str (strcat b64-str (substr *csv-b64-chars* (1+ (lsh val -18)) 1) (substr *csv-b64-chars* (1+ (logand (lsh val -12) 63)) 1) (substr *csv-b64-chars* (1+ (logand (lsh val -6) 63)) 1) (substr *csv-b64-chars* (1+ (logand val 63)) 1) )) ) b64-str ) ;; --- Position (mm) + Quaternion -> 24-Zeichen Base64-String --- ;; Fixed-Point: x,y,z (Faktor 1000 = mm) und qx,qy,qz werden je auf 24 Bit ;; gerundet (6 Werte * 4 Zeichen = 24 Zeichen). qw wird nicht mitkodiert, ;; sondern nur zur Vorzeichen-Normierung verwendet (q und -q sind dieselbe ;; Rotation). Fuer den Insertpoint (volle Lage), siehe csv:trans-encode fuer ;; reine Positionen (K1-K4). (defun csv:kos-encode (x y z qx qy qz qw) (if (< qw 0.0) (setq qx (- qx) qy (- qy) qz (- qz)) ) (csv:b64-encode-ints (list (fix (csv:clamp (* x 1000.0) -8388607 8388607)) (fix (csv:clamp (* y 1000.0) -8388607 8388607)) (fix (csv:clamp (* z 1000.0) -8388607 8388607)) (fix (csv:clamp (* qx 8388607.0) -8388607 8388607)) (fix (csv:clamp (* qy 8388607.0) -8388607 8388607)) (fix (csv:clamp (* qz 8388607.0) -8388607 8388607)) )) ) ;; --- Position (nur x,y,z) -> 12-Zeichen Base64-String --- ;; Fixed-Point Faktor 10.0 (0.1 mm Genauigkeit, Bereich +-838 m), 3 Werte * ;; 4 Zeichen = 12 Zeichen. Fuer die Koordinatensysteme K1-K4 (nur Position, ;; keine Rotation). Ported aus der Referenz-Routine c:ExportTrans. (defun csv:trans-encode (x y z) (csv:b64-encode-ints (list (fix (csv:clamp (* x 10.0) -8388607 8388607)) (fix (csv:clamp (* y 10.0) -8388607 8388607)) (fix (csv:clamp (* z 10.0) -8388607 8388607)) )) ) ;; --- Lokalen Punkt (relativ zum Block-Ursprung) unter Beruecksichtigung der ;; VOLLEN 3D-Orientierung des Elternblocks in Weltkoordinaten umrechnen --- ;; parent-R = volle 3x3-Rotationsmatrix (mat3-* in ssg_core.lsp), nicht nur ;; ein Z-Drehwinkel: ein Elternblock kann selbst eine gekippte Extrusion ;; tragen (z.B. ein Separator-Proxy, der aus dem geneigten Abschnitt einer ;; VF-/GF-Kette neu zusammengesetzt wurde, siehe csv:block-to-json) - eine ;; reine Z-Drehung wuerde dessen Sub-Koordinatensysteme (K1-K4/KS_EIN/ ;; KS_AUS) an einen falschen, teils gespiegelten Weltpunkt legen. Fuer einen ;; flachen Elternblock (Extrusion (0 0 1)) ist parent-R = Rz(rotation) und ;; das Ergebnis identisch zur frueheren reinen Z-Drehung. Rueckgabe: (x y z). (defun csv:local-to-world (parent-pt parent-R local-pt / lz pz rot-pt) (setq lz (if (caddr local-pt) (caddr local-pt) 0.0)) (setq pz (if (caddr parent-pt) (caddr parent-pt) 0.0)) (setq rot-pt (mat3-mul-vec3 parent-R (list (car local-pt) (cadr local-pt) lz))) (list (+ (car parent-pt) (car rot-pt)) (+ (cadr parent-pt) (cadr rot-pt)) (+ pz (caddr rot-pt)) ) ) ;; --- K1-K4-Koordinatensysteme eines Blocks als Positions-Strings lesen --- ;; ename = Entity-Name des platzierten INSERT (Omniflo Bogen/Weiche/Gerade). ;; pt/parent-R = bereits ermittelte Welt-Position/volle 3x3-Orientierung des ;; Eltern-INSERT (siehe csv:block-to-json), keine erneute Abfrage. ;; Sucht in der Block-DEFINITION (wie omni:get-block-hoehe) nach direkten ;; Sub-INSERTs "K1".."K4" und rechnet deren lokale Position ueber die volle ;; Eltern-Orientierung in Weltkoordinaten um (csv:local-to-world). Es wird ;; nur die POSITION kodiert (12-Zeichen-String, csv:trans-encode) - keine ;; Rotation. ;; Zusaetzlich werden Strecken-Koordinatensysteme KS_EIN->K1 und KS_AUS->K2 ;; (inkl. der KSYS_-Varianten, siehe ks-normalize-name in vf_core.lsp) gemappt, ;; sofern kein echter K1/K2 am Block vorhanden ist (echte K-Bloecke haben ;; Vorrang: sie werden vorne angehaengt, csv:k-kos liest per assoc den ersten). ;; Rueckgabe: Assoc-Liste (("K1" . "") ("K2" . ...) ...), nur ;; fuer tatsaechlich vorhandene K-Bloecke (nicht jedes Element hat alle 4). ;; ;; Gruppe-10 eines Sub-INSERTs ist OCS-lokal zu SEINER EIGENEN Extrusion ;; (Gruppe 210), nicht zwingend zur flachen XY-Ebene der Elterndefinition - ;; z.B. KS_AUS von SC_Entladung (BTMT-Entladung), das schraeg in 3D sitzt. ;; mat3-ocs-matrix/mat3-mul-vec3 (ssg_core.lsp, Arbitrary Axis Algorithm) ;; wandeln das erst in echte lokale Koordinaten um, bevor csv:local-to-world ;; mit der Eltern-Rotation weiterrechnet - derselbe Fix wie bereits in ;; ssg-collect-nested-inserts-rel (dort ausfuehrlich begruendet). Ohne diese ;; Umrechnung landete K2 tief unterhalb statt oberhalb des Elements (realer ;; Bug, sichtbar in der Materialfluss-Draufsicht sps_skel/HundM05_bbs.svg). ;; Fuer Extrusion=(0 0 1) (Normalfall, z.B. KS_EIN) reduziert sich das exakt ;; auf die alte reine Uebernahme - unveraendertes Verhalten dort. Denselben ;; Grund hat parent-R als VOLLE Matrix statt eines Z-Drehwinkels: ein ;; Elternblock (z.B. ein Separator-Proxy, ueber ssg-collect-nested-inserts ;; aus dem geneigten Abschnitt einer VF-/GF-Kette neu zusammengesetzt) kann ;; selbst eine gekippte Extrusion tragen - eine reine Z-Drehung des Eltern- ;; INSERT legte dessen K1/K2 dann an einen falschen, teils gespiegelten ;; Weltpunkt (realer Bug: K1 landete beim Vorzeichen von X/Y gespiegelt weit ;; ausserhalb der eigenen Boundingbox, sichtbar als fehlendes K-Kreuz in ;; sps_skel/HundM05_bbs.svg trotz gefuelltem K1 in der CSV). ;; sx/sy/sz: Skalierung des Top-Level-Inserts ename selbst (Gruppencodes ;; 41/42/43), auf sub-pt-real anzuwenden BEVOR in Weltkoordinaten gedreht ;; wird - noetig fuer nicht-uniform skalierte Bloecke wie Staustrecke_SP_ ;; 1000_mm (per Laenge auf der X-Achse gestreckt, siehe insert-inclined- ;; scaled-block, Lisp/ssg_ks_insert.lsp:260). Ohne diese Skalierung wuerde ;; K2 dort so berichtet, als waere der Block unskaliert (1:1) eingefuegt - ;; derselbe Fehler, den csv:vfgf-ks-loc fuer AS-/ES-Elemente schon per ;; elem-sx/elem-sy/elem-sz vermeidet (siehe dort). Fuer alle bisherigen ;; Aufrufer (Omniflo/Kreisel/AS-ES-Marker, durchweg uniform mit 1.0 skaliert ;; eingefuegt) ist die Multiplikation ein No-Op - unveraendertes Verhalten. (defun csv:get-k-kos-strings (ename pt parent-R sx sy sz / ed bname blk-tbl sub-ent sub-ed sub-bname sub-pt sub-extrusion sub-pt-real world-pt target is-real result) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) (setq blk-tbl (tblsearch "BLOCK" bname)) (setq result nil) (if blk-tbl (progn ;; (assoc -2) ist bereits das ERSTE Entity der Blockdefinition, NICHT ;; der BLOCK-Header - direkt hier starten, kein entnext davor (das ;; uebersprang sonst ein K1/KS_EIN, das zufaellig als erstes Entity in ;; der Blockdefinition steht - derselbe Bug wie frueher in ;; ssg-collect-nested-inserts-rel, siehe dortiger Kommentar). (setq sub-ent (cdr (assoc -2 blk-tbl))) (while sub-ent (setq sub-ed (entget sub-ent)) (if (= (cdr (assoc 0 sub-ed)) "INSERT") (progn (setq sub-bname (strcase (cdr (assoc 2 sub-ed)))) ;; Ziel-Slot bestimmen: echte K1-K4 direkt, KS_EIN/KS_AUS gemappt. (setq is-real (wcmatch sub-bname "K1,K2,K3,K4")) (setq target (cond (is-real sub-bname) ((or (= sub-bname "KS_EIN") (= sub-bname "KSYS_EIN")) "K1") ((or (= sub-bname "KS_AUS") (= sub-bname "KSYS_AUS")) "K2") (t nil))) ;; Echte K-Bloecke immer aufnehmen (vorne = Vorrang bei assoc); ;; KS-abgeleitete nur, wenn der Slot noch nicht belegt ist. (if (and target (or is-real (not (assoc target result)))) (progn (setq sub-pt (cdr (assoc 10 sub-ed))) (if (null (caddr sub-pt)) (setq sub-pt (list (car sub-pt) (cadr sub-pt) 0.0))) (setq sub-extrusion (cond ((cdr (assoc 210 sub-ed))) ('(0.0 0.0 1.0)))) (setq sub-pt-real (mat3-mul-vec3 (mat3-ocs-matrix sub-extrusion) sub-pt)) (setq sub-pt-real (list (* sx (car sub-pt-real)) (* sy (cadr sub-pt-real)) (* sz (caddr sub-pt-real)))) (setq world-pt (csv:local-to-world pt parent-R sub-pt-real)) (setq result (cons (cons target (csv:trans-encode (car world-pt) (cadr world-pt) (caddr world-pt))) result)) ) ) ) ) (setq sub-ent (entnext sub-ent)) ) ) ) result ) ;; --- Wert aus csv:get-k-kos-strings nach Name lesen, "" falls nicht vorhanden --- (defun csv:k-kos (k-list name / found) (setq found (assoc name k-list)) (if found (cdr found) "") ) ;; --- K1 (Anfang) / K2 (Ende) einer Omniflo-Gerade SYNTHETISIEREN --- ;; ename = Entity-Name des platzierten Gerade-INSERT. ;; pt/rot-rad = Welt-Einfuegepunkt (= Anfang) und -Rotation (radiant) des ;; Blocks (siehe csv:block-to-json). ;; Geraden fuehren - anders als Boegen/Weichen - KEINE echten K-Bloecke in der ;; Zeichnung. Fuer den Export werden ihre Anschluss-Koordinatensysteme aus der ;; Geometrie berechnet, als laegen dort echte KOS: K1 am Einfuegepunkt (Anfang ;; der lokalen Linie 0,0), K2 am Ende (laenge,0), ueber die Block-Rotation in ;; Weltkoordinaten gedreht. Laenge aus dem LAENGE- bzw. A-Attribut. Damit ;; koennen Geraden in der Python-Nachbarschaftserkennung (export_neighbors.py) ;; genauso ueber ihre KOS gegen andere Geraden/Boegen/Weichen geprueft werden. ;; Rueckgabe wie csv:get-k-kos-strings: (("K1" . str) ("K2" . str)) oder nil. (defun csv:gerade-k-kos-strings (ename pt rot-rad / laenge-str laenge z end-pt) (setq laenge-str (cond ((csv:get-attrib ename "LAENGE")) ((csv:get-attrib ename "A")) (t nil))) (if (and laenge-str (> (strlen laenge-str) 0)) (progn (setq laenge (atof laenge-str)) (setq z (if (caddr pt) (caddr pt) 0.0)) (setq end-pt (list (+ (car pt) (* laenge (cos rot-rad))) (+ (cadr pt) (* laenge (sin rot-rad))) z)) (list (cons "K1" (csv:trans-encode (car pt) (cadr pt) z)) (cons "K2" (csv:trans-encode (car end-pt) (cadr end-pt) (caddr end-pt)))) ) nil ) ) ;; --- KS-Position eines VF/GF-Wrappers ueber das RICHTIGE Element --- ;; bname = Blockname des VF_n/GF_n-Wrappers. ;; elem-pat = Muster des KS-tragenden Teilbloecks ("AS_ELEMENT*" bzw. ;; "ES_ELEMENT*", Grossschreibung - wcmatch ist unempfindlich). ;; ks-pat = Muster des gesuchten Koordinatensystems ("KS_EIN,KSYS_EIN" ;; bzw. "KS_AUS,KSYS_AUS"). ;; Warum zwei Ebenen: das AS_Element UND das ES_Element eines VF_n fuehren ;; JEWEILS ein KS_EIN UND ein KS_AUS (siehe check_hoehen.lsp ch-measure-vfgf). ;; Ein flaches (ssg-collect-nested-inserts bname "KS_AUS") ueber den GANZEN ;; Wrapper lieferte darum zwei Treffer und (car ...) griff den falschen (den ;; des AS_Elements) - K2/ES landete auf der falschen (Anfangs-)Seite. Darum ;; ERST das passende Element (AS/ES) suchen und NUR IN DESSEN Blockdefinition ;; das KS. Die KS-Position wird durch die Weltlage des Elements (world-pt/ ;; R-world/Skalierung aus dem Element-Record) in das Koordinatensystem der ;; Wrapper-Blockdefinition transformiert - dieselbe Verkettung wie in ;; ssg-collect-nested-inserts-rel (OCS ist in den Records bereits aufgeloest). ;; Rueckgabe: (x y z) im Wrapper-Definitionsframe, oder nil wenn nicht gefunden. (defun csv:vfgf-ks-loc (bname elem-pat ks-pat / elem-hits elem-rec elem-bname elem-pt elem-R elem-sx elem-sy elem-sz ks-hits ks-loc scaled) (setq elem-hits (ssg-collect-nested-inserts bname elem-pat)) (if elem-hits (progn (setq elem-rec (car elem-hits)) (setq elem-bname (strcase (cdr (assoc 2 (entget (car elem-rec)))))) ;; Nur das KS INNERHALB dieser Element-Blockdefinition (nicht im Wrapper). (setq ks-hits (ssg-collect-nested-inserts elem-bname ks-pat)) (if ks-hits (progn (setq elem-pt (cadr elem-rec)) (setq elem-R (caddr elem-rec)) (setq elem-sx (nth 3 elem-rec) elem-sy (nth 4 elem-rec) elem-sz (nth 5 elem-rec)) (setq ks-loc (cadr (car ks-hits))) ;; KS-Pos im Element-Frame (setq scaled (list (* elem-sx (car ks-loc)) (* elem-sy (cadr ks-loc)) (* elem-sz (caddr ks-loc)))) ;; Element-Weltlage (im Wrapper-Frame) + rotierte KS-Position. (mapcar '+ elem-pt (mat3-mul-vec3 elem-R scaled)) ) ) ) ) ) ;; --- K1 (Eingang) / K2 (Ausgang) eines VF_n/GF_n-Wrappers ableiten --- ;; ename = Entity-Name des platzierten VF_n/GF_n-INSERT. ;; pt/rot-rad = Welt-Einfuegepunkt/-Rotation (radiant) des Wrappers (siehe ;; csv:block-to-json). ;; VF/GF-Wrapper fuehren - anders als Omniflo-Boegen - KEINE direkten K1-K4- ;; oder KS-Sub-INSERTs; ihre Streckenenden stecken je EINE Ebene tiefer: ;; KS_EIN im AS_Element*, KS_AUS im ES_Element* (siehe check_hoehen.lsp, ;; extract-ks-from-block-raw). csv:vfgf-ks-loc holt die KS-Position aus dem ;; JEWEILS zugehoerigen Element (nicht flach aus dem ganzen Wrapper - beide ;; Elemente tragen beide KS-Typen). Der so ermittelte Punkt (Wrapper-Frame) ;; wird ueber die Wrapper-Weltlage (reine Z-Drehung) in Weltkoordinaten ;; gedreht und wie K1-K4 als reiner Positions-String (csv:trans-encode) ;; exportiert. Damit hat auch eine Strecke K1 und K2 fuer die ;; Python-Kollisionspruefung (export_neighbors.py: Schleuselemente + ;; Kreisel-Kollision ueber die AS/ES-Position mit fester BBox statt der ;; ganzen Wrapper-Box). ;; ;; RICHTUNG: K1 ist IMMER der Eingang eines Elements, K2 IMMER der Ausgang. ;; AS = Eingangs-Element (traegt KS_EIN), ES = Ausgangs-Element (traegt KS_AUS). ;; - VarioFoerderer/Strecke (VF_*): Richtung liegt ueber die Elementrolle ;; fest -> K1 = AS-Ende (KS_EIN), K2 = ES-Ende (KS_AUS). ;; - Gefaellestrecke (GF_*): Foerderrichtung ist bergAB, also durch die HOEHE ;; bestimmt (siehe HOEHE_VON_mm > HOEHE_BIS_mm, check_hoehen.lsp). Der ;; Eingang ist das HOEHERE Ende, der Ausgang das TIEFERE - unabhaengig ;; davon, welches der beiden physischen Elemente das AS bzw. ES ist. Darum ;; wird bei GF nach Z sortiert (hoeheres Z -> K1, tieferes Z -> K2). ;; Rueckgabe wie csv:get-k-kos-strings: (("K1" . str) ("K2" . str)) - nur die ;; tatsaechlich gefundenen Enden. (defun csv:vfgf-k-kos-strings (ename pt rot-rad / ed bname as-loc es-loc as-world es-world ein-world aus-world result) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) (setq result nil) ;; Beide Enden im Wrapper-Frame holen und in Weltkoordinaten umrechnen. ;; VF_n/GF_n-Wrapper stehen an ihrem eigenen top-level INSERT immer flach ;; (Extrusion (0 0 1) - siehe csv:sep-proxies-erzeugen), darum genuegt hier ;; weiterhin die reine Z-Drehungsmatrix (mat3-rz) statt der vollen ;; Elternorientierung, die csv:get-k-kos-strings inzwischen braucht (siehe ;; dort). AS traegt das KS_EIN, ES das KS_AUS - jeweils aus dem RICHTIGEN ;; Element (csv:vfgf-ks-loc; beide Elemente fuehren beide KS-Typen). (setq as-loc (csv:vfgf-ks-loc bname "AS_ELEMENT*" "KS_EIN,KSYS_EIN")) (setq es-loc (csv:vfgf-ks-loc bname "ES_ELEMENT*" "KS_AUS,KSYS_AUS")) (if as-loc (setq as-world (csv:local-to-world pt (mat3-rz rot-rad) as-loc))) (if es-loc (setq es-world (csv:local-to-world pt (mat3-rz rot-rad) es-loc))) ;; Eingang/Ausgang festlegen (siehe Richtung im Kopfkommentar). (cond ;; GF: Richtung ueber die Hoehe - hoeheres Z = Eingang, tieferes Z = Ausgang. ;; Nur wenn BEIDE Enden vorhanden sind; sonst faellt es auf die Rolle zurueck. ((and (wcmatch (strcase bname) "GF_*") as-world es-world) (if (>= (caddr as-world) (caddr es-world)) (setq ein-world as-world aus-world es-world) (setq ein-world es-world aus-world as-world))) ;; VF/Strecke (und GF mit nur einem Ende): AS = Eingang, ES = Ausgang. (t (setq ein-world as-world aus-world es-world)) ) (if ein-world (setq result (cons (cons "K1" (csv:trans-encode (car ein-world) (cadr ein-world) (caddr ein-world))) result))) (if aus-world (setq result (cons (cons "K2" (csv:trans-encode (car aus-world) (cadr aus-world) (caddr aus-world))) result))) (reverse result) ) ;; --- Mindesthoehe der Bounding-Box (Z-Ausdehnung), aus cfg/export.cfg --- ;; [Boundingbox] bb_minimum_height_mm, Default 1 (mm) falls nicht gesetzt. ;; Verhindert dz=0 bei flachen 2D-Bloecken (Draufsicht ohne Z-Ausdehnung). (defun csv:bb-minimum-height-mm () (atof (export:cfg "Boundingbox" "bb_minimum_height_mm" "1")) ) ;; Diagnose fuer csv:get-bbox: zaehlt fehlgeschlagene vla-getboundingbox- ;; Aufrufe und merkt sich die ERSTE Fehlermeldung samt betroffenem Block. Wird ;; von csv:run-export vor der Export-Schleife zurueckgesetzt und danach ;; ausgegeben - so sieht man in der BricsCAD-Konsole sofort, WARUM eine bbox ;; fehlt (frueher wurde der Fehler still zu nil verschluckt, und im JSON fehlte ;; nur das Feld). *csv-bbox-fail-count* = Anzahl, *csv-bbox-fail-first* = ;; "(Blockname) Meldung" des ersten Fehlers. (setq *csv-bbox-fail-count* 0) (setq *csv-bbox-fail-first* nil) ;; --- Bounding-Box (WCS, achsparallel) eines INSERT-Blocks ermitteln --- ;; Erzwingt vorher ein vla-update (Regen), da vla-getboundingbox sonst auf ;; nicht-regenerierten oder auf eingefrorenen Layern liegenden Bloecken scheitert. ;; Rueckgabe: Liste (cx cy cz dx dy dz) -- Mittelpunkt + Ausdehnung, oder nil bei Fehler. ;; dz wird auf csv:bb-minimum-height-mm angehoben, falls kleiner (siehe dort). (defun csv:get-bbox (ename / obj res minpt maxpt dz min-hoehe) (setq obj (vlax-ename->vla-object ename)) (vl-catch-all-apply 'vla-update (list obj)) (setq res (vl-catch-all-apply '(lambda ( / ll ur) (vla-getboundingbox obj 'll 'ur) (list (csv:pt->list ll) (csv:pt->list ur))))) (if (vl-catch-all-error-p res) (progn ;; Fehler NICHT mehr still schlucken: zaehlen und erste Meldung merken. (setq *csv-bbox-fail-count* (1+ (cond (*csv-bbox-fail-count*) (0)))) (if (null *csv-bbox-fail-first*) (setq *csv-bbox-fail-first* (strcat "(" (cond ((cdr (assoc 2 (entget ename)))) ("?")) ") " (vl-catch-all-error-message res)))) nil) (progn (setq minpt (car res)) (setq maxpt (cadr res)) (setq dz (- (caddr maxpt) (caddr minpt))) (setq min-hoehe (csv:bb-minimum-height-mm)) (if (< dz min-hoehe) (setq dz min-hoehe)) (list (/ (+ (car minpt) (car maxpt)) 2.0) (/ (+ (cadr minpt) (cadr maxpt)) 2.0) (/ (+ (caddr minpt) (caddr maxpt)) 2.0) (- (car maxpt) (car minpt)) (- (cadr maxpt) (cadr minpt)) dz ) ) ) ) ;; --- Attribute eines INSERT-Blocks als JSON-Objekt lesen --- ;; ename = Entity-Name des INSERT ;; Rueckgabe: String wie {"TAG1":"Wert1","TAG2":"Wert2"} (defun csv:read-attribs (ename / obj ed typ tag wert parts) (setq obj (entnext ename)) (setq parts nil) (while obj (setq ed (entget obj)) (setq typ (cdr (assoc 0 ed))) (if (equal typ "SEQEND") (setq obj nil) (progn (if (equal typ "ATTRIB") (setq parts (cons (strcat "\"" (csv:json-escape (cdr (assoc 2 ed))) "\":\"" (csv:json-escape (cdr (assoc 1 ed))) "\"") parts)) ) (setq obj (entnext obj)) ) ) ) (if parts (progn (setq parts (reverse parts)) (strcat "{" (car parts) (apply 'strcat (mapcar '(lambda (p) (strcat "," p)) (cdr parts))) "}") ) "{}" ) ) ;; --- K1/K2 eines ZZ_UNIT_MARKER lesen --- ;; Fallback fuer csv:block-to-json (siehe dort): die Werte stehen bereits ;; fertig kodiert in den ATTDEFs K1/K2 (siehe csv:unitmark-aktualisieren), ;; hier nur noch als K-Liste im Format von csv:get-k-kos-strings verpackt. (defun csv:unitmark-k-kos-strings (ename / attribs k1 k2 result) (setq attribs (ssg-attrib-read ename)) (setq k1 (cdr (assoc "K1" attribs))) (setq k2 (cdr (assoc "K2" attribs))) (setq result nil) (if (and k1 (> (strlen k1) 0)) (setq result (cons (cons "K1" k1) result))) (if (and k2 (> (strlen k2) 0)) (setq result (cons (cons "K2" k2) result))) result ) ;; --- Einen INSERT-Block als JSON-Objekt schreiben --- ;; include-bbox = T -> zusaetzlich Bounding-Box (Mitte + Ausdehnung) ermitteln ;; und als "bbox"-Objekt anhaengen (nur fuer EXPORTCSV, nicht fuer EXPORTSIVAS). ;; "insertpoint" (KOS-String von Position+Rotation des Blocks selbst) und ;; "k1".."k4" (KOS-Strings der Koordinatensysteme im Block, siehe ;; csv:get-k-kos-strings) werden immer geschrieben, unabhaengig von ;; include-bbox -- Kodierung ueber csv:kos-encode (siehe dort). (defun csv:block-to-json (ename include-bbox / ed blk-name layer pt rotation extrusion R-world handle attribs bbox bbox-json psx psy psz insert-quat insert-kos k-list warnung-json warnung-eintrag zuordnung-fix-json zuordnung-fix-eintrag strecke-typ-json strecke-typ-eintrag sepliste-json sepliste-app sepliste sepliste-teile sepliste-first sepliste-ids sep-id) (setq ed (entget ename)) (setq blk-name (cdr (assoc 2 ed))) (setq layer (cdr (assoc 8 ed))) (setq pt (cdr (assoc 10 ed))) (setq rotation (cdr (assoc 50 ed))) (setq handle (cdr (assoc 5 ed))) (if (null rotation) (setq rotation 0.0)) (if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0))) ;; Gruppe 10 ist OCS-lokal zur EIGENEN Extrusion dieses INSERT (Gruppe ;; 210) - fuer die allermeisten Bloecke (0 0 1) = Welt, aber ein Separator- ;; Proxy, der ueber ssg-collect-nested-inserts aus dem geneigten Abschnitt ;; einer VF-/GF-Kette neu zusammengesetzt wurde (csv:sep-proxies-erzeugen), ;; kann eine echt gekippte Extrusion tragen. Erst in echte Weltkoordinaten/ ;; -orientierung umrechnen (Arbitrary Axis Algorithm, ssg_core.lsp), bevor ;; irgendetwas darauf aufbaut - sonst zeigt "x"/"y"/"z" (und darueber K1-K4, ;; siehe csv:get-k-kos-strings) einen falschen, teils spiegelverkehrten ;; Weltpunkt (realer Bug: Separator :4/6/8/10/12 in HundM05, K1 landete am ;; Vorzeichen gespiegelt weit ausserhalb der eigenen Boundingbox). Fuer ;; Extrusion=(0 0 1) reduziert sich das exakt auf die alte Uebernahme. (setq extrusion (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0)))) (setq pt (mat3-mul-vec3 (mat3-ocs-matrix extrusion) pt)) (setq R-world (mat3-from-normal-rotation extrusion rotation)) (setq attribs (csv:read-attribs ename)) (setq insert-quat (csv:z-angle-to-quat (* (/ rotation pi) 180.0))) (setq insert-kos (csv:kos-encode (car pt) (cadr pt) (if (caddr pt) (caddr pt) 0.0) (nth 0 insert-quat) (nth 1 insert-quat) (nth 2 insert-quat) (nth 3 insert-quat))) (setq psx (cond ((cdr (assoc 41 ed))) (1.0))) (setq psy (cond ((cdr (assoc 42 ed))) (1.0))) (setq psz (cond ((cdr (assoc 43 ed))) (1.0))) (setq k-list (csv:get-k-kos-strings ename pt R-world psx psy psz)) ;; Omniflo-Geraden fuehren keine echten K-Bloecke - K1/K2 aus der Geometrie ;; (Anfang/Ende ueber Laenge + Rotation) synthetisieren, damit sie im Export ;; wie echte Anschluss-Koordinatensysteme erscheinen und in der Nachbar- ;; schaftserkennung (export_neighbors.py) mitverwendet werden koennen. (if (and (null k-list) (wcmatch (strcase blk-name) (export:pattern "pattern_gerade" "AP110*,AP_110*"))) (setq k-list (csv:gerade-k-kos-strings ename pt rotation)) ) ;; VF_n/GF_n-Wrapper: K1 (Eingang) und K2 (Ausgang) eine Ebene tiefer aus ;; AS_Element/ES_Element ableiten (siehe csv:vfgf-k-kos-strings; VF ueber die ;; Elementrolle, GF ueber die Hoehe). Damit die Python-Kollisionspruefung ;; Kreisel<->Strecke ueber die AS/ES-Position mit fester BBox statt der ;; ganzen Wrapper-Box arbeiten kann. (if (and (null k-list) (wcmatch (strcase blk-name) "VF_*,GF_*")) (setq k-list (csv:vfgf-k-kos-strings ename pt rotation)) ) ;; ZZ_UNIT_MARKER (Foerdereinheit/Gefaelleeinheit): K1/K2 stehen bereits ;; fertig kodiert als eigene ATTDEFs am Marker (csv:unitmark-aktualisieren ;; berechnet sie einmal bei der Marker-Erzeugung aus dem ersten/letzten ;; zugeordneten Element) - keine erneute KS-Suche noetig. (if (and (null k-list) (wcmatch (strcase blk-name) "ZZ_UNIT_MARKER*")) (setq k-list (csv:unitmark-k-kos-strings ename)) ) (setq bbox-json "") (if include-bbox (progn (setq bbox (csv:get-bbox ename)) (if bbox (setq bbox-json (strcat ",\"bbox\":{" "\"cx\":" (rtos (nth 0 bbox) 2 4) ",\"cy\":" (rtos (nth 1 bbox) 2 4) ",\"cz\":" (rtos (nth 2 bbox) 2 4) ",\"dx\":" (rtos (nth 3 bbox) 2 4) ",\"dy\":" (rtos (nth 4 bbox) 2 4) ",\"dz\":" (rtos (nth 5 bbox) 2 4) "}" ) ) ) ) ) ;; Warnung fuer strittige Scanner-Zuordnungen anhaengen (siehe ;; cs-zuordnung-lauf in count_sep_scan.lsp, das *cs-scanner-warnung- ;; by-handle* vor csv:collect-export-blocks befuellt). Referenziert ;; die Variable direkt statt ueber atoms-family: ein in AutoLISP noch ;; nie gesetztes globales Symbol wertet beim Lesen zu nil aus (kein ;; Fehler), genau wie *export-test-override* in diesem Modul. (setq warnung-json "") (setq warnung-eintrag (assoc handle *cs-scanner-warnung-by-handle*)) (if warnung-eintrag (setq warnung-json (strcat ",\"warnung\":\"" (csv:json-escape (cdr warnung-eintrag)) "\"")) ) ;; Bekannte (nicht geratene) Separator-Zuordnung durchreichen: fuer die ;; temporaeren Kopien VERPACKTER Separator_SP-Symbole steht der Carrier fest ;; (der Wrapper-Block, in dem das Symbol steckt) - siehe ;; csv:sep-proxies-zuordnung-setzen und *cs-sep-fix-by-handle*. export_csv.py ;; berechnet die Zuordnung sonst ein zweites Mal per Boundingbox- ;; Ueberschneidung (compute_sensor_zuordnung, Prioritaet GF > VF > Kreisel- ;; haelfte) und wuerde den bekannten Wert damit ueberschreiben - z.B. auf ;; eine Gefaellestrecke, in deren Box der Separator zufaellig hineinragt, ;; obwohl er in einem VF-Block verpackt ist. Mit diesem Feld uebernimmt ;; export_csv.py den Wert unveraendert. (setq zuordnung-fix-json "") (setq zuordnung-fix-eintrag (assoc handle *cs-sep-fix-by-handle*)) (if zuordnung-fix-eintrag (setq zuordnung-fix-json (strcat ",\"zuordnung_fix\":\"" (csv:json-escape (cdr zuordnung-fix-eintrag)) "\"")) ) ;; Streckentyp (VF/GF) DIESES EINZELNEN Separators, bauzeitig gesetzt ;; (ssg-sep-typ-xdata-schreiben, siehe csv:sep-proxies-erzeugen/ ;; -zuordnung-setzen) - NICHT vom Wrapper-Blocknamen ableitbar, da ein ;; VF_n/GF_n-Wrapper intern zwischen VF-/GF-Abschnitten wechseln kann. ;; export_csv.py schreibt diesen Wert in die Merkmale der Proxy-Zeile ;; (Feld "Typ"). (setq strecke-typ-json "") (setq strecke-typ-eintrag (assoc handle *cs-sep-typ-by-handle*)) (if strecke-typ-eintrag (setq strecke-typ-json (strcat ",\"strecke_typ\":\"" (csv:json-escape (cdr strecke-typ-eintrag)) "\"")) ) ;; VF_n/GF_n-Wrapper: Separator-/AS-/ES-Reihenfolge aus der beim Bau ;; geschriebenen XDATA lesen (siehe ssg-sepliste-xdata-lesen, ;; ssg_ks_insert.lsp) und als "sepliste"-Array einbetten. Nur gesetzt, wenn ;; die XDATA vorhanden ist (Altbestand-Wrapper ohne die neue XDATA bleiben ;; ohne dieses Feld - export_neighbors.py faellt dann auf den bisherigen ;; BBox-Kollisionspfad zurueck). (setq sepliste-json "") (if (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN"))) (progn (setq sepliste-app (cond ((wcmatch (strcase blk-name) "VF_*") "SSG_VF_SEP") ((wcmatch (strcase blk-name) "GF_*") "SSG_GF_SEP") (t nil))) (if sepliste-app (setq sepliste (ssg-sepliste-xdata-lesen ename sepliste-app))) (if sepliste (progn ;; ID des Bauteils, das zu diesem Eintrag gehoert: beim Export wird ;; fuer JEDEN Eintrag (AS/SEP/ES) eine echte, temporaere Kopie des ;; verpackten Originals eingefuegt und ueber ssg-id-check-all ;; nummeriert; csv:sepliste-ids-setzen haengt die vergebene ID an den ;; Eintrag (Key = Handle dieses Wrappers). Fehlt sie (Kopie nicht ;; erzeugbar, Block ohne ID-ATTDEF, Altbestand), bleibt das Feld weg - ;; der Python-Teil faellt dann auf seine Koordinaten-Zuordnung zurueck. ;; ;; KEIN x/y mehr im JSON: die sepliste-XDATA-Koordinaten sind der ;; rohe Gruppencode-10-Punkt des jeweiligen Einfuege-Primitivs ;; (siehe gf-insert-hz-with-ks-Kommentar, ssg_ks_insert.lsp) und ;; koennen gespiegelt/verschoben sein (Nutzer-Befund 2026-09-25: ;; Sepliste-x/y von SEP-Eintraegen wich um bis zu mehrere 100mm bzw. ;; vorzeichenverkehrt von der tatsaechlichen, aus der echten ;; Proxy-Kopie berechneten Position ab - siehe die "x"/"y"-Felder ;; der eigenen Bauteil-Zeile, die verlaesslich sind). x/y wurden nie ;; fuer die ID-Zuordnung gebraucht (die laeuft VORHER, LISP-seitig, ;; ueber csv:sepliste-paare/csv:sepliste-ids-setzen mit einer ;; eigenen, unabhaengigen XDATA-Lesung) - nur der Python-Naehe- ;; Fallback (map_sepliste_kette_items in export_csv.py, fuer ;; SEP-Eintraege ohne "id", Altbestand ohne ID-ATTDEF) konsumierte ;; sie und degradiert jetzt auf 0.0/0.0 (siehe dort). (setq sepliste-ids (cdr (assoc handle *csv-sepliste-id-by-handle*))) (setq sepliste-teile "" sepliste-first t) (foreach e sepliste (setq sep-id (cdr (assoc (nth 1 e) sepliste-ids))) (setq sepliste-teile (strcat sepliste-teile (if sepliste-first "" ",") "{\"typ\":\"" (nth 0 e) "\"" ",\"lfdnr\":" (itoa (nth 1 e)) (if sep-id (strcat ",\"id\":\"" (csv:json-escape sep-id) "\"") "") "}")) (setq sepliste-first nil) ) (setq sepliste-json (strcat ",\"sepliste\":[" sepliste-teile "]")) ) ) ) ) (strcat " {\"block_name\":\"" (csv:json-escape blk-name) "\"" ",\"layer\":\"" (csv:json-escape layer) "\"" ",\"handle\":\"" (csv:json-escape handle) "\"" ",\"x\":" (rtos (car pt) 2 4) ",\"y\":" (rtos (cadr pt) 2 4) ",\"z\":" (rtos (if (caddr pt) (caddr pt) 0.0) 2 4) ",\"rotation\":" (rtos (* (/ rotation pi) 180.0) 2 4) ",\"attribs\":" attribs ",\"insertpoint\":\"" insert-kos "\"" ",\"k1\":\"" (csv:k-kos k-list "K1") "\"" ",\"k2\":\"" (csv:k-kos k-list "K2") "\"" ",\"k3\":\"" (csv:k-kos k-list "K3") "\"" ",\"k4\":\"" (csv:k-kos k-list "K4") "\"" bbox-json warnung-json zuordnung-fix-json strecke-typ-json sepliste-json "}" ) ) ;; --- Muster fuer verpackte (in einer Compound-Blockdefinition ;; verschachtelte) Separator-Sub-INSERTs --- ;; Beim finalen Zusammenbau von VF_n/GF_n/KREISEL_n werden Separator_SP- ;; Sensor-Symbole, die zuvor als eigene top-level INSERTs eingefuegt wurden, ;; zu Sub-INSERTs der Compound-Blockdefinition - (ssget "X" ...) findet sie ;; danach nicht mehr (siehe ssg-collect-nested-inserts, ssg_core.lsp). ;; Bewusst NUR das Sensor-SYMBOL (Separator_SP_2D/_3D), NICHT der intern ;; gezeichnete Staustrecke_Separator_SP-Trennsteg (300mm) - der ist ein ;; reines Geometrie-/Laengenelement der Staustrecke, kein eigenstaendig zu ;; zaehlendes Bauteil, und soll hier nicht mitkopiert werden. (defun csv:pattern-nested-separator () "Separator_SP_2D,Separator_SP_3D" ) ;; --- Muster der uebrigen verpackten VF_n/GF_n-Bausteine (Boegen, gerade ;; Foerderer-/Gefaellestrecken-Segmente, Umlenk-/Motorstation) --- ;; Wie csv:pattern-nested-separator/-schleus: diese Bausteine stecken als ;; Sub-INSERTs in der Wrapper-Blockdefinition und sind fuer (ssget "X" ...) ;; unsichtbar. EIN kombiniertes Muster fuer alle vier Familien (statt vier ;; getrennter csv:nested-welt-records-Aufrufe) haelt den zusaetzlichen ;; Scan-Aufwand auf EINEN weiteren Durchlauf der ganzen Zeichnung beschraenkt ;; - csv:element-teileart klassifiziert danach anhand des Blocknamens, in ;; welche TeileArt-Familie ein Treffer faellt. (defun csv:pattern-nested-element () (strcat (export:pattern "pattern_nested_bogen" "Gefaellebogen_*,Vario_Bogen_*,Vario_Kurve_*") "," (export:pattern "pattern_nested_streckenelement" "Staustrecke_SP_1000_mm*") "," (export:pattern "pattern_nested_umlenkstation" "Vario_Umlenkstation_*") "," (export:pattern "pattern_nested_motorstation" "Vario_Motorstation_*") ) ) ;; --- Muster der verpackten AS-/ES-Schleuselemente --- ;; AS_Element_*/ES_Element_* sind die beiden Kettenenden einer VF_n/GF_n- ;; Strecke (Ein-/Ausschleusung zum Kreisel). Sie stecken - wie die Separator- ;; Symbole - als Sub-INSERTs in der Wrapper-Blockdefinition und sind damit ;; fuer (ssget "X" ...) unsichtbar. Dieses Muster findet sie in der ;; Blockdefinition (csv:nested-welt-records); gesetzt wird an ihrer Stelle ;; NICHT eine Kopie des Elements, sondern der dauerhafte Marker ;; ZZ_ASES_MARKER (csv:asmark-aktualisieren). (defun csv:pattern-nested-schleus () (export:pattern "pattern_schleuselement" "AS_Element*,ES_Element*") ) ;; --- Typmarker eines ausgepackten Originals aus seinem Blocknamen --- ;; Liefert dieselben drei Marker, die ssg-sepliste-sammeln (ssg_ks_insert.lsp) ;; in die sepliste schreibt: "AS"/"ES"/"SEP". Ueber ihn wird eine Kopie ihrem ;; sepliste-Eintrag zugeordnet (csv:sepliste-paare) - zugeordnet wird nur ;; innerhalb desselben Typs. (defun csv:proxy-typ (bname) (cond ((wcmatch (strcase bname) "AS_ELEMENT*") "AS") ((wcmatch (strcase bname) "ES_ELEMENT*") "ES") (t "SEP") ) ) ;; --- TeileArt-Familie eines ausgepackten Elements aus seinem Blocknamen --- ;; Reiner Namensklassifikator (parallel zu csv:proxy-typ), file-frei testbar ;; (tests/test_unit.lsp). Vario_Bogen_* deckt sowohl die _TEF_-Variante (VF- ;; Vertikalboegen) als auch die reine Variante ohne _TEF_ (GF-eigene Vertikal- ;; boegen) ab - beide auf denselben TeileArt-Bucket "BOGEN", darum ist - ;; anders als bei vfl-kette-typ (vf_linienzug.lsp) - keine _TEF_-zuerst- ;; Reihenfolge noetig. Vario_Kurve_* ist laut Code-Kommentar (vf_linienzug.lsp) ;; aktuell nirgends im Projekt tatsaechlich eingefuegt, aber zur Vollstaendig- ;; keit mit aufgenommen. Liefert nil fuer alles andere (sollte bei einem ;; ueber csv:pattern-nested-element gefundenen Treffer nie vorkommen - ;; defensive Absicherung, falls Muster und cond je auseinanderlaufen). (defun csv:element-teileart (bname / bn) (setq bn (strcase bname)) (cond ((wcmatch bn "GEFAELLEBOGEN_*") "BOGEN") ((wcmatch bn "VARIO_KURVE_*") "BOGEN") ((wcmatch bn "VARIO_BOGEN_*") "BOGEN") ((wcmatch bn "STAUSTRECKE_SP_1000_MM*") "STRECKENELEMENT") ((wcmatch bn "VARIO_UMLENKSTATION_*") "UMLENKSTATION") ((wcmatch bn "VARIO_MOTORSTATION_*") "MOTORSTATION") (t nil) ) ) ;; --- Muster der Compound-("Wrapper"-)Bloecke, deren Definition ueberhaupt ;; auf verpackte Separator_SP-Symbole durchsucht wird (KR_n/KREISEL_n/ ;; ECKRAD_n/VF_n/GF_n) - alle anderen INSERTs (Omniflo, eigenstaendige ;; Separator_SP, ...) koennen von vornherein nichts "verpackt" enthalten ;; und werden gar nicht erst geprueft. (defun csv:pattern-wrapper-fuer-proxies () (strcat (export:pattern "pattern_kreisel" "KR_*,KREISEL_*,ECKRAD_*") ",VF_*,GF_*") ) ;; --- Skalierungsfaktor absichern --- ;; vla-InsertBlock verweigert den Faktor 0 (entartete Blockreferenz). Der ;; kann nur aus einer fehlerhaften Blockdefinition kommen; 1.0 ist dann die ;; brauchbarste Annahme - die Kopie steht wenigstens an der richtigen Stelle. (defun csv:skalierung-oder-eins (f) (if (or (null f) (equal f 0.0 1e-12)) 1.0 f) ) ;; --- Fuer jedes verpackte Original die Weltlage ermitteln und daran ein ;; echtes Objekt in den Modellraum setzen --- ;; nested-pattern = wcmatch-Muster der zu suchenden Sub-INSERTs, siehe ;; csv:pattern-nested-separator (Separator-Symbole) bzw. ;; csv:pattern-nested-schleus (AS-/ES-Schleuselemente). ;; ;; Sub-Bloecke, die beim Zusammenbau von VF_n/GF_n/KREISEL_n in die Compound- ;; Blockdefinition "verpackt" wurden (siehe ssg-collect-nested-inserts), sind ;; fuer (ssget "X" ...) unsichtbar - und damit weder fuer ssg-id-check-all ;; (eigene ID) noch csv:collect-export-blocks (JSON-Zeile) erreichbar, und in ;; der Zeichnung auch nicht als eigenes Objekt anklickbar. Diese Funktion ;; liefert ihre Weltlage, ohne die Zeichnung anzufassen; was daran gesetzt ;; wird, entscheidet der Aufrufer: ;; - csv:sep-proxies-erzeugen -> temporaere Kopie des Symbols selbst ;; (wird nach dem Export wieder geloescht) ;; - csv:asmark-aktualisieren -> dauerhafter AS/ES-Marker (bleibt stehen ;; und traegt die ID ueber Laeufe hinweg) ;; ;; Die Kopie steht bewusst EXAKT auf der Weltposition/-drehung/-skalierung ;; ihres verpackten Vorbilds (frueher: +500 mm Versatz in Blockrichtung, rein ;; kosmetisch). Der Versatz war schaedlich: die geometrische Sensor-Zuordnung ;; in count_sep_scan.lsp arbeitet ueber die Carrier-Boundingbox, und ein um ;; 500 mm verschobener Separator kippt am Kettenende in die Box des Nachbar- ;; Carriers - die Kopie soll ihr Vorbild in der Zeichenebene 1:1 ;; repraesentieren. Die Platzierung der Ebenen zwischen Wrapper und Symbol ;; steckt in den Records von ssg-collect-nested-inserts (Position/Drehung/ ;; Skalierung relativ zur Wrapper-Definition); hier kommt nur noch die ;; Platzierung des top-level INSERT darauf. ;; ;; Rueckgabe: Liste von Records ;; (wrapper-ename nested-ent nested-bname (x y z) R sx sy sz) ;; mit der fertigen Weltlage jedes Fundes (R = volle 3x3-Orientierung). (defun csv:nested-welt-records (nested-pattern / ss-all i ename ed bname nested pt rotation extrusion0 R0 psx psy psz rec nested-ent nested-bname local-pt R-nested R-final scaled-pt rot-pt world-pt records) (setq ss-all (ssget "X" (list (cons 0 "INSERT")))) (if ss-all (progn (setq i 0) (while (setq ename (ssname ss-all i)) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) (setq nested (if (wcmatch bname (csv:pattern-wrapper-fuer-proxies)) (ssg-collect-nested-inserts bname nested-pattern) ) ) (if nested (progn (setq pt (cdr (assoc 10 ed))) (if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0))) (setq rotation (cond ((cdr (assoc 50 ed))) (0.0))) ;; Extrusion des Wrapper-INSERTs selbst beruecksichtigen statt ;; reine Z-Drehung anzunehmen - GF_n/VF_n stehen zwar bisher immer ;; flach (Extrusion (0 0 1)), aber mat3-from-normal-rotation ;; reduziert sich dafuer ohnehin exakt auf Rz(rotation), kostet ;; also nichts und macht den Code robust falls sich das aendert. (setq extrusion0 (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0)))) (setq R0 (mat3-from-normal-rotation extrusion0 rotation)) (setq psx (cond ((cdr (assoc 41 ed))) (1.0))) (setq psy (cond ((cdr (assoc 42 ed))) (1.0))) (setq psz (cond ((cdr (assoc 43 ed))) (1.0))) (foreach rec nested (setq nested-ent (nth 0 rec)) (setq local-pt (nth 1 rec)) (setq R-nested (nth 2 rec)) (setq nested-bname (cdr (assoc 2 (entget nested-ent)))) (setq scaled-pt (list (* psx (car local-pt)) (* psy (cadr local-pt)) (* psz (caddr local-pt)))) (setq rot-pt (mat3-mul-vec3 R0 scaled-pt)) (setq world-pt (list (+ (car pt) (car rot-pt)) (+ (cadr pt) (cadr rot-pt)) (+ (caddr pt) (caddr rot-pt)))) (setq R-final (mat3-mul-mat3 R0 R-nested)) (setq records (cons (list ename nested-ent nested-bname world-pt R-final (* psx (nth 3 rec)) (* psy (nth 4 rec)) (* psz (nth 5 rec))) records)) ) ) ) (setq i (1+ i)) ) ) ) (reverse records) ) ;; --- Einen Block an einer vollen 3D-Weltlage einfuegen --- ;; ms = ModelSpace-Objekt (der Aufrufer holt es EINMAL, nicht je Block) ;; bname = einzufuegende Blockdefinition ;; world-pt/R = Weltposition und volle 3x3-Orientierung (siehe ;; csv:nested-welt-records) ;; sx/sy/sz = Skalierung; der AS/ES-Marker fuegt bewusst mit 1.0 ein (ein ;; gestauchtes Rechteck waere als Marker unbrauchbar), die ;; Separator-Kopie mit der tatsaechlichen Skalierung ihres ;; Vorbilds. ;; kontext = Blockname des Wrappers, nur fuer die Fehlermeldung. ;; ;; Volle 3D-Orientierung statt eines einzelnen Z-Drehwinkels: ein Skalar- ;; Drehwinkel kann eine Kippung ausserhalb der XY-Ebene (Gefaellestrecke-/ ;; VF-Neigung) gar nicht darstellen. Deshalb - wie insert-block-ks-to-ks ;; (vf_core.lsp) - am Ursprung mit Rotation=0 einfuegen und die komplette Lage ;; (Drehung UND Verschiebung) in EINER vla-TransformBy anwenden. ;; ;; Einfuegen ueber vla-InsertBlock (ActiveX) statt "command _.INSERT": das legt ;; fuer einen Block mit ATTDEFs automatisch ATTRIB-Entities mit den Vorgabe- ;; werten an - OHNE jeden einzelnen Insert-Prompt (Blockname/Einfuegepunkt/ ;; Skalierung/Drehwinkel) ins Kommandozeilen-Fenster zu schreiben. ;; ;; Beide ActiveX-Aufrufe sind gekapselt: ein einzelner Sonderfall (entartete ;; Skalierung, gespiegelter Zwischenblock) darf nicht den kompletten Export der ;; Zeichnung abbrechen, sondern nur dieses eine Objekt ausfallen lassen - mit ;; Meldung, welcher Block. Rueckgabe: ename des neuen INSERT oder nil. (defun csv:block-einfuegen-welt (ms bname world-pt R sx sy sz kontext / T4 block-obj xform-fehler erg) (setq T4 (vlax-tmatrix (list (list (car (car R)) (cadr (car R)) (caddr (car R)) (car world-pt)) (list (car (cadr R)) (cadr (cadr R)) (caddr (cadr R)) (cadr world-pt)) (list (car (caddr R)) (cadr (caddr R)) (caddr (caddr R)) (caddr world-pt)) (list 0.0 0.0 0.0 1.0)))) (setq block-obj (vl-catch-all-apply 'vla-InsertBlock (list ms (vlax-3D-point '(0.0 0.0 0.0)) bname (csv:skalierung-oder-eins sx) (csv:skalierung-oder-eins sy) (csv:skalierung-oder-eins sz) 0.0))) (cond ((vl-catch-all-error-p block-obj) (princ (ssg-textf "exp-sep-proxy-fehler" (list bname kontext (vl-catch-all-error-message block-obj)))) (setq erg nil)) (t (setq xform-fehler (vl-catch-all-apply 'vla-TransformBy (list block-obj T4))) (if (vl-catch-all-error-p xform-fehler) (progn (princ (ssg-textf "exp-sep-proxy-fehler" (list bname kontext (vl-catch-all-error-message xform-fehler)))) (vl-catch-all-apply 'vla-Delete (list block-obj)) (setq erg nil)) (setq erg (vlax-vla-object->ename block-obj)) ) ) ) erg ) ;; --- Muster des AEUSSEREN Trennsteg-Blocks, der das Separator_SP-Symbol ;; und den Streckentyp-Marker traegt --- ;; ssg-sep-typ-xdata-schreiben (ssg_ks_insert.lsp) markiert bauzeitig NICHT ;; das Separator_SP-Symbol selbst, sondern seinen Verpacker ;; Staustrecke_Separator_SP_300_mm - der Grund: Separator_SP steckt als EIN ;; einziges, von der DWG-Blockdefinition geteiltes Sub-INSERT in JEDER ;; Staustrecke_Separator_SP_300_mm-Instanz (Block-Referenzen teilen sich ihre ;; Definition), eine XDATA-Markierung dort waere also fuer JEDEN Separator ;; der ganzen Zeichnung identisch. Staustrecke_Separator_SP_300_mm selbst ist ;; dagegen pro Einfuegung eine EIGENE Instanz mit eigenem Handle - genau dort ;; setzt der Bau seine Markierung. (defun csv:pattern-nested-separator-aussen () "Staustrecke_Separator_SP_300_mm*" ) ;; --- Naechstliegenden Record aus einer csv:nested-welt-records-Liste zu ;; einem Weltpunkt finden --- (planare Distanz x/y reicht: die Symbole ;; sitzen praktisch am selben Punkt wie ihr Verpacker, siehe ;; csv:pattern-nested-separator-aussen) (defun csv:nested-record-naechster (pt records / best best-d rec dx dy d) (setq best nil best-d nil) (foreach rec records (setq dx (- (car (nth 3 rec)) (car pt))) (setq dy (- (cadr (nth 3 rec)) (cadr pt))) (setq d (+ (* dx dx) (* dy dy))) (if (or (null best-d) (< d best-d)) (progn (setq best rec) (setq best-d d)) ) ) best ) ;; --- Temporaere Kopie je verpacktem Separator_SP-Symbol --- ;; Setzt csv:nested-welt-records + csv:block-einfuegen-welt zusammen: fuer ;; jeden Fund eine ECHTE Kopie DESSELBEN Blocks an derselben Weltlage. ;; Die AS-/ES-Kettenenden laufen NICHT mehr hierueber - fuer sie setzt ;; csv:asmark-aktualisieren einen dauerhaften Marker (siehe dort). ;; ;; proxy-liste-Eintrag: (proxy-ename wrapper-ename typ (x y z) strecke-typ). ;; strecke-typ = "VF"/"GF"/nil, gelesen von ssg-sep-typ-xdata-lesen AM ;; AEUSSEREN Trennsteg-Insert (csv:pattern-nested-separator-aussen), NICHT am ;; Separator_SP-Symbol selbst (das ist Block-Definitions-geteilt, siehe dort) ;; und NICHT vom Wrapper-Blocknamen abgeleitet (fruehere Fehlannahme, siehe ;; lib/dump_vf_kette_inhalt.py): ein einzelner VF_n/GF_n-Wrapper kann intern ;; mehrfach zwischen Foerderer- und Gefaellestrecke-Abschnitten wechseln, der ;; Marker sitzt daher direkt am jeweiligen Separator-Insert (gesetzt bauzeitig ;; in vf_linienzug.lsp/Gefaellestrecke.lsp/vf_standard.lsp/vf_etage.lsp, ;; direkt nach dessen Einfuegung). Zuordnung Symbol<->Trennsteg ueber die ;; naechstliegende Weltposition (beide sitzen praktisch am selben Punkt). (defun csv:sep-proxies-erzeugen ( / ms recs recs-aussen rec aussen-rec proxy proxy-liste) (setq recs (csv:nested-welt-records (csv:pattern-nested-separator))) (setq recs-aussen (csv:nested-welt-records (csv:pattern-nested-separator-aussen))) (if recs (progn (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (foreach rec recs (setq aussen-rec (csv:nested-record-naechster (nth 3 rec) recs-aussen)) (setq proxy (csv:block-einfuegen-welt ms (nth 2 rec) (nth 3 rec) (nth 4 rec) (nth 5 rec) (nth 6 rec) (nth 7 rec) (cdr (assoc 2 (entget (nth 0 rec)))))) (if proxy (setq proxy-liste (cons (list proxy (nth 0 rec) (csv:proxy-typ (nth 2 rec)) (nth 3 rec) (if aussen-rec (ssg-sep-typ-xdata-lesen (nth 1 aussen-rec)))) proxy-liste))) ) ) ) (reverse proxy-liste) ) ;; --- Temporaere Kopie je verpacktem uebrigen VF_n/GF_n-Baustein (Bogen/ ;; Streckenelement/Umlenkstation/Motorstation) --- ;; Analog zu csv:sep-proxies-erzeugen, aber ohne die dortige "aussen"/XDATA- ;; Zusatzlogik (die existiert nur fuer Separator wegen SSG_SEP_TYP) und ohne ;; ZUORDNUNG-Zuweisung: diese Elemente sind keine einem Carrier zugeordneten ;; Sensoren, sondern die Geometrie des Carriers (VF_n/GF_n) selbst - ARTINR/ ;; LAYER kommen direkt aus den ATTDEFs der kopierten Original-Blockdefinition ;; (ssg-attrib-read auf die Kopie), wie bei Separator. ;; ;; proxy-liste-Eintrag: (proxy-ename wrapper-ename teileart-key (x y z)). ;; teileart-key (aus csv:element-teileart) wird NICHT ins JSON geschrieben - ;; Python klassifiziert die TeileArt ohnehin ueber block_name + die vier ;; pattern_nested_*-Keys aus cfg/export.cfg, wie jede andere Familie auch. (defun csv:element-proxies-erzeugen ( / ms recs rec proxy proxy-liste) (setq recs (csv:nested-welt-records (csv:pattern-nested-element))) (if recs (progn (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (foreach rec recs (setq proxy (csv:block-einfuegen-welt ms (nth 2 rec) (nth 3 rec) (nth 4 rec) (nth 5 rec) (nth 6 rec) (nth 7 rec) (cdr (assoc 2 (entget (nth 0 rec)))))) (if proxy (setq proxy-liste (cons (list proxy (nth 0 rec) (csv:element-teileart (nth 2 rec)) (nth 3 rec)) proxy-liste))) ) ) ) (reverse proxy-liste) ) ;; --- Temporaere Element-Kopien nach dem Export wieder entfernen --- ;; Eigene, minimale Loeschfunktion statt csv:sep-proxies-loeschen wieder- ;; zuverwenden: *cs-sep-fix-by-handle*/*cs-sep-typ-by-handle*/ ;; *csv-sepliste-id-by-handle* bleiben separator-/AS-/ES-spezifisch, diese ;; Elemente haben keine Entsprechung davon. ;; ;; Drei unabhaengige Gruende, die Kopien trotzdem stehen zu lassen (ODER- ;; verknuepft): der dialoggesteuerte Haken "Element-Kopien behalten" ;; (*csv-export-elemente-behalten*), der Haken "Zuordnung pruefen" ;; (*csv-export-pruef-zuordnung* - zeigt zusammen mit den stehenbleibenden ;; ZZ_UNIT_MARKER-Rechtecken, welche Kopie zu welcher Einheit gehoert), und ;; der bestehende, als TEMPORAER dokumentierte Debug-Schalter ;; "csv_leave_proxies" (ssg_dbg.lsp) - dieser bleibt unveraendert und ;; steuert weiterhin zusaetzlich auch die Separator-Proxies ;; (csv:sep-proxies-loeschen). (defun csv:element-proxies-loeschen (proxy-liste / behalten) (setq behalten (or *csv-export-elemente-behalten* *csv-export-pruef-zuordnung* (and (car (atoms-family 1 '("DBG-SCHALTER-P"))) (dbg-schalter-p "csv_leave_proxies")))) (if behalten (princ (strcat "\n[EXPORT] csv_leave_proxies=1: " (itoa (length proxy-liste)) " Element-Proxy-Kopie(n) bleiben in der Zeichnung" " (Abschalten: (dbg-schalter-off \"csv_leave_proxies\"))")) (foreach rec proxy-liste (entdel (car rec))) ) (princ) ) ;; --- ZUORDNUNG der temporaeren Separator-Kopien aus ihrem Wrapper setzen --- ;; MUSS nach ssg-id-check-all laufen: erst dann steht die ID des Wrapper- ;; Blocks (VF_n/GF_n/KREISEL_n) fest - ein frisch gebauter Wrapper kann beim ;; Erzeugen der Kopien noch gar keine ID haben. ;; ;; Die Zuordnung eines VERPACKTEN Separators ist keine Schaetzung, sondern ;; bekannt: er steckt in genau diesem Wrapper. Ein Separator, der in einem ;; VF-Block mit ID 0010 verpackt ist, bekommt also ZUORDNUNG = 0010. Die ;; geometrische Zuordnung in count_sep_scan.lsp (Carrier-Boundingbox bzw. ;; naechster Carrier) wuerde diesen Wert bei jedem Lauf neu berechnen und ggf. ;; ueberschreiben - bei ueberlappenden Boxen (Kettenende an einem Kreisel) ;; landet der Separator dort leicht beim Nachbarn. Darum wird die bekannte ;; Zuordnung ueber *cs-sep-fix-by-handle* (Key = Entity-Handle der Kopie) ;; festgenagelt; cs-zuordnung-lauf uebernimmt sie unveraendert und zaehlt den ;; Separator beim richtigen Carrier. ;; ;; Gleich nebenbei wird der bauzeitig ermittelte Streckentyp (VF/GF) dieses ;; EINZELNEN Separators (nth 4 rec, siehe csv:sep-proxies-erzeugen) ueber ;; *cs-sep-typ-by-handle* festgehalten. csv:block-to-json schreibt den Wert ;; als "strecke_typ" mit in die Proxy-Zeile. NICHT vom Wrapper-Blocknamen ;; ableiten (fruehere Fehlannahme) - ein einzelner VF_n/GF_n-Wrapper kann ;; intern mehrfach zwischen VF- und GF-Abschnitten wechseln. ;; proxy-liste = Records (proxy-ename wrapper-ename typ (x y z) strecke-typ), ;; siehe csv:sep-proxies-erzeugen. Rueckgabe: Anzahl festgenagelter Kopien. (defun csv:sep-proxies-zuordnung-setzen (proxy-liste / rec proxy wrapper wrapper-id handle gesetzt ohne-id strecke-typ) (setq gesetzt 0 ohne-id 0) (setq *cs-sep-fix-by-handle* nil) (setq *cs-sep-typ-by-handle* nil) (foreach rec proxy-liste (setq proxy (nth 0 rec)) (setq wrapper (nth 1 rec)) (setq handle (cdr (assoc 5 (entget proxy)))) (setq strecke-typ (nth 4 rec)) (if strecke-typ (setq *cs-sep-typ-by-handle* (cons (cons handle strecke-typ) *cs-sep-typ-by-handle*))) (setq wrapper-id (cdr (assoc "ID" (ssg-attrib-read wrapper)))) (if (and wrapper-id (> (strlen wrapper-id) 0)) (progn (ssg-attrib-set-on proxy (list (cons "ZUORDNUNG" wrapper-id))) (setq *cs-sep-fix-by-handle* (cons (cons handle wrapper-id) *cs-sep-fix-by-handle*)) (setq gesetzt (1+ gesetzt)) ) ;; Wrapper ohne ID-Attribut (Altbestand ohne ID-ATTDEF): keine bekannte ;; Zuordnung - die Kopie faellt auf die geometrische Zuordnung zurueck. (setq ohne-id (1+ ohne-id)) ) ) (if (> gesetzt 0) (princ (ssg-textf "exp-sep-zuordnung" (list (itoa gesetzt))))) (if (> ohne-id 0) (princ (ssg-textf "exp-sep-zuordnung-ohne-id" (list (itoa ohne-id))))) gesetzt ) ;; --- Globale Zuordnung sepliste-Eintrag -> ID der zugehoerigen Kopie --- ;; Key = Handle des VF_n/GF_n-Wrappers, Wert = Alist ((lfdnr . "0031") ...). ;; Wird von csv:sepliste-ids-setzen NACH der ID-Vergabe gefuellt, von ;; csv:block-to-json beim Schreiben des "sepliste"-Arrays gelesen und von ;; csv:sep-proxies-loeschen wieder zurueckgesetzt - die IDs gehoeren den ;; temporaeren Kopien dieses EINEN Exportlaufs. (setq *csv-sepliste-id-by-handle* nil) ;; --- Einen sepliste-Eintrag mit der ID seines Bauteils vermerken --- ;; Zwei Quellen schreiben in dieselbe Zuordnung - die dauerhaften AS/ES-Marker ;; (csv:asmark-ids-setzen) und die temporaeren Separator-Kopien ;; (csv:sepliste-ids-setzen). Beide muessen sich den Eintrag EINES Wrappers ;; teilen: ein zweites Paar (handle . alist) waere fuer assoc unsichtbar, die ;; zuerst eingetragene Liste wuerde immer gewinnen. Darum hier zusammenfuehren ;; statt vorne anzuhaengen. (defun csv:sepliste-id-merken (handle lfdnr id / eintrag) (setq eintrag (assoc handle *csv-sepliste-id-by-handle*)) (if eintrag (setq *csv-sepliste-id-by-handle* (subst (cons handle (append (cdr eintrag) (list (cons lfdnr id)))) eintrag *csv-sepliste-id-by-handle*)) (setq *csv-sepliste-id-by-handle* (cons (cons handle (list (cons lfdnr id))) *csv-sepliste-id-by-handle*)) ) id ) ;; --- Abstands-Schwelle (mm) fuer die Meldung einer auffaelligen Zuordnung --- ;; Oberhalb dieses Abstands zwischen sepliste-Koordinate und tatsaechlicher ;; Lage der zugehoerigen Kopie wird gemeldet (die Zuordnung selbst bleibt ;; gueltig, siehe csv:sepliste-paare). Grosszuegig angesetzt: der SEP-Eintrag ;; nennt den Einfuegepunkt des Trennstegs (Staustrecke_Separator_SP_300_mm), ;; die Kopie das darin steckende Sensor-Symbol - ein Versatz in dieser ;; Groessenordnung ist normal, benachbarte Kettenglieder liegen dagegen ;; deutlich weiter auseinander (Staustrecken-Module ab 500 mm). (defun csv:sepliste-abstand-warnung-mm () 500.0) ;; --- sepliste-Eintraege und ausgepackte Kopien einander zuordnen --- ;; eintraege = ((typ lfdnr x y) ...) wie ssg-sepliste-xdata-lesen sie liefert. ;; proxies = ((typ x y) ...) - Reihenfolge beliebig, der INDEX in dieser ;; Liste (0-basiert) ist der Schluessel im Ergebnis. ;; Rueckgabe: ((lfdnr index abstand) ...), aufsteigend nach lfdnr; Eintraege ;; ohne Partner fehlen darin. ;; ;; Zugeordnet wird nur innerhalb desselben Typmarkers (AS/ES/SEP) und ;; EXKLUSIV: alle Paare eines Typs werden nach Abstand sortiert, das kuerzeste ;; zuerst genommen, danach sind Eintrag UND Kopie verbraucht. Das ist bewusst ;; nicht "je Eintrag die naechste Kopie" (so macht es map_separator_kette_items ;; in export_csv.py): waehlen zwei Eintraege dieselbe Kopie, bleibt eine Kopie ;; ohne Eintrag und ein Eintrag ohne ID. Die exklusive Variante ist ausserdem ;; gegen EINEN fehlerhaften Koordinatenwert unempfindlich - alle uebrigen ;; Eintraege finden ihre Kopie ueber den kurzen Abstand zuerst, der fehlerhafte ;; bekommt den Rest zugeteilt (mit entsprechend grossem Abstand, den ;; csv:sepliste-ids-setzen meldet). ;; ;; Die Sortierung ist eine STRIKTE Totalordnung (Abstand, dann lfdnr, dann ;; Index): vl-sort wirft Elemente weg, die unter der Vergleichsfunktion als ;; gleich gelten - zwei Paare mit identischem Abstand wuerden sonst zu einem ;; verschmelzen und ein Eintrag bliebe ohne ID. ;; ;; Reine Rechenfunktion (keine Zeichnung, keine Datei) - getestet in ;; tests/test_unit.lsp (tu-tests-export, Testfaelle "csv:sepliste-paare/*"). (defun csv:sepliste-paare (eintraege proxies / kandidaten e p i dx dy benutzt-e benutzt-p erg) (setq kandidaten nil) (foreach e eintraege (setq i 0) (foreach p proxies (if (= (nth 0 e) (nth 0 p)) (progn (setq dx (- (nth 2 e) (nth 1 p))) (setq dy (- (nth 3 e) (nth 2 p))) (setq kandidaten (cons (list (sqrt (+ (* dx dx) (* dy dy))) (nth 1 e) i) kandidaten)) ) ) (setq i (1+ i)) ) ) (setq kandidaten (vl-sort kandidaten (function (lambda (a b) (cond ((/= (nth 0 a) (nth 0 b)) (< (nth 0 a) (nth 0 b))) ((/= (nth 1 a) (nth 1 b)) (< (nth 1 a) (nth 1 b))) (t (< (nth 2 a) (nth 2 b))) ))))) (setq erg nil benutzt-e nil benutzt-p nil) (foreach k kandidaten (if (and (not (member (nth 1 k) benutzt-e)) (not (member (nth 2 k) benutzt-p))) (progn (setq benutzt-e (cons (nth 1 k) benutzt-e)) (setq benutzt-p (cons (nth 2 k) benutzt-p)) (setq erg (cons (list (nth 1 k) (nth 2 k) (nth 0 k)) erg)) ) ) ) (vl-sort erg (function (lambda (a b) (< (car a) (car b))))) ) ;; --- Nach der ID-Vergabe: ID jeder Kopie an ihren sepliste-Eintrag haengen --- ;; proxy-liste = Records (proxy-ename wrapper-ename typ (x y z) strecke-typ) ;; aus csv:sep-proxies-erzeugen (das 5. Feld wird hier nicht gebraucht). ;; MUSS nach ssg-id-check-all laufen: vorher hat eine frisch erzeugte Kopie ;; noch keine ID. ;; ;; Ergebnis steht in *csv-sepliste-id-by-handle*; csv:block-to-json schreibt ;; es als Feld "id" in jeden sepliste-Eintrag. Damit muss der Python-Teil die ;; Kette nicht mehr ueber Koordinaten-Naehe auf reale Teile zurueckrechnen - ;; die Zuordnung steht bereits im Export. ;; Rueckgabe: Anzahl der Eintraege, die eine ID bekommen haben. (defun csv:sepliste-ids-setzen (proxy-liste / wrapper-enames rec wrapper ed bname handle app sepliste eigene proxies paare paar proxy-rec id typen e relevant gesetzt ohne-id fehlend) (setq gesetzt 0 ohne-id 0) ;; Wrapper einsammeln (jeder nur einmal, in Reihenfolge seiner ersten Kopie). (setq wrapper-enames nil) (foreach rec proxy-liste (if (not (member (nth 1 rec) wrapper-enames)) (setq wrapper-enames (cons (nth 1 rec) wrapper-enames)))) (foreach wrapper (reverse wrapper-enames) (setq ed (entget wrapper)) (setq bname (cdr (assoc 2 ed))) (setq handle (cdr (assoc 5 ed))) (setq app (cond ((wcmatch (strcase bname) "VF_*") "SSG_VF_SEP") ((wcmatch (strcase bname) "GF_*") "SSG_GF_SEP") (t nil))) (setq sepliste (if (and app (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN")))) (ssg-sepliste-xdata-lesen wrapper app))) (if sepliste (progn ;; Nur die Kopien DIESES Wrappers, in Erzeugungsreihenfolge - der Index ;; im Ergebnis von csv:sepliste-paare zeigt in genau diese Liste. (setq eigene nil) (foreach rec proxy-liste (if (eq (nth 1 rec) wrapper) (setq eigene (cons rec eigene)))) (setq eigene (reverse eigene)) (setq proxies (mapcar (function (lambda (r) (list (nth 2 r) (car (nth 3 r)) (cadr (nth 3 r))))) eigene)) (setq paare (csv:sepliste-paare sepliste proxies)) (foreach paar paare (setq proxy-rec (nth (nth 1 paar) eigene)) (setq id (cdr (assoc "ID" (ssg-attrib-read (nth 0 proxy-rec))))) (if (and id (> (strlen id) 0)) (progn (csv:sepliste-id-merken handle (nth 0 paar) id) (setq gesetzt (1+ gesetzt)) ) (setq ohne-id (1+ ohne-id)) ) ;; Auffaellig weit auseinander: die sepliste-Koordinate passt nicht ;; zur tatsaechlichen Lage des Bauteils (bekannter Fehlerfall: ;; gespiegelte x-Koordinate beim Bau). Die Zuordnung bleibt gueltig - ;; sie entsteht exklusiv, nicht ueber diesen Abstand -, wird aber ;; gemeldet, damit die Ursache nicht unbemerkt bleibt. (if (> (nth 2 paar) (csv:sepliste-abstand-warnung-mm)) (princ (ssg-textf "exp-sepliste-abstand" (list bname (nth 2 proxy-rec) (itoa (nth 0 paar)) (rtos (nth 2 paar) 2 0)))) ) ) ;; Fehlende Partner NUR unter den Typen zaehlen, die diese Liste ;; ueberhaupt bedient: AS/ES kommen hier nicht vor (dafuer gibt es die ;; Marker, siehe csv:asmark-ids-setzen), ihre Eintraege waeren sonst ;; jedes Mal als "ohne Kopie" gemeldet. (setq typen nil) (foreach rec eigene (if (not (member (nth 2 rec) typen)) (setq typen (cons (nth 2 rec) typen)))) (setq relevant 0) (foreach e sepliste (if (member (nth 0 e) typen) (setq relevant (1+ relevant)))) (setq fehlend (- relevant (length paare))) (if (> fehlend 0) (princ (ssg-textf "exp-sepliste-ohne-proxy" (list bname (itoa fehlend))))) ) ) ) (if (> gesetzt 0) (princ (ssg-textf "exp-sepliste-ids" (list (itoa gesetzt))))) (if (> ohne-id 0) (princ (ssg-textf "exp-sepliste-ohne-id" (list (itoa ohne-id))))) gesetzt ) ;; =========================================================================== ;; Foerdereinheit/Gefaelleeinheit-Gruppierung (ZZ_UNIT_MARKER) ;; =========================================================================== ;; Fasst die Einzelbausteine einer VF_n/GF_n-Kette (Boegen, Strecken, Umlenk-/ ;; Motorstation, siehe csv:element-proxies-erzeugen) wieder zu Einheiten ;; zusammen: abwechselnd Foerdereinheit (VF) / Gefaelleeinheit (GF), je EINE ;; Zeile mit K1 vom ersten, K2 vom letzten enthaltenen Element. Laeuft rein ;; export-seitig (kein Bau-Code-Eingriff) - Einheiten-Grenzen kommen aus der ;; sepliste (SEP/AS/ES in echter Bau-Reihenfolge, XDATA-lfdnr) plus dem ;; bereits vorhandenen SSG_SEP_TYP je Separator (VF/GF), NICHT aus der ;; unzuverlaessigen csv:nested-welt-records-Listenreihenfolge (siehe ;; Kommentar dort - fuer einen einzelnen Wrapper doppelt umgekehrt) und NICHT ;; aus L_VF_m/L_GF_m (die zaehlen pro Segment, nicht pro Einheit - ein VF- ;; Einheit kann mehrere L_VF_m-Eintraege haben, GF1/GF2-Rampen einer VF- ;; Einheit landen im selben L_GF_m wie eigenstaendige GF-Stuecke, siehe ;; vfl-block-erstellen-Kommentar in vf_linienzug.lsp). ;; --- Sepliste-Eintraege um strecke-typ und verlaessliche Weltposition ;; anreichern --- ;; sepliste = ((typ lfdnr x y) ...) wie ssg-sepliste-xdata-lesen liefert ;; (XDATA-Ebene - deren x/y sind der ROHE Gruppencode-10-Punkt ;; des Bau-Primitivs und koennen gespiegelt/verschoben sein, ;; siehe die sepliste-x/y-Bereinigung im JSON-Export; hier NICHT ;; als Positionsquelle verwendet, nur zur Paarung mit dem echten ;; Proxy per csv:sepliste-paare, wie an anderer Stelle bereits ;; etabliert). ;; sep-proxies-eigene = NUR die sep-proxies-Records (siehe ;; csv:sep-proxies-erzeugen) DIESES Wrappers, in ;; Erzeugungsreihenfolge. ;; asmarks-eigene = NUR die asmark-Records (marker-ename wrapper-ename ;; typ lfdnr) DIESES Wrappers, aus csv:asmark-aktualisieren. ;; Rueckgabe: ((typ lfdnr strecke-typ welt-pt) ...) in lfdnr-Reihenfolge. ;; strecke-typ = nil fuer AS/ES (wird von csv:sepliste-partition vom ;; Nachbarn geerbt) bzw. fuer einen SEP-Eintrag ohne gefundenen Partner. ;; welt-pt = (x y z) der ECHTEN, verlaesslichen Proxy-/Marker-Position (SEP ;; ueber sep-proxies-eigene, AS/ES ueber den asmark-Entity-Einfuegepunkt), ;; oder nil, falls kein Partner gefunden wurde. (defun csv:sepliste-mit-strecke-typ (sepliste sep-proxies-eigene asmarks-eigene / proxies paare paar-by-lfdnr paar erg e strecke-typ welt-pt m) (setq proxies (mapcar (function (lambda (r) (list (nth 2 r) (car (nth 3 r)) (cadr (nth 3 r))))) sep-proxies-eigene)) (setq paare (csv:sepliste-paare sepliste proxies)) (setq paar-by-lfdnr nil) (foreach paar paare (setq paar-by-lfdnr (cons (cons (nth 0 paar) (nth 1 paar)) paar-by-lfdnr))) (setq erg nil) (foreach e sepliste (setq strecke-typ nil welt-pt nil) (cond ((= (nth 0 e) "SEP") (setq paar (assoc (nth 1 e) paar-by-lfdnr)) (if paar (progn (setq strecke-typ (nth 4 (nth (cdr paar) sep-proxies-eigene))) (setq welt-pt (nth 3 (nth (cdr paar) sep-proxies-eigene))) ) ) ) ((member (nth 0 e) (list "AS" "ES")) (setq m nil) (foreach kand asmarks-eigene (if (and (null m) (= (nth 2 kand) (nth 0 e)) (= (nth 3 kand) (itoa (nth 1 e)))) (setq m kand))) (if m (setq welt-pt (cdr (assoc 10 (entget (nth 0 m)))))) ) ) (setq erg (cons (list (nth 0 e) (nth 1 e) strecke-typ welt-pt) erg)) ) (reverse erg) ) ;; --- Ersten SEP-typ in der Liste finden (Vorschau fuer AS) --- ;; Eine Kette beginnt immer mit einer Foerdereinheit (AS haengt am ersten ;; SEP-Eintrag, falls vorhanden) - Default "VF", falls die Kette gar keinen ;; Separator hat (reine Foerdereinheit ohne jeden Zwischenhalt). (defun csv:sepliste-erster-sep-typ (sepliste-typisiert / e) (setq e (car sepliste-typisiert)) (cond ((null e) "VF") ((and (= (nth 0 e) "SEP") (nth 2 e)) (nth 2 e)) (t (csv:sepliste-erster-sep-typ (cdr sepliste-typisiert))) ) ) ;; --- Sepliste (mit strecke-typ) in Einheiten-Spannen partitionieren --- ;; sepliste-typisiert = ((typ lfdnr strecke-typ welt-pt) ...) in lfdnr- ;; Reihenfolge (Rueckgabe von csv:sepliste-mit-strecke-typ). ;; ;; Lauflaengen-Kodierung ueber den EFFEKTIVEN Typ jedes Eintrags, EIN ;; Vorwaerts-Durchlauf mit einer einzigen mitgefuehrten Zustandsvariable ;; "aktueller-typ" (das strecke-typ des zuletzt gesehenen SEP-Eintrags): ;; - AS: effektiver Typ = das strecke-typ des ERSTEN SEP-Eintrags der ;; ganzen Kette (Vorschau, csv:sepliste-erster-sep-typ) - eine Kette ;; beginnt immer mit einer Foerdereinheit. ;; - SEP: effektiver Typ = sein eigenes strecke-typ (faellt es aus - alter ;; Bestand ohne Marker -, bleibt der zuletzt bekannte Typ stehen). ;; "aktueller-typ" wird auf diesen Wert aktualisiert. ;; - ES: effektiver Typ = "aktueller-typ" (der zuletzt gesehene SEP, ;; also die Einheit, die gerade offen ist). ;; Eine neue Einheit beginnt, sobald sich der effektive Typ gegenueber dem ;; Vorgaenger aendert; gleich bleibender Typ (inkl. zwei aufeinanderfolgender ;; SEP-Eintraege desselben Typs, die GEMEINSAM eine einzige Einheit ;; bracketieren - HundM05-Beispiel: SEP3=GF,SEP4=GF sind EINE Gefaelleeinheit) ;; haengt an die offene Einheit an. Kein Sonderfall-Code fuer "erster/zweiter ;; SEP dieses Typs" noetig - die Lauflaengen-Regel deckt beides ab. ;; ;; Rueckgabe: ((einheit-typ (lfdnr ...)) ...) in Kettenreihenfolge. ;; Reine Rechenfunktion (keine Zeichnung, keine Datei) - getestet in ;; tests/test_unit.lsp. (defun csv:sepliste-partition (sepliste-typisiert / erg e eff aktueller-typ offen-typ offen-lfdnrs) (setq aktueller-typ (csv:sepliste-erster-sep-typ sepliste-typisiert)) (setq erg nil offen-typ nil offen-lfdnrs nil) (foreach e sepliste-typisiert (cond ((= (nth 0 e) "SEP") (setq aktueller-typ (cond ((nth 2 e)) (aktueller-typ))) (setq eff aktueller-typ)) (t (setq eff aktueller-typ)) ) (if (and offen-typ (/= eff offen-typ)) (progn (setq erg (cons (list offen-typ (reverse offen-lfdnrs)) erg)) (setq offen-typ nil offen-lfdnrs nil) ) ) (setq offen-typ eff) (setq offen-lfdnrs (cons (nth 1 e) offen-lfdnrs)) ) (if offen-typ (setq erg (cons (list offen-typ (reverse offen-lfdnrs)) erg))) (reverse erg) ) ;; --- Weltposition eines sepliste-lfdnr aus der typisierten Liste holen --- (defun csv:sepliste-typisiert-pos (lfdnr sepliste-typisiert / treffer) (setq treffer nil) (foreach e sepliste-typisiert (if (and (null treffer) (= (nth 1 e) lfdnr)) (setq treffer e))) (if treffer (nth 3 treffer)) ) ;; --- 2D-Skalarprodukt zweier Vektoren (x y) --- (defun csv:dot2 (a b) (+ (* (car a) (car b)) (* (cadr a) (cadr b)))) ;; --- Elemente den Einheiten-Spannen zuordnen --- ;; unit-spans = Rueckgabe von csv:sepliste-partition: ;; ((einheit-typ (lfdnr ...)) ...). ;; sepliste-typisiert = Rueckgabe von csv:sepliste-mit-strecke-typ (liefert ;; die Weltposition jedes Rand-lfdnr). ;; element-proxies-eigene = NUR die element-proxies-Records (siehe ;; csv:element-proxies-erzeugen) DIESES Wrappers, ;; (proxy-ename wrapper-ename teileart-key (x y z)). ;; ;; Vorgehen: fuer jede Spanne den ERSTEN und LETZTEN Rand-lfdnr in eine ;; Weltposition aufloesen (Start-/Endpunkt der Spanne entlang der Kette). ;; Kettenrichtung = Einheitsvektor vom allerersten zum allerletzten ;; Rand-lfdnr der GESAMTEN sepliste (AS->ES). Jedes Element wird per ;; Skalarprodukt auf diese Richtung projiziert (t-Wert) und der Spanne ;; zugeordnet, deren [t-start,t-ende]-Intervall am naechsten liegt (bei ;; eindeutiger Enthaltung: diese Spanne; sonst die mit dem kleinsten ;; Abstand zum naeheren Rand - kein Element bleibt unzugeordnet). ;; ;; Rueckgabe: Liste parallel zu unit-spans, je Spanne eine Liste ;; zugeordneter element-proxies-Records. (defun csv:element-unit-zuordnung (unit-spans sepliste-typisiert element-proxies-eigene / grenzen span lfdnrs start-pos ende-pos richtung erste-pos letzte-pos laenge t-werte erg elem t-elem beste-i beste-abstand i t-start t-ende abstand) ;; Kettenrichtung ueber den allerersten/allerletzten Rand-lfdnr der ;; gesamten sepliste bestimmen (nicht nur der ersten/letzten Spanne - bei ;; einer Kette mit nur einer Spanne sind das dieselben Werte). (setq erste-pos nil letzte-pos nil) (foreach e sepliste-typisiert (if (and (null erste-pos) (nth 3 e)) (setq erste-pos (nth 3 e)))) (foreach e (reverse sepliste-typisiert) (if (and (null letzte-pos) (nth 3 e)) (setq letzte-pos (nth 3 e)))) (if (or (null erste-pos) (null letzte-pos) (< (distance erste-pos letzte-pos) 1e-6)) ;; Entartete Kette (kein Rand-Punkt aufloesbar, oder AS=ES-Position) - ;; keine sinnvolle Projektion moeglich, jede Spanne bekommt keine ;; Elemente zugeordnet (Aufrufer behandelt das wie "keine Elemente"). (setq richtung '(1.0 0.0)) (progn (setq richtung (list (- (car letzte-pos) (car erste-pos)) (- (cadr letzte-pos) (cadr erste-pos)))) (setq laenge (sqrt (csv:dot2 richtung richtung))) (if (> laenge 1e-6) (setq richtung (list (/ (car richtung) laenge) (/ (cadr richtung) laenge))) (setq richtung '(1.0 0.0)) ) ) ) ;; Je Spanne: [t-start, t-ende] aus dem ersten/letzten Rand-lfdnr. (setq grenzen nil) (foreach span unit-spans (setq lfdnrs (cadr span)) (setq start-pos (csv:sepliste-typisiert-pos (car lfdnrs) sepliste-typisiert)) (setq ende-pos (csv:sepliste-typisiert-pos (last lfdnrs) sepliste-typisiert)) (setq t-start (if start-pos (csv:dot2 (list (- (car start-pos) (car erste-pos)) (- (cadr start-pos) (cadr erste-pos))) richtung) 0.0)) (setq t-ende (if ende-pos (csv:dot2 (list (- (car ende-pos) (car erste-pos)) (- (cadr ende-pos) (cadr erste-pos))) richtung) 0.0)) (setq grenzen (cons (list (min t-start t-ende) (max t-start t-ende)) grenzen)) ) (setq grenzen (reverse grenzen)) ;; Je Element: t-Wert projizieren, naechstliegende Spanne waehlen. Jeder ;; Eintrag wird zunaechst als (t-elem . elem) gefuehrt, damit die Spanne ;; am Ende NACH t SORTIERT werden kann - das liefert "erstes"/"letztes" ;; Element einer Spanne entlang der Kettenrichtung (fuer K1/K2 der ;; Einheiten-Zeile, siehe csv:unitmark-aktualisieren), ohne auf die ;; unzuverlaessige csv:nested-welt-records-Reihenfolge angewiesen zu sein. (setq erg nil) (foreach span unit-spans (setq erg (cons nil erg))) (setq erg (reverse erg)) (foreach elem element-proxies-eigene (setq t-elem (csv:dot2 (list (- (car (nth 3 elem)) (car erste-pos)) (- (cadr (nth 3 elem)) (cadr erste-pos))) richtung)) (setq beste-i 0 beste-abstand nil i 0) (foreach g grenzen (setq abstand (cond ((and (>= t-elem (car g)) (<= t-elem (cadr g))) 0.0) ((< t-elem (car g)) (- (car g) t-elem)) (t (- t-elem (cadr g))) )) (if (or (null beste-abstand) (< abstand beste-abstand)) (progn (setq beste-abstand abstand) (setq beste-i i))) (setq i (1+ i)) ) (setq erg (csv:liste-setzen erg beste-i (cons (cons t-elem elem) (nth beste-i erg)))) ) ;; Je Spanne nach t sortieren, dann den t-Wert wieder abstreifen. (mapcar (function (lambda (paare) (mapcar 'cdr (vl-sort paare (function (lambda (a b) (< (car a) (car b)))))))) erg) ) ;; --- Element einer Liste an Index i ersetzen (0-basiert) --- ;; Kleiner Hilfsbaustein, da AutoLISP kein eingebautes "setf (nth i lst)" hat. (defun csv:liste-setzen (lst i wert / j out) (setq out nil j 0) (foreach e lst (setq out (cons (if (= j i) wert e) out)) (setq j (1+ j)) ) (reverse out) ) ;; --- Bounding-Box-Vereinigung mehrerer Entities --- ;; Verallgemeinert csv:get-bbox (siehe dort) von einer Entity auf eine Liste: ;; min/max ueber alle vla-getboundingbox-Ergebnisse, gleiche Fehler- ;; behandlung/Diagnose-Zaehler (*csv-bbox-fail-count*), gleiche Rueckgabeform ;; (cx cy cz dx dy dz). Entities, deren Box nicht ermittelt werden kann, ;; werden uebersprungen (nicht die ganze Vereinigung verworfen) - eine ;; teilweise Union ist besser als gar keine. (defun csv:get-bbox-union (enames / obj res ename minpt maxpt gmin gmax dz min-hoehe) (setq gmin nil gmax nil) (foreach ename enames (setq obj (vlax-ename->vla-object ename)) (vl-catch-all-apply 'vla-update (list obj)) (setq res (vl-catch-all-apply '(lambda ( / ll ur) (vla-getboundingbox obj 'll 'ur) (list (csv:pt->list ll) (csv:pt->list ur))))) (if (vl-catch-all-error-p res) (progn (setq *csv-bbox-fail-count* (1+ (cond (*csv-bbox-fail-count*) (0)))) (if (null *csv-bbox-fail-first*) (setq *csv-bbox-fail-first* (strcat "(" (cond ((cdr (assoc 2 (entget ename)))) ("?")) ") " (vl-catch-all-error-message res)))) ) (progn (setq minpt (car res)) (setq maxpt (cadr res)) (setq gmin (if gmin (mapcar 'min gmin minpt) minpt)) (setq gmax (if gmax (mapcar 'max gmax maxpt) maxpt)) ) ) ) (if (and gmin gmax) (progn (setq dz (- (caddr gmax) (caddr gmin))) (setq min-hoehe (csv:bb-minimum-height-mm)) (if (< dz min-hoehe) (setq dz min-hoehe)) (list (/ (+ (car gmin) (car gmax)) 2.0) (/ (+ (cadr gmin) (cadr gmax)) 2.0) (/ (+ (caddr gmin) (caddr gmax)) 2.0) (- (car gmax) (car gmin)) (- (cadr gmax) (cadr gmin)) dz ) ) nil ) ) ;; =========================================================================== ;; AS-/ES-Marker (ZZ_ASES_MARKER) ;; =========================================================================== ;; Ein kleines Rechteck, das der Export an JEDES AS-/ES-Ende einer VF_n/GF_n- ;; Kette setzt und das dort DAUERHAFT stehen bleibt. Es ist zweierlei: ;; ;; Sichtbarmachung - die Kettenenden stecken verpackt in der Wrapper- ;; Blockdefinition (AS_Element_*/ES_Element_*) und sind in der Zeichnung ;; sonst weder anklickbar noch als eigenes Objekt erkennbar. ;; ID-Traeger - das (unsichtbare) ID-Attribut des Markers fuellt ;; ssg-id-check-all, und der naechste Export VERWENDET DENSELBEN MARKER ;; WIEDER. Ein AS/ES behaelt seine TeileId dadurch ueber Exportlaeufe ;; hinweg - anders als die temporaeren Separator-Kopien, die bei jedem Lauf ;; neu entstehen und neue IDs bekommen. ;; ;; Der Marker ist abgeleitete Geometrie: csv:asmark-aktualisieren baut bei ;; JEDEM Export alle Marker neu auf (Lage folgt damit automatisch einer ;; umgebauten Kette) und uebernimmt dabei nur die ID des bisherigen Markers. ;; Nicht wiederverwendete Marker werden geloescht - ein Marker ohne Kette ;; bleibt also nicht als Karteileiche stehen. (defun csv:asmark-blockname () "ZZ_ASES_MARKER") ;; Kantenlaenge (mm) des Rechtecks, aus cfg/export.cfg [Marker]. (defun csv:asmark-groesse-mm () (atof (export:cfg "Marker" "ases_groesse_mm" "200")) ) ;; Attribut-Schema des Markers. Alle ATTDEFs sind UNSICHTBAR ;; (ssg-attrib-make-defs setzt Flag 70=1) - sichtbar ist nur das Rechteck. ;; ID - fuellt ssg-id-check-all; wird beim naechsten Export uebernommen ;; ZUORDNUNG - ID des VF_n/GF_n-Wrappers, zu dem das Kettenende gehoert ;; (zugleich der Schluessel, ueber den der Marker wiedergefunden ;; wird, siehe csv:asmark-finden) ;; TYP - "AS" oder "ES", wie in der sepliste (ssg-sepliste-sammeln) ;; LFDNR - lfdnr des zugehoerigen sepliste-Eintrags ;; ELEMENT - Blockname des echten Schleuselements (AS_Element_90_links_3D): ;; haelt die Variante (30/90, links/rechts, 2D/3D) fest, die der ;; Marker selbst nicht mehr zeigt ;; ARTINR - Sivas-Nummer aus dem Attribut des echten Elements (setq *csv-asmark-attrib-defs* '(("ID" "") ("ZUORDNUNG" "") ("TYP" "") ("LFDNR" "") ("ELEMENT" "") ("ARTINR" "")) ) ;; --- Blockdefinition des Markers bei Bedarf anlegen --- ;; Es gibt bewusst KEINE DWG dafuer: der Marker ist reine Hilfsgeometrie und ;; soll in jeder Zeichnung ohne Blockbibliothek entstehen koennen. Aufbau wie ;; bei den Geruest-Baugruppen (GeruestInsert.lsp): Geometrie + ATTDEFs in den ;; Modellraum zeichnen, alles seit lastEnt einsammeln, per "_.-BLOCK" zur ;; Definition machen (das entfernt die Vorlage-Entities wieder). ;; Die Geometrie liegt auf Layer "0", damit der Marker den Layer seiner ;; Blockreferenz annimmt (den setzt csv:asmark-aktualisieren aus cfg/layer.cfg). ;; ;; WICHTIG - der Auswahlsatz nimmt NUR die beiden hier erzeugten Entity-Typen ;; auf: (entlast) liefert bei einer Blockreferenz MIT Attributen die Referenz ;; selbst, und (entnext) steigt von dort in deren ATTRIB-Unterentities ab. Ohne ;; Filter landen also die Attribute des zuletzt eingefuegten Blocks (z.B. eines ;; gerade gebauten VF_n) mit im Auswahlsatz - "_.-BLOCK" verschiebt sie in die ;; neue Blockdefinition und der Block steht danach OHNE Attribute da (real ;; beobachtet: VF_5 verlor beim ersten Export saemtliche Attribute, inklusive ;; seiner ID). ;; Rueckgabe: Blockname oder nil. (defun csv:asmark-blockdef-sicherstellen ( / name h lastEnt ss e typ) (setq name (csv:asmark-blockname)) (if (tblsearch "BLOCK" name) name (progn (setq h (/ (csv:asmark-groesse-mm) 2.0)) (setq lastEnt (entlast)) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 (list (- h) (- h))) (cons 10 (list h (- h))) (cons 10 (list h h)) (cons 10 (list (- h) h)))) (ssg-attrib-make-defs *csv-asmark-attrib-defs* (/ h 2.0)) (setq ss (ssadd)) (setq e (if lastEnt (entnext lastEnt) (entnext))) (while e (setq typ (cdr (assoc 0 (entget e)))) (if (member typ '("LWPOLYLINE" "ATTDEF")) (ssadd e ss)) (setq e (entnext e)) ) (command "_.-BLOCK" name (list 0.0 0.0 0.0) ss "") (if (tblsearch "BLOCK" name) (progn (princ (ssg-textf "exp-asmark-blockdef" (list name))) name) (progn (princ (ssg-textf "exp-asmark-blockdef-fehler" (list name))) nil) ) ) ) ) ;; --- Vorhandene Marker der Zeichnung einsammeln --- ;; Rueckgabe: Liste von (ename zuordnung typ lfdnr id), alle Werte als String ;; (fehlende Attribute als ""). (defun csv:asmark-sammeln ( / ss i ename attribs out) (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 (csv:asmark-blockname))))) (if ss (progn (setq i 0) (while (setq ename (ssname ss i)) (setq attribs (ssg-attrib-read ename)) (setq out (cons (list ename (cond ((cdr (assoc "ZUORDNUNG" attribs))) ("")) (cond ((cdr (assoc "TYP" attribs))) ("")) (cond ((cdr (assoc "LFDNR" attribs))) ("")) (cond ((cdr (assoc "ID" attribs))) (""))) out)) (setq i (1+ i)) ) ) ) (reverse out) ) ;; --- Den Marker eines Kettenendes im Bestand suchen --- ;; Schluessel: Wrapper-ID + Typ + lfdnr (alles Strings). Bewusst NICHT ueber ;; die Position: eine Kette, die verschoben oder umgebaut wurde, soll ihre ;; TeileIds behalten. Ein Wrapper OHNE ID (frisch gebaut, ssg-id-check-all lief ;; noch nicht) findet folgerichtig nichts - seine Marker entstehen neu; die ;; ZUORDNUNG wird nach der ID-Vergabe nachgetragen (csv:asmark-ids-setzen), ;; sodass es beim naechsten Export passt. (defun csv:asmark-finden (bestand zuordnung typ lfdnr / m treffer) (foreach m bestand (if (and (null treffer) (= (nth 1 m) zuordnung) (= (nth 2 m) typ) (= (nth 3 m) lfdnr)) (setq treffer m) ) ) treffer ) ;; --- Alle AS-/ES-Marker der Zeichnung neu aufbauen --- ;; Laeuft VOR ssg-id-check-all (csv:export-vorbereiten): neue Marker haben dann ;; noch kein ID-Attribut und werden dort nummeriert, uebernommene tragen die ID ;; ihres Vorgaengers und behalten sie. ;; ;; Ablauf je VF_n/GF_n-Wrapper mit sepliste: ;; 1. Weltlage aller verpackten AS-/ES-Elemente holen (csv:nested-welt-records) ;; 2. sie den AS-/ES-Eintraegen der sepliste zuordnen (csv:sepliste-paare - ;; dieselbe exklusive Zuordnung wie bei den Separator-Kopien; SEP-Eintraege ;; finden hier keinen Partner und bleiben unberuehrt) ;; 3. je Paar den bisherigen Marker suchen, seine ID merken, ihn loeschen und ;; an der AKTUELLEN Lage neu setzen ;; Was danach im Bestand uebrig ist, gehoert zu keiner Kette mehr und wird ;; geloescht. ;; ;; Rueckgabe: Liste von Records (marker-ename wrapper-ename typ lfdnr) fuer ;; csv:asmark-ids-setzen. (defun csv:asmark-aktualisieren ( / recs bestand blockname ms wrapper-enames rec wrapper ed bname wrapper-id app sepliste eigene proxies paare paar elem lfdnr typ alt alt-id mark artinr m neu uebernommen verwaist ergebnis) (setq neu 0 uebernommen 0 verwaist 0) (setq recs (csv:nested-welt-records (csv:pattern-nested-schleus))) (setq bestand (csv:asmark-sammeln)) (setq blockname (if recs (csv:asmark-blockdef-sicherstellen))) (if blockname (progn (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq wrapper-enames nil) (foreach rec recs (if (not (member (nth 0 rec) wrapper-enames)) (setq wrapper-enames (cons (nth 0 rec) wrapper-enames)))) (foreach wrapper (reverse wrapper-enames) (setq ed (entget wrapper)) (setq bname (cdr (assoc 2 ed))) (setq wrapper-id (cond ((cdr (assoc "ID" (ssg-attrib-read wrapper)))) (""))) (setq app (cond ((wcmatch (strcase bname) "VF_*") "SSG_VF_SEP") ((wcmatch (strcase bname) "GF_*") "SSG_GF_SEP") (t nil))) (setq sepliste (if (and app (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN")))) (ssg-sepliste-xdata-lesen wrapper app))) (if sepliste (progn (setq eigene nil) (foreach rec recs (if (eq (nth 0 rec) wrapper) (setq eigene (cons rec eigene)))) (setq eigene (reverse eigene)) (setq proxies (mapcar (function (lambda (r) (list (csv:proxy-typ (nth 2 r)) (car (nth 3 r)) (cadr (nth 3 r))))) eigene)) (setq paare (csv:sepliste-paare sepliste proxies)) (foreach paar paare (setq lfdnr (nth 0 paar)) (setq elem (nth (nth 1 paar) eigene)) (setq typ (csv:proxy-typ (nth 2 elem))) (setq alt (csv:asmark-finden bestand wrapper-id typ (itoa lfdnr))) (setq alt-id "") (if alt (progn (setq alt-id (nth 4 alt)) (entdel (nth 0 alt)) (setq bestand (vl-remove alt bestand)) (setq uebernommen (1+ uebernommen)) ) (setq neu (1+ neu)) ) ;; Marker mit Skalierung 1.0 einfuegen - die Skalierung des ;; Elements gehoert dem Element, ein gestauchtes Marker-Rechteck ;; waere als Positionszeichen unbrauchbar. Orientierung folgt ;; dagegen dem Element (auch bei geneigter Kette). (setq mark (csv:block-einfuegen-welt ms blockname (nth 3 elem) (nth 4 elem) 1.0 1.0 1.0 bname)) (if mark (progn ;; ARTINR nur lesen, wenn der Sub-INSERT ueberhaupt ATTRIBs ;; fuehrt (Gruppe 66 = 1): ssg-attrib-read wandert per entnext ;; bis zum SEQEND - fehlt der, laeuft es ueber das Element ;; hinaus durch die restliche Blockdefinition und liefert das ;; ARTINR IRGENDEINES spaeteren Bausteins der Kette. (setq artinr "") (if (equal 1 (cdr (assoc 66 (entget (nth 1 elem))))) (setq artinr (cond ((cdr (assoc "ARTINR" (ssg-attrib-read (nth 1 elem))))) ("")))) (ssg-attrib-set-on mark (list (cons "ID" alt-id) (cons "ZUORDNUNG" wrapper-id) (cons "TYP" typ) (cons "LFDNR" (itoa lfdnr)) (cons "ELEMENT" (nth 2 elem)) (cons "ARTINR" artinr))) (ssg-layer-setzen mark "ases_marker") (setq ergebnis (cons (list mark wrapper typ lfdnr) ergebnis)) ) ) ) ) ) ) ) ) ;; Rest des Bestands: kein Kettenende mehr dahinter (Kette geloescht, Eintrag ;; entfallen, Wrapper ohne sepliste). Marker sind abgeleitete Geometrie - ;; ohne Kette bleiben sie nicht stehen. (foreach m bestand (entdel (nth 0 m)) (setq verwaist (1+ verwaist)) ) (if (or (> neu 0) (> uebernommen 0) (> verwaist 0)) (princ (ssg-textf "exp-asmark-bilanz" (list (itoa neu) (itoa uebernommen) (itoa verwaist))))) (reverse ergebnis) ) ;; --- Nach der ID-Vergabe: Marker-ID an den sepliste-Eintrag haengen --- ;; marker-liste = Records (marker-ename wrapper-ename typ lfdnr) aus ;; csv:asmark-aktualisieren. Zwei Aufgaben: ;; 1. ZUORDNUNG nachtragen - beim Setzen der Marker kann der Wrapper noch ;; keine ID gehabt haben (frisch gebaute Kette). Ohne sie faende der ;; NAECHSTE Export den Marker nicht wieder und legte ihn samt neuer ID ;; erneut an; die TeileId waere dann doch nicht stabil. ;; 2. die ID des Markers unter *csv-sepliste-id-by-handle* eintragen, damit ;; csv:block-to-json sie als Feld "id" am AS-/ES-Eintrag schreibt. ;; Rueckgabe: Anzahl der Eintraege mit ID. (defun csv:asmark-ids-setzen (marker-liste / rec mark wrapper handle wrapper-id id gesetzt ohne-id) (setq gesetzt 0 ohne-id 0) (foreach rec marker-liste (setq mark (nth 0 rec)) (setq wrapper (nth 1 rec)) (setq handle (cdr (assoc 5 (entget wrapper)))) (setq wrapper-id (cdr (assoc "ID" (ssg-attrib-read wrapper)))) (if (and wrapper-id (> (strlen wrapper-id) 0)) (ssg-attrib-set-on mark (list (cons "ZUORDNUNG" wrapper-id)))) (setq id (cdr (assoc "ID" (ssg-attrib-read mark)))) (if (and id (> (strlen id) 0)) (progn (csv:sepliste-id-merken handle (nth 3 rec) id) (setq gesetzt (1+ gesetzt)) ) (setq ohne-id (1+ ohne-id)) ) ) (if (> gesetzt 0) (princ (ssg-textf "exp-asmark-ids" (list (itoa gesetzt))))) (if (> ohne-id 0) (princ (ssg-textf "exp-sepliste-ohne-id" (list (itoa ohne-id))))) gesetzt ) ;; --- Temporaere Kopien (csv:sep-proxies-erzeugen / ;; csv:schleus-proxies-erzeugen) nach dem Export wieder entfernen --- ;; proxy-liste = Records (proxy-ename wrapper-ename typ (x y z)), nur der car ;; (die Kopie selbst) wird geloescht. ;; ;; Der Debug-Schalter "csv_leave_proxies" (ssg_dbg.lsp) unterdrueckt das ;; Loeschen: die Kopien bleiben zur Ansicht in der Zeichnung stehen, damit sich ;; die tatsaechliche Lage der exportierten Separatoren gegen die ;; sepliste-Koordinaten pruefen laesst. *cs-sep-fix-by-handle* und ;; *csv-sepliste-id-by-handle* werden trotzdem zurueckgesetzt - sie gelten nur ;; fuer den gerade gelaufenen Export. (defun csv:sep-proxies-loeschen (proxy-liste / behalten) (setq behalten (and (car (atoms-family 1 '("DBG-SCHALTER-P"))) (dbg-schalter-p "csv_leave_proxies"))) (if behalten (princ (strcat "\n[EXPORT] csv_leave_proxies=1: " (itoa (length proxy-liste)) " Separator-Proxy-Kopie(n) bleiben in der Zeichnung" " (Abschalten: (dbg-schalter-off \"csv_leave_proxies\"))")) (foreach rec proxy-liste (entdel (car rec))) ) (setq *cs-sep-fix-by-handle* nil) (setq *cs-sep-typ-by-handle* nil) (setq *csv-sepliste-id-by-handle* nil) (princ) ) ;; =========================================================================== ;; Foerdereinheit-/Gefaelleeinheit-Marker (ZZ_UNIT_MARKER) ;; =========================================================================== ;; Ein Rechteck, das der Export je Einheiten-Spanne (siehe ;; csv:sepliste-partition/csv:element-unit-zuordnung weiter oben) setzt und ;; dort DAUERHAFT stehen bleibt - analog zu ZZ_ASES_MARKER, aber auf die ;; Bounding-Box-Vereinigung der enthaltenen Elemente skaliert statt fest ;; quadratisch. Persistiert wie ZZ_ASES_MARKER ueber Exportlaeufe hinweg ;; (Wiederfinden ueber ZUORDNUNG+TYP+LFDNR), damit die TeileId stabil bleibt. ;; ;; Nur aktiv, wenn *csv-export-alle-elemente* NICHT gesetzt ist (siehe ;; Schalter weiter unten) - im Rohdaten-Modus werden keine neuen Marker ;; angelegt, ein Aufraeum-Durchlauf entfernt aber IMMER verwaiste Marker ;; (auch im Rohdaten-Modus - sonst blieben bei einem Wechsel gruppiert->roh ;; alte Marker als Karteileichen stehen). (defun csv:unitmark-blockname () "ZZ_UNIT_MARKER") ;; Attribut-Schema. Alle ATTDEFs unsichtbar (wie *csv-asmark-attrib-defs*). ;; ID - fuellt ssg-id-check-all, ueber Exportlaeufe stabil ;; ZUORDNUNG - ID des VF_n/GF_n-Wrappers (Schluessel zum Wiederfinden) ;; TYP - "VF" (Foerdereinheit) oder "GF" (Gefaelleeinheit) ;; LFDNR - 1-basierte Einheiten-Nummer INNERHALB des Wrappers (NICHT ;; der sepliste-lfdnr - eine frische Zaehlung je Einheit) ;; LAENGE_m - Summe der LAENGE/A-Attribute aller enthaltenen ;; Streckenelement-Mitglieder (Meter, als String) ;; ANZAHL_BOEGEN - Anzahl der enthaltenen Mitglieder mit TeileArt "BOGEN" ;; K1/K2 - KS_EIN des ERSTEN bzw. KS_AUS des LETZTEN Mitglieds der ;; Spanne, bereits als csv:trans-encode-String (wie K1-K4 ;; ueberall sonst im Export) - NICHT als rtos-Text: rtos ;; haengt an DIMZIN/LUPREC/LUNITS und ist fuer persistente ;; ATTDEF-Werte ungeeignet (siehe rtos-Hinweis in anderen ;; sepliste-Serialisierungen, ssg_ks_insert.lsp). Der ;; fertig kodierte String wird unveraendert zurueckgelesen, ;; kein Decode/Re-encode-Rundlauf noetig. (setq *csv-unitmark-attrib-defs* '(("ID" "") ("ZUORDNUNG" "") ("TYP" "") ("LFDNR" "") ("LAENGE_m" "") ("ANZAHL_BOEGEN" "") ("K1" "") ("K2" "")) ) ;; --- Blockdefinition des Markers bei Bedarf anlegen --- ;; 1x1-Einheitsquadrat auf Layer "0" (wie csv:asmark-blockdef-sicherstellen) - ;; wird beim Einfuegen ueber sx/sy auf die tatsaechliche Bounding-Box- ;; Ausdehnung der Einheit skaliert (csv:block-einfuegen-welt), anders als der ;; feste ZZ_ASES_MARKER. Keine eigene DWG (reine Hilfsgeometrie). ;; Rueckgabe: Blockname oder nil. (defun csv:unitmark-blockdef-sicherstellen ( / name lastEnt ss e typ) (setq name (csv:unitmark-blockname)) (if (tblsearch "BLOCK" name) name (progn (setq lastEnt (entlast)) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 (list -0.5 -0.5)) (cons 10 (list 0.5 -0.5)) (cons 10 (list 0.5 0.5)) (cons 10 (list -0.5 0.5)))) (ssg-attrib-make-defs *csv-unitmark-attrib-defs* 0.05) (setq ss (ssadd)) (setq e (if lastEnt (entnext lastEnt) (entnext))) (while e (setq typ (cdr (assoc 0 (entget e)))) (if (member typ '("LWPOLYLINE" "ATTDEF")) (ssadd e ss)) (setq e (entnext e)) ) (command "_.-BLOCK" name (list 0.0 0.0 0.0) ss "") (if (tblsearch "BLOCK" name) (progn (princ (ssg-textf "exp-unitmark-blockdef" (list name))) name) (progn (princ (ssg-textf "exp-unitmark-blockdef-fehler" (list name))) nil) ) ) ) ) ;; --- Vorhandene Marker der Zeichnung einsammeln --- ;; Rueckgabe: Liste von (ename zuordnung typ lfdnr id), analog ;; csv:asmark-sammeln. (defun csv:unitmark-sammeln ( / ss i ename attribs out) (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 (csv:unitmark-blockname))))) (if ss (progn (setq i 0) (while (setq ename (ssname ss i)) (setq attribs (ssg-attrib-read ename)) (setq out (cons (list ename (cond ((cdr (assoc "ZUORDNUNG" attribs))) ("")) (cond ((cdr (assoc "TYP" attribs))) ("")) (cond ((cdr (assoc "LFDNR" attribs))) ("")) (cond ((cdr (assoc "ID" attribs))) (""))) out)) (setq i (1+ i)) ) ) ) out ) ;; --- Bestehenden Marker ueber (ZUORDNUNG, TYP, LFDNR) wiederfinden --- (defun csv:unitmark-finden (bestand zuordnung typ lfdnr / m treffer) (foreach m bestand (if (and (null treffer) (= (nth 1 m) zuordnung) (= (nth 2 m) typ) (= (nth 3 m) lfdnr)) (setq treffer m) ) ) treffer ) ;; --- Laenge (m) eines Streckenelement-Mitglieds aus seinem LAENGE/A- ;; Attribut lesen; 0.0 falls keins vorhanden --- (defun csv:unitmark-elem-laenge-mm (proxy-ename / attribs wert) (setq attribs (ssg-attrib-read proxy-ename)) (setq wert (cond ((cdr (assoc "LAENGE" attribs))) ((cdr (assoc "A" attribs))) (nil))) (if wert (atof wert) 0.0) ) ;; --- K1/K2 eines Mitglieds lesen, bereits als csv:trans-encode-String --- ;; Dieselbe KS_EIN/KS_AUS-Suche wie csv:get-k-kos-strings (nur EINE Ebene ;; tief in der Proxy-Blockdefinition, echte K1-K4 haben Vorrang). ks-ziel = ;; "K1" oder "K2" (Ziel-Slot wie dort). ;; Rueckgabe: 12-Zeichen Base64-String oder nil, falls das Mitglied kein ;; passendes KS traegt (z.B. das nie verwendete Vario_Kurve_*). (defun csv:unitmark-elem-ks (proxy-ename ks-ziel / ed pt rotation extrusion R-world psx psy psz blk-tbl sub-ent sub-ed sub-bname sub-pt sub-extrusion sub-pt-real is-real target treffer) (setq ed (entget proxy-ename)) (setq pt (cdr (assoc 10 ed))) (if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0))) (setq rotation (cond ((cdr (assoc 50 ed))) (0.0))) (setq extrusion (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0)))) (setq pt (mat3-mul-vec3 (mat3-ocs-matrix extrusion) pt)) (setq R-world (mat3-from-normal-rotation extrusion rotation)) (setq psx (cond ((cdr (assoc 41 ed))) (1.0))) (setq psy (cond ((cdr (assoc 42 ed))) (1.0))) (setq psz (cond ((cdr (assoc 43 ed))) (1.0))) (setq blk-tbl (tblsearch "BLOCK" (cdr (assoc 2 ed)))) (setq treffer nil) (if blk-tbl (progn (setq sub-ent (cdr (assoc -2 blk-tbl))) (while sub-ent (setq sub-ed (entget sub-ent)) (if (= (cdr (assoc 0 sub-ed)) "INSERT") (progn (setq sub-bname (strcase (cdr (assoc 2 sub-ed)))) (setq is-real (wcmatch sub-bname "K1,K2,K3,K4")) (setq target (cond (is-real sub-bname) ((or (= sub-bname "KS_EIN") (= sub-bname "KSYS_EIN")) "K1") ((or (= sub-bname "KS_AUS") (= sub-bname "KSYS_AUS")) "K2") (t nil))) (if (and target (= target ks-ziel) (or is-real (null treffer))) (progn (setq sub-pt (cdr (assoc 10 sub-ed))) (if (null (caddr sub-pt)) (setq sub-pt (list (car sub-pt) (cadr sub-pt) 0.0))) (setq sub-extrusion (cond ((cdr (assoc 210 sub-ed))) ('(0.0 0.0 1.0)))) (setq sub-pt-real (mat3-mul-vec3 (mat3-ocs-matrix sub-extrusion) sub-pt)) (setq sub-pt-real (list (* psx (car sub-pt-real)) (* psy (cadr sub-pt-real)) (* psz (caddr sub-pt-real)))) (setq sub-pt-real (csv:local-to-world pt R-world sub-pt-real)) (setq treffer (csv:trans-encode (car sub-pt-real) (cadr sub-pt-real) (caddr sub-pt-real))) ) ) ) ) (setq sub-ent (entnext sub-ent)) ) ) ) treffer ) ;; --- Alle Foerdereinheit-/Gefaelleeinheit-Marker der Zeichnung neu ;; aufbauen --- ;; Laeuft VOR ssg-id-check-all (csv:export-vorbereiten), analog ;; csv:asmark-aktualisieren. sep-proxies/element-proxies/asmarks = die drei ;; bereits erzeugten Proxy-/Marker-Listen dieses Exportlaufs. ;; ;; Ist *csv-export-alle-elemente* gesetzt (Rohdaten-Modus): KEINE neuen ;; Marker anlegen, nur den kompletten vorhandenen Bestand aufraeumen (sonst ;; blieben bei einem Wechsel gruppiert->roh alte Marker als Karteileichen ;; stehen). ;; ;; Rueckgabe: Liste von Records (marker-ename wrapper-ename typ lfdnr) fuer ;; csv:unitmark-ids-setzen. (defun csv:unitmark-aktualisieren (sep-proxies element-proxies asmarks / blockname bestand ms wrapper-enames rec wrapper ed bname wrapper-id app sepliste sepliste-typisiert sep-eigene elem-eigene asmarks-eigene unit-spans zuordnungen span span-i typ lfdnrs zugeordnet alt alt-id mark bbox-enames bbox laenge-mm anzahl-boegen elem lfdnr-erstes lfdnr-letztes k1 k2 ergebnis neu uebernommen verwaist) (setq neu 0 uebernommen 0 verwaist 0) (setq bestand (csv:unitmark-sammeln)) ;; Neue Marker nur im GENAU gruppierten Modus anlegen - sowohl ;; "all_elements" als auch "separator_track" wollen keine ZZ_UNIT_MARKER, ;; der Aufraeum-Pass unten (verwaiste Marker loeschen) laeuft in JEDEM ;; Modus unbedingt weiter. (if (= *csv-export-modus* "group_vf_gf") (progn (setq blockname (csv:unitmark-blockdef-sicherstellen)) (if blockname (progn (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) ;; Wrapper einsammeln (jeder nur einmal) - Vereinigung ueber alle ;; drei Proxy-Listen, damit auch ein Wrapper OHNE Boegen/Strecken ;; (nur AS-Separator-ES, reine Einzel-Foerdereinheit) erfasst wird. (setq wrapper-enames nil) (foreach rec sep-proxies (if (not (member (nth 1 rec) wrapper-enames)) (setq wrapper-enames (cons (nth 1 rec) wrapper-enames)))) (foreach rec element-proxies (if (not (member (nth 1 rec) wrapper-enames)) (setq wrapper-enames (cons (nth 1 rec) wrapper-enames)))) (foreach rec asmarks (if (not (member (nth 1 rec) wrapper-enames)) (setq wrapper-enames (cons (nth 1 rec) wrapper-enames)))) (foreach wrapper (reverse wrapper-enames) (setq ed (entget wrapper)) (setq bname (cdr (assoc 2 ed))) (setq wrapper-id (cond ((cdr (assoc "ID" (ssg-attrib-read wrapper)))) (""))) (setq app (cond ((wcmatch (strcase bname) "VF_*") "SSG_VF_SEP") ((wcmatch (strcase bname) "GF_*") "SSG_GF_SEP") (t nil))) (setq sepliste (if (and app (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN")))) (ssg-sepliste-xdata-lesen wrapper app))) (if sepliste (progn (setq sep-eigene nil) (foreach rec sep-proxies (if (eq (nth 1 rec) wrapper) (setq sep-eigene (cons rec sep-eigene)))) (setq sep-eigene (reverse sep-eigene)) (setq elem-eigene nil) (foreach rec element-proxies (if (eq (nth 1 rec) wrapper) (setq elem-eigene (cons rec elem-eigene)))) (setq elem-eigene (reverse elem-eigene)) (setq asmarks-eigene nil) (foreach rec asmarks (if (eq (nth 1 rec) wrapper) (setq asmarks-eigene (cons rec asmarks-eigene)))) (setq asmarks-eigene (reverse asmarks-eigene)) (setq sepliste-typisiert (csv:sepliste-mit-strecke-typ sepliste sep-eigene asmarks-eigene)) (setq unit-spans (csv:sepliste-partition sepliste-typisiert)) (setq zuordnungen (csv:element-unit-zuordnung unit-spans sepliste-typisiert elem-eigene)) (setq span-i 0) (foreach span unit-spans (setq typ (car span)) (setq lfdnrs (cadr span)) ;; zugeordnet ist bereits NACH KETTENRICHTUNG SORTIERT ;; (csv:element-unit-zuordnung) - das erste Element liefert ;; K1, das letzte K2. (setq zugeordnet (nth span-i zuordnungen)) ;; Bounding-Box-Vereinigung ueber alle zugeordneten ;; Element-Proxies. Ist eine Spanne leer (z.B. eine ganz ;; kurze Gefaelleeinheit ohne eigenes Bogen-/Strecken- ;; Element zwischen zwei direkt benachbarten Separatoren), ;; entsteht fuer sie kein Marker - eine Einheit ohne jedes ;; zugeordnete Bauteil hat keine sinnvolle Geometrie. (setq bbox-enames nil) (foreach elem zugeordnet (setq bbox-enames (cons (nth 0 elem) bbox-enames))) (setq bbox (if bbox-enames (csv:get-bbox-union bbox-enames))) (if bbox (progn ;; Laenge/Anzahl Boegen aus den zugeordneten Elementen. (setq laenge-mm 0.0 anzahl-boegen 0) (foreach elem zugeordnet (if (= (nth 2 elem) "STRECKENELEMENT") (setq laenge-mm (+ laenge-mm (csv:unitmark-elem-laenge-mm (nth 0 elem))))) (if (= (nth 2 elem) "BOGEN") (setq anzahl-boegen (1+ anzahl-boegen))) ) ;; K1/K2: eigenes KS_EIN des ERSTEN, KS_AUS des ;; LETZTEN zugeordneten Elements (Kettenrichtungs- ;; Sortierung, siehe oben) - fehlt bei einem Element ;; das passende KS (z.B. das nie verwendete ;; Vario_Kurve_*), bleibt K1/K2 leer, kein Abbruch. (setq k1 (csv:unitmark-elem-ks (nth 0 (car zugeordnet)) "K1")) (setq k2 (csv:unitmark-elem-ks (nth 0 (last zugeordnet)) "K2")) (setq mark (csv:block-einfuegen-welt ms blockname (list (nth 0 bbox) (nth 1 bbox) (nth 2 bbox)) (mat3-rz 0.0) (max (nth 3 bbox) 1.0) (max (nth 4 bbox) 1.0) 1.0 bname)) (if mark (progn (setq alt (csv:unitmark-finden bestand wrapper-id typ (itoa (1+ span-i)))) (setq alt-id "") (if alt (progn (setq alt-id (nth 4 alt)) (entdel (nth 0 alt)) (setq bestand (vl-remove alt bestand)) (setq uebernommen (1+ uebernommen)) ) (setq neu (1+ neu)) ) (ssg-attrib-set-on mark (list (cons "ID" alt-id) (cons "ZUORDNUNG" wrapper-id) (cons "TYP" typ) (cons "LFDNR" (itoa (1+ span-i))) (cons "LAENGE_m" (rtos (/ laenge-mm 1000.0) 2 3)) (cons "ANZAHL_BOEGEN" (itoa anzahl-boegen)) (cons "K1" (cond (k1) (""))) (cons "K2" (cond (k2) (""))) )) (ssg-layer-setzen mark "ases_marker") (setq ergebnis (cons (list mark wrapper typ (1+ span-i)) ergebnis)) ) ) ) ) (setq span-i (1+ span-i)) ) ) ) ) ) ) ) ) ;; Rest des Bestands (auch im Rohdaten-Modus, wo bestand nie durch obige ;; Schleife verkleinert wurde): keine Kette/Einheit mehr dahinter. (foreach m bestand (entdel (nth 0 m)) (setq verwaist (1+ verwaist)) ) (if (or (> neu 0) (> uebernommen 0) (> verwaist 0)) (princ (ssg-textf "exp-unitmark-bilanz" (list (itoa neu) (itoa uebernommen) (itoa verwaist))))) (reverse ergebnis) ) ;; --- Nach der ID-Vergabe: ZUORDNUNG bereits gesetzt (anders als bei ;; ZZ_ASES_MARKER, siehe csv:unitmark-aktualisieren) - hier bleibt nur die ;; Bilanz-Meldung uebrig. Kein sepliste-Bezug (Einheiten sind nicht Teil der ;; sepliste selbst). --- (defun csv:unitmark-ids-setzen (marker-liste / rec mark id gesetzt ohne-id) (setq gesetzt 0 ohne-id 0) (foreach rec marker-liste (setq mark (nth 0 rec)) (setq id (cdr (assoc "ID" (ssg-attrib-read mark)))) (if (and id (> (strlen id) 0)) (setq gesetzt (1+ gesetzt)) (setq ohne-id (1+ ohne-id)) ) ) (if (> gesetzt 0) (princ (ssg-textf "exp-unitmark-ids" (list (itoa gesetzt))))) gesetzt ) ;; --- Relevante Bloecke sammeln --- ;; Filtert INSERT-Entities auf exportierbare Bloecke: ;; KR_* = Kreisel Compound-Bloecke ;; AP110* = Omniflo Geraden ;; Omniflo Boegen/Weichen = rein numerische Blocknamen (SivasNr) ;; Vario* = VarioFoerderer-Bloecke ;; GF_* = Gefaellestrecke Compound-Bloecke ;; ZZ_ASES_MARKER = die Marker der AS-/ES-Kettenenden einer VF_n/GF_n-Strecke ;; (siehe csv:asmark-aktualisieren; pattern_ases_marker in cfg/export.cfg). ;; Das Kettenende selbst steckt verpackt in der Wrapper-Blockdefinition und ;; waere sonst weder sichtbar noch exportierbar; der Marker vertritt es - ;; mit eigener, ueber Exportlaeufe stabiler ID und den Attributen ;; TYP/LFDNR/ELEMENT/ARTINR. ;; Separator_SP*/S-LP*, Scanner* = eigenstaendige Sensor-Bloecke (siehe ;; pattern_separator/pattern_scanner in cfg/export.cfg). Landen in ;; export_raw.json fuer BEIDE Exporte (EXPORTCSV/EXPORTSIVAS teilen sich ;; diese Sammlung) - export_csv.py gibt ihnen eigene TeileArt-Zeilen, ;; export_sivas.py schliesst sie bewusst wieder aus (siehe dort), da ihre ;; Anzahl schon ueber ANZAHL_SEPARATOR/ANZAHL_SCANNER an Kreisel/GF/VF ;; gezaehlt wird. ;; BTMT-Beladung*/SC_Entladung* = eigenstaendige BTMT Be-/Entladestationen ;; (siehe pattern_btmt_beladung/pattern_btmt_entladung in cfg/export.cfg, ;; ils-insert-station in SSG_LIB_Commands.lsp). Anders als Separator/ ;; Scanner werden sie von KEINEM anderen Element mitgezaehlt - export_csv.py ;; UND export_sivas.py fuehren sie beide als eigene TeileArt-Zeilen. ;; Eingang*/Ausgang* = Materialfluss-Ein-/Ausgangssymbole (siehe ;; pattern_eingang/pattern_ausgang in cfg/export.cfg, ils-insert-station in ;; SSG_LIB_Commands.lsp). Wie BTMT eigenstaendig, aber NUR fuer den ;; CSV-Export: export_csv.py gibt ihnen eigene TeileArt-Zeilen und traegt ;; sie - wie Separator/AS/ES - in die "TrackIds"-Spalte ein (auch auf ;; Kreiseln, siehe KREISEL_UMLAUF_TEILEARTEN in lib/export_neighbors.py); ;; export_sivas.py schliesst sie bewusst aus. ;; GR_* = Geruest-Baugruppen (siehe pattern_geruest in cfg/export.cfg, ;; GeruestInsert.lsp). Wie BTMT eigenstaendig und von keinem anderen ;; Element mitgezaehlt - export_csv.py UND export_sivas.py fuehren sie ;; beide als eigene TeileArt-Zeilen. ;; Gibt Auswahlsatz zurueck oder nil. (defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname ist-nested-element) (setq ss-all (ssget "X" (list (cons 0 "INSERT")))) (if (null ss-all) (setq ss-out nil) (progn (setq ss-out (ssadd)) (setq i 0) (while (setq ename (ssname ss-all i)) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) ;; Uebrige verpackte VF_n/GF_n-Bausteine (Boegen, gerade Foerderer-/ ;; Gefaellestrecken-Segmente, Umlenk-/Motorstation, siehe ;; csv:pattern-nested-element/csv:element-proxies-erzeugen): NUR im ;; Rohdaten-Modus (*csv-export-alle-elemente* = T) als eigene Export- ;; Zeile gesammelt. Im Default (gruppierter Modus, nil) fasst ;; csv:unitmark-aktualisieren sie zu Foerdereinheit-/Gefaelleeinheit- ;; Zeilen zusammen (pattern_unit_marker unten) - die Proxy-Kopien ;; selbst werden dann trotz Treffer auf pattern_strecke (Vario*/ ;; Staustrecke* per Praefix) explizit AUSGESCHLOSSEN, damit sie nicht ;; doppelt (einzeln UND als Teil der Einheiten-Zeile) erscheinen. (setq ist-nested-element (and (not (csv:export-alle-elemente-p)) (wcmatch bname (csv:pattern-nested-element)))) (if (and (not ist-nested-element) (or (wcmatch bname (export:pattern "pattern_kreisel" "KR_*,KREISEL_*,ECKRAD_*")) (wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*")) (wcmatch bname (export:pattern "pattern_strecke" "Vario*,Staustrecke*,AUS_Element*,EIN_Element*,VF_*,GF_*")) (wcmatch bname (export:pattern "pattern_ases_marker" "ZZ_ASES_MARKER*")) (wcmatch bname (export:pattern "pattern_separator" "Separator_SP*,S-LP*")) (wcmatch bname (export:pattern "pattern_scanner" "Scanner*")) (wcmatch bname (export:pattern "pattern_btmt_beladung" "BTMT-Beladung*")) (wcmatch bname (export:pattern "pattern_btmt_entladung" "SC_Entladung*")) (wcmatch bname (export:pattern "pattern_eingang" "Eingang*")) (wcmatch bname (export:pattern "pattern_ausgang" "Ausgang*")) (wcmatch bname (export:pattern "pattern_geruest" "GR_*")) (wcmatch bname (export:pattern "pattern_unit_marker" "ZZ_UNIT_MARKER*")) ;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen) ;; Rein LISP-intern (Python klassifiziert Omniflo stattdessen ;; ueber exakten Katalog-Match), daher fest im Code statt in ;; cfg/export.cfg. (wcmatch bname "#*") )) (ssadd ename ss-out) ) (setq i (1+ i)) ) (if (= (sslength ss-out) 0) (setq ss-out nil)) ) ) ss-out ) ;; --- HOEHE/DREHUNG aller Omniflo-Elemente still aktualisieren --- ;; Wird automatisch vor jedem Export aufgerufen. (defun omni:update-all-attribs ( / ss i ename ed bname teileart) (setq ss (ssget "X" (list (cons 0 "INSERT")))) (if ss (progn (setq i 0) (while (setq ename (ssname ss i)) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) (setq teileart (csv:get-attrib ename "TEILEART")) (if (or teileart (wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*"))) (progn (omni:set-hoehe-attrib ename) (omni:set-drehung-attrib ename) ) ) (setq i (1+ i)) ) ) ) ) ;; --- Gemeinsame Export-Funktion --- ;; Sammelt relevante Bloecke, schreibt JSON, ruft Python auf. ;; label = Anzeigename (z.B. "EXPORTCSV") ;; --- Export-Vorbereitung: Zeichnungszustand fuer den Export herrichten --- ;; Aus csv:run-export ausgelagert: alle Schritte, die VOR dem Sammeln/Schreiben ;; den Zeichnungszustand herrichten - Separator-Proxies einpacken, IDs ;; sicherstellen, Proxy-Zuordnung setzen, Omniflo-Attribute (HOEHE/DREHUNG) ;; aktualisieren, Separator-/Scanner-Zuordnung pruefen, global regenerieren und ;; die bbox-Fehlerdiagnose zuruecksetzen. Rueckgabe: die Liste ALLER erzeugten ;; Kopien - Separatoren UND AS/ES-Schleuselemente (der Aufrufer entfernt sie am ;; Ende wieder). label dient nur den Meldungen. (defun csv:export-vorbereiten (label / sep-proxies asmarks element-proxies unitmarks) ;; Verpackte Separator_SP-Symbole (siehe csv:sep-proxies-erzeugen) VOR der ;; ID-Vergabe durch temporaere, echte Kopien ersetzen - sie werden am Ende ;; von csv:run-export wieder entfernt (csv:sep-proxies-loeschen). (setq sep-proxies (csv:sep-proxies-erzeugen)) ;; Die AS-/ES-Kettenenden stecken ebenfalls verpackt im Wrapper, bekommen ;; aber KEINE temporaere Kopie, sondern einen DAUERHAFTEN Marker ;; (ZZ_ASES_MARKER): er macht das Kettenende in der Zeichnung sichtbar und ;; traegt dessen ID ueber Exportlaeufe hinweg (siehe csv:asmark-*). (setq asmarks (csv:asmark-aktualisieren)) ;; Die uebrigen Kettenbausteine (Boegen, gerade Foerderer-/Gefaellestrecken- ;; Segmente, Umlenk-/Motorstation) ebenso wie die Separatoren durch ;; temporaere Kopien ersetzen - siehe csv:element-proxies-erzeugen. MUSS wie ;; sep-proxies VOR ssg-id-check-all stehen, damit die frischen Kopien in ;; dessen Lauf mit nummeriert werden (siehe ssg-id-collect-blocks, ;; ssg_id.lsp). Im Modus "separator_track" werden gar keine Element-Kopien ;; erzeugt - dieser Modus kennt nur AS/ES/Separator. (setq element-proxies (if (csv:export-separator-track-p) nil (csv:element-proxies-erzeugen))) ;; Foerdereinheit-/Gefaelleeinheit-Marker (ZZ_UNIT_MARKER) aus den drei ;; obigen Proxy-/Marker-Listen bauen - MUSS nach ihnen (braucht ihre ;; Weltpositionen) und VOR ssg-id-check-all stehen (frische Marker werden ;; dort mit nummeriert), siehe csv:unitmark-aktualisieren. (setq unitmarks (csv:unitmark-aktualisieren sep-proxies element-proxies asmarks)) ;; Vor dem Export: IDs aller Bloecke sicherstellen und Duplikate korrigieren. ;; Erst hier - also erst nachdem ALLE Kopien aus allen Wrapper-Bloecken ;; stehen - wird ueberhaupt eine ID vergeben. ssg-id-check-all ermittelt ;; dabei zuerst das globale Maximum der bereits vergebenen IDs (Phase 0) ;; und nummeriert die noch ID-losen Kopien erst danach - sonst bekaemen sie ;; IDs, die die Wrapper (VF_n/GF_n/Kreisel) selbst schon tragen. (princ (ssg-textf "exp-check-ids" (list label))) (ssg-id-check-all) ;; Jetzt steht die ID jedes Wrappers fest: die bekannte (nicht geratene) ;; ZUORDNUNG der verpackten Separatoren auf die Wrapper-ID setzen und fuer ;; cs-zuordnung-lauf festnageln. Nur fuer die Separator-Kopien - die ;; AS/ES-Marker sind keine Sensoren und werden nicht gezaehlt (ihre ;; ZUORDNUNG setzt csv:asmark-ids-setzen). (csv:sep-proxies-zuordnung-setzen sep-proxies) ;; Ebenfalls erst jetzt moeglich: die ID jedes Bauteils an seinen sepliste- ;; Eintrag haengen (csv:block-to-json schreibt sie als Feld "id" mit) - ;; AS/ES ueber die Marker, SEP ueber die temporaeren Kopien. Beide schreiben ;; in dieselbe Zuordnung, die hier einmal zurueckgesetzt wird. (setq *csv-sepliste-id-by-handle* nil) (csv:asmark-ids-setzen asmarks) (csv:sepliste-ids-setzen sep-proxies) (csv:unitmark-ids-setzen unitmarks) ;; Vor dem Export HOEHE/DREHUNG aller Omniflo-Elemente aktualisieren (princ (ssg-textf "exp-update-hoehe-drehung" (list label))) (omni:update-all-attribs) ;; Vor dem Export: Separator-/Scanner-Zuordnung pruefen und ;; ANZAHL_SEPARATOR/ANZAHL_SCANNER an Kreisel/Streckengruppe/ ;; Gefaellestrecke aktualisieren (siehe count_sep_scan.lsp, ;; cs-zuordnung-lauf). Scanner ausserhalb jeder Carrier-Boundingbox ;; werden dabei per Abstand zugeordnet (ZUORDNUNG-Attribut = Carrier- ;; ID) und - bei mehrdeutigem Abstand - als "strittig" markiert; ;; *cs-scanner-warnung-by-handle* wird von csv:block-to-json unten ;; ausgelesen und haengt den Warnungstext an den betroffenen Scanner- ;; Block im JSON an. verbose=nil haelt die Export-Konsole kompakt ;; (die ausfuehrliche Detailzeile je Carrier gibt es nur beim ;; interaktiven Befehl ZAEHLE_SEP_SCAN). ;; ;; Der Lauf ist teuer (Boundingbox+Regen je Carrier und Sensor), ;; darum vorher der billige Schnelltest cs-zuordnung-noetig-p (nur ;; Attribute lesen, keine Boundingboxen): nur bei leeren ZUORDNUNG- ;; Eintraegen oder abweichenden Summen wird tatsaechlich neu gerechnet. (ssg-ensure "count_sep_scan") (if (atoms-family 1 '("cs-zuordnung-lauf")) (if (cs-zuordnung-noetig-p) (cs-zuordnung-lauf label nil) (princ (ssg-textf "sens-skip" (list label))) ) ) ;; Vor dem Sammeln/Schreiben EINMAL global regenerieren. vla-getboundingbox ;; liefert nur auf regenerierten Objekten eine gueltige Box; ein pro-Objekt ;; vla-update (csv:get-bbox) reicht dafuer in der Praxis nicht immer aus ;; (fuehrte real dazu, dass in einem Export ALLE Bloecke ohne bbox blieben). ;; REGENALL erzwingt die vollstaendige Regeneration der gesamten Zeichnung. (vl-catch-all-apply '(lambda () (command "_.REGENALL"))) ;; bbox-Fehlerdiagnose fuer diesen Lauf zuruecksetzen (siehe csv:get-bbox). (setq *csv-bbox-fail-count* 0) (setq *csv-bbox-fail-first* nil) ;; Nur die TEMPORAEREN Kopien zurueckgeben - die AS/ES-Marker bleiben ;; bewusst in der Zeichnung stehen und duerfen nicht mitgeloescht werden. (list sep-proxies element-proxies)) ;; --- Python-Export-Skript aufrufen und Ergebnis auswerten --------------- ;; Aus csv:run-export ausgelagert: das fertige raw-JSON (out-pfad) an das ;; Python-Skript py-name uebergeben, synchron ausfuehren und den Exitcode ;; auswerten (kein stiller Fehlschlag). Arbeitet ausschliesslich ueber die ;; uebergebenen Pfade/Namen und die Umgebung (DXFM_LIB/DXFM_DATA/DXFM_LOG) - ;; keine Zeichnungs-/Sammel-Logik mehr, daher gut fuer sich testbar. ;; label/out-dir dienen nur den Meldungen bzw. dem Ergebnis-Pfad. (defun csv:python-aufrufen (label out-dir out-pfad py-name csv-name / py-skript ergebnis-pfad py-exe log-pfad rc) ;; Python-Skript aufrufen. DXFM_LIB muss gesetzt sein - fehlt es ;; (z.B. weil BricsCAD nicht ueber bin/start_briscad.bat gestartet ;; wurde und die Umgebungsvariablen daher nie in diesen Prozess ;; vererbt wurden), wuerde das folgende strcat sonst mit einem ;; kryptischen Lisp-Fehler ("bad argument type ") abbrechen. (if (null (getenv "DXFM_LIB")) (princ (ssg-textf "exp-dxfm-lib-missing" (list label))) (progn (setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name)) (if (findfile py-skript) (progn (setq ergebnis-pfad (strcat out-dir "/" (export:dwg-praefix) csv-name)) (setq py-exe (export:python-exe)) (setq log-pfad (strcat (cond ((getenv "DXFM_LOG")) (out-dir)) "/export_python.log")) (princ (ssg-textf "exp-python-exe" (list label py-exe))) (princ (ssg-textf "exp-calling-python" (list label))) ;; Synchron ausfuehren und Exitcode auswerten - ein stiller ;; Fehlschlag (z.B. WindowsApps-Platzhalter statt Interpreter) ;; darf nicht mehr als "Export gestartet" durchgehen. (setq rc (export:run-python py-exe py-skript (list out-pfad (getenv "DXFM_DATA") ergebnis-pfad) log-pfad)) (cond ((null rc) (princ (ssg-textf "exp-python-call-failed" (list label)))) ((/= rc 0) (princ (ssg-textf "exp-python-error" (list label rc log-pfad))) (export:log-ausgeben log-pfad 12) ;; Exitcode 49 (Store-Platzhalter direkt) bzw. 9009 (cmd.exe: ;; "Befehl nicht gefunden") = kein brauchbarer Interpreter. ;; Gezielter Hinweis, wie er korrekt gesetzt wird. (if (or (= rc 49) (= rc 9009) (export:python-store-stub-p py-exe)) (princ (ssg-text "exp-python-store-hint")) )) ((not (findfile ergebnis-pfad)) (princ (ssg-textf "exp-csv-missing" (list label ergebnis-pfad log-pfad))) (export:log-ausgeben log-pfad 12)) (t (princ (ssg-textf "exp-export-done" (list label ergebnis-pfad)))) ) ) (princ (ssg-textf "exp-python-not-found" (list label py-skript))) ) ) ) ) ;; py-name = Python-Skript-Name (z.B. "export_csv.py") ;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv") ;; include-bbox = T -> Bounding-Box je Block ermitteln und mit exportieren ;; (siehe csv:block-to-json); fuer EXPORTSIVAS nil. (defun csv:run-export (label py-name csv-name include-bbox / ss i ename fh out-pfad first-block count out-dir sep-proxies element-proxies vorbereitung-ergebnis) ;; Zeichnungszustand fuer den Export herrichten (Proxies, IDs, Zuordnung, ;; Attribut-Update, Sep/Scan-Zaehlung, REGENALL, bbox-Reset) - ausgelagert. ;; Rueckgabe: (sep-proxies element-proxies), beide unten wieder zu entfernen. (setq vorbereitung-ergebnis (csv:export-vorbereiten label)) (setq sep-proxies (nth 0 vorbereitung-ergebnis)) (setq element-proxies (nth 1 vorbereitung-ergebnis)) (princ (ssg-textf "exp-collect-blocks" (list label))) (setq ss (csv:collect-export-blocks)) (if (null ss) (progn (princ (ssg-textf "exp-no-blocks-found" (list label))) (princ) ) (progn (setq count (sslength ss)) (princ (ssg-textf "exp-blocks-found" (list label count))) ;; Ausgabeordner: DXFM_RESULTS, ausser *export-test-override* ist gesetzt ;; (nur waehrend TEST_EXPORT_ALL, siehe tests/test_export_all.lsp). ;; WICHTIG: Hier bewusst KEIN (setenv "DXFM_RESULTS" ...) verwenden! ;; (setenv ...) schreibt in BricsCAD dauerhaft in die Profil-Registry ;; und ueberlebt damit jeden Neustart - ein einziger Testlauf wuerde ;; DXFM_RESULTS fuer alle zukuenftigen Sitzungen unwiderruflich auf den ;; Testordner umbiegen. *export-test-override* ist eine reine ;; Lisp-Variable (nur Prozess-/Sitzungsspeicher) und daher sicher. (setq out-dir (if *export-test-override* *export-test-override* (getenv "DXFM_RESULTS"))) (if (not (vl-file-directory-p out-dir)) (vl-mkdir out-dir)) (princ (ssg-textf "exp-output-dir" (list label out-dir))) ;; JSON-Datei zusammenbauen (setq out-pfad (strcat out-dir "/" (export:filename "raw_json_datei"))) (setq fh (open out-pfad "w")) (if (null fh) (progn (princ (ssg-textf "exp-file-open-error" (list label out-pfad))) (princ) ) (progn (write-line "[" fh) (setq i 0) (setq first-block T) (while (setq ename (ssname ss i)) (if (not first-block) (write-line "," fh) ) (write-line (csv:block-to-json ename include-bbox) fh) (setq first-block nil) (setq i (1+ i)) ) (write-line "]" fh) (close fh) (princ (ssg-textf "exp-json-written" (list label out-pfad))) ;; bbox-Fehler dieses Laufs melden (falls csv:get-bbox scheiterte) - ;; nennt Anzahl und die erste Fehlermeldung samt Block, damit die ;; Ursache fehlender Bounding-Boxen sofort sichtbar ist statt still ;; im JSON zu fehlen. (if (and *csv-bbox-fail-count* (> *csv-bbox-fail-count* 0)) (princ (ssg-textf "exp-bbox-fail" (list (itoa *csv-bbox-fail-count*) (cond (*csv-bbox-fail-first*) ("?")))))) ;; Python-Export-Skript aufrufen (ausgelagert, siehe oben). (csv:python-aufrufen label out-dir out-pfad py-name csv-name) ) ) ) ) ;; Temporaere Separator-/Element-Kopien wieder entfernen - sie haben ihren ;; Zweck (ID-Vergabe + JSON-Zeile ueber die obigen, unveraenderten ;; Sammel-Funktionen) erfuellt. Die AS-/ES-Marker (ZZ_ASES_MARKER) bleiben ;; bewusst stehen (siehe csv:export-vorbereiten). (csv:sep-proxies-loeschen sep-proxies) (csv:element-proxies-loeschen element-proxies) (princ) ) ;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen --- (defun c:EXPORTSIVAS () (csv:run-export "EXPORTSIVAS" (export:filename "sivas_script") (export:filename "sivas_csv") nil) ) ;; --- EXPORTCSV: Einfache Item-Liste aller Bloecke (ohne Summierung) --- ;; Ermittelt zusaetzlich je Block eine Bounding-Box (siehe csv:get-bbox), ;; die im Python-Skript als Position/Boundingbox-Spalten ausgegeben wird. (defun c:EXPORTCSV () (csv:run-export "EXPORTCSV" (export:filename "csv_script") (export:filename "csv_csv") T) ) ;; --- CSV_EXPORT_KONFIG: Dialog fuer Export-Modus + Proxy-Sichtbarkeit --- (defun csv:export-konfig-init ( / idx) (setq idx (cond ((= *csv-export-modus* "all_elements") "1") ((= *csv-export-modus* "separator_track") "2") (t "0"))) (set_tile "modus" idx) (set_tile "pruef_zuordnung" (if *csv-export-pruef-zuordnung* "1" "0")) (set_tile "elemente_behalten" (if *csv-export-elemente-behalten* "1" "0")) ) (defun csv:export-konfig-accept ( / idx) (setq idx (get_tile "modus")) (csv:export-modus-setzen (cond ((= idx "1") "all_elements") ((= idx "2") "separator_track") (t "group_vf_gf"))) (setq *csv-export-pruef-zuordnung* (= (get_tile "pruef_zuordnung") "1")) (setq *csv-export-elemente-behalten* (= (get_tile "elemente_behalten") "1")) ) (defun c:CSV_EXPORT_KONFIG () (ssg-dialog-run (strcat (getenv "DXFM_DCL") "/csv_export_konfig.dcl") "csv_export_konfig" 'csv:export-konfig-init 'csv:export-konfig-accept ) (princ) ) ;; ============================================================ ;; OMNIFLO HOEHE/DREHUNG AKTUALISIEREN ;; ============================================================ ;; --- Attribut-Wert eines INSERT-Blocks nach Tag lesen --- (defun csv:get-attrib (ename tag / obj ed typ atag) (setq obj (entnext ename)) (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") (= (strcase (cdr (assoc 2 ed))) (strcase tag))) (progn (setq obj nil) (setq atag (cdr (assoc 1 ed)))) (setq obj (entnext obj)) ) ) ) ) atag ) ;; --- Hoehe eines Omniflo-Blocks aus der Zeichnung ermitteln --- ;; Liest z-Koordinate des Einfuegepunkts. ;; Falls der Block KS_EIN, KS_AUS oder K1-K4 enthaelt, ;; wird die minimale Z-Koordinate dieser Unterelemente + Block-Z verwendet. (defun omni:get-block-hoehe (ename / ed bname pt z-insert blk-tbl sub-ent sub-ed sub-bname sub-pt z-list z-min) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) (setq pt (cdr (assoc 10 ed))) (setq z-insert (if (caddr pt) (caddr pt) 0.0)) (setq blk-tbl (tblsearch "BLOCK" bname)) (if (null blk-tbl) z-insert (progn (setq sub-ent (entnext (cdr (assoc -2 blk-tbl)))) (setq z-list nil) (while sub-ent (setq sub-ed (entget sub-ent)) (if (= (cdr (assoc 0 sub-ed)) "INSERT") (progn (setq sub-bname (strcase (cdr (assoc 2 sub-ed)))) (if (wcmatch sub-bname (export:pattern "pattern_ks_subblocks" "KS_EIN,KS_AUS,K1,K2,K3,K4")) (progn (setq sub-pt (cdr (assoc 10 sub-ed))) (setq z-list (cons (if (caddr sub-pt) (caddr sub-pt) 0.0) z-list)) ) ) ) ) (setq sub-ent (entnext sub-ent)) ) (if z-list (progn (setq z-min (car z-list)) (foreach z (cdr z-list) (if (< z z-min) (setq z-min z)) ) (+ z-insert z-min) ) z-insert ) ) ) ) ;; --- HOEHE-Attribut eines Omniflo-Blocks setzen --- ;; Liest Z-Koordinate (ggf. aus KS-Unterblock) und schreibt als HOEHE-Attribut. (defun omni:set-hoehe-attrib (ename / hoehe) (setq hoehe (omni:get-block-hoehe ename)) (ssg-attrib-set-on ename (list (cons "HOEHE" (rtos hoehe 2 1)))) hoehe ) ;; --- DREHUNG-Attribut eines Omniflo-Blocks setzen --- ;; Liest CAD-Rotationswinkel (Gruppe 50, Bogenmass) und schreibt als DREHUNG-Attribut. (defun omni:set-drehung-attrib (ename / ed rotation deg) (setq ed (entget ename)) (setq rotation (cdr (assoc 50 ed))) (if (null rotation) (setq rotation 0.0)) (setq deg (* (/ rotation pi) 180.0)) (ssg-attrib-set-on ename (list (cons "DREHUNG" (rtos deg 2 1)))) deg ) ;; ============================================================ ;; C:OMNI_UPDATE_ATTRIBS - HOEHE und DREHUNG aller Omniflo-Elemente aktualisieren ;; Setzt HOEHE aus Z-Koordinate (bzw. min. KS-Sub-Block) und ;; DREHUNG aus CAD-Rotationswinkel fuer alle Bloecke mit TEILEART-Attribut. ;; ============================================================ (defun c:OMNI_UPDATE_ATTRIBS ( / ss i ename ed bname teileart count) (setq ss (ssget "X" (list (cons 0 "INSERT")))) (if (null ss) (princ (ssg-text "exp-omni-no-inserts")) (progn (setq count 0) (setq i 0) (while (setq ename (ssname ss i)) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) ;; Nur Omniflo-Elemente (erkennbar an TEILEART-Attribut oder AP110-Blockname) (setq teileart (csv:get-attrib ename "TEILEART")) (if (or teileart (wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*"))) (progn (omni:set-hoehe-attrib ename) (omni:set-drehung-attrib ename) (setq count (1+ count)) ) ) (setq i (1+ i)) ) (princ (ssg-textf "exp-omni-updated" (list count))) ) ) (princ) )