Files
dxfmakros/Lisp/export.lsp
T
Samer AyadiandClaude Opus 5.5 1e6b152d72 export: jeden Wert nur an einer Stelle setzen (ZUORDNUNG, sepliste-IDs, Typen, K1/K2)
- ZUORDNUNG: ssg-id-check-all laeuft jetzt ZUERST, danach sind die
  Wrapper-IDs endgueltig - Separator-Kopien, AS/ES- und Einheiten-Marker
  bekommen ZUORDNUNG direkt beim Erzeugen. Entfallen:
  csv:sep-proxies-zuordnung-setzen, csv:asmark-ids-setzen,
  csv:unitmark-ids-setzen. zuordnung_fix/*cs-sep-fix-by-handle* bleibt
  (count_sep_scan rechnet eigenstaendige Sensoren bewusst neu).
- sepliste-IDs: Zuordnung ueber die KS-Kettenfolge je Typ
  (csv:sepliste-kette-paare) statt ueber die teils gespiegelten
  sepliste-Koordinaten (csv:sepliste-paare, csv:sepliste-ids-setzen
  entfallen). Die Kette wird je Lauf einmal berechnet (csv:kette-von);
  die ID liest csv:block-to-json erst beim Schreiben. Behebt vertauschte
  TrackIds/Nachbarn in HundM05 VF_1 (0031/0029).
- Element-Klassifizierung: eine Tabelle csv:element-familien (cfg-Muster)
  fuer Suche und Klassifizierung; csv:proxy-typ entfaellt.
- Einheiten-Marker: K1/K2 nur noch in *csv-baustein-by-handle*
  (csv:geometrie-merken), K1/K2-Attribute und
  csv:unitmark-k-kos-strings entfallen.

Geprueft: HundM05-Export alt/neu headless verglichen - einzige Abweichung
ist die korrigierte Reihenfolge in VF_1. LISP-Unit-Tests 303/303.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-28 12:10:16 +02:00

2869 lines
134 KiB
Common Lisp

;; ============================================================
;; 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))))
;; --- 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).
;; 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
)
;; --- K-Punkte + Boundingbox unter dem Handle eines Stellvertreters merken ---
;; EINZIGE Stelle, die *csv-baustein-by-handle* fuellt. punkte = Alist
;; (("K1" x y z) ...) in Welt, bbox wie csv:get-bbox. Ohne Punkte bleibt die
;; K-Liste nil und csv:k-liste faellt auf die KS des Stellvertreters zurueck.
(defun csv:geometrie-merken (stellvertreter punkte bbox)
(setq *csv-baustein-by-handle*
(cons (list (cdr (assoc 5 (entget stellvertreter)))
(csv:k-liste-kodieren punkte)
bbox)
*csv-baustein-by-handle*))
)
;; --- 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).
(defun csv:baustein-merken (stellvertreter rec)
(csv:geometrie-merken stellvertreter
(csv:ks-welt-punkte (nth 2 rec) (nth 3 rec) (nth 4 rec)
(nth 5 rec) (nth 6 rec) (nth 7 rec))
(csv:baustein-bbox rec))
)
;; --- 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)))
"}")
)
"{}"
)
)
;; --- 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
sepliste-teile sepliste-first sepliste-ids sep-id sep-ent)
(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))
)
(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-erzeugen 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 - der Typ der Einheit,
;; in der er in der Kette liegt (csv:kette-sep-typen, eingetragen von
;; csv:ketten-verarbeiten). 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 "")
(setq sepliste (csv:sepliste-lesen ename))
(if sepliste
(progn
;; ID des Bauteils, das zu diesem Eintrag gehoert: beim Export
;; steht fuer jeden Eintrag (AS/SEP/ES) ein temporaerer
;; Stellvertreter (Separator-Kopie bzw. AS-/ES-Marker);
;; csv:ketten-verarbeiten hat ihn dem Eintrag in Kettenfolge
;; zugeordnet (Key = Handle dieses Wrappers), seine ID wird erst hier
;; gelesen. Fehlt sie (Stellvertreter nicht erzeugbar, Block ohne
;; ID-ATTDEF, Altbestand), bleibt das Feld weg.
;;
;; 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 die Kettenfolge, csv:sepliste-kette-paare) - 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-ent (cdr (assoc (nth 1 e) sepliste-ids)))
(setq sep-id (if sep-ent (cdr (assoc "ID" (ssg-attrib-read sep-ent)))))
(if (= sep-id "") (setq sep-id nil))
(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"
)
;; --- TeileArt-Familien der uebrigen verpackten VF_n/GF_n-Bausteine ---
;; EINZIGE Tabelle fuer Suche UND Klassifizierung: ((familie . muster) ...),
;; Muster aus cfg/export.cfg [blockpattern] pattern_nested_* (Default wie
;; dort). csv:pattern-nested-element sucht damit, csv:element-teileart
;; ordnet einen Fund damit seiner Familie zu - ein in der cfg ergaenztes
;; Muster wirkt dadurch an beiden Stellen gleich (frueher war die
;; Klassifizierung fest verdrahtet: ein neuer cfg-Eintrag wurde gefunden,
;; aber als nil klassifiziert und fiel still aus der Kette).
;; Vario_Bogen_* deckt die _TEF_-Variante (VF-Vertikalboegen) und die reine
;; GF-Variante ab, beide auf "BOGEN".
(defun csv:element-familien ()
(list
(cons "BOGEN" (export:pattern "pattern_nested_bogen" "Gefaellebogen_*,Vario_Bogen_*,Vario_Kurve_*"))
(cons "STRECKENELEMENT" (export:pattern "pattern_nested_streckenelement" "Staustrecke_SP_1000_mm*"))
(cons "UMLENKSTATION" (export:pattern "pattern_nested_umlenkstation" "Vario_Umlenkstation_*"))
(cons "MOTORSTATION" (export:pattern "pattern_nested_motorstation" "Vario_Motorstation_*")))
)
;; --- Muster der uebrigen verpackten VF_n/GF_n-Bausteine (Boegen, gerade
;; Foerderer-/Gefaellestrecken-Segmente, Umlenk-/Motorstation) ---
;; Diese Bausteine stecken als Sub-INSERTs in der Wrapper-Blockdefinition und
;; sind fuer (ssget "X" ...) unsichtbar. EIN kombiniertes Muster fuer alle
;; Familien haelt den zusaetzlichen Scan auf EINEN Durchlauf beschraenkt.
(defun csv:pattern-nested-element ()
(ssg-join (mapcar 'cdr (csv:element-familien)) ",")
)
;; --- 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 temporaere Marker
;; ZZ_ASES_MARKER (csv:asmark-aktualisieren).
(defun csv:pattern-nested-schleus ()
(export:pattern "pattern_schleuselement" "AS_Element*,ES_Element*")
)
;; --- TeileArt-Familie eines ausgepackten Elements aus seinem Blocknamen ---
;; Erste Familie aus csv:element-familien, deren Muster passt (Gross-/
;; Kleinschreibung egal), sonst nil. File-frei testbar (tests/test_unit.lsp).
(defun csv:element-teileart (bname / bn fam treffer)
(setq bn (strcase bname))
(foreach fam (csv:element-familien)
(if (and (null treffer) (wcmatch bn (strcase (cdr fam))))
(setq treffer (car fam))))
treffer
)
;; --- 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 -> AS/ES-Marker (ebenfalls temporaer, seine
;; ID bleibt als reservierte ID am Wrapper)
;;
;; 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
;; traegt ---
;; Der Trennsteg Staustrecke_Separator_SP_300_mm ist der Kettenbaustein (mit
;; KS_EIN/KS_AUS, pro Einfuegung eine eigene Instanz); das Separator_SP-Symbol
;; darin steckt als EIN von der Blockdefinition geteiltes Sub-INSERT in jedem
;; Trennsteg und taugt daher nicht als Schluessel fuer einen einzelnen
;; Separator.
(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 eigenen Marker (siehe dort).
;;
;; proxy-liste-Eintrag: (proxy-ename wrapper-ename typ (x y z) trennsteg-ent)
;; - trennsteg-ent = der verpackte Trennsteg (Kettenbaustein, Schluessel fuer
;; die ID-Vergabe in Kettenfolge UND fuer den Streckentyp VF/GF, beides in
;; csv:ketten-verarbeiten), nil fuer ein Symbol ohne Trennsteg (Kreisel-
;; Separator). Zuordnung Symbol<->Trennsteg ueber die Symbollage innerhalb
;; des Trennstegs (csv:trennsteg-zu-symbol).
;;
;; ZUORDNUNG wird hier EINMAL gesetzt: die Zuordnung eines VERPACKTEN
;; Separators ist keine Schaetzung, er steckt in genau diesem Wrapper
;; (VF_n/GF_n/KREISEL_n). Laeuft nach dem ersten ssg-id-check-all
;; (csv:export-vorbereiten), die Wrapper-ID steht also schon endgueltig fest.
;; Zusaetzlich wird die Kopie in *cs-sep-fix-by-handle* als "bekannt"
;; festgenagelt: count_sep_scan.lsp (cs-zuordnung-lauf) und export_csv.py
;; (Feld "zuordnung_fix") rechnen die Zuordnung eigenstaendiger Sensoren bei
;; jedem Lauf geometrisch neu und brauchen diese Markierung, um verpackte
;; Separatoren davon auszunehmen - bei ueberlappenden Carrier-Boxen
;; (Kettenende an einem Kreisel) laege die Geometrie leicht beim Nachbarn.
;; Wrapper ohne ID-Attribut (Altbestand ohne ID-ATTDEF): keine bekannte
;; Zuordnung, die Kopie faellt auf die geometrische Zuordnung zurueck.
(defun csv:sep-proxies-erzeugen ( / ms recs aussen-paare rec aussen-rec proxy proxy-liste
wrapper-id gesetzt ohne-id)
(setq gesetzt 0 ohne-id 0)
(setq *cs-sep-fix-by-handle* nil)
(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
(progn
(setq wrapper-id (cdr (assoc "ID" (ssg-attrib-read (nth 0 rec)))))
(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 (cdr (assoc 5 (entget proxy))) wrapper-id)
*cs-sep-fix-by-handle*))
(setq gesetzt (1+ gesetzt)))
(setq ohne-id (1+ ohne-id)))
(setq proxy-liste
(cons (list proxy (nth 0 rec) "SEP" (nth 3 rec)
(if aussen-rec (nth 1 aussen-rec)))
proxy-liste))))
)
)
)
(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)))))
(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 Trennsteg-
;; Zuordnung (Symbol im Trennsteg gibt es nur beim Separator) 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-verarbeiten).
;; 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)
)
;; --- Globale Zuordnung sepliste-Eintrag -> Bauteil ---
;; Key = Handle des VF_n/GF_n-Wrappers, Wert = Alist ((lfdnr . ename) ...),
;; ename = der Stellvertreter (Separator-Kopie bzw. AS-/ES-Marker) dieses
;; Eintrags. Gefuellt von csv:ketten-verarbeiten (Kettenfolge), gelesen von
;; csv:block-to-json beim Schreiben des "sepliste"-Arrays - die ID wird ERST
;; DORT vom Stellvertreter gelesen, damit eine spaetere Duplikat-Korrektur in
;; ssg-id-check-all sie nicht veralten laesst. Zurueckgesetzt von
;; csv:export-vorbereiten und csv:sep-proxies-loeschen.
(setq *csv-sepliste-id-by-handle* nil)
;; --- Einen sepliste-Eintrag mit seinem Stellvertreter vermerken ---
;; Alle Eintraege EINES Wrappers teilen sich ein Paar (handle . alist): ein
;; zweites Paar waere fuer assoc unsichtbar. Darum zusammenfuehren statt
;; vorne anzuhaengen.
(defun csv:sepliste-id-merken (handle lfdnr ename / 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 ename))))
eintrag *csv-sepliste-id-by-handle*))
(setq *csv-sepliste-id-by-handle*
(cons (cons handle (list (cons lfdnr ename))) *csv-sepliste-id-by-handle*))
)
ename
)
;; --- XDATA-App der sepliste eines Wrappers aus seinem Blocknamen ---
(defun csv:sepliste-app (bname)
(cond
((wcmatch (strcase bname) "VF_*") "SSG_VF_SEP")
((wcmatch (strcase bname) "GF_*") "SSG_GF_SEP")
(t nil))
)
;; --- sepliste eines Wrappers lesen ---
;; Rueckgabe: ((typ lfdnr x y) ...) wie ssg-sepliste-xdata-lesen, oder nil
;; (kein VF_n/GF_n, Altbestand ohne sepliste-XDATA).
(defun csv:sepliste-lesen (wrapper / app)
(setq app (csv:sepliste-app (cdr (assoc 2 (entget wrapper)))))
(if (and app (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN"))))
(ssg-sepliste-xdata-lesen wrapper app))
)
;; --- sepliste-Eintraege den Bausteinen der geordneten Kette zuordnen ---
;; eintraege = ((typ lfdnr x y) ...) wie ssg-sepliste-xdata-lesen sie liefert.
;; typen = Bausteintypen der geordneten Kette (csv:kette-typ, Kettenfolge).
;; Rueckgabe: ((lfdnr . index) ...), aufsteigend nach lfdnr; index = 0-basiert
;; in typen. Eintraege ohne Partner fehlen darin.
;;
;; Zuordnung ueber die REIHENFOLGE je Typ: das k-te AS/SEP/ES der sepliste
;; (nach lfdnr) ist das k-te AS/SEP/ES der Kette. Die sepliste entsteht beim
;; Bau aus einer entnext-Wanderung (ssg-sepliste-sammeln), also in
;; Baureihenfolge, und gebaut wird in Foerderrichtung - dieselbe Folge, die
;; csv:kette-ordnen ueber die KS rekonstruiert. Die x/y-Koordinaten der
;; sepliste werden NICHT benutzt (sie koennen beim Bau gespiegelt sein, siehe
;; ssg-sepliste-sammeln).
;;
;; Reine Rechenfunktion - getestet in tests/test_unit.lsp.
(defun csv:sepliste-kette-paare (eintraege typen / erg typ lfdnrs idxs i x)
(foreach typ '("AS" "SEP" "ES")
(setq lfdnrs nil)
(foreach x eintraege
(if (= (car x) typ) (setq lfdnrs (cons (cadr x) lfdnrs))))
(setq lfdnrs (vl-sort lfdnrs '<))
(setq idxs nil i 0)
(foreach x typen
(if (= x typ) (setq idxs (cons i idxs)))
(setq i (1+ i)))
(setq idxs (reverse idxs))
(while (and lfdnrs idxs)
(setq erg (cons (cons (car lfdnrs) (car idxs)) erg))
(setq lfdnrs (cdr lfdnrs) idxs (cdr idxs)))
)
(vl-sort erg (function (lambda (a b) (< (car a) (car b)))))
)
;; ===========================================================================
;; 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 ---
;; EINZIGER Typ-Klassifikator der Kette: "AS"/"ES" (Schleuselemente), "SEP"
;; (Trennsteg), sonst die Familien aus csv:element-teileart (BOGEN/
;; STRECKENELEMENT/UMLENKSTATION/MOTORSTATION); nil fuer alles andere.
(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)
)
;; --- Streckentyp (VF/GF) jedes Separators einer geordneten Kette ---
;; EINZIGE Quelle fuer das "Typ"-Merkmal der Separator-Zeilen: der Separator
;; erbt den Typ der Einheit, in die csv:kette-einheiten ihn schneidet - also
;; VF fuer den Separator direkt vor der Umlenkstation und jeden Separator
;; zwischen Umlenk- und Motorstation, sonst GF. Damit passen Separator-Typ und
;; Einheiten-Boundingbox per Konstruktion zusammen.
;; typen = Liste der Bausteintypen in Foerderrichtung (siehe csv:kette-typ).
;; Rueckgabe: ((index . "VF"/"GF") ...) fuer jeden "SEP"-Index, aufsteigend.
(defun csv:kette-sep-typen (typen / erg einheit idx)
(foreach einheit (csv:kette-einheiten typen)
(foreach idx (cadr einheit)
(if (= (nth idx typen) "SEP")
(setq erg (cons (cons idx (car einheit)) erg)))))
(vl-sort erg (function (lambda (a b) (< (car a) (car b)))))
)
;; --- 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. Die Kettenenden stecken verpackt in der Wrapper-
;; Blockdefinition (AS_Element_*/ES_Element_*); der Marker vertritt sie im
;; Export als eigene Zeile. Wie die Separator-/Element-Kopien ist er TEMPORAER:
;; csv:run-export loescht ihn am Ende wieder, nur der Debug-Schalter
;; "csv_leave_proxies" (csv:hilfskopien-loeschen) laesst ihn zur Ansicht stehen.
;;
;; Die ID ist trotzdem stabil: csv:res-ids-schreiben legt sie als reservierte
;; ID (XDATA SSG_ID_RES, Schluessel "AS|1", siehe ssg-id-res-* in ssg_id.lsp)
;; am Wrapper ab, der naechste Export gibt sie dem neuen Marker wieder. Weil
;; ssg-id-max-in-ss die reservierten IDs mitzaehlt, vergibt ssg-id-check-all
;; sie in der Zwischenzeit an niemand anderen.
;;
;; Aeltere Zeichnungen (und ein Lauf mit csv_leave_proxies) haben noch Marker
;; in der Zeichnung stehen: deren ID wird uebernommen, falls der Wrapper noch
;; keine reservierte ID fuehrt (csv:asmark-finden), danach werden sie
;; geloescht.
(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. Die Wrapper-ID steht beim Suchen schon fest (erster
;; ssg-id-check-all in csv:export-vorbereiten); ein Wrapper ganz ohne
;; ID-Attribut (Altbestand) findet folgerichtig nichts - seine Marker
;; entstehen bei jedem Export neu.
(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
)
;; --- Schluessel der reservierten ID eines Kettenendes am Wrapper ---
;; typ = "AS"/"ES", lfdnr = Integer oder String. Beispiel: "AS|1".
(defun csv:asmark-res-key (typ lfdnr)
(strcat typ "|" (if (numberp lfdnr) (itoa lfdnr) lfdnr))
)
;; --- Alle AS-/ES-Marker der Zeichnung neu aufbauen ---
;; Laeuft NACH dem ersten ssg-id-check-all (csv:export-vorbereiten): jeder
;; Wrapper traegt dann seine endgueltige ID, ZUORDNUNG wird hier also EINMAL
;; und richtig gesetzt. Neue Marker haben noch kein ID-Attribut und werden in
;; csv:ketten-verarbeiten in Kettenfolge nummeriert, uebernommene tragen die
;; reservierte ID des Wrappers (bzw. die ihres noch stehenden Vorgaengers).
;;
;; Ablauf je VF_n/GF_n-Wrapper mit sepliste:
;; 1. geordnete Kette holen (csv:kette-von) - AS/ES sind Kettenbausteine
;; 2. sepliste-Eintraege den Bausteinen zuordnen (csv:sepliste-kette-paare,
;; k-tes AS/ES der sepliste = k-tes AS/ES der Kette); nur AS/ES
;; bekommen hier einen Marker
;; 3. je Paar die bisherige ID holen (reservierte ID am Wrapper, sonst ein
;; noch stehender Marker - der wird geloescht) und den Marker 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
;; element-ent) - element-ent = das verpackte AS-/ES-Element (Schluessel fuer
;; die ID-Vergabe in Kettenfolge, csv:ketten-verarbeiten).
(defun csv:asmark-aktualisieren ( / bestand blockname ms wrapper wrapper-id
sepliste teile teil paar elem lfdnr typ alt
alt-id mark artinr m neu uebernommen verwaist
ergebnis reserviert)
(setq neu 0 uebernommen 0 verwaist 0)
(setq bestand (csv:asmark-sammeln))
(setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
;; Absteigende Wrapper-ID: die Marker entstehen in derselben Reihenfolge wie
;; frueher (Zeichnungsreihenfolge), damit die Laufnummer der Bezeichnung
;; ("ILS Ausschleuselement :1"), die der Export aus der Erzeugungsreihenfolge
;; zaehlt, je Kette gleich bleibt.
(foreach wrapper (reverse (csv:wrapper-nach-id))
(setq sepliste (csv:sepliste-lesen wrapper))
(if (and sepliste (null blockname))
(setq blockname (csv:asmark-blockdef-sicherstellen)))
(if (and sepliste blockname)
(progn
(setq wrapper-id (cond ((cdr (assoc "ID" (ssg-attrib-read wrapper)))) ("")))
(setq teile (csv:kette-von wrapper))
(setq reserviert (ssg-id-res-lesen wrapper))
(foreach paar (csv:sepliste-kette-paare sepliste (mapcar 'car teile))
(setq lfdnr (car paar))
(setq teil (nth (cdr paar) teile))
(setq typ (car teil))
(if (member typ '("AS" "ES"))
(progn
(setq elem (nth 1 teil))
;; ID-Quelle: reservierte ID am Wrapper, sonst (Altbestand /
;; csv_leave_proxies) der noch stehende Marker.
(setq alt (csv:asmark-finden bestand wrapper-id typ (itoa lfdnr)))
(setq alt-id (cond ((cdr (assoc (csv:asmark-res-key typ lfdnr) reserviert)))
(alt (nth 4 alt))
("")))
(if alt
(progn
(entdel (nth 0 alt))
(setq bestand (vl-remove alt bestand))
)
)
(if (> (strlen alt-id) 0)
(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 (cdr (assoc 2 (entget wrapper)))))
(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))
(setq ergebnis (cons (list mark wrapper typ lfdnr (nth 1 elem)) ergebnis))
;; ID nach dem Export als reservierte ID am Wrapper ablegen
;; (csv:res-ids-schreiben).
(csv:res-merken wrapper (csv:asmark-res-key typ lfdnr) mark)
)
)
)
)
)
)
)
)
;; 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)
)
;; --- 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 (beim Erzeugen gesetzt - die
;; Wrapper-ID steht nach dem ersten ssg-id-check-all fest)
;; 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) stehen NICHT als
;; Attribut am Marker, sondern wie bei jedem Stellvertreter in
;; *csv-baustein-by-handle* (csv:geometrie-merken) - csv:k-liste liest sie dort.
;; Aeltere Blockdefinitionen in Zeichnungen haben noch K1/K2-ATTDEFs; die
;; bleiben leer und werden nicht gelesen.
(setq *csv-unitmark-attrib-defs*
'(("ID" "") ("ZUORDNUNG" "") ("TYP" "") ("LFDNR" "")
("LAENGE_m" "") ("ANZAHL_BOEGEN" ""))
)
;; --- 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))))
(ssg-layer-setzen mark "ases_marker")
;; Export-Geometrie wie bei jedem Stellvertreter: die gemessene 3D-
;; Vereinigung der Bausteine statt der Box des flachen Rechtecks.
(csv:geometrie-merken mark
(append (if k1 (list (cons "K1" k1)))
(if k2 (list (cons "K2" k2))))
bbox)))
)
)
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)))))))
;; ===========================================================================
;; Stabile IDs der temporaeren Kettenobjekte (reservierte IDs am Wrapper)
;; ===========================================================================
;; AS-/ES-Marker, Separator-/Element-Kopien und Einheiten-Proxies entstehen
;; bei jedem Export neu und werden danach geloescht. Ihre ID bleibt trotzdem
;; gleich: sie wird als reservierte ID (XDATA SSG_ID_RES, ssg-id-res-* in
;; ssg_id.lsp) am VF_n/GF_n-Wrapper abgelegt und beim naechsten Export dem
;; neuen Objekt an derselben Stelle wiedergegeben. Schluessel:
;; "AS|n"/"ES|n" - AS-/ES-Marker, n = sepliste-lfdnr (csv:asmark-res-key)
;; "K|i" - Kopie des i-ten Bausteins der geordneten Kette
;; (0-basiert, Reihenfolge von csv:kette-ordnen)
;; "U|n" - n-te Einheit des Wrappers (Modus group_vf_gf)
;; Die Positionen sind deterministisch, solange der Wrapper unveraendert ist;
;; ein Edit baut einen NEUEN Wrapper (ohne diese XDATA) - dann entstehen neue
;; IDs, verschobene Zuordnungen aber nicht.
;;
;; Ablauf: die Erzeuger melden jedes Objekt mit csv:res-merken an, NACH
;; ssg-id-check-all schreibt csv:res-ids-schreiben je Wrapper den kompletten
;; Stand (ersetzt den alten - Eintraege fuer entfallene Objekte verschwinden).
;; Sammlung dieses Laufs: ((wrapper (key . ename) ...) ...)
(setq *csv-res-sammlung* nil)
(defun csv:res-key-kette (i) (strcat "K|" (itoa i)))
(defun csv:res-key-einheit (lfdnr) (strcat "U|" (itoa lfdnr)))
;; Objekt ename unter key fuer den Wrapper anmelden.
(defun csv:res-merken (wrapper key ename / eintrag)
(setq eintrag (assoc wrapper *csv-res-sammlung*))
(if eintrag
(setq *csv-res-sammlung*
(subst (append eintrag (list (cons key ename))) eintrag *csv-res-sammlung*))
(setq *csv-res-sammlung*
(cons (list wrapper (cons key ename)) *csv-res-sammlung*)))
ename
)
;; Nach der ID-Vergabe: je Wrapper die IDs aller angemeldeten Objekte als
;; reservierte IDs schreiben. Rueckgabe: Anzahl geschriebener IDs.
(defun csv:res-ids-schreiben ( / eintrag paare p id n)
(setq n 0)
(foreach eintrag *csv-res-sammlung*
(setq paare nil)
(foreach p (cdr eintrag)
(setq id (cdr (assoc "ID" (ssg-attrib-read (cdr p)))))
(if (and id (> (strlen id) 0))
(setq paare (cons (cons (car p) id) paare))))
(ssg-id-res-schreiben (car eintrag) (reverse paare))
(setq n (+ n (length paare)))
)
(setq *csv-res-sammlung* nil)
n
)
;; --- Einem Export-Objekt die naechste ID geben, falls es noch keine hat ---
;; naechste-id = zuletzt vergebene Nummer, res-id = reservierte ID fuer dieses
;; Objekt (oder nil) - wird bevorzugt und verbraucht keine neue Nummer.
;; Rueckgabe: neue letzte Nummer.
(defun csv:id-vergeben (ename naechste-id res-id / id)
(setq id (cdr (assoc "ID" (ssg-attrib-read ename))))
(if (or (null id) (= id ""))
(if (and res-id (> (strlen res-id) 0))
(ssg-id-set-and-verify ename res-id "reservierte ID")
(progn
(setq naechste-id (1+ naechste-id))
(ssg-id-set-and-verify ename (ssg-id-format naechste-id) "Kettenfolge"))))
naechste-id
)
;; --- Geordnete Kette eines Wrappers, je Exportlauf nur einmal berechnet ---
;; csv:kette-teile + csv:kette-ordnen (Rueckgabe wie csv:kette-ordnen). Beide
;; Nutzer - csv:asmark-aktualisieren und csv:ketten-verarbeiten - sehen damit
;; garantiert DIESELBE Kette (und eine Luecken-Meldung erscheint nur einmal).
;; *csv-ketten* = ((wrapper-ename . teile) ...), csv:export-vorbereiten setzt
;; es zu Beginn jedes Laufs zurueck.
(setq *csv-ketten* nil)
(defun csv:kette-von (wrapper / e)
(if (setq e (assoc wrapper *csv-ketten*))
(cdr e)
(progn
(setq e (csv:kette-ordnen (csv:kette-teile wrapper) (cdr (assoc 2 (entget wrapper)))))
(setq *csv-ketten* (cons (cons wrapper e) *csv-ketten*))
e))
)
;; --- Ketten verarbeiten: Einheiten-Proxies bauen und IDs in Kettenfolge ---
;; Laeuft zwischen den beiden ssg-id-check-all-Laeufen (csv:export-
;; vorbereiten). Je VF_n/GF_n-Wrapper (nach Wrapper-ID aufsteigend):
;; 1. geordnete Kette holen (csv:kette-von)
;; 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 (AS/ES-Marker mit
;; reservierter ID vom Wrapper) bleiben unangetastet.
;; Nebenbei (in BEIDEN Modi), aus derselben Kette:
;; - Streckentyp VF/GF jeder Separator-Kopie aus ihrer Einheit
;; (csv:kette-sep-typen) nach *cs-sep-typ-by-handle* - csv:block-to-json
;; schreibt ihn als "strecke_typ" in die Separator-Zeile
;; - Stellvertreter jedes sepliste-Eintrags (csv:sepliste-kette-paare) nach
;; *csv-sepliste-id-by-handle* - csv:block-to-json schreibt dessen ID als
;; Feld "id" in den sepliste-Eintrag
;; 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 res key sep-typen
sepliste paar sl-gesetzt sl-fehlend)
(setq *cs-sep-typ-by-handle* nil)
(setq *csv-sepliste-id-by-handle* nil)
(setq sl-gesetzt 0)
(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 4 r) (setq traeger (cons (cons (list (nth 1 r) (nth 4 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-von wrapper))
(setq res (ssg-id-res-lesen wrapper))
(setq sep-typen (csv:kette-sep-typen (mapcar 'car teile)))
;; Einheiten (nur gruppiert); starts = ((erster-index key . 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 (list (car (cadr einheit)) (csv:res-key-einheit lfdnr) mark)
starts))))))
;; IDs entlang der Kette - reservierte ID des Platzes zuerst (siehe
;; csv:res-merken); AS-/ES-Marker haben ihre ID schon und sind bereits
;; unter ihrem eigenen Schluessel angemeldet (csv:asmark-aktualisieren).
(setq i 0)
(foreach teil teile
(foreach u starts
(if (= (nth 0 u) i)
(progn
(setq naechste-id (csv:id-vergeben (nth 2 u) naechste-id
(cdr (assoc (nth 1 u) res))))
(csv:res-merken wrapper (nth 1 u) (nth 2 u)))))
(if (setq tr (cdr (assoc (list wrapper (nth 1 (nth 1 teil))) traeger)))
(progn
(if (assoc i sep-typen)
(setq *cs-sep-typ-by-handle*
(cons (cons (cdr (assoc 5 (entget tr))) (cdr (assoc i sep-typen)))
*cs-sep-typ-by-handle*)))
(if (member (car teil) '("AS" "ES"))
(setq naechste-id (csv:id-vergeben tr naechste-id nil))
(progn
(setq key (csv:res-key-kette i))
(setq naechste-id (csv:id-vergeben tr naechste-id (cdr (assoc key res))))
(csv:res-merken wrapper key tr)))))
(setq i (1+ i)))
;; sepliste-Eintraege -> Stellvertreter (Kettenfolge statt Koordinaten).
(setq sepliste (csv:sepliste-lesen wrapper))
(if sepliste
(progn
(setq sl-fehlend (length sepliste))
(foreach paar (csv:sepliste-kette-paare sepliste (mapcar 'car teile))
(if (setq tr (cdr (assoc (list wrapper (nth 1 (nth 1 (nth (cdr paar) teile))))
traeger)))
(progn
(csv:sepliste-id-merken (cdr (assoc 5 (entget wrapper))) (car paar) tr)
(setq sl-gesetzt (1+ sl-gesetzt) sl-fehlend (1- sl-fehlend)))))
;; Mehr sepliste-Eintraege als Kettenbausteine mit Stellvertreter:
;; sepliste und Kette passen nicht zusammen (Kette umgebaut, Luecke in
;; der KS-Kette) - die uebrigen Eintraege bleiben ohne ID.
(if (> sl-fehlend 0)
(princ (ssg-textf "exp-sepliste-ohne-proxy"
(list (cdr (assoc 2 (entget wrapper))) (itoa sl-fehlend)))))))
)
(if (> sl-gesetzt 0)
(princ (ssg-textf "exp-sepliste-ids" (list (itoa sl-gesetzt)))))
(if gruppiert
(princ (ssg-textf "exp-unitmark-bilanz" (list (itoa (length ergebnis)) (itoa alt)))))
(reverse ergebnis)
)
;; --- Relevante Bloecke sammeln ---
;; Filtert INSERT-Entities auf exportierbare Bloecke:
;; KR_* = Kreisel Compound-Bloecke
;; AP110* = Omniflo Geraden
;; Omniflo Boegen/Weichen = rein numerische Blocknamen (SivasNr)
;; Vario* = VarioFoerderer-Bloecke
;; GF_* = Gefaellestrecke Compound-Bloecke
;; ZZ_ASES_MARKER = die Marker der AS-/ES-Kettenenden einer VF_n/GF_n-Strecke
;; (siehe csv:asmark-aktualisieren; pattern_ases_marker in cfg/export.cfg).
;; Das Kettenende selbst steckt verpackt in der Wrapper-Blockdefinition und
;; waere sonst weder sichtbar noch exportierbar; der Marker vertritt es -
;; mit eigener, ueber Exportlaeufe stabiler ID und den Attributen
;; TYP/LFDNR/ELEMENT/ARTINR.
;; Separator_SP*/S-LP*, Scanner* = eigenstaendige Sensor-Bloecke (siehe
;; pattern_separator/pattern_scanner in cfg/export.cfg). Landen in
;; export_raw.json fuer BEIDE Exporte (EXPORTCSV/EXPORTSIVAS teilen sich
;; diese Sammlung) - export_csv.py gibt ihnen eigene TeileArt-Zeilen,
;; export_sivas.py schliesst sie bewusst wieder aus (siehe dort), da ihre
;; Anzahl schon ueber ANZAHL_SEPARATOR/ANZAHL_SCANNER an Kreisel/GF/VF
;; gezaehlt wird.
;; BTMT-Beladung*/SC_Entladung* = eigenstaendige BTMT Be-/Entladestationen
;; (siehe pattern_btmt_beladung/pattern_btmt_entladung in cfg/export.cfg,
;; ils-insert-station in SSG_LIB_Commands.lsp). Anders als Separator/
;; Scanner werden sie von KEINEM anderen Element mitgezaehlt - export_csv.py
;; UND export_sivas.py fuehren sie beide als eigene TeileArt-Zeilen.
;; Eingang*/Ausgang* = Materialfluss-Ein-/Ausgangssymbole (siehe
;; pattern_eingang/pattern_ausgang in cfg/export.cfg, ils-insert-station in
;; SSG_LIB_Commands.lsp). Wie BTMT eigenstaendig, aber NUR fuer den
;; CSV-Export: export_csv.py gibt ihnen eigene TeileArt-Zeilen und traegt
;; sie - wie Separator/AS/ES - in die "TrackIds"-Spalte ein (auch auf
;; Kreiseln, siehe KREISEL_UMLAUF_TEILEARTEN in lib/export_neighbors.py);
;; export_sivas.py schliesst sie bewusst aus.
;; GR_* = Geruest-Baugruppen (siehe pattern_geruest in cfg/export.cfg,
;; GeruestInsert.lsp). Wie BTMT eigenstaendig und von keinem anderen
;; Element mitgezaehlt - export_csv.py UND export_sivas.py fuehren sie
;; beide als eigene TeileArt-Zeilen.
;; Gibt Auswahlsatz zurueck oder nil.
(defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname ist-nested-element)
(setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss-all) (setq ss-out nil)
(progn
(setq ss-out (ssadd))
(setq i 0)
(while (setq ename (ssname ss-all i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
;; Uebrige verpackte VF_n/GF_n-Bausteine (Boegen, gerade Foerderer-/
;; Gefaellestrecken-Segmente, Umlenk-/Motorstation, siehe
;; csv:pattern-nested-element/csv:element-proxies-erzeugen): NUR im
;; Rohdaten-Modus (*csv-export-alle-elemente* = T) als eigene Export-
;; Zeile gesammelt. Im Default (gruppierter Modus, nil) fasst
;; csv: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))))
(if (and (not ist-nested-element)
(or
(wcmatch bname (export:pattern "pattern_kreisel" "KR_*,KREISEL_*,ECKRAD_*"))
(wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*"))
(wcmatch bname (export:pattern "pattern_strecke"
"Vario*,Staustrecke*,AUS_Element*,EIN_Element*,VF_*,GF_*"))
(wcmatch bname (export:pattern "pattern_ases_marker" "ZZ_ASES_MARKER*"))
(wcmatch bname (export:pattern "pattern_separator" "Separator_SP*,S-LP*"))
(wcmatch bname (export:pattern "pattern_scanner" "Scanner*"))
(wcmatch bname (export:pattern "pattern_btmt_beladung" "BTMT-Beladung*"))
(wcmatch bname (export:pattern "pattern_btmt_entladung" "SC_Entladung*"))
(wcmatch bname (export:pattern "pattern_eingang" "Eingang*"))
(wcmatch bname (export:pattern "pattern_ausgang" "Ausgang*"))
(wcmatch bname (export:pattern "pattern_geruest" "GR_*"))
(wcmatch bname (export:pattern "pattern_unit_marker" "ZZ_UNIT_MARKER*"))
;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen)
;; Rein LISP-intern (Python klassifiziert Omniflo stattdessen
;; ueber exakten Katalog-Match), daher fest im Code statt in
;; cfg/export.cfg.
(wcmatch bname "#*")
))
(ssadd ename ss-out)
)
(setq i (1+ i))
)
(if (= (sslength ss-out) 0) (setq ss-out nil))
)
)
ss-out
)
;; --- HOEHE/DREHUNG aller Omniflo-Elemente still aktualisieren ---
;; Wird automatisch vor jedem Export aufgerufen.
(defun omni:update-all-attribs ( / ss i ename ed bname teileart)
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
(if ss
(progn
(setq i 0)
(while (setq ename (ssname ss i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq teileart (csv:get-attrib ename "TEILEART"))
(if (or teileart
(wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*")))
(progn
(omni:set-hoehe-attrib ename)
(omni:set-drehung-attrib ename)
)
)
(setq i (1+ i))
)
)
)
)
;; --- Gemeinsame Export-Funktion ---
;; Sammelt relevante Bloecke, schreibt JSON, ruft Python auf.
;; label = Anzeigename (z.B. "EXPORTCSV")
;; --- Export-Vorbereitung: Zeichnungszustand fuer den Export herrichten ---
;; Aus csv:run-export ausgelagert: alle Schritte, die VOR dem Sammeln/Schreiben
;; den Zeichnungszustand herrichten - IDs sicherstellen, Stellvertreter der
;; verpackten Kettenbausteine erzeugen und nummerieren, Omniflo-Attribute
;; (HOEHE/DREHUNG) aktualisieren, Separator-/Scanner-Zuordnung pruefen, global
;; regenerieren und die bbox-Fehlerdiagnose zuruecksetzen. Rueckgabe:
;; (sep-proxies element-proxies unitmarks asmarks) - alle temporaer, der
;; Aufrufer entfernt sie am Ende wieder. label dient nur den Meldungen.
;;
;; Reihenfolge (jeder Wert wird genau EINMAL gesetzt):
;; 1. ssg-id-check-all - Wrapper-IDs endgueltig (fehlende vergeben,
;; Duplikate korrigiert), BEVOR ein Stellvertreter entsteht. Damit kann
;; jeder Stellvertreter seine ZUORDNUNG beim Erzeugen bekommen.
;; 2. Stellvertreter erzeugen (Separator-Kopien, AS-/ES-Marker, Element-
;; Kopien) - ZUORDNUNG direkt dabei
;; 3. csv:ketten-verarbeiten - Einheiten-Proxies, IDs in Kettenfolge,
;; Separator-Typ und sepliste-Stellvertreter aus derselben Kette
;; 4. ssg-id-check-all - Restnummerierung (z.B. Kreisel-Separator ohne
;; Kette) und Duplikat-Korrektur unter den neuen Stellvertretern
(defun csv:export-vorbereiten (label / sep-proxies asmarks element-proxies unitmarks)
;; Stand eines frueheren Laufs verwerfen: Baustein-Geometrie der
;; Stellvertreter, Anmeldungen fuer reservierte IDs (csv:res-merken),
;; geordnete Ketten (csv:kette-von), sepliste-Stellvertreter.
(setq *csv-baustein-by-handle* nil)
(setq *csv-res-sammlung* nil)
(setq *csv-ketten* nil)
(setq *csv-sepliste-id-by-handle* nil)
;; 1. IDs aller Bloecke sicherstellen und Duplikate korrigieren - hier nur
;; fuer die dauerhaften Bloecke, Stellvertreter gibt es noch keine.
(princ (ssg-textf "exp-check-ids" (list label)))
(ssg-id-check-all)
;; 2. Verpackte Separator_SP-Symbole durch temporaere, echte Kopien
;; vertreten (csv:sep-proxies-erzeugen) - 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 und
;; bekommen einen temporaeren Marker (ZZ_ASES_MARKER); ihre ID bleibt als
;; reservierte ID am Wrapper 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).
(setq element-proxies
(if (csv:export-alle-elemente-p) (csv:element-proxies-erzeugen)))
;; 3. Ketten verarbeiten: Foerdereinheit-/Gefaelleeinheit-Proxies (ZZ_UNIT_
;; MARKER, nur Modus group_vf_gf) aus den KS-verketteten Bausteinen bauen,
;; alle neuen Export-Objekte jeder Kette von AS nach ES aufsteigend
;; nummerieren, Separator-Typ und sepliste-Stellvertreter eintragen.
(setq unitmarks (csv:ketten-verarbeiten sep-proxies element-proxies asmarks))
;; 4. Restnummerierung + Duplikat-Korrektur. ssg-id-check-all ermittelt
;; zuerst das globale Maximum der vergebenen IDs (Phase 0) und nummeriert
;; erst danach - neue IDs liegen damit ueber jeder vorhandenen.
(ssg-id-check-all)
;; IDs aller temporaeren Kettenobjekte als reservierte IDs am Wrapper
;; ablegen - der naechste Export gibt sie ihnen zurueck (csv:res-merken).
(csv:res-ids-schreiben)
;; 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)
;; Alle temporaeren Hilfsmittel zurueckgeben (Separator-/Element-Kopien,
;; Einheiten-Proxies, AS-/ES-Marker) - csv:run-export entfernt sie wieder.
(list sep-proxies element-proxies unitmarks asmarks))
;; --- 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 element-proxies
unitmarks asmarks 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 asmarks), 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))
(setq asmarks (nth 3 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 und AS-/ES-Marker wieder entfernen -
;; sie haben ihren Zweck (ID-Vergabe + JSON-Zeile ueber die obigen,
;; unveraenderten Sammel-Funktionen) erfuellt. Die AS-/ES-IDs bleiben als
;; reservierte IDs am Wrapper (csv:res-ids-schreiben).
(csv:sep-proxies-loeschen sep-proxies)
(csv:hilfskopien-loeschen asmarks "exp-art-ases")
(csv:hilfskopien-loeschen element-proxies "exp-art-element")
(csv:hilfskopien-loeschen unitmarks "exp-art-einheit")
(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"))
)
(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"))
)
(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)
)