mistangl/dxfmakros
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
42309c77d2c3b4fd6b2c05f55f0293324e8cbff0
dxfmakros/Lisp/export.lsp
T
Michael StanglandClaude Sonnet 5 42309c77d2 export_csv: Separator-TYP-XDATA vom aeusseren Trennsteg statt vom geteilten Symbol lesen 
Der letzte Fix markierte bauzeitig korrekt den aeusseren
Staustrecke_Separator_SP_300_mm-Trennsteg, csv:sep-proxies-erzeugen las den
Marker aber vom inneren Separator_SP-Symbol - das ist als Teil EINER
gemeinsamen DWG-Blockdefinition zwischen ALLEN Separatoren der Zeichnung
geteilt und kann keinen individuellen Marker tragen. Export sucht jetzt
zusaetzlich den aeusseren Trennsteg (eigene Instanz je Separator) und
ordnet ihn dem Symbol ueber die naechstliegende Weltposition zu.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-24 09:27:57 +02:00

2137 lines
98 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; 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)
;; --- 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 "<Zeichnungsname>_" 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 "<name>_export.csv"
;; bzw. "<name>_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. <DXFMAKRO>/.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" . "<pos-string>") ("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).
(defun csv:get-k-kos-strings (ename pt parent-R / ed bname blk-tbl sub-ent sub-ed
sub-bname sub-pt sub-extrusion sub-pt-real world-pt
target is-real result)
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq blk-tbl (tblsearch "BLOCK" bname))
(setq result nil)
(if blk-tbl
(progn
;; (assoc -2) ist bereits das ERSTE Entity der Blockdefinition, NICHT
;; der BLOCK-Header - direkt hier starten, kein entnext davor (das
;; uebersprang sonst ein K1/KS_EIN, das zufaellig als erstes Entity in
;; der Blockdefinition steht - derselbe Bug wie frueher in
;; ssg-collect-nested-inserts-rel, siehe dortiger Kommentar).
(setq sub-ent (cdr (assoc -2 blk-tbl)))
(while sub-ent
(setq sub-ed (entget sub-ent))
(if (= (cdr (assoc 0 sub-ed)) "INSERT")
(progn
(setq sub-bname (strcase (cdr (assoc 2 sub-ed))))
;; Ziel-Slot bestimmen: echte K1-K4 direkt, KS_EIN/KS_AUS gemappt.
(setq is-real (wcmatch sub-bname "K1,K2,K3,K4"))
(setq target
(cond
(is-real sub-bname)
((or (= sub-bname "KS_EIN") (= sub-bname "KSYS_EIN")) "K1")
((or (= sub-bname "KS_AUS") (= sub-bname "KSYS_AUS")) "K2")
(t nil)))
;; Echte K-Bloecke immer aufnehmen (vorne = Vorrang bei assoc);
;; KS-abgeleitete nur, wenn der Slot noch nicht belegt ist.
(if (and target (or is-real (not (assoc target result))))
(progn
(setq sub-pt (cdr (assoc 10 sub-ed)))
(if (null (caddr sub-pt))
(setq sub-pt (list (car sub-pt) (cadr sub-pt) 0.0)))
(setq sub-extrusion (cond ((cdr (assoc 210 sub-ed))) ('(0.0 0.0 1.0))))
(setq sub-pt-real (mat3-mul-vec3 (mat3-ocs-matrix sub-extrusion) sub-pt))
(setq world-pt (csv:local-to-world pt parent-R sub-pt-real))
(setq result (cons
(cons target
(csv:trans-encode
(car world-pt) (cadr world-pt) (caddr world-pt)))
result))
)
)
)
)
(setq sub-ent (entnext sub-ent))
)
)
)
result
)
;; --- Wert aus csv:get-k-kos-strings nach Name lesen, "" falls nicht vorhanden ---
(defun csv:k-kos (k-list name / found)
(setq found (assoc name k-list))
(if found (cdr found) "")
)
;; --- K1 (Anfang) / K2 (Ende) einer Omniflo-Gerade SYNTHETISIEREN ---
;; ename = Entity-Name des platzierten Gerade-INSERT.
;; pt/rot-rad = Welt-Einfuegepunkt (= Anfang) und -Rotation (radiant) des
;; Blocks (siehe csv:block-to-json).
;; Geraden fuehren - anders als Boegen/Weichen - KEINE echten K-Bloecke in der
;; Zeichnung. Fuer den Export werden ihre Anschluss-Koordinatensysteme aus der
;; Geometrie berechnet, als laegen dort echte KOS: K1 am Einfuegepunkt (Anfang
;; der lokalen Linie 0,0), K2 am Ende (laenge,0), ueber die Block-Rotation in
;; Weltkoordinaten gedreht. Laenge aus dem LAENGE- bzw. A-Attribut. Damit
;; koennen Geraden in der Python-Nachbarschaftserkennung (export_neighbors.py)
;; genauso ueber ihre KOS gegen andere Geraden/Boegen/Weichen geprueft werden.
;; Rueckgabe wie csv:get-k-kos-strings: (("K1" . str) ("K2" . str)) oder nil.
(defun csv:gerade-k-kos-strings (ename pt rot-rad / laenge-str laenge z end-pt)
(setq laenge-str (cond ((csv:get-attrib ename "LAENGE"))
((csv:get-attrib ename "A"))
(t nil)))
(if (and laenge-str (> (strlen laenge-str) 0))
(progn
(setq laenge (atof laenge-str))
(setq z (if (caddr pt) (caddr pt) 0.0))
(setq end-pt (list (+ (car pt) (* laenge (cos rot-rad)))
(+ (cadr pt) (* laenge (sin rot-rad)))
z))
(list
(cons "K1" (csv:trans-encode (car pt) (cadr pt) z))
(cons "K2" (csv:trans-encode (car end-pt) (cadr end-pt) (caddr end-pt))))
)
nil
)
)
;; --- KS-Position eines VF/GF-Wrappers ueber das RICHTIGE Element ---
;; bname = Blockname des VF_n/GF_n-Wrappers.
;; elem-pat = Muster des KS-tragenden Teilbloecks ("AS_ELEMENT*" bzw.
;; "ES_ELEMENT*", Grossschreibung - wcmatch ist unempfindlich).
;; ks-pat = Muster des gesuchten Koordinatensystems ("KS_EIN,KSYS_EIN"
;; bzw. "KS_AUS,KSYS_AUS").
;; Warum zwei Ebenen: das AS_Element UND das ES_Element eines VF_n fuehren
;; JEWEILS ein KS_EIN UND ein KS_AUS (siehe check_hoehen.lsp ch-measure-vfgf).
;; Ein flaches (ssg-collect-nested-inserts bname "KS_AUS") ueber den GANZEN
;; Wrapper lieferte darum zwei Treffer und (car ...) griff den falschen (den
;; des AS_Elements) - K2/ES landete auf der falschen (Anfangs-)Seite. Darum
;; ERST das passende Element (AS/ES) suchen und NUR IN DESSEN Blockdefinition
;; das KS. Die KS-Position wird durch die Weltlage des Elements (world-pt/
;; R-world/Skalierung aus dem Element-Record) in das Koordinatensystem der
;; Wrapper-Blockdefinition transformiert - dieselbe Verkettung wie in
;; ssg-collect-nested-inserts-rel (OCS ist in den Records bereits aufgeloest).
;; Rueckgabe: (x y z) im Wrapper-Definitionsframe, oder nil wenn nicht gefunden.
(defun csv:vfgf-ks-loc (bname elem-pat ks-pat / elem-hits elem-rec elem-bname
elem-pt elem-R elem-sx elem-sy elem-sz ks-hits ks-loc
scaled)
(setq elem-hits (ssg-collect-nested-inserts bname elem-pat))
(if elem-hits
(progn
(setq elem-rec (car elem-hits))
(setq elem-bname (strcase (cdr (assoc 2 (entget (car elem-rec))))))
;; Nur das KS INNERHALB dieser Element-Blockdefinition (nicht im Wrapper).
(setq ks-hits (ssg-collect-nested-inserts elem-bname ks-pat))
(if ks-hits
(progn
(setq elem-pt (cadr elem-rec))
(setq elem-R (caddr elem-rec))
(setq elem-sx (nth 3 elem-rec) elem-sy (nth 4 elem-rec) elem-sz (nth 5 elem-rec))
(setq ks-loc (cadr (car ks-hits))) ;; KS-Pos im Element-Frame
(setq scaled (list (* elem-sx (car ks-loc))
(* elem-sy (cadr ks-loc))
(* elem-sz (caddr ks-loc))))
;; Element-Weltlage (im Wrapper-Frame) + rotierte KS-Position.
(mapcar '+ elem-pt (mat3-mul-vec3 elem-R scaled))
)
)
)
)
)
;; --- K1 (Eingang) / K2 (Ausgang) eines VF_n/GF_n-Wrappers ableiten ---
;; ename = Entity-Name des platzierten VF_n/GF_n-INSERT.
;; pt/rot-rad = Welt-Einfuegepunkt/-Rotation (radiant) des Wrappers (siehe
;; csv:block-to-json).
;; VF/GF-Wrapper fuehren - anders als Omniflo-Boegen - KEINE direkten K1-K4-
;; oder KS-Sub-INSERTs; ihre Streckenenden stecken je EINE Ebene tiefer:
;; KS_EIN im AS_Element*, KS_AUS im ES_Element* (siehe check_hoehen.lsp,
;; extract-ks-from-block-raw). csv:vfgf-ks-loc holt die KS-Position aus dem
;; JEWEILS zugehoerigen Element (nicht flach aus dem ganzen Wrapper - beide
;; Elemente tragen beide KS-Typen). Der so ermittelte Punkt (Wrapper-Frame)
;; wird ueber die Wrapper-Weltlage (reine Z-Drehung) in Weltkoordinaten
;; gedreht und wie K1-K4 als reiner Positions-String (csv:trans-encode)
;; exportiert. Damit hat auch eine Strecke K1 und K2 fuer die
;; Python-Kollisionspruefung (export_neighbors.py: Schleuselemente +
;; Kreisel-Kollision ueber die AS/ES-Position mit fester BBox statt der
;; ganzen Wrapper-Box).
;;
;; RICHTUNG: K1 ist IMMER der Eingang eines Elements, K2 IMMER der Ausgang.
;; AS = Eingangs-Element (traegt KS_EIN), ES = Ausgangs-Element (traegt KS_AUS).
;; - VarioFoerderer/Strecke (VF_*): Richtung liegt ueber die Elementrolle
;; fest -> K1 = AS-Ende (KS_EIN), K2 = ES-Ende (KS_AUS).
;; - Gefaellestrecke (GF_*): Foerderrichtung ist bergAB, also durch die HOEHE
;; bestimmt (siehe HOEHE_VON_mm > HOEHE_BIS_mm, check_hoehen.lsp). Der
;; Eingang ist das HOEHERE Ende, der Ausgang das TIEFERE - unabhaengig
;; davon, welches der beiden physischen Elemente das AS bzw. ES ist. Darum
;; wird bei GF nach Z sortiert (hoeheres Z -> K1, tieferes Z -> K2).
;; Rueckgabe wie csv:get-k-kos-strings: (("K1" . str) ("K2" . str)) - nur die
;; tatsaechlich gefundenen Enden.
(defun csv:vfgf-k-kos-strings (ename pt rot-rad / ed bname as-loc es-loc
as-world es-world ein-world aus-world result)
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq result nil)
;; Beide Enden im Wrapper-Frame holen und in Weltkoordinaten umrechnen.
;; VF_n/GF_n-Wrapper stehen an ihrem eigenen top-level INSERT immer flach
;; (Extrusion (0 0 1) - siehe csv:sep-proxies-erzeugen), darum genuegt hier
;; weiterhin die reine Z-Drehungsmatrix (mat3-rz) statt der vollen
;; Elternorientierung, die csv:get-k-kos-strings inzwischen braucht (siehe
;; dort). AS traegt das KS_EIN, ES das KS_AUS - jeweils aus dem RICHTIGEN
;; Element (csv:vfgf-ks-loc; beide Elemente fuehren beide KS-Typen).
(setq as-loc (csv:vfgf-ks-loc bname "AS_ELEMENT*" "KS_EIN,KSYS_EIN"))
(setq es-loc (csv:vfgf-ks-loc bname "ES_ELEMENT*" "KS_AUS,KSYS_AUS"))
(if as-loc (setq as-world (csv:local-to-world pt (mat3-rz rot-rad) as-loc)))
(if es-loc (setq es-world (csv:local-to-world pt (mat3-rz rot-rad) es-loc)))
;; Eingang/Ausgang festlegen (siehe Richtung im Kopfkommentar).
(cond
;; GF: Richtung ueber die Hoehe - hoeheres Z = Eingang, tieferes Z = Ausgang.
;; Nur wenn BEIDE Enden vorhanden sind; sonst faellt es auf die Rolle zurueck.
((and (wcmatch (strcase bname) "GF_*") as-world es-world)
(if (>= (caddr as-world) (caddr es-world))
(setq ein-world as-world aus-world es-world)
(setq ein-world es-world aus-world as-world)))
;; VF/Strecke (und GF mit nur einem Ende): AS = Eingang, ES = Ausgang.
(t (setq ein-world as-world aus-world es-world))
)
(if ein-world
(setq result (cons (cons "K1"
(csv:trans-encode (car ein-world) (cadr ein-world) (caddr ein-world))) result)))
(if aus-world
(setq result (cons (cons "K2"
(csv:trans-encode (car aus-world) (cadr aus-world) (caddr aus-world))) result)))
(reverse result)
)
;; --- Mindesthoehe der Bounding-Box (Z-Ausdehnung), aus cfg/export.cfg ---
;; [Boundingbox] bb_minimum_height_mm, Default 1 (mm) falls nicht gesetzt.
;; Verhindert dz=0 bei flachen 2D-Bloecken (Draufsicht ohne Z-Ausdehnung).
(defun csv:bb-minimum-height-mm ()
(atof (export:cfg "Boundingbox" "bb_minimum_height_mm" "1"))
)
;; Diagnose fuer csv:get-bbox: zaehlt fehlgeschlagene vla-getboundingbox-
;; Aufrufe und merkt sich die ERSTE Fehlermeldung samt betroffenem Block. Wird
;; von csv:run-export vor der Export-Schleife zurueckgesetzt und danach
;; ausgegeben - so sieht man in der BricsCAD-Konsole sofort, WARUM eine bbox
;; fehlt (frueher wurde der Fehler still zu nil verschluckt, und im JSON fehlte
;; nur das Feld). *csv-bbox-fail-count* = Anzahl, *csv-bbox-fail-first* =
;; "(Blockname) Meldung" des ersten Fehlers.
(setq *csv-bbox-fail-count* 0)
(setq *csv-bbox-fail-first* nil)
;; --- Bounding-Box (WCS, achsparallel) eines INSERT-Blocks ermitteln ---
;; Erzwingt vorher ein vla-update (Regen), da vla-getboundingbox sonst auf
;; nicht-regenerierten oder auf eingefrorenen Layern liegenden Bloecken scheitert.
;; Rueckgabe: Liste (cx cy cz dx dy dz) -- Mittelpunkt + Ausdehnung, oder nil bei Fehler.
;; dz wird auf csv:bb-minimum-height-mm angehoben, falls kleiner (siehe dort).
(defun csv:get-bbox (ename / obj res minpt maxpt dz min-hoehe)
(setq obj (vlax-ename->vla-object ename))
(vl-catch-all-apply 'vla-update (list obj))
(setq res
(vl-catch-all-apply
'(lambda ( / ll ur)
(vla-getboundingbox obj 'll 'ur)
(list (csv:pt->list ll) (csv:pt->list ur)))))
(if (vl-catch-all-error-p res)
(progn
;; Fehler NICHT mehr still schlucken: zaehlen und erste Meldung merken.
(setq *csv-bbox-fail-count* (1+ (cond (*csv-bbox-fail-count*) (0))))
(if (null *csv-bbox-fail-first*)
(setq *csv-bbox-fail-first*
(strcat "(" (cond ((cdr (assoc 2 (entget ename)))) ("?")) ") "
(vl-catch-all-error-message res))))
nil)
(progn
(setq minpt (car res))
(setq maxpt (cadr res))
(setq dz (- (caddr maxpt) (caddr minpt)))
(setq min-hoehe (csv:bb-minimum-height-mm))
(if (< dz min-hoehe) (setq dz min-hoehe))
(list
(/ (+ (car minpt) (car maxpt)) 2.0)
(/ (+ (cadr minpt) (cadr maxpt)) 2.0)
(/ (+ (caddr minpt) (caddr maxpt)) 2.0)
(- (car maxpt) (car minpt))
(- (cadr maxpt) (cadr minpt))
dz
)
)
)
)
;; --- Attribute eines INSERT-Blocks als JSON-Objekt lesen ---
;; ename = Entity-Name des INSERT
;; Rueckgabe: String wie {"TAG1":"Wert1","TAG2":"Wert2"}
(defun csv:read-attribs (ename / obj ed typ tag wert parts)
(setq obj (entnext ename))
(setq parts nil)
(while obj
(setq ed (entget obj))
(setq typ (cdr (assoc 0 ed)))
(if (equal typ "SEQEND") (setq obj nil)
(progn
(if (equal typ "ATTRIB")
(setq parts (cons (strcat "\"" (csv:json-escape (cdr (assoc 2 ed)))
"\":\"" (csv:json-escape (cdr (assoc 1 ed))) "\"")
parts))
)
(setq obj (entnext obj))
)
)
)
(if parts
(progn
(setq parts (reverse parts))
(strcat "{" (car parts)
(apply 'strcat (mapcar '(lambda (p) (strcat "," p)) (cdr parts)))
"}")
)
"{}"
)
)
;; --- Einen INSERT-Block als JSON-Objekt schreiben ---
;; include-bbox = T -> zusaetzlich Bounding-Box (Mitte + Ausdehnung) ermitteln
;; und als "bbox"-Objekt anhaengen (nur fuer EXPORTCSV, nicht fuer EXPORTSIVAS).
;; "insertpoint" (KOS-String von Position+Rotation des Blocks selbst) und
;; "k1".."k4" (KOS-Strings der Koordinatensysteme im Block, siehe
;; csv:get-k-kos-strings) werden immer geschrieben, unabhaengig von
;; include-bbox -- Kodierung ueber csv:kos-encode (siehe dort).
(defun csv:block-to-json (ename include-bbox / ed blk-name layer pt rotation extrusion R-world
handle attribs bbox bbox-json
insert-quat insert-kos k-list warnung-json warnung-eintrag
zuordnung-fix-json zuordnung-fix-eintrag
strecke-typ-json strecke-typ-eintrag
sepliste-json sepliste-app sepliste
sepliste-teile sepliste-first sepliste-ids sep-id)
(setq ed (entget ename))
(setq blk-name (cdr (assoc 2 ed)))
(setq layer (cdr (assoc 8 ed)))
(setq pt (cdr (assoc 10 ed)))
(setq rotation (cdr (assoc 50 ed)))
(setq handle (cdr (assoc 5 ed)))
(if (null rotation) (setq rotation 0.0))
(if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0)))
;; Gruppe 10 ist OCS-lokal zur EIGENEN Extrusion dieses INSERT (Gruppe
;; 210) - fuer die allermeisten Bloecke (0 0 1) = Welt, aber ein Separator-
;; Proxy, der ueber ssg-collect-nested-inserts aus dem geneigten Abschnitt
;; einer VF-/GF-Kette neu zusammengesetzt wurde (csv:sep-proxies-erzeugen),
;; kann eine echt gekippte Extrusion tragen. Erst in echte Weltkoordinaten/
;; -orientierung umrechnen (Arbitrary Axis Algorithm, ssg_core.lsp), bevor
;; irgendetwas darauf aufbaut - sonst zeigt "x"/"y"/"z" (und darueber K1-K4,
;; siehe csv:get-k-kos-strings) einen falschen, teils spiegelverkehrten
;; Weltpunkt (realer Bug: Separator :4/6/8/10/12 in HundM05, K1 landete am
;; Vorzeichen gespiegelt weit ausserhalb der eigenen Boundingbox). Fuer
;; Extrusion=(0 0 1) reduziert sich das exakt auf die alte Uebernahme.
(setq extrusion (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0))))
(setq pt (mat3-mul-vec3 (mat3-ocs-matrix extrusion) pt))
(setq R-world (mat3-from-normal-rotation extrusion rotation))
(setq attribs (csv:read-attribs ename))
(setq insert-quat (csv:z-angle-to-quat (* (/ rotation pi) 180.0)))
(setq insert-kos (csv:kos-encode
(car pt) (cadr pt) (if (caddr pt) (caddr pt) 0.0)
(nth 0 insert-quat) (nth 1 insert-quat) (nth 2 insert-quat) (nth 3 insert-quat)))
(setq k-list (csv:get-k-kos-strings ename pt R-world))
;; 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))
)
(setq bbox-json "")
(if include-bbox
(progn
(setq bbox (csv:get-bbox ename))
(if bbox
(setq bbox-json
(strcat
",\"bbox\":{"
"\"cx\":" (rtos (nth 0 bbox) 2 4)
",\"cy\":" (rtos (nth 1 bbox) 2 4)
",\"cz\":" (rtos (nth 2 bbox) 2 4)
",\"dx\":" (rtos (nth 3 bbox) 2 4)
",\"dy\":" (rtos (nth 4 bbox) 2 4)
",\"dz\":" (rtos (nth 5 bbox) 2 4)
"}"
)
)
)
)
)
;; Warnung fuer strittige Scanner-Zuordnungen anhaengen (siehe
;; cs-zuordnung-lauf in count_sep_scan.lsp, das *cs-scanner-warnung-
;; by-handle* vor csv:collect-export-blocks befuellt). Referenziert
;; die Variable direkt statt ueber atoms-family: ein in AutoLISP noch
;; nie gesetztes globales Symbol wertet beim Lesen zu nil aus (kein
;; Fehler), genau wie *export-test-override* in diesem Modul.
(setq warnung-json "")
(setq warnung-eintrag (assoc handle *cs-scanner-warnung-by-handle*))
(if warnung-eintrag
(setq warnung-json (strcat ",\"warnung\":\"" (csv:json-escape (cdr warnung-eintrag)) "\""))
)
;; Bekannte (nicht geratene) Separator-Zuordnung durchreichen: fuer die
;; temporaeren Kopien VERPACKTER Separator_SP-Symbole steht der Carrier fest
;; (der Wrapper-Block, in dem das Symbol steckt) - siehe
;; csv:sep-proxies-zuordnung-setzen und *cs-sep-fix-by-handle*. export_csv.py
;; berechnet die Zuordnung sonst ein zweites Mal per Boundingbox-
;; Ueberschneidung (compute_sensor_zuordnung, Prioritaet GF > VF > Kreisel-
;; haelfte) und wuerde den bekannten Wert damit ueberschreiben - z.B. auf
;; eine Gefaellestrecke, in deren Box der Separator zufaellig hineinragt,
;; obwohl er in einem VF-Block verpackt ist. Mit diesem Feld uebernimmt
;; export_csv.py den Wert unveraendert.
(setq zuordnung-fix-json "")
(setq zuordnung-fix-eintrag (assoc handle *cs-sep-fix-by-handle*))
(if zuordnung-fix-eintrag
(setq zuordnung-fix-json
(strcat ",\"zuordnung_fix\":\"" (csv:json-escape (cdr zuordnung-fix-eintrag)) "\""))
)
;; Streckentyp (VF/GF) DIESES EINZELNEN Separators, bauzeitig gesetzt
;; (ssg-sep-typ-xdata-schreiben, siehe csv:sep-proxies-erzeugen/
;; -zuordnung-setzen) - NICHT vom Wrapper-Blocknamen ableitbar, da ein
;; VF_n/GF_n-Wrapper intern zwischen VF-/GF-Abschnitten wechseln kann.
;; export_csv.py schreibt diesen Wert in die Merkmale der Proxy-Zeile
;; (Feld "Typ").
(setq strecke-typ-json "")
(setq strecke-typ-eintrag (assoc handle *cs-sep-typ-by-handle*))
(if strecke-typ-eintrag
(setq strecke-typ-json
(strcat ",\"strecke_typ\":\"" (csv:json-escape (cdr strecke-typ-eintrag)) "\""))
)
;; VF_n/GF_n-Wrapper: Separator-/AS-/ES-Reihenfolge aus der beim Bau
;; geschriebenen XDATA lesen (siehe ssg-sepliste-xdata-lesen,
;; ssg_ks_insert.lsp) und als "sepliste"-Array einbetten. Nur gesetzt, wenn
;; die XDATA vorhanden ist (Altbestand-Wrapper ohne die neue XDATA bleiben
;; ohne dieses Feld - export_neighbors.py faellt dann auf den bisherigen
;; BBox-Kollisionspfad zurueck).
(setq sepliste-json "")
(if (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN")))
(progn
(setq sepliste-app
(cond
((wcmatch (strcase blk-name) "VF_*") "SSG_VF_SEP")
((wcmatch (strcase blk-name) "GF_*") "SSG_GF_SEP")
(t nil)))
(if sepliste-app
(setq sepliste (ssg-sepliste-xdata-lesen ename sepliste-app)))
(if sepliste
(progn
;; ID des Bauteils, das zu diesem Eintrag gehoert: beim Export wird
;; fuer JEDEN Eintrag (AS/SEP/ES) eine echte, temporaere Kopie des
;; verpackten Originals eingefuegt und ueber ssg-id-check-all
;; nummeriert; csv:sepliste-ids-setzen haengt die vergebene ID an den
;; Eintrag (Key = Handle dieses Wrappers). Fehlt sie (Kopie nicht
;; erzeugbar, Block ohne ID-ATTDEF, Altbestand), bleibt das Feld weg -
;; der Python-Teil faellt dann auf seine Koordinaten-Zuordnung zurueck.
(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))
",\"x\":" (rtos (nth 2 e) 2 2)
",\"y\":" (rtos (nth 3 e) 2 2)
(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 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")
)
)
;; --- Muster der Compound-("Wrapper"-)Bloecke, deren Definition ueberhaupt
;; auf verpackte Separator_SP-Symbole durchsucht wird (KR_n/KREISEL_n/
;; ECKRAD_n/VF_n/GF_n) - alle anderen INSERTs (Omniflo, eigenstaendige
;; Separator_SP, ...) koennen von vornherein nichts "verpackt" enthalten
;; und werden gar nicht erst geprueft.
(defun csv:pattern-wrapper-fuer-proxies ()
(strcat (export:pattern "pattern_kreisel" "KR_*,KREISEL_*,ECKRAD_*") ",VF_*,GF_*")
)
;; --- Skalierungsfaktor absichern ---
;; vla-InsertBlock verweigert den Faktor 0 (entartete Blockreferenz). Der
;; kann nur aus einer fehlerhaften Blockdefinition kommen; 1.0 ist dann die
;; brauchbarste Annahme - die Kopie steht wenigstens an der richtigen Stelle.
(defun csv:skalierung-oder-eins (f)
(if (or (null f) (equal f 0.0 1e-12)) 1.0 f)
)
;; --- Fuer jedes verpackte Original die Weltlage ermitteln und daran ein
;; echtes Objekt in den Modellraum setzen ---
;; nested-pattern = wcmatch-Muster der zu suchenden Sub-INSERTs, siehe
;; csv:pattern-nested-separator (Separator-Symbole) bzw.
;; csv:pattern-nested-schleus (AS-/ES-Schleuselemente).
;;
;; Sub-Bloecke, die beim Zusammenbau von VF_n/GF_n/KREISEL_n in die Compound-
;; Blockdefinition "verpackt" wurden (siehe ssg-collect-nested-inserts), sind
;; fuer (ssget "X" ...) unsichtbar - und damit weder fuer ssg-id-check-all
;; (eigene ID) noch csv:collect-export-blocks (JSON-Zeile) erreichbar, und in
;; der Zeichnung auch nicht als eigenes Objekt anklickbar. Diese Funktion
;; liefert ihre Weltlage, ohne die Zeichnung anzufassen; was daran gesetzt
;; wird, entscheidet der Aufrufer:
;; - csv:sep-proxies-erzeugen -> temporaere Kopie des Symbols selbst
;; (wird nach dem Export wieder geloescht)
;; - csv:asmark-aktualisieren -> dauerhafter AS/ES-Marker (bleibt stehen
;; und traegt die ID ueber Laeufe hinweg)
;;
;; Die Kopie steht bewusst EXAKT auf der Weltposition/-drehung/-skalierung
;; ihres verpackten Vorbilds (frueher: +500 mm Versatz in Blockrichtung, rein
;; kosmetisch). Der Versatz war schaedlich: die geometrische Sensor-Zuordnung
;; in count_sep_scan.lsp arbeitet ueber die Carrier-Boundingbox, und ein um
;; 500 mm verschobener Separator kippt am Kettenende in die Box des Nachbar-
;; Carriers - die Kopie soll ihr Vorbild in der Zeichenebene 1:1
;; repraesentieren. Die Platzierung der Ebenen zwischen Wrapper und Symbol
;; steckt in den Records von ssg-collect-nested-inserts (Position/Drehung/
;; Skalierung relativ zur Wrapper-Definition); hier kommt nur noch die
;; Platzierung des top-level INSERT darauf.
;;
;; Rueckgabe: Liste von Records
;; (wrapper-ename nested-ent nested-bname (x y z) R sx sy sz)
;; mit der fertigen Weltlage jedes Fundes (R = volle 3x3-Orientierung).
(defun csv:nested-welt-records (nested-pattern
/ ss-all i ename ed bname nested pt rotation
extrusion0 R0 psx psy psz rec nested-ent nested-bname
local-pt R-nested R-final scaled-pt rot-pt world-pt
records)
(setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
(if ss-all
(progn
(setq i 0)
(while (setq ename (ssname ss-all i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq nested
(if (wcmatch bname (csv:pattern-wrapper-fuer-proxies))
(ssg-collect-nested-inserts bname nested-pattern)
)
)
(if nested
(progn
(setq pt (cdr (assoc 10 ed)))
(if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0)))
(setq rotation (cond ((cdr (assoc 50 ed))) (0.0)))
;; Extrusion des Wrapper-INSERTs selbst beruecksichtigen statt
;; reine Z-Drehung anzunehmen - GF_n/VF_n stehen zwar bisher immer
;; flach (Extrusion (0 0 1)), aber mat3-from-normal-rotation
;; reduziert sich dafuer ohnehin exakt auf Rz(rotation), kostet
;; also nichts und macht den Code robust falls sich das aendert.
(setq extrusion0 (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0))))
(setq R0 (mat3-from-normal-rotation extrusion0 rotation))
(setq psx (cond ((cdr (assoc 41 ed))) (1.0)))
(setq psy (cond ((cdr (assoc 42 ed))) (1.0)))
(setq psz (cond ((cdr (assoc 43 ed))) (1.0)))
(foreach rec nested
(setq nested-ent (nth 0 rec))
(setq local-pt (nth 1 rec))
(setq R-nested (nth 2 rec))
(setq nested-bname (cdr (assoc 2 (entget nested-ent))))
(setq scaled-pt (list (* psx (car local-pt))
(* psy (cadr local-pt))
(* psz (caddr local-pt))))
(setq rot-pt (mat3-mul-vec3 R0 scaled-pt))
(setq world-pt (list (+ (car pt) (car rot-pt))
(+ (cadr pt) (cadr rot-pt))
(+ (caddr pt) (caddr rot-pt))))
(setq R-final (mat3-mul-mat3 R0 R-nested))
(setq records
(cons (list ename nested-ent nested-bname world-pt R-final
(* psx (nth 3 rec)) (* psy (nth 4 rec)) (* psz (nth 5 rec)))
records))
)
)
)
(setq i (1+ i))
)
)
)
(reverse records)
)
;; --- Einen Block an einer vollen 3D-Weltlage einfuegen ---
;; ms = ModelSpace-Objekt (der Aufrufer holt es EINMAL, nicht je Block)
;; bname = einzufuegende Blockdefinition
;; world-pt/R = Weltposition und volle 3x3-Orientierung (siehe
;; csv:nested-welt-records)
;; sx/sy/sz = Skalierung; der AS/ES-Marker fuegt bewusst mit 1.0 ein (ein
;; gestauchtes Rechteck waere als Marker unbrauchbar), die
;; Separator-Kopie mit der tatsaechlichen Skalierung ihres
;; Vorbilds.
;; kontext = Blockname des Wrappers, nur fuer die Fehlermeldung.
;;
;; Volle 3D-Orientierung statt eines einzelnen Z-Drehwinkels: ein Skalar-
;; Drehwinkel kann eine Kippung ausserhalb der XY-Ebene (Gefaellestrecke-/
;; VF-Neigung) gar nicht darstellen. Deshalb - wie insert-block-ks-to-ks
;; (vf_core.lsp) - am Ursprung mit Rotation=0 einfuegen und die komplette Lage
;; (Drehung UND Verschiebung) in EINER vla-TransformBy anwenden.
;;
;; Einfuegen ueber vla-InsertBlock (ActiveX) statt "command _.INSERT": das legt
;; fuer einen Block mit ATTDEFs automatisch ATTRIB-Entities mit den Vorgabe-
;; werten an - OHNE jeden einzelnen Insert-Prompt (Blockname/Einfuegepunkt/
;; Skalierung/Drehwinkel) ins Kommandozeilen-Fenster zu schreiben.
;;
;; Beide ActiveX-Aufrufe sind gekapselt: ein einzelner Sonderfall (entartete
;; Skalierung, gespiegelter Zwischenblock) darf nicht den kompletten Export der
;; Zeichnung abbrechen, sondern nur dieses eine Objekt ausfallen lassen - mit
;; Meldung, welcher Block. Rueckgabe: ename des neuen INSERT oder nil.
(defun csv:block-einfuegen-welt (ms bname world-pt R sx sy sz kontext
/ T4 block-obj xform-fehler erg)
(setq T4 (vlax-tmatrix
(list (list (car (car R)) (cadr (car R)) (caddr (car R)) (car world-pt))
(list (car (cadr R)) (cadr (cadr R)) (caddr (cadr R)) (cadr world-pt))
(list (car (caddr R)) (cadr (caddr R)) (caddr (caddr R)) (caddr world-pt))
(list 0.0 0.0 0.0 1.0))))
(setq block-obj
(vl-catch-all-apply 'vla-InsertBlock
(list ms (vlax-3D-point '(0.0 0.0 0.0)) bname
(csv:skalierung-oder-eins sx)
(csv:skalierung-oder-eins sy)
(csv:skalierung-oder-eins sz)
0.0)))
(cond
((vl-catch-all-error-p block-obj)
(princ (ssg-textf "exp-sep-proxy-fehler"
(list bname kontext (vl-catch-all-error-message block-obj))))
(setq erg nil))
(t
(setq xform-fehler (vl-catch-all-apply 'vla-TransformBy (list block-obj T4)))
(if (vl-catch-all-error-p xform-fehler)
(progn
(princ (ssg-textf "exp-sep-proxy-fehler"
(list bname kontext (vl-catch-all-error-message xform-fehler))))
(vl-catch-all-apply 'vla-Delete (list block-obj))
(setq erg nil))
(setq erg (vlax-vla-object->ename block-obj))
)
)
)
erg
)
;; --- Muster des AEUSSEREN Trennsteg-Blocks, der das Separator_SP-Symbol
;; und den Streckentyp-Marker traegt ---
;; ssg-sep-typ-xdata-schreiben (ssg_ks_insert.lsp) markiert bauzeitig NICHT
;; das Separator_SP-Symbol selbst, sondern seinen Verpacker
;; Staustrecke_Separator_SP_300_mm - der Grund: Separator_SP steckt als EIN
;; einziges, von der DWG-Blockdefinition geteiltes Sub-INSERT in JEDER
;; Staustrecke_Separator_SP_300_mm-Instanz (Block-Referenzen teilen sich ihre
;; Definition), eine XDATA-Markierung dort waere also fuer JEDEN Separator
;; der ganzen Zeichnung identisch. Staustrecke_Separator_SP_300_mm selbst ist
;; dagegen pro Einfuegung eine EIGENE Instanz mit eigenem Handle - genau dort
;; setzt der Bau seine Markierung.
(defun csv:pattern-nested-separator-aussen ()
"Staustrecke_Separator_SP_300_mm*"
)
;; --- Naechstliegenden Record aus einer csv:nested-welt-records-Liste zu
;; einem Weltpunkt finden --- (planare Distanz x/y reicht: die Symbole
;; sitzen praktisch am selben Punkt wie ihr Verpacker, siehe
;; csv:pattern-nested-separator-aussen)
(defun csv:nested-record-naechster (pt records / best best-d rec dx dy d)
(setq best nil best-d nil)
(foreach rec records
(setq dx (- (car (nth 3 rec)) (car pt)))
(setq dy (- (cadr (nth 3 rec)) (cadr pt)))
(setq d (+ (* dx dx) (* dy dy)))
(if (or (null best-d) (< d best-d))
(progn (setq best rec) (setq best-d d))
)
)
best
)
;; --- Temporaere Kopie je verpacktem Separator_SP-Symbol ---
;; Setzt csv:nested-welt-records + csv:block-einfuegen-welt zusammen: fuer
;; jeden Fund eine ECHTE Kopie DESSELBEN Blocks an derselben Weltlage.
;; Die AS-/ES-Kettenenden laufen NICHT mehr hierueber - fuer sie setzt
;; csv:asmark-aktualisieren einen dauerhaften Marker (siehe dort).
;;
;; proxy-liste-Eintrag: (proxy-ename wrapper-ename typ (x y z) strecke-typ).
;; strecke-typ = "VF"/"GF"/nil, gelesen von ssg-sep-typ-xdata-lesen AM
;; AEUSSEREN Trennsteg-Insert (csv:pattern-nested-separator-aussen), NICHT am
;; Separator_SP-Symbol selbst (das ist Block-Definitions-geteilt, siehe dort)
;; und NICHT vom Wrapper-Blocknamen abgeleitet (fruehere Fehlannahme, siehe
;; lib/dump_vf_kette_inhalt.py): ein einzelner VF_n/GF_n-Wrapper kann intern
;; mehrfach zwischen Foerderer- und Gefaellestrecke-Abschnitten wechseln, der
;; Marker sitzt daher direkt am jeweiligen Separator-Insert (gesetzt bauzeitig
;; in vf_linienzug.lsp/Gefaellestrecke.lsp/vf_standard.lsp/vf_etage.lsp,
;; direkt nach dessen Einfuegung). Zuordnung Symbol<->Trennsteg ueber die
;; naechstliegende Weltposition (beide sitzen praktisch am selben Punkt).
(defun csv:sep-proxies-erzeugen ( / ms recs recs-aussen rec aussen-rec proxy proxy-liste)
(setq recs (csv:nested-welt-records (csv:pattern-nested-separator)))
(setq recs-aussen (csv:nested-welt-records (csv:pattern-nested-separator-aussen)))
(if recs
(progn
(setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(foreach rec recs
(setq aussen-rec (csv:nested-record-naechster (nth 3 rec) recs-aussen))
(setq proxy (csv:block-einfuegen-welt ms (nth 2 rec) (nth 3 rec) (nth 4 rec)
(nth 5 rec) (nth 6 rec) (nth 7 rec)
(cdr (assoc 2 (entget (nth 0 rec))))))
(if proxy
(setq proxy-liste
(cons (list proxy (nth 0 rec) (csv:proxy-typ (nth 2 rec)) (nth 3 rec)
(if aussen-rec (ssg-sep-typ-xdata-lesen (nth 1 aussen-rec))))
proxy-liste)))
)
)
)
(reverse proxy-liste)
)
;; --- 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
)
;; ===========================================================================
;; AS-/ES-Marker (ZZ_ASES_MARKER)
;; ===========================================================================
;; Ein kleines Rechteck, das der Export an JEDES AS-/ES-Ende einer VF_n/GF_n-
;; Kette setzt und das dort DAUERHAFT stehen bleibt. Es ist zweierlei:
;;
;; Sichtbarmachung - die Kettenenden stecken verpackt in der Wrapper-
;; Blockdefinition (AS_Element_*/ES_Element_*) und sind in der Zeichnung
;; sonst weder anklickbar noch als eigenes Objekt erkennbar.
;; ID-Traeger - das (unsichtbare) ID-Attribut des Markers fuellt
;; ssg-id-check-all, und der naechste Export VERWENDET DENSELBEN MARKER
;; WIEDER. Ein AS/ES behaelt seine TeileId dadurch ueber Exportlaeufe
;; hinweg - anders als die temporaeren Separator-Kopien, die bei jedem Lauf
;; neu entstehen und neue IDs bekommen.
;;
;; Der Marker ist abgeleitete Geometrie: csv:asmark-aktualisieren baut bei
;; JEDEM Export alle Marker neu auf (Lage folgt damit automatisch einer
;; umgebauten Kette) und uebernimmt dabei nur die ID des bisherigen Markers.
;; Nicht wiederverwendete Marker werden geloescht - ein Marker ohne Kette
;; bleibt also nicht als Karteileiche stehen.
(defun csv:asmark-blockname () "ZZ_ASES_MARKER")
;; Kantenlaenge (mm) des Rechtecks, aus cfg/export.cfg [Marker].
(defun csv:asmark-groesse-mm ()
(atof (export:cfg "Marker" "ases_groesse_mm" "200"))
)
;; Attribut-Schema des Markers. Alle ATTDEFs sind UNSICHTBAR
;; (ssg-attrib-make-defs setzt Flag 70=1) - sichtbar ist nur das Rechteck.
;; ID - fuellt ssg-id-check-all; wird beim naechsten Export uebernommen
;; ZUORDNUNG - ID des VF_n/GF_n-Wrappers, zu dem das Kettenende gehoert
;; (zugleich der Schluessel, ueber den der Marker wiedergefunden
;; wird, siehe csv:asmark-finden)
;; TYP - "AS" oder "ES", wie in der sepliste (ssg-sepliste-sammeln)
;; LFDNR - lfdnr des zugehoerigen sepliste-Eintrags
;; ELEMENT - Blockname des echten Schleuselements (AS_Element_90_links_3D):
;; haelt die Variante (30/90, links/rechts, 2D/3D) fest, die der
;; Marker selbst nicht mehr zeigt
;; ARTINR - Sivas-Nummer aus dem Attribut des echten Elements
(setq *csv-asmark-attrib-defs*
'(("ID" "") ("ZUORDNUNG" "") ("TYP" "") ("LFDNR" "") ("ELEMENT" "") ("ARTINR" ""))
)
;; --- Blockdefinition des Markers bei Bedarf anlegen ---
;; Es gibt bewusst KEINE DWG dafuer: der Marker ist reine Hilfsgeometrie und
;; soll in jeder Zeichnung ohne Blockbibliothek entstehen koennen. Aufbau wie
;; bei den Geruest-Baugruppen (GeruestInsert.lsp): Geometrie + ATTDEFs in den
;; Modellraum zeichnen, alles seit lastEnt einsammeln, per "_.-BLOCK" zur
;; Definition machen (das entfernt die Vorlage-Entities wieder).
;; Die Geometrie liegt auf Layer "0", damit der Marker den Layer seiner
;; Blockreferenz annimmt (den setzt csv:asmark-aktualisieren aus cfg/layer.cfg).
;;
;; WICHTIG - der Auswahlsatz nimmt NUR die beiden hier erzeugten Entity-Typen
;; auf: (entlast) liefert bei einer Blockreferenz MIT Attributen die Referenz
;; selbst, und (entnext) steigt von dort in deren ATTRIB-Unterentities ab. Ohne
;; Filter landen also die Attribute des zuletzt eingefuegten Blocks (z.B. eines
;; gerade gebauten VF_n) mit im Auswahlsatz - "_.-BLOCK" verschiebt sie in die
;; neue Blockdefinition und der Block steht danach OHNE Attribute da (real
;; beobachtet: VF_5 verlor beim ersten Export saemtliche Attribute, inklusive
;; seiner ID).
;; Rueckgabe: Blockname oder nil.
(defun csv:asmark-blockdef-sicherstellen ( / name h lastEnt ss e typ)
(setq name (csv:asmark-blockname))
(if (tblsearch "BLOCK" name)
name
(progn
(setq h (/ (csv:asmark-groesse-mm) 2.0))
(setq lastEnt (entlast))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "0")
'(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
(cons 10 (list (- h) (- h)))
(cons 10 (list h (- h)))
(cons 10 (list h h))
(cons 10 (list (- h) h))))
(ssg-attrib-make-defs *csv-asmark-attrib-defs* (/ h 2.0))
(setq ss (ssadd))
(setq e (if lastEnt (entnext lastEnt) (entnext)))
(while e
(setq typ (cdr (assoc 0 (entget e))))
(if (member typ '("LWPOLYLINE" "ATTDEF")) (ssadd e ss))
(setq e (entnext e))
)
(command "_.-BLOCK" name (list 0.0 0.0 0.0) ss "")
(if (tblsearch "BLOCK" name)
(progn (princ (ssg-textf "exp-asmark-blockdef" (list name))) name)
(progn (princ (ssg-textf "exp-asmark-blockdef-fehler" (list name))) nil)
)
)
)
)
;; --- Vorhandene Marker der Zeichnung einsammeln ---
;; Rueckgabe: Liste von (ename zuordnung typ lfdnr id), alle Werte als String
;; (fehlende Attribute als "").
(defun csv:asmark-sammeln ( / ss i ename attribs out)
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 (csv:asmark-blockname)))))
(if ss
(progn
(setq i 0)
(while (setq ename (ssname ss i))
(setq attribs (ssg-attrib-read ename))
(setq out
(cons (list ename
(cond ((cdr (assoc "ZUORDNUNG" attribs))) (""))
(cond ((cdr (assoc "TYP" attribs))) (""))
(cond ((cdr (assoc "LFDNR" attribs))) (""))
(cond ((cdr (assoc "ID" attribs))) ("")))
out))
(setq i (1+ i))
)
)
)
(reverse out)
)
;; --- Den Marker eines Kettenendes im Bestand suchen ---
;; Schluessel: Wrapper-ID + Typ + lfdnr (alles Strings). Bewusst NICHT ueber
;; die Position: eine Kette, die verschoben oder umgebaut wurde, soll ihre
;; TeileIds behalten. Ein Wrapper OHNE ID (frisch gebaut, ssg-id-check-all lief
;; noch nicht) findet folgerichtig nichts - seine Marker entstehen neu; die
;; ZUORDNUNG wird nach der ID-Vergabe nachgetragen (csv:asmark-ids-setzen),
;; sodass es beim naechsten Export passt.
(defun csv:asmark-finden (bestand zuordnung typ lfdnr / m treffer)
(foreach m bestand
(if (and (null treffer)
(= (nth 1 m) zuordnung)
(= (nth 2 m) typ)
(= (nth 3 m) lfdnr))
(setq treffer m)
)
)
treffer
)
;; --- Alle AS-/ES-Marker der Zeichnung neu aufbauen ---
;; Laeuft VOR ssg-id-check-all (csv:export-vorbereiten): neue Marker haben dann
;; noch kein ID-Attribut und werden dort nummeriert, uebernommene tragen die ID
;; ihres Vorgaengers und behalten sie.
;;
;; Ablauf je VF_n/GF_n-Wrapper mit sepliste:
;; 1. Weltlage aller verpackten AS-/ES-Elemente holen (csv:nested-welt-records)
;; 2. sie den AS-/ES-Eintraegen der sepliste zuordnen (csv:sepliste-paare -
;; dieselbe exklusive Zuordnung wie bei den Separator-Kopien; SEP-Eintraege
;; finden hier keinen Partner und bleiben unberuehrt)
;; 3. je Paar den bisherigen Marker suchen, seine ID merken, ihn loeschen und
;; an der AKTUELLEN Lage neu setzen
;; Was danach im Bestand uebrig ist, gehoert zu keiner Kette mehr und wird
;; geloescht.
;;
;; Rueckgabe: Liste von Records (marker-ename wrapper-ename typ lfdnr) fuer
;; csv:asmark-ids-setzen.
(defun csv:asmark-aktualisieren ( / recs bestand blockname ms wrapper-enames rec
wrapper ed bname wrapper-id app sepliste eigene
proxies paare paar elem lfdnr typ alt alt-id
mark artinr m neu uebernommen verwaist ergebnis)
(setq neu 0 uebernommen 0 verwaist 0)
(setq recs (csv:nested-welt-records (csv:pattern-nested-schleus)))
(setq bestand (csv:asmark-sammeln))
(setq blockname (if recs (csv:asmark-blockdef-sicherstellen)))
(if blockname
(progn
(setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq wrapper-enames nil)
(foreach rec recs
(if (not (member (nth 0 rec) wrapper-enames))
(setq wrapper-enames (cons (nth 0 rec) wrapper-enames))))
(foreach wrapper (reverse wrapper-enames)
(setq ed (entget wrapper))
(setq bname (cdr (assoc 2 ed)))
(setq wrapper-id (cond ((cdr (assoc "ID" (ssg-attrib-read wrapper)))) ("")))
(setq app
(cond
((wcmatch (strcase bname) "VF_*") "SSG_VF_SEP")
((wcmatch (strcase bname) "GF_*") "SSG_GF_SEP")
(t nil)))
(setq sepliste
(if (and app (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN"))))
(ssg-sepliste-xdata-lesen wrapper app)))
(if sepliste
(progn
(setq eigene nil)
(foreach rec recs
(if (eq (nth 0 rec) wrapper) (setq eigene (cons rec eigene))))
(setq eigene (reverse eigene))
(setq proxies
(mapcar (function (lambda (r)
(list (csv:proxy-typ (nth 2 r)) (car (nth 3 r)) (cadr (nth 3 r)))))
eigene))
(setq paare (csv:sepliste-paare sepliste proxies))
(foreach paar paare
(setq lfdnr (nth 0 paar))
(setq elem (nth (nth 1 paar) eigene))
(setq typ (csv:proxy-typ (nth 2 elem)))
(setq alt (csv:asmark-finden bestand wrapper-id typ (itoa lfdnr)))
(setq alt-id "")
(if alt
(progn
(setq alt-id (nth 4 alt))
(entdel (nth 0 alt))
(setq bestand (vl-remove alt bestand))
(setq uebernommen (1+ uebernommen))
)
(setq neu (1+ neu))
)
;; Marker mit Skalierung 1.0 einfuegen - die Skalierung des
;; Elements gehoert dem Element, ein gestauchtes Marker-Rechteck
;; waere als Positionszeichen unbrauchbar. Orientierung folgt
;; dagegen dem Element (auch bei geneigter Kette).
(setq mark (csv:block-einfuegen-welt ms blockname (nth 3 elem) (nth 4 elem)
1.0 1.0 1.0 bname))
(if mark
(progn
;; ARTINR nur lesen, wenn der Sub-INSERT ueberhaupt ATTRIBs
;; fuehrt (Gruppe 66 = 1): ssg-attrib-read wandert per entnext
;; bis zum SEQEND - fehlt der, laeuft es ueber das Element
;; hinaus durch die restliche Blockdefinition und liefert das
;; ARTINR IRGENDEINES spaeteren Bausteins der Kette.
(setq artinr "")
(if (equal 1 (cdr (assoc 66 (entget (nth 1 elem)))))
(setq artinr
(cond ((cdr (assoc "ARTINR" (ssg-attrib-read (nth 1 elem))))) (""))))
(ssg-attrib-set-on mark
(list (cons "ID" alt-id)
(cons "ZUORDNUNG" wrapper-id)
(cons "TYP" typ)
(cons "LFDNR" (itoa lfdnr))
(cons "ELEMENT" (nth 2 elem))
(cons "ARTINR" artinr)))
(ssg-layer-setzen mark "ases_marker")
(setq ergebnis (cons (list mark wrapper typ lfdnr) ergebnis))
)
)
)
)
)
)
)
)
;; Rest des Bestands: kein Kettenende mehr dahinter (Kette geloescht, Eintrag
;; entfallen, Wrapper ohne sepliste). Marker sind abgeleitete Geometrie -
;; ohne Kette bleiben sie nicht stehen.
(foreach m bestand
(entdel (nth 0 m))
(setq verwaist (1+ verwaist))
)
(if (or (> neu 0) (> uebernommen 0) (> verwaist 0))
(princ (ssg-textf "exp-asmark-bilanz"
(list (itoa neu) (itoa uebernommen) (itoa verwaist)))))
(reverse ergebnis)
)
;; --- Nach der ID-Vergabe: Marker-ID an den sepliste-Eintrag haengen ---
;; marker-liste = Records (marker-ename wrapper-ename typ lfdnr) aus
;; csv:asmark-aktualisieren. Zwei Aufgaben:
;; 1. ZUORDNUNG nachtragen - beim Setzen der Marker kann der Wrapper noch
;; keine ID gehabt haben (frisch gebaute Kette). Ohne sie faende der
;; NAECHSTE Export den Marker nicht wieder und legte ihn samt neuer ID
;; erneut an; die TeileId waere dann doch nicht stabil.
;; 2. die ID des Markers unter *csv-sepliste-id-by-handle* eintragen, damit
;; csv:block-to-json sie als Feld "id" am AS-/ES-Eintrag schreibt.
;; Rueckgabe: Anzahl der Eintraege mit ID.
(defun csv:asmark-ids-setzen (marker-liste / rec mark wrapper handle wrapper-id id
gesetzt ohne-id)
(setq gesetzt 0 ohne-id 0)
(foreach rec marker-liste
(setq mark (nth 0 rec))
(setq wrapper (nth 1 rec))
(setq handle (cdr (assoc 5 (entget wrapper))))
(setq wrapper-id (cdr (assoc "ID" (ssg-attrib-read wrapper))))
(if (and wrapper-id (> (strlen wrapper-id) 0))
(ssg-attrib-set-on mark (list (cons "ZUORDNUNG" wrapper-id))))
(setq id (cdr (assoc "ID" (ssg-attrib-read mark))))
(if (and id (> (strlen id) 0))
(progn
(csv:sepliste-id-merken handle (nth 3 rec) id)
(setq gesetzt (1+ gesetzt))
)
(setq ohne-id (1+ ohne-id))
)
)
(if (> gesetzt 0)
(princ (ssg-textf "exp-asmark-ids" (list (itoa gesetzt)))))
(if (> ohne-id 0)
(princ (ssg-textf "exp-sepliste-ohne-id" (list (itoa ohne-id)))))
gesetzt
)
;; --- Temporaere Kopien (csv:sep-proxies-erzeugen /
;; csv:schleus-proxies-erzeugen) nach dem Export wieder entfernen ---
;; proxy-liste = Records (proxy-ename wrapper-ename typ (x y z)), nur der car
;; (die Kopie selbst) wird geloescht.
;;
;; Der Debug-Schalter "csv_leave_proxies" (ssg_dbg.lsp) unterdrueckt das
;; Loeschen: die Kopien bleiben zur Ansicht in der Zeichnung stehen, damit sich
;; die tatsaechliche Lage der exportierten Separatoren gegen die
;; sepliste-Koordinaten pruefen laesst. *cs-sep-fix-by-handle* und
;; *csv-sepliste-id-by-handle* werden trotzdem zurueckgesetzt - sie gelten nur
;; fuer den gerade gelaufenen Export.
(defun csv:sep-proxies-loeschen (proxy-liste / behalten)
(setq behalten (and (car (atoms-family 1 '("DBG-SCHALTER-P")))
(dbg-schalter-p "csv_leave_proxies")))
(if behalten
(princ (strcat "\n[EXPORT] csv_leave_proxies=1: "
(itoa (length proxy-liste))
" Separator-Proxy-Kopie(n) bleiben in der Zeichnung"
" (Abschalten: (dbg-schalter-off \"csv_leave_proxies\"))"))
(foreach rec proxy-liste (entdel (car rec)))
)
(setq *cs-sep-fix-by-handle* nil)
(setq *cs-sep-typ-by-handle* nil)
(setq *csv-sepliste-id-by-handle* nil)
(princ)
)
;; --- Relevante Bloecke sammeln ---
;; Filtert INSERT-Entities auf exportierbare Bloecke:
;; KR_* = Kreisel Compound-Bloecke
;; AP110* = Omniflo Geraden
;; Omniflo Boegen/Weichen = rein numerische Blocknamen (SivasNr)
;; Vario* = VarioFoerderer-Bloecke
;; GF_* = Gefaellestrecke Compound-Bloecke
;; ZZ_ASES_MARKER = die Marker der AS-/ES-Kettenenden einer VF_n/GF_n-Strecke
;; (siehe csv:asmark-aktualisieren; pattern_ases_marker in cfg/export.cfg).
;; Das Kettenende selbst steckt verpackt in der Wrapper-Blockdefinition und
;; waere sonst weder sichtbar noch exportierbar; der Marker vertritt es -
;; mit eigener, ueber Exportlaeufe stabiler ID und den Attributen
;; TYP/LFDNR/ELEMENT/ARTINR.
;; Separator_SP*/S-LP*, Scanner* = eigenstaendige Sensor-Bloecke (siehe
;; pattern_separator/pattern_scanner in cfg/export.cfg). Landen in
;; export_raw.json fuer BEIDE Exporte (EXPORTCSV/EXPORTSIVAS teilen sich
;; diese Sammlung) - export_csv.py gibt ihnen eigene TeileArt-Zeilen,
;; export_sivas.py schliesst sie bewusst wieder aus (siehe dort), da ihre
;; Anzahl schon ueber ANZAHL_SEPARATOR/ANZAHL_SCANNER an Kreisel/GF/VF
;; gezaehlt wird.
;; BTMT-Beladung*/SC_Entladung* = eigenstaendige BTMT Be-/Entladestationen
;; (siehe pattern_btmt_beladung/pattern_btmt_entladung in cfg/export.cfg,
;; ils-insert-station in SSG_LIB_Commands.lsp). Anders als Separator/
;; Scanner werden sie von KEINEM anderen Element mitgezaehlt - export_csv.py
;; UND export_sivas.py fuehren sie beide als eigene TeileArt-Zeilen.
;; Eingang*/Ausgang* = Materialfluss-Ein-/Ausgangssymbole (siehe
;; pattern_eingang/pattern_ausgang in cfg/export.cfg, ils-insert-station in
;; SSG_LIB_Commands.lsp). Wie BTMT eigenstaendig, aber NUR fuer den
;; CSV-Export: export_csv.py gibt ihnen eigene TeileArt-Zeilen und traegt
;; sie - wie Separator/AS/ES - in die "TrackIds"-Spalte ein (auch auf
;; Kreiseln, siehe KREISEL_UMLAUF_TEILEARTEN in lib/export_neighbors.py);
;; export_sivas.py schliesst sie bewusst aus.
;; GR_* = Geruest-Baugruppen (siehe pattern_geruest in cfg/export.cfg,
;; GeruestInsert.lsp). Wie BTMT eigenstaendig und von keinem anderen
;; Element mitgezaehlt - export_csv.py UND export_sivas.py fuehren sie
;; beide als eigene TeileArt-Zeilen.
;; Gibt Auswahlsatz zurueck oder nil.
(defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname)
(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)))
(if (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_*"))
;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen)
;; Rein LISP-intern (Python klassifiziert Omniflo stattdessen
;; ueber exakten Katalog-Match), daher fest im Code statt in
;; cfg/export.cfg.
(wcmatch bname "#*")
)
(ssadd ename ss-out)
)
(setq i (1+ i))
)
(if (= (sslength ss-out) 0) (setq ss-out nil))
)
)
ss-out
)
;; --- HOEHE/DREHUNG aller Omniflo-Elemente still aktualisieren ---
;; Wird automatisch vor jedem Export aufgerufen.
(defun omni:update-all-attribs ( / ss i ename ed bname teileart)
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
(if ss
(progn
(setq i 0)
(while (setq ename (ssname ss i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq teileart (csv:get-attrib ename "TEILEART"))
(if (or teileart
(wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*")))
(progn
(omni:set-hoehe-attrib ename)
(omni:set-drehung-attrib ename)
)
)
(setq i (1+ i))
)
)
)
)
;; --- Gemeinsame Export-Funktion ---
;; Sammelt relevante Bloecke, schreibt JSON, ruft Python auf.
;; label = Anzeigename (z.B. "EXPORTCSV")
;; --- Export-Vorbereitung: Zeichnungszustand fuer den Export herrichten ---
;; Aus csv:run-export ausgelagert: alle Schritte, die VOR dem Sammeln/Schreiben
;; den Zeichnungszustand herrichten - Separator-Proxies einpacken, IDs
;; sicherstellen, Proxy-Zuordnung setzen, Omniflo-Attribute (HOEHE/DREHUNG)
;; aktualisieren, Separator-/Scanner-Zuordnung pruefen, global regenerieren und
;; die bbox-Fehlerdiagnose zuruecksetzen. Rueckgabe: die Liste ALLER erzeugten
;; Kopien - Separatoren UND AS/ES-Schleuselemente (der Aufrufer entfernt sie am
;; Ende wieder). label dient nur den Meldungen.
(defun csv:export-vorbereiten (label / sep-proxies asmarks)
;; 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))
;; 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)
;; Vor dem Export HOEHE/DREHUNG aller Omniflo-Elemente aktualisieren
(princ (ssg-textf "exp-update-hoehe-drehung" (list label)))
(omni:update-all-attribs)
;; Vor dem Export: Separator-/Scanner-Zuordnung pruefen und
;; ANZAHL_SEPARATOR/ANZAHL_SCANNER an Kreisel/Streckengruppe/
;; Gefaellestrecke aktualisieren (siehe count_sep_scan.lsp,
;; cs-zuordnung-lauf). Scanner ausserhalb jeder Carrier-Boundingbox
;; werden dabei per Abstand zugeordnet (ZUORDNUNG-Attribut = Carrier-
;; ID) und - bei mehrdeutigem Abstand - als "strittig" markiert;
;; *cs-scanner-warnung-by-handle* wird von csv:block-to-json unten
;; ausgelesen und haengt den Warnungstext an den betroffenen Scanner-
;; Block im JSON an. verbose=nil haelt die Export-Konsole kompakt
;; (die ausfuehrliche Detailzeile je Carrier gibt es nur beim
;; interaktiven Befehl ZAEHLE_SEP_SCAN).
;;
;; Der Lauf ist teuer (Boundingbox+Regen je Carrier und Sensor),
;; darum vorher der billige Schnelltest cs-zuordnung-noetig-p (nur
;; Attribute lesen, keine Boundingboxen): nur bei leeren ZUORDNUNG-
;; Eintraegen oder abweichenden Summen wird tatsaechlich neu gerechnet.
(ssg-ensure "count_sep_scan")
(if (atoms-family 1 '("cs-zuordnung-lauf"))
(if (cs-zuordnung-noetig-p)
(cs-zuordnung-lauf label nil)
(princ (ssg-textf "sens-skip" (list label)))
)
)
;; Vor dem Sammeln/Schreiben EINMAL global regenerieren. vla-getboundingbox
;; liefert nur auf regenerierten Objekten eine gueltige Box; ein pro-Objekt
;; vla-update (csv:get-bbox) reicht dafuer in der Praxis nicht immer aus
;; (fuehrte real dazu, dass in einem Export ALLE Bloecke ohne bbox blieben).
;; REGENALL erzwingt die vollstaendige Regeneration der gesamten Zeichnung.
(vl-catch-all-apply '(lambda () (command "_.REGENALL")))
;; bbox-Fehlerdiagnose fuer diesen Lauf zuruecksetzen (siehe csv:get-bbox).
(setq *csv-bbox-fail-count* 0)
(setq *csv-bbox-fail-first* nil)
;; Nur die TEMPORAEREN Kopien zurueckgeben - die AS/ES-Marker bleiben
;; bewusst in der Zeichnung stehen und duerfen nicht mitgeloescht werden.
sep-proxies)
;; --- Python-Export-Skript aufrufen und Ergebnis auswerten ---------------
;; Aus csv:run-export ausgelagert: das fertige raw-JSON (out-pfad) an das
;; Python-Skript py-name uebergeben, synchron ausfuehren und den Exitcode
;; auswerten (kein stiller Fehlschlag). Arbeitet ausschliesslich ueber die
;; uebergebenen Pfade/Namen und die Umgebung (DXFM_LIB/DXFM_DATA/DXFM_LOG) -
;; keine Zeichnungs-/Sammel-Logik mehr, daher gut fuer sich testbar.
;; label/out-dir dienen nur den Meldungen bzw. dem Ergebnis-Pfad.
(defun csv:python-aufrufen (label out-dir out-pfad py-name csv-name
/ py-skript ergebnis-pfad py-exe log-pfad rc)
;; Python-Skript aufrufen. DXFM_LIB muss gesetzt sein - fehlt es
;; (z.B. weil BricsCAD nicht ueber bin/start_briscad.bat gestartet
;; wurde und die Umgebungsvariablen daher nie in diesen Prozess
;; vererbt wurden), wuerde das folgende strcat sonst mit einem
;; kryptischen Lisp-Fehler ("bad argument type <NIL>") 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)
;; Zeichnungszustand fuer den Export herrichten (Proxies, IDs, Zuordnung,
;; Attribut-Update, Sep/Scan-Zaehlung, REGENALL, bbox-Reset) - ausgelagert.
;; Rueckgabe: alle erzeugten Kopien (unten wieder zu entfernen).
(setq sep-proxies (csv:export-vorbereiten label))
(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-/AS-/ES-Kopien wieder entfernen - sie haben ihren
;; Zweck (ID-Vergabe + JSON-Zeile ueber die obigen, unveraenderten
;; Sammel-Funktionen) erfuellt.
(csv:sep-proxies-loeschen sep-proxies)
(princ)
)
;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen ---
(defun c:EXPORTSIVAS ()
(csv:run-export "EXPORTSIVAS"
(export:filename "sivas_script")
(export:filename "sivas_csv")
nil)
)
;; --- EXPORTCSV: Einfache Item-Liste aller Bloecke (ohne Summierung) ---
;; Ermittelt zusaetzlich je Block eine Bounding-Box (siehe csv:get-bbox),
;; die im Python-Skript als Position/Boundingbox-Spalten ausgegeben wird.
(defun c:EXPORTCSV ()
(csv:run-export "EXPORTCSV"
(export:filename "csv_script")
(export:filename "csv_csv")
T)
)
;; ============================================================
;; 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)
)
Reference in New Issue View Git Blame Copy Permalink