Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
e08b8b2b08f98486163df1819f0d4f52dd197c2e
dxfmakros/Lisp/export.lsp
T
m.stangl 3698c8982c Sepliste-XDATA fuer Separator/AS/ES-Reihenfolge + Unit-Tests, makunbound-Fix 
Sammelt beim Bau von VF_n/GF_n-Ketten die Baureihenfolge der Separator-/
AS-/ES-Sub-Bloecke vor dem Block-Sweep und schreibt sie als XDATA auf den
fertigen Wrapper (ssg_ks_insert.lsp); export.lsp liest sie fuer das neue
"sepliste"-Feld im CSV-Export, export_neighbors.py nutzt es als Fallback
zur BBox-Kollisionspruefung. Dazu Unit-Tests fuer die reinen Serialisierungs-
funktionen (Chunking, Roundtrip) in test_unit.lsp.

Ausserdem: makunbound (existiert nicht in BricsCAD-AutoLISP) aus
test_run_all.lsp entfernt - verursachte Laufzeitfehler bei
SSG_RUN_ALL_TESTS_EXPORT/_OFFEN.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-09 20:36:42 +02:00

1338 lines
58 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; export.lsp - Export-Funktionen fuer INSERT-Bloecke
;;
;; Enthaelt:
;; - JSON-Sammler (csv:collect-export-blocks, csv:run-export)
;; - Python-basierter Export: EXPORTSIVAS, EXPORTCSV
;;
;; Alle Blockname-Muster dieses Moduls sind zentral in cfg/export.cfg
;; (INI-Style, Abschnitt [blockpattern]) deklariert und werden beim
;; Laden des Moduls einmalig eingelesen (export:load-cfg).
;; Datei-/Skriptnamen sind fest im Code hinterlegt (*export-filenames*).
;; ============================================================
(vl-load-com)
;; --- Export-Konfiguration aus cfg/export.cfg laden ---
;; Nutzt den zentralen INI-Parser aus ssg_core.lsp (ssg-load-ini / ssg-ini-get /
;; ssg-ini-list), damit fuer alle Module derselbe .cfg-Standard gilt.
(defun export:load-cfg ( / cfg-pfad)
(setq cfg-pfad (strcat (getenv "DXFM_CFG") "/export.cfg"))
(setq *export-cfg* (ssg-load-ini cfg-pfad))
(if (null *export-cfg*)
(princ (ssg-textf "exp-cfg-not-found" (list cfg-pfad)))
)
(princ)
)
;; --- Einzelwert aus *export-cfg* lesen, mit Fallback ---
;; section = "blockpattern"
(defun export:cfg (section key default)
(ssg-ini-get *export-cfg* section key default)
)
;; --- Muster aus [blockpattern] als normalisierter wcmatch-String ---
;; key = Config-Key, z.B. "pattern_kreisel"
;; default-str = Fallback-Wert als kommagetrennter String, falls Config fehlt
;; Rueckgabe: kommagetrennter String ohne Leerzeichen, z.B. "KR_*,KREISEL_*"
(defun export:pattern (key default-str)
(ssg-ini-list *export-cfg* "blockpattern" key default-str)
)
;; Beim Laden des Moduls einmalig einlesen (Lazy-Loading via ssg-ensure "export")
(export:load-cfg)
;; --- Test-Override fuer den Ausgabeordner (nur Lisp-Sitzungsspeicher) ---
;; Wird ausschliesslich von TEST_EXPORT_ALL (tests/test_export_all.lsp)
;; waehrend des Testlaufs auf DXFM_TESTOUT gesetzt und danach garantiert
;; wieder auf nil zurueckgesetzt. Bewusst KEIN (setenv "DXFM_RESULTS" ...):
;; (setenv ...) schreibt in BricsCAD dauerhaft in die Profil-Registry und
;; ueberlebt damit jeden Neustart.
(setq *export-test-override* nil)
;; --- Feste Datei-/Skriptnamen dieses Moduls (keine Config, direkt im Code) ---
(setq *export-filenames*
(list
(cons "raw_json_datei" "export_raw.json")
(cons "sivas_script" "export_sivas.py")
(cons "sivas_csv" "sivas.csv")
(cons "csv_script" "export_csv.py")
(cons "csv_csv" "export.csv")
)
)
;; --- Dateinamen aus *export-filenames* lesen ---
(defun export:filename (key)
(cdr (assoc key *export-filenames*))
)
;; --- Zeichnungsname als Dateiname-Praefix ermitteln ---
;; Liefert "<Zeichnungsname>_" oder "" (leer), wenn die Zeichnung noch nie
;; gespeichert wurde (DWGTITLED=0, Name z.B. "Zeichnung1"/"Drawing1").
;; So heisst die Export-CSV bei einer benannten Zeichnung "<name>_export.csv"
;; bzw. "<name>_sivas.csv" statt nur "export.csv"/"export_sivas.csv" - bei
;; mehreren offenen/parallel bearbeiteten Zeichnungen sonst nicht unterscheidbar.
(defun export:dwg-praefix ( / dwgname)
(if (= (getvar "DWGTITLED") 0)
""
(progn
(setq dwgname (getvar "DWGNAME"))
(if (and dwgname (/= dwgname ""))
(strcat (vl-filename-base dwgname) "_")
""
)
)
)
)
;; ============================================================
;; PYTHON-INTERPRETER ERMITTELN
;; ============================================================
;; BricsCAD erbt seine Umgebung von start_briscad.bat/setenv.bat - dort wird
;; das Projekt-venv NICHT aktiviert. Ein blankes "python" trifft unter Windows
;; 11 daher den WindowsApps-Platzhalter
;; (%LOCALAPPDATA%\Microsoft\WindowsApps\python.exe), der kein Interpreter ist,
;; sondern nur auf den Microsoft Store verweist und mit Exitcode 49 abbricht.
;; Der Export schrieb dann zwar die JSON, aber nie eine CSV.
;;
;; Aufloesungsreihenfolge (erster Treffer gewinnt):
;; 1. cfg/export.cfg [python] interpreter= (explizite Vorgabe)
;; 2. Umgebungsvariable DXFM_PYTHON (von setenv.bat gesetzt)
;; 3. <DXFMAKRO>/.venv/Scripts/python.exe (Projekt-venv, siehe install_py.bat)
;; 4. "py" (Python-Launcher, C:\Windows\py.exe) - kein Store-Platzhalter
;; 5. "python" (PATH) als letzter Ausweg
(defun export:python-store-stub-p (pfad / p)
(setq p (strcase (vl-string-translate "\\" "/" pfad)))
(and (vl-string-search "/WINDOWSAPPS/" p) T)
)
;; --- Kandidat pruefen: existierende Datei und kein Store-Platzhalter ---
(defun export:python-kandidat-ok-p (pfad)
(and pfad
(/= pfad "")
(findfile pfad)
(not (export:python-store-stub-p pfad)))
)
(defun export:python-exe ( / cfg-wert env-wert venv-pfad launcher-pfad)
(cond
;; 1. Explizite Vorgabe aus der Config
((export:python-kandidat-ok-p
(setq cfg-wert (export:cfg "python" "interpreter" "")))
cfg-wert)
;; 2. Umgebungsvariable
((export:python-kandidat-ok-p (setq env-wert (getenv "DXFM_PYTHON")))
env-wert)
;; 3. Projekt-venv
((export:python-kandidat-ok-p
(setq venv-pfad (strcat (cond ((getenv "DXFMAKRO")) ("."))
"/.venv/Scripts/python.exe")))
venv-pfad)
;; 4. Python-Launcher (liegt in C:\Windows, daher kein Store-Platzhalter).
;; Voller Pfad statt nur "py.exe": findfile durchsucht die BricsCAD-
;; Suchpfade, nicht zwangslaeufig den System-PATH.
((export:python-kandidat-ok-p
(setq launcher-pfad (strcat (cond ((getenv "SystemRoot")) ("C:/Windows"))
"/py.exe")))
launcher-pfad)
;; 5. Letzter Ausweg - kann der Store-Platzhalter sein, deshalb wird der
;; Exitcode nach dem Aufruf geprueft (siehe export:run-python).
(t "python")
)
)
;; --- Python-Skript synchron ausfuehren, Ausgabe in Logdatei ---
;; Ersetzt das frueherer "fire and forget" (startapp "cmd" "/c ..."): das
;; cmd-Fenster schloss sich sofort wieder, jede Python-Fehlermeldung (fehlender
;; Interpreter, Traceback) war unsichtbar und der Befehl meldete trotzdem
;; "Export gestartet". Jetzt wird ueber WScript.Shell.Run mit bWaitOnReturn=T
;; gewartet, stdout/stderr nach DXFM_LOG/export_python.log umgeleitet und der
;; Exitcode ausgewertet.
;; Rueckgabe: Exitcode (0 = ok) oder nil, wenn der Aufruf selbst scheiterte.
(defun export:run-python (py-exe py-skript args log-pfad / cmd sh rc code)
;; Aeussere Anfuehrungszeichen um die gesamte /c-Zeile: sonst verschluckt
;; cmd.exe die Quotes um den Interpreterpfad (Leerzeichen in "Program Files").
(setq cmd (strcat "cmd.exe /c \"\"" py-exe "\""))
(setq cmd (strcat cmd " \"" py-skript "\""))
(foreach a args (setq cmd (strcat cmd " \"" a "\"")))
(setq cmd (strcat cmd " > \"" log-pfad "\" 2>&1\""))
;; Run(cmd, 0, T): 0 = kein Fenster, T = warten und Exitcode liefern.
(setq rc
(vl-catch-all-apply
'(lambda ()
(setq sh (vlax-create-object "WScript.Shell"))
(setq code (vlax-invoke sh 'Run cmd 0 :vlax-true))
(vlax-release-object sh)
(setq sh nil)
code)))
(if (vl-catch-all-error-p rc)
(progn
(if sh (vl-catch-all-apply 'vlax-release-object (list sh)))
nil)
rc
)
)
;; --- Erste Zeilen der Python-Logdatei in die Kommandozeile spiegeln ---
;; Damit steht die eigentliche Fehlerursache direkt in BricsCAD und nicht nur
;; in der Logdatei. max-zeilen begrenzt die Ausgabe (Tracebacks koennen lang sein).
(defun export:log-ausgeben (log-pfad max-zeilen / fh zeile n)
(if (setq fh (open log-pfad "r"))
(progn
(setq n 0)
(while (and (setq zeile (read-line fh)) (< n max-zeilen))
(if (/= zeile "")
(progn (princ (strcat "\n | " zeile)) (setq n (1+ n)))
)
)
(close fh)
)
)
(princ)
)
;; --- String fuer JSON escapen (Anfuehrungszeichen/Backslash) ---
;; Konvertiert nicht-String-Werte (z.B. T, nil, Zahlen) defensiv in String.
(defun csv:json-escape (s)
(if (not (= (type s) 'STR))
(setq s (if s (vl-princ-to-string s) ""))
)
(setq s (vl-string-subst "\\\\" "\\" s))
(vl-string-subst "\\\"" "\"" 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
;; Eltern-Rotation (reine Z-Drehung um den Einfuegepunkt) in Weltkoordinaten
;; umrechnen. Rueckgabe: (x y z) ---
(defun csv:local-to-world (parent-pt parent-rot-rad local-pt / c s lx ly lz pz)
(setq c (cos parent-rot-rad) s (sin parent-rot-rad))
(setq lx (car local-pt) ly (cadr local-pt))
(setq lz (if (caddr local-pt) (caddr local-pt) 0.0))
(setq pz (if (caddr parent-pt) (caddr parent-pt) 0.0))
(list
(+ (car parent-pt) (- (* lx c) (* ly s)))
(+ (cadr parent-pt) (+ (* lx s) (* ly c)))
(+ pz lz)
)
)
;; --- K1-K4-Koordinatensysteme eines Blocks als Positions-Strings lesen ---
;; ename = Entity-Name des platzierten INSERT (Omniflo Bogen/Weiche/Gerade).
;; pt/rot-rad = bereits ermittelte Welt-Position/-Rotation (radiant) 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
;; Eltern-Rotation (reine Z-Drehung) in Weltkoordinaten um. 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).
(defun csv:get-k-kos-strings (ename pt rot-rad / ed bname blk-tbl sub-ent sub-ed
sub-bname sub-pt world-pt target is-real result)
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq blk-tbl (tblsearch "BLOCK" bname))
(setq result nil)
(if blk-tbl
(progn
(setq sub-ent (entnext (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)))
(setq world-pt (csv:local-to-world pt rot-rad sub-pt))
(setq result (cons
(cons target
(csv:trans-encode
(car world-pt) (cadr world-pt) (caddr world-pt)))
result))
)
)
)
)
(setq sub-ent (entnext sub-ent))
)
)
)
result
)
;; --- Wert aus csv:get-k-kos-strings nach Name lesen, "" falls nicht vorhanden ---
(defun csv:k-kos (k-list name / found)
(setq found (assoc name k-list))
(if found (cdr found) "")
)
;; --- K1 (Anfang) / K2 (Ende) einer Omniflo-Gerade SYNTHETISIEREN ---
;; ename = Entity-Name des platzierten Gerade-INSERT.
;; pt/rot-rad = Welt-Einfuegepunkt (= Anfang) und -Rotation (radiant) des
;; Blocks (siehe csv:block-to-json).
;; Geraden fuehren - anders als Boegen/Weichen - KEINE echten K-Bloecke in der
;; Zeichnung. Fuer den Export werden ihre Anschluss-Koordinatensysteme aus der
;; Geometrie berechnet, als laegen dort echte KOS: K1 am Einfuegepunkt (Anfang
;; der lokalen Linie 0,0), K2 am Ende (laenge,0), ueber die Block-Rotation in
;; Weltkoordinaten gedreht. Laenge aus dem LAENGE- bzw. A-Attribut. Damit
;; koennen Geraden in der Python-Nachbarschaftserkennung (export_neighbors.py)
;; genauso ueber ihre KOS gegen andere Geraden/Boegen/Weichen geprueft werden.
;; Rueckgabe wie csv:get-k-kos-strings: (("K1" . str) ("K2" . str)) oder nil.
(defun csv:gerade-k-kos-strings (ename pt rot-rad / laenge-str laenge z end-pt)
(setq laenge-str (cond ((csv:get-attrib ename "LAENGE"))
((csv:get-attrib ename "A"))
(t nil)))
(if (and laenge-str (> (strlen laenge-str) 0))
(progn
(setq laenge (atof laenge-str))
(setq z (if (caddr pt) (caddr pt) 0.0))
(setq end-pt (list (+ (car pt) (* laenge (cos rot-rad)))
(+ (cadr pt) (* laenge (sin rot-rad)))
z))
(list
(cons "K1" (csv:trans-encode (car pt) (cadr pt) z))
(cons "K2" (csv:trans-encode (car end-pt) (cadr end-pt) (caddr end-pt))))
)
nil
)
)
;; --- KS-Position eines VF/GF-Wrappers ueber das RICHTIGE Element ---
;; bname = Blockname des VF_n/GF_n-Wrappers.
;; elem-pat = Muster des KS-tragenden Teilbloecks ("AS_ELEMENT*" bzw.
;; "ES_ELEMENT*", Grossschreibung - wcmatch ist unempfindlich).
;; ks-pat = Muster des gesuchten Koordinatensystems ("KS_EIN,KSYS_EIN"
;; bzw. "KS_AUS,KSYS_AUS").
;; Warum zwei Ebenen: das AS_Element UND das ES_Element eines VF_n fuehren
;; JEWEILS ein KS_EIN UND ein KS_AUS (siehe check_hoehen.lsp ch-measure-vfgf).
;; Ein flaches (ssg-collect-nested-inserts bname "KS_AUS") ueber den GANZEN
;; Wrapper lieferte darum zwei Treffer und (car ...) griff den falschen (den
;; des AS_Elements) - K2/ES landete auf der falschen (Anfangs-)Seite. Darum
;; ERST das passende Element (AS/ES) suchen und NUR IN DESSEN Blockdefinition
;; das KS. Die KS-Position wird durch die Weltlage des Elements (world-pt/
;; R-world/Skalierung aus dem Element-Record) in das Koordinatensystem der
;; Wrapper-Blockdefinition transformiert - dieselbe Verkettung wie in
;; ssg-collect-nested-inserts-rel (OCS ist in den Records bereits aufgeloest).
;; Rueckgabe: (x y z) im Wrapper-Definitionsframe, oder nil wenn nicht gefunden.
(defun csv:vfgf-ks-loc (bname elem-pat ks-pat / elem-hits elem-rec elem-bname
elem-pt elem-R elem-sx elem-sy elem-sz ks-hits ks-loc
scaled)
(setq elem-hits (ssg-collect-nested-inserts bname elem-pat))
(if elem-hits
(progn
(setq elem-rec (car elem-hits))
(setq elem-bname (strcase (cdr (assoc 2 (entget (car elem-rec))))))
;; Nur das KS INNERHALB dieser Element-Blockdefinition (nicht im Wrapper).
(setq ks-hits (ssg-collect-nested-inserts elem-bname ks-pat))
(if ks-hits
(progn
(setq elem-pt (cadr elem-rec))
(setq elem-R (caddr elem-rec))
(setq elem-sx (nth 3 elem-rec) elem-sy (nth 4 elem-rec) elem-sz (nth 5 elem-rec))
(setq ks-loc (cadr (car ks-hits))) ;; KS-Pos im Element-Frame
(setq scaled (list (* elem-sx (car ks-loc))
(* elem-sy (cadr ks-loc))
(* elem-sz (caddr ks-loc))))
;; Element-Weltlage (im Wrapper-Frame) + rotierte KS-Position.
(mapcar '+ elem-pt (mat3-mul-vec3 elem-R scaled))
)
)
)
)
)
;; --- K1 (Eingang) / K2 (Ausgang) eines VF_n/GF_n-Wrappers ableiten ---
;; ename = Entity-Name des platzierten VF_n/GF_n-INSERT.
;; pt/rot-rad = Welt-Einfuegepunkt/-Rotation (radiant) des Wrappers (siehe
;; csv:block-to-json).
;; VF/GF-Wrapper fuehren - anders als Omniflo-Boegen - KEINE direkten K1-K4-
;; oder KS-Sub-INSERTs; ihre Streckenenden stecken je EINE Ebene tiefer:
;; KS_EIN im AS_Element*, KS_AUS im ES_Element* (siehe check_hoehen.lsp,
;; extract-ks-from-block-raw). csv:vfgf-ks-loc holt die KS-Position aus dem
;; JEWEILS zugehoerigen Element (nicht flach aus dem ganzen Wrapper - beide
;; Elemente tragen beide KS-Typen). Der so ermittelte Punkt (Wrapper-Frame)
;; wird ueber die Wrapper-Weltlage (reine Z-Drehung) in Weltkoordinaten
;; gedreht und wie K1-K4 als reiner Positions-String (csv:trans-encode)
;; exportiert. Damit hat auch eine Strecke K1 und K2 fuer die
;; Python-Kollisionspruefung (export_neighbors.py: Schleuselemente +
;; Kreisel-Kollision ueber die AS/ES-Position mit fester BBox statt der
;; ganzen Wrapper-Box).
;;
;; RICHTUNG: K1 ist IMMER der Eingang eines Elements, K2 IMMER der Ausgang.
;; AS = Eingangs-Element (traegt KS_EIN), ES = Ausgangs-Element (traegt KS_AUS).
;; - VarioFoerderer/Strecke (VF_*): Richtung liegt ueber die Elementrolle
;; fest -> K1 = AS-Ende (KS_EIN), K2 = ES-Ende (KS_AUS).
;; - Gefaellestrecke (GF_*): Foerderrichtung ist bergAB, also durch die HOEHE
;; bestimmt (siehe HOEHE_VON_mm > HOEHE_BIS_mm, check_hoehen.lsp). Der
;; Eingang ist das HOEHERE Ende, der Ausgang das TIEFERE - unabhaengig
;; davon, welches der beiden physischen Elemente das AS bzw. ES ist. Darum
;; wird bei GF nach Z sortiert (hoeheres Z -> K1, tieferes Z -> K2).
;; Rueckgabe wie csv:get-k-kos-strings: (("K1" . str) ("K2" . str)) - nur die
;; tatsaechlich gefundenen Enden.
(defun csv:vfgf-k-kos-strings (ename pt rot-rad / ed bname as-loc es-loc
as-world es-world ein-world aus-world result)
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq result nil)
;; Beide Enden im Wrapper-Frame holen und in Weltkoordinaten (reine
;; Z-Drehung) umrechnen. AS traegt das KS_EIN, ES das KS_AUS - jeweils aus
;; dem RICHTIGEN Element (csv:vfgf-ks-loc; beide Elemente fuehren beide
;; KS-Typen).
(setq as-loc (csv:vfgf-ks-loc bname "AS_ELEMENT*" "KS_EIN,KSYS_EIN"))
(setq es-loc (csv:vfgf-ks-loc bname "ES_ELEMENT*" "KS_AUS,KSYS_AUS"))
(if as-loc (setq as-world (csv:local-to-world pt rot-rad as-loc)))
(if es-loc (setq es-world (csv:local-to-world pt rot-rad es-loc)))
;; Eingang/Ausgang festlegen (siehe Richtung im Kopfkommentar).
(cond
;; GF: Richtung ueber die Hoehe - hoeheres Z = Eingang, tieferes Z = Ausgang.
;; Nur wenn BEIDE Enden vorhanden sind; sonst faellt es auf die Rolle zurueck.
((and (wcmatch (strcase bname) "GF_*") as-world es-world)
(if (>= (caddr as-world) (caddr es-world))
(setq ein-world as-world aus-world es-world)
(setq ein-world es-world aus-world as-world)))
;; VF/Strecke (und GF mit nur einem Ende): AS = Eingang, ES = Ausgang.
(t (setq ein-world as-world aus-world es-world))
)
(if ein-world
(setq result (cons (cons "K1"
(csv:trans-encode (car ein-world) (cadr ein-world) (caddr ein-world))) result)))
(if aus-world
(setq result (cons (cons "K2"
(csv:trans-encode (car aus-world) (cadr aus-world) (caddr aus-world))) result)))
(reverse result)
)
;; --- Mindesthoehe der Bounding-Box (Z-Ausdehnung), aus cfg/export.cfg ---
;; [Boundingbox] bb_minimum_height_mm, Default 1 (mm) falls nicht gesetzt.
;; Verhindert dz=0 bei flachen 2D-Bloecken (Draufsicht ohne Z-Ausdehnung).
(defun csv:bb-minimum-height-mm ()
(atof (export:cfg "Boundingbox" "bb_minimum_height_mm" "1"))
)
;; --- 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)
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 handle attribs bbox bbox-json
insert-quat insert-kos k-list warnung-json warnung-eintrag
zuordnung-fix-json zuordnung-fix-eintrag sepliste-json sepliste-app sepliste
sepliste-teile sepliste-first)
(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))
(setq attribs (csv:read-attribs ename))
(setq insert-quat (csv:z-angle-to-quat (* (/ rotation pi) 180.0)))
(setq insert-kos (csv:kos-encode
(car pt) (cadr pt) (if (caddr pt) (caddr pt) 0.0)
(nth 0 insert-quat) (nth 1 insert-quat) (nth 2 insert-quat) (nth 3 insert-quat)))
(setq k-list (csv:get-k-kos-strings ename pt rotation))
;; Omniflo-Geraden fuehren keine echten K-Bloecke - K1/K2 aus der Geometrie
;; (Anfang/Ende ueber Laenge + Rotation) synthetisieren, damit sie im Export
;; wie echte Anschluss-Koordinatensysteme erscheinen und in der Nachbar-
;; schaftserkennung (export_neighbors.py) mitverwendet werden koennen.
(if (and (null k-list)
(wcmatch (strcase blk-name)
(export:pattern "pattern_gerade" "AP110*,AP_110*")))
(setq k-list (csv:gerade-k-kos-strings ename pt rotation))
)
;; VF_n/GF_n-Wrapper: K1 (Eingang) und K2 (Ausgang) eine Ebene tiefer aus
;; AS_Element/ES_Element ableiten (siehe csv:vfgf-k-kos-strings; VF ueber die
;; Elementrolle, GF ueber die Hoehe). Damit die Python-Kollisionspruefung
;; Kreisel<->Strecke ueber die AS/ES-Position mit fester BBox statt der
;; ganzen Wrapper-Box arbeiten kann.
(if (and (null k-list)
(wcmatch (strcase blk-name) "VF_*,GF_*"))
(setq k-list (csv:vfgf-k-kos-strings ename pt rotation))
)
(setq bbox-json "")
(if include-bbox
(progn
(setq bbox (csv:get-bbox ename))
(if bbox
(setq bbox-json
(strcat
",\"bbox\":{"
"\"cx\":" (rtos (nth 0 bbox) 2 4)
",\"cy\":" (rtos (nth 1 bbox) 2 4)
",\"cz\":" (rtos (nth 2 bbox) 2 4)
",\"dx\":" (rtos (nth 3 bbox) 2 4)
",\"dy\":" (rtos (nth 4 bbox) 2 4)
",\"dz\":" (rtos (nth 5 bbox) 2 4)
"}"
)
)
)
)
)
;; Warnung fuer strittige Scanner-Zuordnungen anhaengen (siehe
;; cs-zuordnung-lauf in count_sep_scan.lsp, das *cs-scanner-warnung-
;; by-handle* vor csv:collect-export-blocks befuellt). Referenziert
;; die Variable direkt statt ueber atoms-family: ein in AutoLISP noch
;; nie gesetztes globales Symbol wertet beim Lesen zu nil aus (kein
;; Fehler), genau wie *export-test-override* in diesem Modul.
(setq warnung-json "")
(setq warnung-eintrag (assoc handle *cs-scanner-warnung-by-handle*))
(if warnung-eintrag
(setq warnung-json (strcat ",\"warnung\":\"" (csv:json-escape (cdr warnung-eintrag)) "\""))
)
;; Bekannte (nicht geratene) Separator-Zuordnung durchreichen: fuer die
;; temporaeren Kopien VERPACKTER Separator_SP-Symbole steht der Carrier fest
;; (der Wrapper-Block, in dem das Symbol steckt) - siehe
;; csv:sep-proxies-zuordnung-setzen und *cs-sep-fix-by-handle*. export_csv.py
;; berechnet die Zuordnung sonst ein zweites Mal per Boundingbox-
;; Ueberschneidung (compute_sensor_zuordnung, Prioritaet GF > VF > Kreisel-
;; haelfte) und wuerde den bekannten Wert damit ueberschreiben - z.B. auf
;; eine Gefaellestrecke, in deren Box der Separator zufaellig hineinragt,
;; obwohl er in einem VF-Block verpackt ist. Mit diesem Feld uebernimmt
;; export_csv.py den Wert unveraendert.
(setq zuordnung-fix-json "")
(setq zuordnung-fix-eintrag (assoc handle *cs-sep-fix-by-handle*))
(if zuordnung-fix-eintrag
(setq zuordnung-fix-json
(strcat ",\"zuordnung_fix\":\"" (csv:json-escape (cdr zuordnung-fix-eintrag)) "\""))
)
;; VF_n/GF_n-Wrapper: Separator-/AS-/ES-Reihenfolge aus der beim Bau
;; geschriebenen XDATA lesen (siehe ssg-sepliste-xdata-lesen,
;; ssg_ks_insert.lsp) und als "sepliste"-Array einbetten. Nur gesetzt, wenn
;; die XDATA vorhanden ist (Altbestand-Wrapper ohne die neue XDATA bleiben
;; ohne dieses Feld - export_neighbors.py faellt dann auf den bisherigen
;; BBox-Kollisionspfad zurueck).
(setq sepliste-json "")
(if (car (atoms-family 1 '("SSG-SEPLISTE-XDATA-LESEN")))
(progn
(setq sepliste-app
(cond
((wcmatch (strcase blk-name) "VF_*") "SSG_VF_SEP")
((wcmatch (strcase blk-name) "GF_*") "SSG_GF_SEP")
(t nil)))
(if sepliste-app
(setq sepliste (ssg-sepliste-xdata-lesen ename sepliste-app)))
(if sepliste
(progn
(setq sepliste-teile "" sepliste-first t)
(foreach e sepliste
(setq sepliste-teile
(strcat sepliste-teile (if sepliste-first "" ",")
"{\"typ\":\"" (nth 0 e) "\""
",\"lfdnr\":" (itoa (nth 1 e))
",\"x\":" (rtos (nth 2 e) 2 2)
",\"y\":" (rtos (nth 3 e) 2 2)
"}"))
(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
sepliste-json
"}"
)
)
;; --- Muster fuer verpackte (in einer Compound-Blockdefinition
;; verschachtelte) Separator-Sub-INSERTs ---
;; Beim finalen Zusammenbau von VF_n/GF_n/KREISEL_n werden Separator_SP-
;; Sensor-Symbole, die zuvor als eigene top-level INSERTs eingefuegt wurden,
;; zu Sub-INSERTs der Compound-Blockdefinition - (ssget "X" ...) findet sie
;; danach nicht mehr (siehe ssg-collect-nested-inserts, ssg_core.lsp).
;; Bewusst NUR das Sensor-SYMBOL (Separator_SP_2D/_3D), NICHT der intern
;; gezeichnete Staustrecke_Separator_SP-Trennsteg (300mm) - der ist ein
;; reines Geometrie-/Laengenelement der Staustrecke, kein eigenstaendig zu
;; zaehlendes Bauteil, und soll hier nicht mitkopiert werden.
(defun csv:pattern-nested-separator ()
"Separator_SP_2D,Separator_SP_3D"
)
;; --- Muster der 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 Separator_SP-Symbol eine ECHTE, temporaere Kopie
;; an DERSELBEN Stelle in den Modellraum einfuegen ---
;; Separator_SP-Sensor-Symbole, 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. Statt beide Sammel-Funktionen dafuer
;; anzupassen, wird hier VOR der ID-Vergabe (csv:run-export) fuer jeden Fund
;; eine ECHTE Kopie desselben Blocks eingefuegt.
;; Diese Kopie ist ein normaler, top-level INSERT und durchlaeuft ID-
;; Vergabe/Export danach unveraendert ueber die bestehenden Funktionen -
;; deren Blockname-Muster (Separator_SP*) trifft ja bereits zu.
;;
;; 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.
;;
;; Einfuegen ueber vla-InsertBlock (ActiveX) statt "command _.INSERT": das
;; legt fuer einen Block mit ATTDEFs automatisch ATTRIB-Entities mit den
;; Vorgabewerten an (wie TEFInsert.lsp/tefl-insert-element, ssg_ks_insert.lsp
;; u.a. bereits nutzen) - OHNE jeden einzelnen Insert-Prompt (Blockname/
;; Einfuegepunkt/Skalierung/Drehwinkel) ins Kommandozeilen-Fenster zu
;; schreiben. "command _.INSERT" wuerde das bei JEDEM verpackten Fund tun,
;; selbst wenn alle Werte per LISP vorgegeben sind - bei mehreren Funden
;; entsprechend viel Bildschirm-Rauschen. vla-get-ModelSpace wird hier LOKAL
;; ermittelt statt den (evtl. noch unbelegten) globalen "modelspace" aus
;; vf_core.lsp/Gefaellestrecke.lsp/ssg_ks_insert.lsp vorauszusetzen - die
;; koennten in dieser Sitzung noch gar nicht geladen worden sein, falls die
;; Zeichnung mit bereits vorhandenen VF_n/GF_n-Bloecken geoeffnet und direkt
;; exportiert wird, ohne vorher FOERDERANLAGE/GEFAELLESTRECKE aufzurufen.
;;
;; Rueckgabe: Liste von Paaren (proxy-ename . wrapper-ename) - der Wrapper
;; wird mitgefuehrt, weil erst NACH der ID-Vergabe daraus die ZUORDNUNG der
;; Kopie gesetzt werden kann (csv:sep-proxies-zuordnung-setzen). Die
;; proxy-enames dienen ausserdem csv:sep-proxies-loeschen nach dem Export.
(defun csv:sep-proxies-erzeugen ( / ms ss-all i ename ed bname nested pt rotation
extrusion0 R0 psx psy psz rec nested-ent nested-bname
local-pt R-nested R-final scaled-pt rot-pt world-pt
T4 block-obj xform-fehler proxy-liste)
(setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
(if ss-all
(progn
(setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq i 0)
(while (setq ename (ssname ss-all i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq nested
(if (wcmatch bname (csv:pattern-wrapper-fuer-proxies))
(ssg-collect-nested-inserts bname (csv:pattern-nested-separator))
)
)
(if nested
(progn
(setq pt (cdr (assoc 10 ed)))
(if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0)))
(setq rotation (cond ((cdr (assoc 50 ed))) (0.0)))
;; Extrusion des Wrapper-INSERTs selbst beruecksichtigen statt
;; reine Z-Drehung anzunehmen - GF_n/VF_n stehen zwar bisher immer
;; flach (Extrusion (0 0 1)), aber mat3-from-normal-rotation
;; reduziert sich dafuer ohnehin exakt auf Rz(rotation), kostet
;; also nichts und macht den Code robust falls sich das aendert.
(setq extrusion0 (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0))))
(setq R0 (mat3-from-normal-rotation extrusion0 rotation))
(setq psx (cond ((cdr (assoc 41 ed))) (1.0)))
(setq psy (cond ((cdr (assoc 42 ed))) (1.0)))
(setq psz (cond ((cdr (assoc 43 ed))) (1.0)))
(foreach rec nested
(setq nested-ent (nth 0 rec))
(setq local-pt (nth 1 rec))
(setq R-nested (nth 2 rec))
(setq nested-bname (cdr (assoc 2 (entget nested-ent))))
(setq scaled-pt (list (* psx (car local-pt))
(* psy (cadr local-pt))
(* psz (caddr local-pt))))
(setq rot-pt (mat3-mul-vec3 R0 scaled-pt))
(setq world-pt (list (+ (car pt) (car rot-pt))
(+ (cadr pt) (cadr rot-pt))
(+ (caddr pt) (caddr rot-pt))))
(setq R-final (mat3-mul-mat3 R0 R-nested))
;; Volle 3D-Orientierung statt bisher nur eines Z-Drehwinkels:
;; ein einzelner 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, statt Rotation als vla-InsertBlock-Parameter.
(setq T4 (vlax-tmatrix
(list (list (car (car R-final)) (cadr (car R-final)) (caddr (car R-final)) (car world-pt))
(list (car (cadr R-final)) (cadr (cadr R-final)) (caddr (cadr R-final)) (cadr world-pt))
(list (car (caddr R-final)) (cadr (caddr R-final)) (caddr (caddr R-final)) (caddr world-pt))
(list 0.0 0.0 0.0 1.0))))
;; Gekapselt, weil hier - anders als beim frueheren festen
;; 1.0/1.0/1.0 - die tatsaechlichen Skalierungsfaktoren
;; durchgereicht werden: ein einzelner Sonderfall (entartete
;; Skalierung, gespiegelter Zwischenblock) darf nicht den
;; kompletten Export der Zeichnung abbrechen, sondern nur diese
;; eine Kopie ausfallen lassen - mit Meldung, welcher Block.
(setq block-obj
(vl-catch-all-apply 'vla-InsertBlock
(list ms (vlax-3D-point '(0.0 0.0 0.0)) nested-bname
(csv:skalierung-oder-eins (* psx (nth 3 rec)))
(csv:skalierung-oder-eins (* psy (nth 4 rec)))
(csv:skalierung-oder-eins (* psz (nth 5 rec)))
0.0)))
(cond
((vl-catch-all-error-p block-obj)
(princ (ssg-textf "exp-sep-proxy-fehler"
(list nested-bname bname
(vl-catch-all-error-message block-obj)))))
(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 nested-bname bname
(vl-catch-all-error-message xform-fehler))))
(vl-catch-all-apply 'vla-Delete (list block-obj))
)
(setq proxy-liste
(cons (cons (vlax-vla-object->ename block-obj) ename) proxy-liste))
)
)
)
)
)
)
(setq i (1+ i))
)
)
)
proxy-liste
)
;; --- ZUORDNUNG der temporaeren Separator-Kopien aus ihrem Wrapper setzen ---
;; MUSS nach ssg-id-check-all laufen: erst dann steht die ID des Wrapper-
;; Blocks (VF_n/GF_n/KREISEL_n) fest - ein frisch gebauter Wrapper kann beim
;; Erzeugen der Kopien noch gar keine ID haben.
;;
;; Die Zuordnung eines VERPACKTEN Separators ist keine Schaetzung, sondern
;; bekannt: er steckt in genau diesem Wrapper. Ein Separator, der in einem
;; VF-Block mit ID 0010 verpackt ist, bekommt also ZUORDNUNG = 0010. Die
;; geometrische Zuordnung in count_sep_scan.lsp (Carrier-Boundingbox bzw.
;; naechster Carrier) wuerde diesen Wert bei jedem Lauf neu berechnen und ggf.
;; ueberschreiben - bei ueberlappenden Boxen (Kettenende an einem Kreisel)
;; landet der Separator dort leicht beim Nachbarn. Darum wird die bekannte
;; Zuordnung ueber *cs-sep-fix-by-handle* (Key = Entity-Handle der Kopie)
;; festgenagelt; cs-zuordnung-lauf uebernimmt sie unveraendert und zaehlt den
;; Separator beim richtigen Carrier.
;; Rueckgabe: Anzahl festgenagelter Kopien.
(defun csv:sep-proxies-zuordnung-setzen (proxy-liste / paar proxy wrapper wrapper-id
handle gesetzt ohne-id)
(setq gesetzt 0 ohne-id 0)
(setq *cs-sep-fix-by-handle* nil)
(foreach paar proxy-liste
(setq proxy (car paar))
(setq wrapper (cdr paar))
(setq wrapper-id (cdr (assoc "ID" (ssg-attrib-read wrapper))))
(if (and wrapper-id (> (strlen wrapper-id) 0))
(progn
(ssg-attrib-set-on proxy (list (cons "ZUORDNUNG" wrapper-id)))
(setq handle (cdr (assoc 5 (entget proxy))))
(setq *cs-sep-fix-by-handle*
(cons (cons handle wrapper-id) *cs-sep-fix-by-handle*))
(setq gesetzt (1+ gesetzt))
)
;; Wrapper ohne ID-Attribut (Altbestand ohne ID-ATTDEF): keine bekannte
;; Zuordnung - die Kopie faellt auf die geometrische Zuordnung zurueck.
(setq ohne-id (1+ ohne-id))
)
)
(if (> gesetzt 0)
(princ (ssg-textf "exp-sep-zuordnung" (list (itoa gesetzt)))))
(if (> ohne-id 0)
(princ (ssg-textf "exp-sep-zuordnung-ohne-id" (list (itoa ohne-id)))))
gesetzt
)
;; --- Temporaere Separator_SP-Kopien (csv:sep-proxies-erzeugen) nach dem
;; Export wieder entfernen ---
;; proxy-liste = Paare (proxy-ename . wrapper-ename), nur der car wird geloescht.
(defun csv:sep-proxies-loeschen (proxy-liste)
(foreach paar proxy-liste (entdel (car paar)))
(setq *cs-sep-fix-by-handle* nil)
(princ)
)
;; --- Relevante Bloecke sammeln ---
;; Filtert INSERT-Entities auf exportierbare Bloecke:
;; KR_* = Kreisel Compound-Bloecke
;; AP110* = Omniflo Geraden
;; Omniflo Boegen/Weichen = rein numerische Blocknamen (SivasNr)
;; Vario* = VarioFoerderer-Bloecke
;; GF_* = Gefaellestrecke Compound-Bloecke
;; 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.
;; Gibt Auswahlsatz zurueck oder nil.
(defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname)
(setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss-all) (setq ss-out nil)
(progn
(setq ss-out (ssadd))
(setq i 0)
(while (setq ename (ssname ss-all i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(if (or
(wcmatch bname (export:pattern "pattern_kreisel" "KR_*,KREISEL_*,ECKRAD_*"))
(wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*"))
(wcmatch bname (export:pattern "pattern_strecke"
"Vario*,Staustrecke*,AUS_Element*,EIN_Element*,VF_*,GF_*"))
(wcmatch bname (export:pattern "pattern_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*"))
;; 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")
;; 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
py-skript ergebnis-pfad py-exe log-pfad rc first-block
count out-dir sep-proxies)
;; Verpackte Separator_SP-Symbole (siehe csv:sep-proxies-erzeugen) VOR der
;; ID-Vergabe durch temporaere, echte Kopien ersetzen - sie werden am Ende
;; dieser Funktion wieder entfernt (csv:sep-proxies-loeschen).
(setq sep-proxies (csv:sep-proxies-erzeugen))
;; Vor dem Export: IDs aller Bloecke sicherstellen und Duplikate korrigieren.
;; Erst hier - also erst nachdem ALLE Kopien aus allen Wrapper-Bloecken
;; stehen - wird ueberhaupt eine ID vergeben. ssg-id-check-all ermittelt
;; dabei zuerst das globale Maximum der bereits vergebenen IDs (Phase 0)
;; und nummeriert die noch ID-losen Kopien erst danach - sonst bekaemen sie
;; IDs, die die Wrapper (VF_n/GF_n/Kreisel) selbst schon tragen.
(princ (ssg-textf "exp-check-ids" (list label)))
(ssg-id-check-all)
;; Jetzt steht die ID jedes Wrappers fest: die bekannte (nicht geratene)
;; ZUORDNUNG der verpackten Separatoren auf die Wrapper-ID setzen und fuer
;; cs-zuordnung-lauf festnageln.
(csv:sep-proxies-zuordnung-setzen sep-proxies)
;; Vor dem Export HOEHE/DREHUNG aller Omniflo-Elemente aktualisieren
(princ (ssg-textf "exp-update-hoehe-drehung" (list label)))
(omni:update-all-attribs)
;; Vor dem Export: Separator-/Scanner-Zuordnung pruefen und
;; ANZAHL_SEPARATOR/ANZAHL_SCANNER an Kreisel/Streckengruppe/
;; Gefaellestrecke aktualisieren (siehe count_sep_scan.lsp,
;; cs-zuordnung-lauf). Scanner ausserhalb jeder Carrier-Boundingbox
;; werden dabei per Abstand zugeordnet (ZUORDNUNG-Attribut = Carrier-
;; ID) und - bei mehrdeutigem Abstand - als "strittig" markiert;
;; *cs-scanner-warnung-by-handle* wird von csv:block-to-json unten
;; ausgelesen und haengt den Warnungstext an den betroffenen Scanner-
;; Block im JSON an. verbose=nil haelt die Export-Konsole kompakt
;; (die ausfuehrliche Detailzeile je Carrier gibt es nur beim
;; interaktiven Befehl ZAEHLE_SEP_SCAN).
;;
;; Der Lauf ist teuer (Boundingbox+Regen je Carrier und Sensor),
;; darum vorher der billige Schnelltest cs-zuordnung-noetig-p (nur
;; Attribute lesen, keine Boundingboxen): nur bei leeren ZUORDNUNG-
;; Eintraegen oder abweichenden Summen wird tatsaechlich neu gerechnet.
(ssg-ensure "count_sep_scan")
(if (atoms-family 1 '("cs-zuordnung-lauf"))
(if (cs-zuordnung-noetig-p)
(cs-zuordnung-lauf label nil)
(princ (ssg-textf "sens-skip" (list label)))
)
)
(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)))
;; 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)))
)
)
)
)
)
)
)
;; Temporaere Separator-/Scanner-Kopien wieder entfernen - sie haben ihren
;; Zweck (ID-Vergabe + JSON-Zeile ueber die obigen, unveraenderten
;; Sammel-Funktionen) erfuellt.
(csv:sep-proxies-loeschen sep-proxies)
(princ)
)
;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen ---
(defun c:EXPORTSIVAS ()
(csv:run-export "EXPORTSIVAS"
(export:filename "sivas_script")
(export:filename "sivas_csv")
nil)
)
;; --- EXPORTCSV: Einfache Item-Liste aller Bloecke (ohne Summierung) ---
;; Ermittelt zusaetzlich je Block eine Bounding-Box (siehe csv:get-bbox),
;; die im Python-Skript als Position/Boundingbox-Spalten ausgegeben wird.
(defun c:EXPORTCSV ()
(csv:run-export "EXPORTCSV"
(export:filename "csv_script")
(export:filename "csv_csv")
T)
)
;; ============================================================
;; OMNIFLO HOEHE/DREHUNG AKTUALISIEREN
;; ============================================================
;; --- Attribut-Wert eines INSERT-Blocks nach Tag lesen ---
(defun csv:get-attrib (ename tag / obj ed typ atag)
(setq obj (entnext ename))
(while obj
(setq ed (entget obj))
(setq typ (cdr (assoc 0 ed)))
(if (equal typ "SEQEND")
(setq obj nil)
(progn
(if (and (equal typ "ATTRIB")
(= (strcase (cdr (assoc 2 ed))) (strcase tag)))
(progn (setq obj nil) (setq atag (cdr (assoc 1 ed))))
(setq obj (entnext obj))
)
)
)
)
atag
)
;; --- Hoehe eines Omniflo-Blocks aus der Zeichnung ermitteln ---
;; Liest z-Koordinate des Einfuegepunkts.
;; Falls der Block KS_EIN, KS_AUS oder K1-K4 enthaelt,
;; wird die minimale Z-Koordinate dieser Unterelemente + Block-Z verwendet.
(defun omni:get-block-hoehe (ename / ed bname pt z-insert blk-tbl sub-ent sub-ed sub-bname sub-pt z-list z-min)
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq pt (cdr (assoc 10 ed)))
(setq z-insert (if (caddr pt) (caddr pt) 0.0))
(setq blk-tbl (tblsearch "BLOCK" bname))
(if (null blk-tbl)
z-insert
(progn
(setq sub-ent (entnext (cdr (assoc -2 blk-tbl))))
(setq z-list nil)
(while sub-ent
(setq sub-ed (entget sub-ent))
(if (= (cdr (assoc 0 sub-ed)) "INSERT")
(progn
(setq sub-bname (strcase (cdr (assoc 2 sub-ed))))
(if (wcmatch sub-bname
(export:pattern "pattern_ks_subblocks" "KS_EIN,KS_AUS,K1,K2,K3,K4"))
(progn
(setq sub-pt (cdr (assoc 10 sub-ed)))
(setq z-list (cons (if (caddr sub-pt) (caddr sub-pt) 0.0) z-list))
)
)
)
)
(setq sub-ent (entnext sub-ent))
)
(if z-list
(progn
(setq z-min (car z-list))
(foreach z (cdr z-list)
(if (< z z-min) (setq z-min z))
)
(+ z-insert z-min)
)
z-insert
)
)
)
)
;; --- HOEHE-Attribut eines Omniflo-Blocks setzen ---
;; Liest Z-Koordinate (ggf. aus KS-Unterblock) und schreibt als HOEHE-Attribut.
(defun omni:set-hoehe-attrib (ename / hoehe)
(setq hoehe (omni:get-block-hoehe ename))
(ssg-attrib-set-on ename (list (cons "HOEHE" (rtos hoehe 2 1))))
hoehe
)
;; --- DREHUNG-Attribut eines Omniflo-Blocks setzen ---
;; Liest CAD-Rotationswinkel (Gruppe 50, Bogenmass) und schreibt als DREHUNG-Attribut.
(defun omni:set-drehung-attrib (ename / ed rotation deg)
(setq ed (entget ename))
(setq rotation (cdr (assoc 50 ed)))
(if (null rotation) (setq rotation 0.0))
(setq deg (* (/ rotation pi) 180.0))
(ssg-attrib-set-on ename (list (cons "DREHUNG" (rtos deg 2 1))))
deg
)
;; ============================================================
;; C:OMNI_UPDATE_ATTRIBS - HOEHE und DREHUNG aller Omniflo-Elemente aktualisieren
;; Setzt HOEHE aus Z-Koordinate (bzw. min. KS-Sub-Block) und
;; DREHUNG aus CAD-Rotationswinkel fuer alle Bloecke mit TEILEART-Attribut.
;; ============================================================
(defun c:OMNI_UPDATE_ATTRIBS ( / ss i ename ed bname teileart count)
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss)
(princ (ssg-text "exp-omni-no-inserts"))
(progn
(setq count 0)
(setq i 0)
(while (setq ename (ssname ss i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
;; Nur Omniflo-Elemente (erkennbar an TEILEART-Attribut oder AP110-Blockname)
(setq teileart (csv:get-attrib ename "TEILEART"))
(if (or teileart
(wcmatch (strcase bname) (export:pattern "pattern_gerade" "AP110*,AP_110*")))
(progn
(omni:set-hoehe-attrib ename)
(omni:set-drehung-attrib ename)
(setq count (1+ count))
)
)
(setq i (1+ i))
)
(princ (ssg-textf "exp-omni-updated" (list count)))
)
)
(princ)
)
Reference in New Issue View Git Blame Copy Permalink