;; ============================================================ ;; 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:ketten-verarbeiten 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:ketten-verarbeiten) 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")) ;; --- Hilfskopien nach dem Export stehen lassen: EIN Schalter --- ;; Standard: der Export raeumt alle Hilfskopien wieder ab (Separator-/ ;; Element-Kopien, Einheiten-Proxies, siehe csv:hilfskopien-loeschen). Nur der ;; Debug-Schalter "csv_leave_proxies" (ssg_dbg.lsp, Standard 0) laesst sie ;; stehen, damit man in BricsCAD sieht, was exportiert wurde. Bedienbar per ;; (dbg-schalter-on/-off "csv_leave_proxies") oder im Dialog CSV_EXPORT_KONFIG ;; - beide Wege schalten denselben Zustand. (defun csv:hilfskopien-behalten-p () (and (car (atoms-family 1 '("DBG-SCHALTER-P"))) (dbg-schalter-p "csv_leave_proxies"))) (defun csv:hilfskopien-behalten-setzen (an) (if (car (atoms-family 1 '("DBG-SCHALTER-SET"))) (dbg-schalter-set "csv_leave_proxies" (if an 1 0)))) ;; --- Bloecke auf gefrorenen Layern vom Export ausschliessen --- ;; Standard an (T). Nur GEFRORENE Layer zaehlen (ssg-ent-layer-gefroren-p, ;; ssg_layer.lsp) - ausgeschaltete Layer werden weiter exportiert. Bedienbar ;; im Dialog CSV_EXPORT_KONFIG. Wirkt in csv:collect-export-blocks auf den ;; Block selbst UND - ueber *csv-ausschluss-enames* - auf die Hilfsobjekte ;; (Separator-/Element-Kopien, Einheiten-/AS-ES-Marker) eines gefrorenen ;; VF_n/GF_n-Wrappers, die auf eigenen Layern liegen. (if (not (boundp '*csv-gefrorene-ausschliessen*)) (setq *csv-gefrorene-ausschliessen* T)) (defun csv:gefrorene-ausschliessen-p () (if *csv-gefrorene-ausschliessen* T nil)) (defun csv:gefrorene-ausschliessen-setzen (an) (setq *csv-gefrorene-ausschliessen* (if an T nil))) ;; Hilfsobjekte (car eines Records), deren Wrapper (nth 1) gefroren-fn ;; erfuellt. records = Record-Listen der Form (hilfsobjekt wrapper ...), wie ;; sie csv:sep-proxies-erzeugen, csv:element-proxies-erzeugen, ;; csv:asmark-aktualisieren und csv:ketten-verarbeiten liefern. ;; gefroren-fn = Praedikat auf den Wrapper. Reine Listenlogik, file-frei ;; testbar (tests/test_unit.lsp). (defun csv:hilfskopien-ausschluss (records gefroren-fn / result) (foreach rec records (if (and (car rec) (nth 1 rec) (apply gefroren-fn (list (nth 1 rec)))) (setq result (cons (car rec) result)))) (reverse result) ) (setq *csv-ausschluss-enames* 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:record-welt-lage fuer verpackte Bausteine per ;; Record-Skalierung 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. ;; ;; Der eigentliche Kern ist csv:ks-welt-punkte (arbeitet auf einer ;; Blockdefinition + Weltlage, liefert Punkte statt Strings) - so koennen auch ;; Zeilen, deren exportierter INSERT NICHT der Kettenbaustein selbst ist ;; (Separator-Symbolkopie, AS-/ES-Marker, VF_n/GF_n-Wrapper), die KS ihres ;; echten Bausteins ueber DIESELBE Rechnung bekommen (siehe csv:k-liste). (defun csv:get-k-kos-strings (ename pt parent-R sx sy sz) (csv:k-liste-kodieren (csv:ks-welt-punkte (cdr (assoc 2 (entget ename))) pt parent-R sx sy sz)) ) ;; --- K1-K4 einer Blockdefinition an einer Weltlage, als Weltpunkte --- ;; bname = Blockdefinition, deren DIREKTE Sub-INSERTs K1-K4/KS_EIN/KS_AUS ;; gelesen werden (Regeln siehe csv:get-k-kos-strings). ;; pt/parent-R = Weltposition/volle 3x3-Orientierung dieser Definition. ;; sx/sy/sz = Skalierung dieser Definition. ;; Rueckgabe: Assoc-Liste (("K1" x y z) ("K2" x y z) ...) - echte K-Bloecke ;; vorne (Vorrang bei assoc), nil wenn die Definition keine KS traegt. (defun csv:ks-welt-punkte (bname pt parent-R sx sy sz / blk-tbl sub-ent sub-ed sub-bname sub-pt sub-extrusion sub-pt-real world-pt target is-real result) (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 world-pt) result)) ) ) ) ) (setq sub-ent (entnext sub-ent)) ) ) ) result ) ;; --- K-Punkteliste (csv:ks-welt-punkte) -> K-Liste mit trans-encode-Strings --- (defun csv:k-liste-kodieren (punkte) (mapcar (function (lambda (e) (cons (car e) (csv:trans-encode (nth 1 e) (nth 2 e) (nth 3 e))))) punkte) ) ;; --- Platzierung eines ssg-collect-nested-inserts-Records in Weltlage --- ;; pt/R0/psx/psy/psz = Weltlage des INSERT, dessen Definition durchsucht wurde. ;; rec = (ename (x y z) R sx sy sz) relativ zu dieser Definition. ;; Rueckgabe: ((x y z) R sx sy sz) in Weltkoordinaten. Gemeinsam genutzt von ;; csv:nested-welt-records (Proxies/Marker) und csv:vfgf-k-kos-strings. (defun csv:record-welt-lage (pt R0 psx psy psz rec / local-pt rot-pt) (setq local-pt (nth 1 rec)) (setq rot-pt (mat3-mul-vec3 R0 (list (* psx (car local-pt)) (* psy (cadr local-pt)) (* psz (caddr local-pt))))) (list (mapcar '+ pt rot-pt) (mat3-mul-mat3 R0 (nth 2 rec)) (* psx (nth 3 rec)) (* psy (nth 4 rec)) (* psz (nth 5 rec))) ) ;; --------------------------------------------------------------------------- ;; K1-K4 und Boundingbox je Export-Zeile: Stellvertreter vs. Kettenbaustein ;; --------------------------------------------------------------------------- ;; Bogen/Streckenelement/Motor-/Umlenkstation werden als 1:1-Kopie ihres ;; Kettenbausteins exportiert - K1/K2 (= KS_EIN/KS_AUS) und Boundingbox sind ;; die des Bausteins, aufeinanderfolgende Teile teilen sich exakt ihren ;; Anschlusspunkt (K2 des einen = K1 des naechsten). Drei Zeilenarten ;; exportieren dagegen einen STELLVERTRETER: ;; Separator - Kopie des Sensor-SYMBOLS Separator_SP; der Kettenbaustein ist ;; sein Verpacker Staustrecke_Separator_SP_300_mm (das Symbol ;; traegt nur ein eigenes KS_EIN, 235 mm innerhalb des Trennstegs) ;; AS/ES - ZZ_ASES_MARKER-Rechteck ohne eigene KS; der Baustein ist das ;; verpackte AS_Element_*/ES_Element_* (K1 = KS_EIN, K2 = KS_AUS: ;; beim AS Kreisel -> Kettenanfang, beim ES Kettenende -> Kreisel) ;; ;; Welche Geometrie die Zeile fuehrt, haengt am Export-Modus: ;; all_elements - Separator UND AS/ES: die des umgebenden BAUSTEINS, ;; genau wie bei allen anderen Kettenteilen: K1/K2 = ;; KS_EIN/KS_AUS des Trennstegs bzw. AS-/ES-Elements, ;; Boundingbox (und damit Position) = die des Bausteins. ;; Die Kette ist dann lueckenlos ueber K2 -> K1 verbunden. ;; group_vf_gf - AS/ES wie all_elements (sie schliessen die Kette an die ;; Einheiten an, deren K1/K2 ebenfalls vom Baustein ;; kommen); Separator wie separator_track. ;; separator_track - die des STELLVERTRETERS selbst: das KS des Separator- ;; Symbols und seine Symbol-Boundingbox, der AS-/ES-Marker ;; ohne K (Verhalten vor der Kettenerweiterung). ;; Die Modus-Entscheidung trifft der Aufrufer (csv:sep-proxies-erzeugen bzw. ;; csv:asmark-aktualisieren), csv:baustein-merken selbst merkt immer. ;; Die Baustein-Geometrie wird beim Erzeugen des Stellvertreters aus dem ;; Baustein-Record berechnet (csv:baustein-merken) und unter dessen Handle ;; gemerkt; csv:k-liste bzw. csv:block-to-json liefern sie dann anstelle der ;; eigenen. K1/K2 eines VF_n/GF_n-Wrappers kommen unabhaengig vom Modus aus ;; AS/ES (csv:vfgf-element-punkte). ;; Die Einheiten-Proxies (ZZ_UNIT_MARKER, csv:unitmark-einfuegen) tragen sich ;; hier ebenfalls ein - ihre Box ist die gemessene 3D-Vereinigung der Bausteine. ;; *csv-baustein-by-handle*: ((handle k-liste-kodiert bbox) ...), je ;; Exportlauf neu (csv:export-vorbereiten setzt zurueck). (setq *csv-baustein-by-handle* nil) ;; --- Boundingbox eines Bausteins an seiner Weltlage --- ;; Die verpackte Blockreferenz selbst liefert keine Welt-Boundingbox (sie ist ;; nicht Space-resident, siehe ssg-collect-nested-inserts) - darum eine ;; kurzlebige Kopie an derselben Lage einfuegen (csv:block-einfuegen-welt, ;; dieselbe Platzierung wie jede Proxy-Kopie), messen und sofort loeschen. ;; rec wie csv:nested-welt-records. Rueckgabe wie csv:get-bbox oder nil. (defun csv:baustein-bbox (rec / ms kopie bbox) (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq kopie (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 kopie (progn (setq bbox (csv:get-bbox kopie)) (entdel kopie))) bbox ) ;; --- Baustein-Geometrie (K-Punkte + Boundingbox) unter dem Handle seines ;; Stellvertreters merken --- rec wie csv:nested-welt-records: (wrapper ;; nested-ent bname (x y z) R sx sy sz). Ob gemerkt wird, entscheidet der ;; Aufrufer je Modus (siehe oben). Traegt der Baustein keine KS, bleibt die ;; K-Liste nil und csv:k-liste faellt auf die KS des Stellvertreters zurueck. (defun csv:baustein-merken (stellvertreter rec / punkte) (setq punkte (csv:ks-welt-punkte (nth 2 rec) (nth 3 rec) (nth 4 rec) (nth 5 rec) (nth 6 rec) (nth 7 rec))) (setq *csv-baustein-by-handle* (cons (list (cdr (assoc 5 (entget stellvertreter))) (csv:k-liste-kodieren punkte) (csv:baustein-bbox rec)) *csv-baustein-by-handle*)) ) ;; --- Gemerkte Baustein-Boundingbox eines Stellvertreters, sonst nil --- (defun csv:baustein-bbox-gemerkt (handle) (caddr (assoc handle *csv-baustein-by-handle*)) ) ;; --- K-Liste (kodiert) eines exportierten INSERT --- ;; Gemerkte Baustein-KS (csv:baustein-merken) haben Vorrang, sonst die KS der eigenen ;; Blockdefinition an der eigenen Weltlage (OCS aufgeloest wie in ;; csv:block-to-json). Einstieg fuer K1-K4 in csv:block-to-json. (defun csv:k-liste (ename / ed pt extrusion) (setq ed (entget ename)) (cond ((cadr (assoc (cdr (assoc 5 ed)) *csv-baustein-by-handle*))) (t (setq pt (cdr (assoc 10 ed))) (if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0))) (setq extrusion (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0)))) (csv:get-k-kos-strings ename (mat3-mul-vec3 (mat3-ocs-matrix extrusion) pt) (mat3-from-normal-rotation extrusion (cond ((cdr (assoc 50 ed))) (0.0))) (cond ((cdr (assoc 41 ed))) (1.0)) (cond ((cdr (assoc 42 ed))) (1.0)) (cond ((cdr (assoc 43 ed))) (1.0)))) ) ) ;; --- 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 ) ) ;; --- K-Punkte des AS- bzw. ES-Elements eines VF/GF-Wrappers, in Weltlage --- ;; bname = Blockname des VF_n/GF_n-Wrappers. ;; pt/R0 = Weltlage des Wrapper-INSERT. ;; elem-pat = "AS_ELEMENT*" bzw. "ES_ELEMENT*". ;; Das AS_Element UND das ES_Element fuehren JEWEILS ein KS_EIN UND ein KS_AUS ;; (siehe check_hoehen.lsp ch-measure-vfgf) - darum ERST das Element suchen und ;; seine KS dann ueber csv:ks-welt-punkte lesen, dieselbe Rechnung, die auch die ;; AS-/ES-Zeile im Modus all_elements bekommt (csv:baustein-merken). K1/K2 des ;; Wrappers stimmen dadurch per Konstruktion mit K1 des AS bzw. K2 des ES ;; ueberein. Rueckgabe wie csv:ks-welt-punkte, nil wenn kein Element. (defun csv:vfgf-element-punkte (bname pt R0 elem-pat / elem-rec lage) (setq elem-rec (car (ssg-collect-nested-inserts bname elem-pat))) (if elem-rec (progn (setq lage (csv:record-welt-lage pt R0 1.0 1.0 1.0 elem-rec)) (csv:ks-welt-punkte (cdr (assoc 2 (entget (car elem-rec)))) (nth 0 lage) (nth 1 lage) (nth 2 lage) (nth 3 lage) (nth 4 lage)) ) ) ) ;; --- 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-element-punkte holt die KS aus dem ;; JEWEILS zugehoerigen Element (nicht flach aus dem ganzen Wrapper - beide ;; Elemente tragen beide KS-Typen), direkt in Weltkoordinaten, und sie werden ;; 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 R0 as-world es-world ein-world aus-world result) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) (setq result nil) ;; 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 ;; die reine Z-Drehungsmatrix (mat3-rz). AS-Eingang = K1 (KS_EIN) des AS, ;; ES-Ausgang = K2 (KS_AUS) des ES (csv:vfgf-element-punkte). (setq R0 (mat3-rz rot-rad)) (setq as-world (cdr (assoc "K1" (csv:vfgf-element-punkte bname pt R0 "AS_ELEMENT*")))) (setq es-world (cdr (assoc "K2" (csv:vfgf-element-punkte bname pt R0 "ES_ELEMENT*")))) ;; 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" ein-world) result))) (if aus-world (setq result (cons (cons "K2" aus-world) result))) (csv:k-liste-kodieren (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:ketten-verarbeiten), ;; 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 handle attribs bbox bbox-json 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 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))) ;; K1-K4: gemerkte Baustein-KS eines Stellvertreters (Separator-Symbol, ;; AS-/ES-Marker) oder die KS der eigenen Blockdefinition - siehe csv:k-liste. (setq k-list (csv:k-liste ename)) ;; 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:ketten-verarbeiten ;; 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 ;; Stellvertreter im Modus all_elements: Boundingbox des umgebenden ;; Bausteins (csv:baustein-merken), sonst die eigene. (setq bbox (cond ((csv:baustein-bbox-gemerkt handle)) (t (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 records) (setq ss-all (ssget "X" (list (cons 0 "INSERT")))) (if ss-all (progn (setq i 0) (while (setq ename (ssname ss-all i)) (if (wcmatch (cdr (assoc 2 (entget ename))) (csv:pattern-wrapper-fuer-proxies)) (setq records (append records (csv:wrapper-welt-records ename nested-pattern)))) (setq i (1+ i)) ) ) ) records ) ;; --- Verpackte Sub-INSERTs EINES Wrapper-INSERT in Weltlage --- ;; Wie csv:nested-welt-records, aber nur fuer den Wrapper ename (gleiches ;; Record-Format). Genutzt von csv:nested-welt-records und von der ;; Einheiten-Gruppierung (csv:kette-teile), die je VF_n/GF_n arbeitet. (defun csv:wrapper-welt-records (ename nested-pattern / ed nested pt extrusion0 R0 psx psy psz rec records) (setq ed (entget ename)) (setq nested (ssg-collect-nested-inserts (cdr (assoc 2 ed)) nested-pattern)) (if nested (progn (setq pt (cdr (assoc 10 ed))) (if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 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 (cond ((cdr (assoc 50 ed))) (0.0)))) (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 records (cons (append (list ename (nth 0 rec) (cdr (assoc 2 (entget (nth 0 rec))))) (csv:record-welt-lage pt R0 psx psy psz rec)) records)) ) ) ) (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*" ) ;; --- Trennsteg (Staustrecke_Separator_SP_300_mm) zu einem Separator_SP- ;; Symbol finden --- ;; sym-pt = Weltposition des Symbols (csv:nested-welt-records). ;; aussen-paare = Liste ((symbol-weltpunkt . trennsteg-record) ...), siehe ;; csv:trennsteg-paare. ;; Zugeordnet wird der Trennsteg, dessen EIGENES Symbol an sym-pt liegt ;; (Toleranz 1 mm) - NICHT der mit dem naechstliegenden Ursprung: das Symbol ;; sitzt 235 mm vom Ursprung seines Trennstegs, aber nur 65 mm vom Ursprung ;; des folgenden Bausteins; folgen zwei Trennstege aufeinander, griff die ;; Ursprungsnaehe den falschen. Ein Symbol ohne Trennsteg (Kreisel-Separator) ;; bekommt nil. (defun csv:trennsteg-zu-symbol (sym-pt aussen-paare / treffer paar) (foreach paar aussen-paare (if (and (null treffer) (< (distance sym-pt (car paar)) 1.0)) (setq treffer (cdr paar)))) treffer ) ;; --- Je Trennsteg-Record die Weltlage seines eingebauten Separator_SP- ;; Symbols berechnen --- Rueckgabe: ((symbol-weltpunkt . record) ...). (defun csv:trennsteg-paare (recs-aussen / rec sym lage paare) (foreach rec recs-aussen (setq sym (car (ssg-collect-nested-inserts (nth 2 rec) (csv:pattern-nested-separator)))) (if sym (progn (setq lage (csv:record-welt-lage (nth 3 rec) (nth 4 rec) (nth 5 rec) (nth 6 rec) (nth 7 rec) sym)) (setq paare (cons (cons (car lage) rec) paare))))) (reverse paare) ) ;; --- 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 ;; trennsteg-ent) - trennsteg-ent = der verpackte Trennsteg (Kettenbaustein, ;; Schluessel fuer die ID-Vergabe in Kettenfolge, csv:ketten-ids-vergeben), ;; nil fuer ein Symbol ohne Trennsteg (Kreisel-Separator). ;; 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 ;; Symbollage innerhalb des Trennstegs (csv:trennsteg-zu-symbol). (defun csv:sep-proxies-erzeugen ( / ms recs aussen-paare rec aussen-rec proxy proxy-liste) (setq recs (csv:nested-welt-records (csv:pattern-nested-separator))) (setq aussen-paare (csv:trennsteg-paare (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:trennsteg-zu-symbol (nth 3 rec) aussen-paare)) (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)))))) ;; all_elements: K1/K2 + Boundingbox der Zeile = die des Trennstegs ;; (der Kettenbaustein) statt des Symbols - siehe csv:baustein-merken. (if (and proxy aussen-rec (csv:export-alle-elemente-p)) (csv:baustein-merken proxy aussen-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))) (if aussen-rec (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) ;; baustein-ent) - baustein-ent = der verpackte Baustein (Schluessel fuer die ;; ID-Vergabe in Kettenfolge, csv:ketten-ids-vergeben). ;; 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) (nth 1 rec)) proxy-liste))) ) ) ) (reverse proxy-liste) ) ;; --- Export-Hilfskopien nach dem Export wieder entfernen --- ;; proxy-liste = Records, deren car die Hilfskopie ist. ;; art-key = Sprachschluessel der Objektart fuer die Meldung ;; ("exp-art-separator"/"exp-art-element"/"exp-art-einheit"). ;; Standard: loeschen. Bei gesetztem csv_leave_proxies (siehe ;; csv:hilfskopien-behalten-p) bleiben sie stehen, mit einer Meldung je Art ;; (nur wenn es welche gibt). (defun csv:hilfskopien-loeschen (proxy-liste art-key) (cond ((null proxy-liste)) ((csv:hilfskopien-behalten-p) (princ (ssg-textf "exp-hilfskopien-behalten" (list (itoa (length proxy-liste)) (ssg-text art-key))))) (t (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 (Modus group_vf_gf) ;; =========================================================================== ;; Eine VF_n/GF_n-Kette besteht abwechselnd aus Gefaelle- und Foerder- ;; abschnitten (GF, VF, GF, ...) - so baut der Linienzug sie auch iterativ auf. ;; Ein Foerderabschnitt (VF) ist eindeutig an seinen Stationen erkennbar: er ;; BEGINNT am Separator direkt vor der Umlenkstation und ENDET an der ;; Motorstation. Alles dazwischen ist Gefaelle (GF). Beide koennen um Kurven ;; laufen - darum wird die Reihenfolge NICHT ueber Projektion oder die ;; sepliste-XDATA bestimmt, sondern als Vektorkette entlang der KS: auf K2 ;; (KS_AUS) eines Bausteins liegt exakt K1 (KS_EIN) des naechsten. ;; ;; csv:kette-teile - Bausteine eines Wrappers mit Typ, Welt-Record, K1/K2 ;; csv:kette-ordnen - in Foerderrichtung ordnen (Start AS, K2 -> K1) ;; csv:kette-einheiten- Typfolge in VF-/GF-Einheiten schneiden (reine ;; Rechenfunktion, getestet in tests/test_unit.lsp) ;; csv:unitmark-erzeugen (weiter unten) - je Einheit ein Proxy-Rechteck ;; Toleranz (mm), innerhalb der K2 eines Bausteins als K1 des naechsten gilt. (defun csv:kette-toleranz-mm () 2.0) ;; --- Bausteintyp aus dem Blocknamen --- ;; "AS"/"ES"/"SEP" wie csv:proxy-typ, sonst die Familien aus ;; csv:element-teileart (BOGEN/STRECKENELEMENT/UMLENKSTATION/MOTORSTATION). (defun csv:kette-typ (bname / bn) (setq bn (strcase bname)) (cond ((wcmatch bn "AS_ELEMENT*") "AS") ((wcmatch bn "ES_ELEMENT*") "ES") ((wcmatch bn (strcase (csv:pattern-nested-separator-aussen))) "SEP") (t (csv:element-teileart bname)) ) ) ;; --- Alle Kettenbausteine eines VF_n/GF_n-Wrappers --- ;; Rueckgabe: Liste von (typ rec k1 k2) - rec wie csv:nested-welt-records, ;; k1/k2 = Weltpunkte von KS_EIN/KS_AUS (csv:ks-welt-punkte) oder nil. ;; Gesucht wird der Trennsteg (nicht das Separator-Symbol darin): er ist der ;; Kettenbaustein, ssg-collect-nested-inserts steigt bei ihm nicht weiter ab. (defun csv:kette-teile (wrapper / rec punkte typ teile) (foreach rec (csv:wrapper-welt-records wrapper (strcat (csv:pattern-nested-schleus) "," (csv:pattern-nested-separator-aussen) "," (csv:pattern-nested-element))) (setq typ (csv:kette-typ (nth 2 rec))) (if typ (progn (setq punkte (csv:ks-welt-punkte (nth 2 rec) (nth 3 rec) (nth 4 rec) (nth 5 rec) (nth 6 rec) (nth 7 rec))) (setq teile (cons (list typ rec (cdr (assoc "K1" punkte)) (cdr (assoc "K2" punkte))) teile)))) ) (reverse teile) ) ;; --- Nachfolger eines Bausteins: der, dessen K1 auf k2 liegt --- (defun csv:kette-nachfolger (k2 teile / treffer tol) (setq tol (csv:kette-toleranz-mm)) (if k2 (foreach t1 teile (if (and (null treffer) (nth 2 t1) (< (distance k2 (nth 2 t1)) tol)) (setq treffer t1)))) treffer ) ;; --- Anfang einer (Teil-)Kette: bevorzugt das AS, sonst ein Baustein, auf ;; dessen K1 kein K2 eines anderen liegt --- (defun csv:kette-anfang (teile / anfang tol) (setq tol (csv:kette-toleranz-mm)) (foreach t1 teile (if (and (null anfang) (= (car t1) "AS")) (setq anfang t1))) (foreach t1 teile (if (and (null anfang) (not (vl-some (function (lambda (t2) (and (not (eq t1 t2)) (nth 3 t2) (nth 2 t1) (< (distance (nth 3 t2) (nth 2 t1)) tol)))) teile))) (setq anfang t1))) (cond (anfang) ((car teile))) ) ;; --- Bausteine in Foerderrichtung ordnen (Vektorkette K2 -> K1) --- ;; Beginnt am AS und haengt jeweils den Baustein an, dessen K1 auf dem K2 des ;; letzten liegt. Reisst die Kette ab (Baustein ohne KS, Luecke > Toleranz), ;; wird das gemeldet und mit dem Rest als neue Teilkette weitergemacht - kein ;; Baustein geht verloren, die Einheitengrenzen koennen dort aber falsch sein. ;; kontext = Blockname des Wrappers (nur fuer die Meldung). (defun csv:kette-ordnen (teile kontext / rest geordnet aktuell naechster) (setq rest teile) (while rest (if geordnet (princ (ssg-textf "exp-kette-luecke" (list kontext (itoa (length rest)))))) (setq aktuell (csv:kette-anfang rest)) (while aktuell (setq geordnet (cons aktuell geordnet)) (setq rest (vl-remove aktuell rest)) (setq naechster (csv:kette-nachfolger (nth 3 aktuell) rest)) (setq aktuell naechster) ) ) (reverse geordnet) ) ;; --- Typfolge einer geordneten Kette in VF-/GF-Einheiten schneiden --- ;; typen = Liste der Bausteintypen in Foerderrichtung (siehe csv:kette-typ). ;; Regeln: ;; - AS/ES gehoeren zu keiner Einheit (eigene Export-Zeilen). ;; - Eine VF beginnt an einem SEP, dem direkt eine UMLENKSTATION folgt, ;; bzw. an einer UMLENKSTATION ohne solchen SEP davor, und endet MIT der ;; naechsten MOTORSTATION. ;; - Alles andere sammelt sich zu einer GF zwischen den VFs. ;; Rueckgabe: ((einheit-typ (index ...)) ...) mit 0-basierten Indizes in ;; typen, in Kettenreihenfolge; leere Einheiten entstehen nicht. (defun csv:kette-einheiten (typen / erg i typ naechster offen-typ offen) (setq i 0 offen-typ "GF") (while (< i (length typen)) (setq typ (nth i typen) naechster (nth (1+ i) typen)) (cond ((member typ '("AS" "ES"))) ;; VF-Beginn: SEP vor Umlenkstation oder Umlenkstation selbst ((and (/= offen-typ "VF") (or (and (= typ "SEP") (= naechster "UMLENKSTATION")) (= typ "UMLENKSTATION"))) (if offen (setq erg (cons (list offen-typ (reverse offen)) erg))) (setq offen-typ "VF" offen (list i))) ;; VF-Ende: die Motorstation gehoert noch dazu ((and (= offen-typ "VF") (= typ "MOTORSTATION")) (setq erg (cons (list "VF" (reverse (cons i offen))) erg)) (setq offen-typ "GF" offen nil)) (t (setq offen (cons i offen))) ) (setq i (1+ i)) ) (if offen (setq erg (cons (list offen-typ (reverse offen)) erg))) (reverse erg) ) ;; --- 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") ;; all_elements/group_vf_gf: K1/K2 + Boundingbox der Zeile = ;; die des echten AS-/ES-Elements (der Marker selbst traegt ;; keine KS) - AS: Kreisel -> Kettenanfang, ES: Kettenende -> ;; Kreisel. Siehe csv:baustein-merken. (if (not (csv:export-separator-track-p)) (csv:baustein-merken mark elem)) ;; 5. Feld: das verpackte Element (Schluessel fuer die ID- ;; Vergabe in Kettenfolge, csv:ketten-ids-vergeben). (setq ergebnis (cons (list mark wrapper typ lfdnr (nth 1 elem)) 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) (csv:hilfskopien-loeschen proxy-liste "exp-art-separator") (setq *cs-sep-fix-by-handle* nil) (setq *cs-sep-typ-by-handle* nil) (setq *csv-sepliste-id-by-handle* nil) (princ) ) ;; =========================================================================== ;; Foerdereinheit-/Gefaelleeinheit-Proxies (ZZ_UNIT_MARKER) ;; =========================================================================== ;; Je Einheit (csv:kette-einheiten) ein Rechteck auf der Bounding-Box- ;; Vereinigung ihrer Bausteine. Es ist ein reines Export-Hilfsmittel wie die ;; Separator-/Element-Kopien: es entsteht bei jedem Export neu, bekommt in ;; ssg-id-check-all eine ID, liefert die Export-Zeile und wird am Ende von ;; csv:run-export wieder geloescht - ausser der Debug-Schalter ;; "csv_leave_proxies" (siehe csv:hilfskopien-loeschen) laesst es zur ;; Ansicht stehen. ;; Nur im Modus group_vf_gf; in den anderen Modi entsteht keins. (defun csv:unitmark-blockname () "ZZ_UNIT_MARKER") ;; Attribut-Schema. Alle ATTDEFs unsichtbar (wie *csv-asmark-attrib-defs*). ;; ID - fuellt ssg-id-check-all ;; ZUORDNUNG - ID des VF_n/GF_n-Wrappers (csv:unitmark-ids-setzen traegt ;; sie nach der ID-Vergabe nach) ;; TYP - "VF" (Foerdereinheit) oder "GF" (Gefaelleeinheit) ;; LFDNR - 1-basierte Einheiten-Nummer INNERHALB des Wrappers ;; LAENGE_m - Summe der Laengen K1->K2 aller enthaltenen Streckenelemente ;; (Meter) - geometrisch, weil die Staustrecke beim Bau per ;; Laenge skaliert wird und ihr Attribut das nicht wiedergibt ;; ANZAHL_BOEGEN - Anzahl der enthaltenen Boegen (inkl. Vario-Kurven) ;; K1/K2 - KS_EIN des ERSTEN bzw. KS_AUS des LETZTEN Bausteins, als ;; csv:trans-encode-String (NICHT rtos, siehe DIMZIN-Hinweis) (setq *csv-unitmark-attrib-defs* '(("ID" "") ("ZUORDNUNG" "") ("TYP" "") ("LFDNR" "") ("LAENGE_m" "") ("ANZAHL_BOEGEN" "") ("K1" "") ("K2" "")) ) ;; --- Blockdefinition des Proxies bei Bedarf anlegen --- ;; 1x1-Einheitsquadrat auf Layer "0" (wie csv:asmark-blockdef-sicherstellen) - ;; wird beim Einfuegen ueber sx/sy auf die Bounding-Box der Einheit skaliert. ;; 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) ) ) ) ) ;; --- Alle vorhandenen Proxies loeschen --- ;; Raeumt stehengebliebene Proxies eines Debug-Laufs und die frueher dauerhaft ;; gesetzten Marker aelterer Versionen weg, bevor neu aufgebaut wird. ;; Rueckgabe: Anzahl geloeschter Proxies. (defun csv:unitmark-bestand-loeschen ( / ss i n) (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 (csv:unitmark-blockname))))) (setq n 0) (if ss (progn (setq i 0) (while (< i (sslength ss)) (entdel (ssname ss i)) (setq i (1+ i))) (setq n (sslength ss)))) n ) ;; --- Bounding-Box-Vereinigung einer Liste von Kettenbausteinen --- ;; Die verpackten Bausteine liefern selbst keine Welt-Boundingbox; darum je ;; Baustein eine kurzlebige Kopie an seiner Weltlage (csv:block-einfuegen- ;; welt, wie jede Proxy-Kopie), Vereinigung messen, Kopien sofort loeschen. ;; teile = Liste von (typ rec k1 k2). Rueckgabe wie csv:get-bbox oder nil. (defun csv:kette-bbox (teile / ms kopien kopie t1 rec bbox) (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (foreach t1 teile (setq rec (nth 1 t1)) (setq kopie (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 kopie (setq kopien (cons kopie kopien)))) (if kopien (setq bbox (csv:get-bbox-union kopien))) (foreach kopie kopien (entdel kopie)) bbox ) ;; --- Proxy fuer eine Einheit einfuegen und beschriften --- ;; mitglieder = die (typ rec k1 k2) der Einheit in Kettenreihenfolge. ;; Rueckgabe: ename des Proxies oder nil (keine Boundingbox ermittelbar). (defun csv:unitmark-einfuegen (ms blockname wrapper typ lfdnr mitglieder / bbox laenge-mm anzahl-boegen t1 k1 k2 mark) (setq bbox (csv:kette-bbox mitglieder)) (if bbox (progn (setq laenge-mm 0.0 anzahl-boegen 0) (foreach t1 mitglieder (if (and (= (car t1) "STRECKENELEMENT") (nth 2 t1) (nth 3 t1)) (setq laenge-mm (+ laenge-mm (distance (nth 2 t1) (nth 3 t1))))) (if (= (car t1) "BOGEN") (setq anzahl-boegen (1+ anzahl-boegen)))) (setq k1 (nth 2 (car mitglieder)) k2 (nth 3 (last mitglieder))) (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 (cdr (assoc 2 (entget wrapper))))) (if mark (progn (ssg-attrib-set-on mark (list (cons "ID" "") (cons "ZUORDNUNG" (cond ((cdr (assoc "ID" (ssg-attrib-read wrapper)))) (""))) (cons "TYP" typ) (cons "LFDNR" (itoa lfdnr)) (cons "LAENGE_m" (rtos (/ laenge-mm 1000.0) 2 3)) (cons "ANZAHL_BOEGEN" (itoa anzahl-boegen)) (cons "K1" (if k1 (csv:trans-encode (car k1) (cadr k1) (caddr k1)) "")) (cons "K2" (if k2 (csv:trans-encode (car k2) (cadr k2) (caddr k2)) "")))) (ssg-layer-setzen mark "ases_marker") ;; Export-Geometrie wie bei jedem Stellvertreter: die gemessene 3D- ;; Vereinigung der Bausteine statt der Box des flachen Rechtecks, ;; K1/K2 wie in den Attributen (siehe *csv-baustein-by-handle*). (setq *csv-baustein-by-handle* (cons (list (cdr (assoc 5 (entget mark))) (csv:k-liste-kodieren (append (if k1 (list (cons "K1" k1))) (if k2 (list (cons "K2" k2))))) bbox) *csv-baustein-by-handle*)))) ) ) mark ) ;; --- VF_n/GF_n-Wrapper der Zeichnung, nach ihrer ID aufsteigend --- ;; Wrapper ohne ID (frisch gebaut, nummeriert erst ssg-id-check-all) am Ende. (defun csv:wrapper-nach-id ( / ss i liste) (if (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "VF_*,GF_*")))) (progn (setq i 0) (while (< i (sslength ss)) (setq liste (cons (ssname ss i) liste)) (setq i (1+ i))))) (vl-sort liste (function (lambda (a b / ia ib) (setq ia (atoi (cond ((cdr (assoc "ID" (ssg-attrib-read a)))) (""))) ib (atoi (cond ((cdr (assoc "ID" (ssg-attrib-read b)))) ("")))) (cond ((= ia 0) nil) ((= ib 0) t) (t (< ia ib))))))) ;; --- Einem Export-Objekt die naechste ID geben, falls es noch keine hat --- ;; naechste-id = zuletzt vergebene Nummer. Rueckgabe: neue letzte Nummer. (defun csv:id-vergeben (ename naechste-id / id) (setq id (cdr (assoc "ID" (ssg-attrib-read ename)))) (if (or (null id) (= id "")) (progn (setq naechste-id (1+ naechste-id)) (ssg-id-set-and-verify ename (ssg-id-format naechste-id) "Kettenfolge"))) naechste-id ) ;; --- Ketten verarbeiten: Einheiten-Proxies bauen und IDs in Kettenfolge --- ;; Laeuft VOR ssg-id-check-all (csv:export-vorbereiten). Je VF_n/GF_n-Wrapper ;; (nach Wrapper-ID aufsteigend): ;; 1. Bausteine holen und als Vektorkette ordnen (csv:kette-teile/-ordnen) ;; 2. nur Modus group_vf_gf: in Einheiten schneiden (csv:kette-einheiten) ;; und je Einheit einen Proxy setzen (csv:unitmark-einfuegen) ;; 3. alle Export-Objekte dieser Kette, die noch keine ID haben, entlang der ;; Kette AS -> ES aufsteigend nummerieren: AS-/ES-Marker, Separator- ;; Kopien, Element-Kopien (alle ueber ihren verpackten Baustein der ;; Kettenposition zugeordnet) und Einheiten-Proxies (an der Position ;; ihres ersten Bausteins, vor diesem). ;; Ohne diese Vergabe nummeriert erst ssg-id-check-all - in der Reihenfolge ;; von (ssget "X"), in BricsCAD also rueckwaerts (zuletzt erzeugt zuerst). ;; Die Export-CSV ist nach TeileId sortiert, damit stehen die Zeilen jeder ;; Kette jetzt von AS nach ES. Bereits vorhandene IDs (dauerhafte AS/ES- ;; Marker) bleiben unangetastet. ;; sep-proxies/element-proxies/asmarks = die Stellvertreter-Listen dieses ;; Laufs (letztes Feld jedes Records = verpackter Baustein). ;; Rueckgabe: Einheiten-Proxy-Records (proxy-ename wrapper-ename typ lfdnr) - ;; car ist der Proxy, damit csv:hilfskopien-loeschen sie entfernen kann. (defun csv:ketten-verarbeiten (sep-proxies element-proxies asmarks / alt gruppiert blockname ms traeger r naechste-id wrapper teile einheit lfdnr mark starts i teil u tr ergebnis) (setq alt (csv:unitmark-bestand-loeschen)) (setq gruppiert (= *csv-export-modus* "group_vf_gf")) (if gruppiert (setq blockname (csv:unitmark-blockdef-sicherstellen))) (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) ;; Stellvertreter ueber (wrapper baustein) nachschlagbar machen. (foreach r sep-proxies (if (nth 5 r) (setq traeger (cons (cons (list (nth 1 r) (nth 5 r)) (nth 0 r)) traeger)))) (foreach r element-proxies (if (nth 4 r) (setq traeger (cons (cons (list (nth 1 r) (nth 4 r)) (nth 0 r)) traeger)))) (foreach r asmarks (if (nth 4 r) (setq traeger (cons (cons (list (nth 1 r) (nth 4 r)) (nth 0 r)) traeger)))) (setq naechste-id (ssg-id-max)) (foreach wrapper (csv:wrapper-nach-id) (setq teile (csv:kette-ordnen (csv:kette-teile wrapper) (cdr (assoc 2 (entget wrapper))))) ;; Einheiten (nur gruppiert); starts = ((erster-index . proxy) ...) (setq starts nil lfdnr 0) (if (and gruppiert blockname) (foreach einheit (csv:kette-einheiten (mapcar 'car teile)) (setq lfdnr (1+ lfdnr)) (setq mark (csv:unitmark-einfuegen ms blockname wrapper (car einheit) lfdnr (mapcar (function (lambda (idx) (nth idx teile))) (cadr einheit)))) (if mark (progn (setq ergebnis (cons (list mark wrapper (car einheit) lfdnr) ergebnis)) (setq starts (cons (cons (car (cadr einheit)) mark) starts)))))) ;; IDs entlang der Kette (setq i 0) (foreach teil teile (foreach u starts (if (= (car u) i) (setq naechste-id (csv:id-vergeben (cdr u) naechste-id)))) (if (setq tr (cdr (assoc (list wrapper (nth 1 (nth 1 teil))) traeger))) (setq naechste-id (csv:id-vergeben tr naechste-id))) (setq i (1+ i))) ) (if gruppiert (princ (ssg-textf "exp-unitmark-bilanz" (list (itoa (length ergebnis)) (itoa alt))))) (reverse ergebnis) ) ;; --- Nach der ID-Vergabe: ZUORDNUNG nachtragen --- ;; Beim Erzeugen kann ein frisch gebauter Wrapper noch keine ID gehabt haben; ;; erst nach ssg-id-check-all steht sie fest. (defun csv:unitmark-ids-setzen (marker-liste / rec wrapper-id gesetzt) (setq gesetzt 0) (foreach rec marker-liste (setq wrapper-id (cdr (assoc "ID" (ssg-attrib-read (nth 1 rec))))) (if (and wrapper-id (> (strlen wrapper-id) 0)) (ssg-attrib-set-on (nth 0 rec) (list (cons "ZUORDNUNG" wrapper-id)))) (if (> (strlen (cond ((cdr (assoc "ID" (ssg-attrib-read (nth 0 rec))))) (""))) 0) (setq gesetzt (1+ gesetzt))) ) (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. ;; Bloecke auf GEFRORENEN Layern (und die Hilfsobjekte gefrorener VF_n/GF_n) ;; werden ausgelassen, solange *csv-gefrorene-ausschliessen* an ist (Standard, ;; Dialog CSV_EXPORT_KONFIG); ausgeschaltete Layer zaehlen nicht als gefroren. ;; Gibt Auswahlsatz zurueck oder nil. (defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname ist-nested-element gefroren n-gefroren) (setq n-gefroren 0) (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:ketten-verarbeiten 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)))) ;; Gefrorener Layer (Schalter *csv-gefrorene-ausschliessen*): der ;; Block selbst liegt darauf, oder er ist Hilfsobjekt eines ;; gefrorenen VF_n/GF_n (*csv-ausschluss-enames*, csv:export-vorbereiten). (setq gefroren (and (csv:gefrorene-ausschliessen-p) (or (ssg-ent-layer-gefroren-p ename) (member ename *csv-ausschluss-enames*)))) (if gefroren (setq n-gefroren (1+ n-gefroren))) (if (and (not ist-nested-element) (not gefroren) (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)) ) ) (if (> n-gefroren 0) (princ (ssg-textf "exp-gefroren-ausgelassen" (list (itoa n-gefroren))))) 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) (setq *csv-ausschluss-enames* nil) ;; Baustein-Geometrie der Stellvertreter (Separator-Kopie, AS-/ES-Marker) ;; wird beim Erzeugen neu gemerkt - Stand eines frueheren Laufs verwerfen. (setq *csv-baustein-by-handle* nil) ;; 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) als temporaere Kopien - NUR im Modus ;; all_elements, der sie als eigene Zeilen exportiert (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). (setq element-proxies (if (csv:export-alle-elemente-p) (csv:element-proxies-erzeugen))) ;; Ketten verarbeiten: Foerdereinheit-/Gefaelleeinheit-Proxies (ZZ_UNIT_ ;; MARKER, nur Modus group_vf_gf) aus den KS-verketteten Bausteinen bauen und ;; alle neuen Export-Objekte jeder Kette von AS nach ES aufsteigend ;; nummerieren - VOR ssg-id-check-all, siehe csv:ketten-verarbeiten. (setq unitmarks (csv:ketten-verarbeiten sep-proxies element-proxies asmarks)) ;; Hilfsobjekte gefrorener Wrapper merken: sie liegen auf eigenen Layern, ;; der Wrapper-Layer allein haelt sie daher nicht aus dem Export heraus ;; (Auswertung in csv:collect-export-blocks). Erzeugt werden sie trotzdem, ;; damit IDs und AS/ES-Marker ueber Laeufe stabil bleiben. (setq *csv-ausschluss-enames* (if (csv:gefrorene-ausschliessen-p) (csv:hilfskopien-ausschluss (append sep-proxies asmarks element-proxies unitmarks) 'ssg-ent-layer-gefroren-p))) ;; 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 Hilfsmittel zurueckgeben (Separator-/Element-Kopien, ;; Einheiten-Proxies) - die AS/ES-Marker bleiben bewusst in der Zeichnung ;; stehen und duerfen nicht mitgeloescht werden. (list sep-proxies element-proxies unitmarks)) ;; --- 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 unitmarks vorbereitung-ergebnis) ;; Zeichnungszustand fuer den Export herrichten (Proxies, IDs, Zuordnung, ;; Attribut-Update, Sep/Scan-Zaehlung, REGENALL, bbox-Reset) - ausgelagert. ;; Rueckgabe: (sep-proxies element-proxies unitmarks), alle 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)) (setq unitmarks (nth 2 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:hilfskopien-loeschen element-proxies "exp-art-element") (csv:hilfskopien-loeschen unitmarks "exp-art-einheit") (setq *csv-ausschluss-enames* nil) (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 --- ;; Reihenfolge der Combobox-Eintraege MUSS zwischen -init und -accept ;; uebereinstimmen (Index 0/1/2 <-> Modus-String) - beide leiten sie aus ;; derselben Liste *csv-export-konfig-modi* ab, damit sie nicht ;; auseinanderlaufen kann. (setq *csv-export-konfig-modi* (list (cons "group_vf_gf" "Gruppiert: Foerdereinheit/Gefaelleeinheit (Standard)") (cons "all_elements" "Alle Einzelelemente (Boegen, Strecken, Umlenk-/Motorstation)") (cons "separator_track" "Nur Separator-Spur (AS/ES/Separator, ohne Streckenelemente)") )) (defun csv:export-konfig-init ( / idx eintrag) (start_list "modus") (foreach eintrag *csv-export-konfig-modi* (add_list (cdr eintrag))) (end_list) (setq idx 0) (setq eintrag (vl-position *csv-export-modus* (mapcar 'car *csv-export-konfig-modi*))) (if eintrag (setq idx eintrag)) (set_tile "modus" (itoa idx)) (set_tile "hilfskopien_behalten" (if (csv:hilfskopien-behalten-p) "1" "0")) (set_tile "gefrorene_ausschliessen" (if (csv:gefrorene-ausschliessen-p) "1" "0")) ) (defun csv:export-konfig-accept ( / idx modus) (setq idx (atoi (get_tile "modus"))) (setq modus (car (nth idx *csv-export-konfig-modi*))) (if modus (csv:export-modus-setzen modus)) (csv:hilfskopien-behalten-setzen (= (get_tile "hilfskopien_behalten") "1")) (csv:gefrorene-ausschliessen-setzen (= (get_tile "gefrorene_ausschliessen") "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) )