Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master'

Browse Source
This commit is contained in:
Yuelin Wang
2026-09-18 17:47:53 +02:00
parent 797afe48b4 350c294717
commit 733946c368
39 changed files with 3487 additions and 824 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/GeruestInsert.lsp
+930 -152
View File
File diff suppressed because it is too large Load Diff
Lisp/count_sep_scan.lsp
+284 -202
View File
@@ -605,59 +605,20 @@
)
)
;;; ============================================================
;;; ENGINE - wird sowohl von ZAEHLE_SEP_SCAN als auch automatisch
;;; vor jedem CSV-/Sivas-Export aufgerufen (siehe export.lsp,
;;; csv:run-export).
;;;
;;; label = Anzeigepraefix fuer die Konsolenausgabe (z.B. "EXPORTCSV").
;;; verbose = T -> zusaetzlich je Carrier eine Detailzeile ausgeben
;;; (nur fuer den interaktiven Befehl sinnvoll - der
;;; automatische Aufruf aus csv:run-export laesst dies aus,
;;; damit die Export-Konsole kompakt bleibt).
;;;
;;; Setzt als Nebenwirkung:
;;; *cs-scanner-ergaenzt* - Liste (scanner-id carrier-id
;;; distanz-mm strittig-p
;;; zweiter-carrier-id zweite-distanz-mm)
;;; je per Abstand (nicht per BBox)
;;; zugeordnetem Scanner.
;;; *cs-scanner-warnung-by-handle* - Assoc-Liste (handle . warnungstext)
;;; fuer strittige Scanner-Zuordnungen,
;;; von csv:block-to-json ausgelesen.
;;; *cs-korrekturen* - Liste (typ-wort sensor-id alt-id
;;; neu-id) je Sensor, dessen gespeicherte
;;; ZUORDNUNG nicht zur Geometrie passte
;;; und ueberschrieben wurde (Report).
;;; ============================================================
(defun cs-zuordnung-lauf (label verbose /
mss ss i ent ed nm bb cx cy lbl carrier-id
carriers grid scanlist seplist sk pt
scanCounts sepCounts n-scan-unassigned n-sep-unassigned
n-strittig n-zuordnung-fehlt alt
s sent spt res mode rec best-d second-rec second-d
vorgabe-id vorgabe-rec
scanner-id contested handle
en nm2 ns nsep newS newP okS okP eintrag)
(setq carriers nil scanlist nil seplist nil
n-zuordnung-fehlt 0 n-scan-unassigned 0 n-sep-unassigned 0 n-strittig 0)
(setq *cs-scanner-ergaenzt* nil)
(setq *cs-scanner-warnung-by-handle* nil)
(setq *cs-korrekturen* nil)
(setq *senstol* (cs-senstol))
;; Alte Markierungskreise entfernen (Idempotenz - Sensoren, die in
;; einem frueheren Lauf unzuordenbar waren, koennen inzwischen einen
;; Carrier bekommen haben oder umgekehrt).
(setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*))))
(if mss (command "_.ERASE" mss ""))
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
(princ (ssg-textf "sens-start" (list label)))
;;; ------------------------------------------------------------
;;; Alle INSERTs der Zeichnung in Carrier-, Scanner- und Separator-
;;; Listen einsortieren.
;;; Rueckgabe: (carriers scanlist seplist)
;;; carriers = Liste von Records (ename tagScan tagSep minx miny
;;; maxx maxy cx cy id label)
;;; scanlist/seplist = Liste von (ename einfuegepunkt)
;;; Ein Carrier ohne ermittelbare Bounding-Box wird gemeldet und
;;; uebersprungen (kann sonst nicht zugeordnet werden).
;;; ------------------------------------------------------------
(defun cs-sammle-bloecke ( / ss i ent ed nm bb cx cy lbl carrier-id
sk pt carriers scanlist seplist)
(setq ss (ssget "_X" '((0 . "INSERT"))))
(if (null ss)
(princ (ssg-textf "sens-no-inserts" (list label)))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
@@ -693,167 +654,288 @@
)
(setq i (1+ i))
)
)
)
(list carriers scanlist seplist)
)
(setq grid (cs-grid-build carriers))
(setq scanCounts nil sepCounts nil)
;;; ------------------------------------------------------------
;;; Abweichende gespeicherte ZUORDNUNG als Korrektur in
;;; *cs-korrekturen* vermerken, BEVOR sie ueberschrieben wird
;;; (Selbstheilung eingefrorener/verwaister Zuordnungen). typ-wort
;;; ist "Scanner" oder "Separator"; neu-id die geometrisch/vorgegeben
;;; ermittelte Carrier-ID.
;;; ------------------------------------------------------------
(defun cs-korrektur-vermerken (sent typ-wort neu-id / alt)
(setq alt (cs-get-att-str sent *zuordnung-tag*))
(if (and alt (/= alt "") (/= alt neu-id))
(setq *cs-korrekturen*
(cons (list typ-wort (cs-get-att-str sent "ID") alt neu-id)
*cs-korrekturen*)))
)
;; --- Scanner zuordnen (inkl. Distanz-Fallback + Strittig-Erkennung) ---
(foreach s scanlist
(setq sent (car s) spt (cadr s))
;;; ------------------------------------------------------------
;;; Strittige Distanz-Zuordnung eines Scanners protokollieren:
;;; Eintrag in *cs-scanner-ergaenzt* (immer) und - bei zu knappem
;;; Abstand zum zweitnaechsten Carrier - eine Warnung in
;;; *cs-scanner-warnung-by-handle* (von csv:block-to-json gelesen).
;;; Rueckgabe: T, wenn die Zuordnung strittig ist.
;;; ------------------------------------------------------------
(defun cs-scanner-distanz-melden (sent rec best-d second-rec second-d /
scanner-id contested handle)
(setq scanner-id (cs-get-att-str sent "ID"))
(setq contested (and second-rec
(<= (- second-d best-d) (cs-strittig-diff-mm))))
(setq *cs-scanner-ergaenzt*
(cons (list scanner-id (nth 9 rec) (fix (+ best-d 0.5))
contested
(if contested (nth 9 second-rec) nil)
(if contested (fix (+ second-d 0.5)) nil))
*cs-scanner-ergaenzt*))
(if contested
(progn
(setq handle (cdr (assoc 5 (entget sent))))
(setq *cs-scanner-warnung-by-handle*
(cons (cons handle
(strcat "Distanz-Zuordnung unsicher: "
(nth 9 rec) " (" (itoa (fix (+ best-d 0.5))) "mm) vs. "
(nth 9 second-rec) " (" (itoa (fix (+ second-d 0.5))) "mm)"))
*cs-scanner-warnung-by-handle*))
)
)
contested
)
;;; ------------------------------------------------------------
;;; Scanner den Carriern zuordnen (rein geometrisch: BBox, sonst
;;; naechster Carrier). Setzt je zugeordnetem Scanner das ZUORDNUNG-
;;; Attribut und fuellt *cs-scanner-ergaenzt*/*cs-scanner-warnung-by-
;;; handle* (Distanz-Fallback + Strittig-Report).
;;; Rueckgabe: (scanCounts n-scan-unassigned n-strittig n-zuordnung-fehlt)
;;; ------------------------------------------------------------
(defun cs-scanner-zuordnen (scanlist carriers grid /
scanCounts n-scan-unassigned n-strittig
n-zuordnung-fehlt s sent spt res mode rec
best-d second-rec second-d)
(setq scanCounts nil n-scan-unassigned 0 n-strittig 0 n-zuordnung-fehlt 0)
(foreach s scanlist
(setq sent (car s) spt (cadr s))
(setq res (cs-resolve-sensor spt carriers grid))
(setq mode (nth 0 res) rec (nth 1 res)
best-d (nth 2 res) second-rec (nth 3 res) second-d (nth 4 res))
(cond
((eq mode 'none)
(setq n-scan-unassigned (1+ n-scan-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq scanCounts (cs-bump scanCounts (car rec)))
(cs-korrektur-vermerken sent "Scanner" (nth 9 rec))
(if (member mode '(bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
(if (eq mode 'distance)
(if (cs-scanner-distanz-melden sent rec best-d second-rec second-d)
(setq n-strittig (1+ n-strittig))))
)
)
)
(setq *cs-scanner-ergaenzt* (reverse *cs-scanner-ergaenzt*))
(list scanCounts n-scan-unassigned n-strittig n-zuordnung-fehlt)
)
;;; ------------------------------------------------------------
;;; Separatoren den Carriern zuordnen. Wie cs-scanner-zuordnen, aber
;;; ohne Strittig-Report; zusaetzlich hat eine festgenagelte Zuordnung
;;; (verpackter Separator, *cs-sep-fix-by-handle*) Vorrang vor der
;;; Geometrie - nur wenn der genannte Carrier nicht (mehr) existiert,
;;; wird geometrisch zugeordnet. Bei mode 'vorgabe wird der geschriebene
;;; Wert NICHT als Korrektur gemeldet (er ist die Vorgabe selbst).
;;; Rueckgabe: (sepCounts n-sep-unassigned n-zuordnung-fehlt)
;;; ------------------------------------------------------------
(defun cs-separatoren-zuordnen (seplist carriers grid /
sepCounts n-sep-unassigned n-zuordnung-fehlt
s sent spt res mode rec vorgabe-id vorgabe-rec)
(setq sepCounts nil n-sep-unassigned 0 n-zuordnung-fehlt 0)
(foreach s seplist
(setq sent (car s) spt (cadr s))
(setq vorgabe-id (cdr (assoc (cdr (assoc 5 (entget sent))) *cs-sep-fix-by-handle*)))
(setq vorgabe-rec (cs-carrier-by-id vorgabe-id carriers))
(if vorgabe-rec
(setq mode 'vorgabe rec vorgabe-rec)
(progn
(setq res (cs-resolve-sensor spt carriers grid))
(setq mode (nth 0 res) rec (nth 1 res)
best-d (nth 2 res) second-rec (nth 3 res) second-d (nth 4 res))
(cond
((eq mode 'none)
(setq n-scan-unassigned (1+ n-scan-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq scanCounts (cs-bump scanCounts (car rec)))
;; Abweichende gespeicherte ZUORDNUNG als Korrektur vermerken,
;; bevor sie unten ueberschrieben wird (Selbstheilung eingefrorener
;; oder verwaister Zuordnungen).
(setq alt (cs-get-att-str sent *zuordnung-tag*))
(if (and alt (/= alt "") (/= alt (nth 9 rec)))
(setq *cs-korrekturen*
(cons (list "Scanner" (cs-get-att-str sent "ID") alt (nth 9 rec))
*cs-korrekturen*)))
(if (member mode '(bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
(if (eq mode 'distance)
(progn
(setq scanner-id (cs-get-att-str sent "ID"))
(setq contested (and second-rec
(<= (- second-d best-d) (cs-strittig-diff-mm))))
(setq *cs-scanner-ergaenzt*
(cons (list scanner-id (nth 9 rec) (fix (+ best-d 0.5))
contested
(if contested (nth 9 second-rec) nil)
(if contested (fix (+ second-d 0.5)) nil))
*cs-scanner-ergaenzt*))
(if contested
(progn
(setq n-strittig (1+ n-strittig))
(setq handle (cdr (assoc 5 (entget sent))))
(setq *cs-scanner-warnung-by-handle*
(cons (cons handle
(strcat "Distanz-Zuordnung unsicher: "
(nth 9 rec) " (" (itoa (fix (+ best-d 0.5))) "mm) vs. "
(nth 9 second-rec) " (" (itoa (fix (+ second-d 0.5))) "mm)"))
*cs-scanner-warnung-by-handle*))
)
)
)
)
)
)
(setq mode (nth 0 res) rec (nth 1 res))
)
(setq *cs-scanner-ergaenzt* (reverse *cs-scanner-ergaenzt*))
;; --- Separatoren zuordnen (gleiche Logik, ohne Strittig-Report -
;; der Distanz-Fallback stellt hier nur sicher, dass die
;; ANZAHL_SEPARATOR-Summe auch bei Sonderfaellen stimmt). ---
(foreach s seplist
(setq sent (car s) spt (cadr s))
;; Festgenagelte Zuordnung (verpackter Separator, Carrier bekannt -
;; siehe *cs-sep-fix-by-handle*) hat Vorrang vor der Geometrie. Nur
;; wenn der genannte Carrier gar nicht (mehr) existiert, wird
;; geometrisch zugeordnet.
(setq vorgabe-id (cdr (assoc (cdr (assoc 5 (entget sent))) *cs-sep-fix-by-handle*)))
(setq vorgabe-rec (cs-carrier-by-id vorgabe-id carriers))
(if vorgabe-rec
(setq mode 'vorgabe rec vorgabe-rec)
(progn
(setq res (cs-resolve-sensor spt carriers grid))
(setq mode (nth 0 res) rec (nth 1 res))
)
)
(cond
((eq mode 'none)
(setq n-sep-unassigned (1+ n-sep-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq sepCounts (cs-bump sepCounts (car rec)))
;; Abweichung nur bei geometrischer Zuordnung als Korrektur melden -
;; bei mode 'vorgabe ist der geschriebene Wert die Vorgabe selbst,
;; keine Korrektur einer Fehl-Zuordnung.
(setq alt (cs-get-att-str sent *zuordnung-tag*))
(if (and (not (eq mode 'vorgabe)) alt (/= alt "") (/= alt (nth 9 rec)))
(setq *cs-korrekturen*
(cons (list "Separator" (cs-get-att-str sent "ID") alt (nth 9 rec))
*cs-korrekturen*)))
(if (member mode '(vorgabe bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
)
)
)
(cond
((eq mode 'none)
(setq n-sep-unassigned (1+ n-sep-unassigned))
(cs-mark-unassigned sent))
((null rec) nil) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
(t
(setq sepCounts (cs-bump sepCounts (car rec)))
(if (not (eq mode 'vorgabe))
(cs-korrektur-vermerken sent "Separator" (nth 9 rec)))
(if (member mode '(vorgabe bbox distance))
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
)
)
)
(list sepCounts n-sep-unassigned n-zuordnung-fehlt)
)
;; --- ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben ---
(foreach rec carriers
(setq en (car rec))
(setq nm2 (cdr (assoc 2 (entget en))))
(setq ns (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
(setq nsep (cond ((assoc en sepCounts) (cdr (assoc en sepCounts))) (t 0)))
(setq newS ns)
;; ANZAHL_SEPARATOR = nur die tatsaechlich platzierten Separator-
;; Symbole (Separator_SP/S-LP), die diesem Carrier zugeordnet sind.
;; Der intern in der GF/VF-Kette gezeichnete 300-mm-Block
;; Staustrecke_Separator_SP ist nur ein Kettenglied (Foerder-/
;; Uebergabestueck), KEIN eigenstaendiger Separator - er wird bewusst
;; NICHT mitgezaehlt (Entscheidung: nur platzierte Symbole zaehlen).
(setq newP nsep)
(setq okS (cs-set-att en (nth 1 rec) (itoa newS)))
(setq okP (cs-set-att en (nth 2 rec) (itoa newP)))
(if verbose
(princ (ssg-textf "sens-carrier-zeile"
(list nm2 (nth 9 rec) (itoa newS) (itoa newP)))))
(if (not (and okS okP))
(princ (ssg-textf "sens-carrier-fehler" (list nm2))))
;;; ------------------------------------------------------------
;;; ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben.
;;; scanCounts/sepCounts = Assoc-Listen (carrier-ename . anzahl).
;;; ANZAHL_SEPARATOR = nur die tatsaechlich platzierten Separator-
;;; Symbole (Separator_SP/S-LP); der intern in der GF/VF-Kette
;;; gezeichnete 300-mm-Block Staustrecke_Separator_SP ist nur ein
;;; Kettenglied und wird bewusst NICHT mitgezaehlt.
;;; verbose = T -> je Carrier eine Detailzeile ausgeben.
;;; ------------------------------------------------------------
(defun cs-anzahl-schreiben (carriers scanCounts sepCounts verbose /
rec en nm2 ns nsep okS okP)
(foreach rec carriers
(setq en (car rec))
(setq nm2 (cdr (assoc 2 (entget en))))
(setq ns (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
(setq nsep (cond ((assoc en sepCounts) (cdr (assoc en sepCounts))) (t 0)))
(setq okS (cs-set-att en (nth 1 rec) (itoa ns)))
(setq okP (cs-set-att en (nth 2 rec) (itoa nsep)))
(if verbose
(princ (ssg-textf "sens-carrier-zeile"
(list nm2 (nth 9 rec) (itoa ns) (itoa nsep)))))
(if (not (and okS okP))
(princ (ssg-textf "sens-carrier-fehler" (list nm2))))
)
)
;;; ------------------------------------------------------------
;;; Abschliessende Konsolen-Zusammenfassung ausgeben: Gesamtzahlen,
;;; per Distanz ergaenzte Scanner (*cs-scanner-ergaenzt*), strittige
;;; Zuordnungen, korrigierte ZUORDNUNGen (*cs-korrekturen*) sowie
;;; markierte unzuordenbare und fehlgeschlagene Attributschreibungen.
;;; ------------------------------------------------------------
(defun cs-bericht-ausgeben (label n-carrier n-scan n-scan-unassigned
n-sep n-sep-unassigned n-strittig
n-zuordnung-fehlt / eintrag)
(princ (ssg-textf "sens-summary"
(list label (itoa n-carrier)
(itoa n-scan) (itoa n-scan-unassigned)
(itoa n-sep) (itoa n-sep-unassigned))))
(if *cs-scanner-ergaenzt*
(progn
(princ (ssg-textf "sens-ergaenzt-header"
(list label (itoa (length *cs-scanner-ergaenzt*)))))
(foreach eintrag *cs-scanner-ergaenzt*
(princ (ssg-textf "sens-ergaenzt-zeile"
(list (nth 0 eintrag) (nth 1 eintrag) (itoa (nth 2 eintrag)))))
(if (nth 3 eintrag)
(princ (ssg-textf "sens-strittig-suffix"
(list (nth 4 eintrag) (itoa (nth 5 eintrag))))))
)
)
)
(if (> n-strittig 0)
(princ (ssg-textf "sens-strittig-summary" (list label (itoa n-strittig)))))
;; --- Zusammenfassung ---
(princ (ssg-textf "sens-summary"
(list label (itoa (length carriers))
(itoa (length scanlist)) (itoa n-scan-unassigned)
(itoa (length seplist)) (itoa n-sep-unassigned))))
;; --- Korrigierte (nicht zur Geometrie passende) ZUORDNUNG melden ---
(if *cs-korrekturen*
(progn
(setq *cs-korrekturen* (reverse *cs-korrekturen*))
(princ (ssg-textf "sens-korrektur-header"
(list label (itoa (length *cs-korrekturen*)))))
(foreach eintrag *cs-korrekturen*
(princ (ssg-textf "sens-korrektur-zeile"
(list (nth 0 eintrag) (nth 1 eintrag)
(nth 2 eintrag) (nth 3 eintrag)))))
)
)
(if *cs-scanner-ergaenzt*
(progn
(princ (ssg-textf "sens-ergaenzt-header"
(list label (itoa (length *cs-scanner-ergaenzt*)))))
(foreach eintrag *cs-scanner-ergaenzt*
(princ (ssg-textf "sens-ergaenzt-zeile"
(list (nth 0 eintrag) (nth 1 eintrag) (itoa (nth 2 eintrag)))))
(if (nth 3 eintrag)
(princ (ssg-textf "sens-strittig-suffix"
(list (nth 4 eintrag) (itoa (nth 5 eintrag))))))
)
)
)
(if (> n-strittig 0)
(princ (ssg-textf "sens-strittig-summary" (list label (itoa n-strittig)))))
(if (> (+ n-scan-unassigned n-sep-unassigned) 0)
(princ (ssg-textf "sens-unassigned-marked"
(list label (itoa (+ n-scan-unassigned n-sep-unassigned)) *mark-layer*))))
(if (> n-zuordnung-fehlt 0)
(princ (ssg-textf "sens-zuordnung-fehlt" (list label (itoa n-zuordnung-fehlt)))))
)
;; --- Korrigierte (nicht zur Geometrie passende) ZUORDNUNG melden ---
(if *cs-korrekturen*
(progn
(setq *cs-korrekturen* (reverse *cs-korrekturen*))
(princ (ssg-textf "sens-korrektur-header"
(list label (itoa (length *cs-korrekturen*)))))
(foreach eintrag *cs-korrekturen*
(princ (ssg-textf "sens-korrektur-zeile"
(list (nth 0 eintrag) (nth 1 eintrag)
(nth 2 eintrag) (nth 3 eintrag)))))
)
)
;;; ============================================================
;;; ENGINE - wird sowohl von ZAEHLE_SEP_SCAN als auch automatisch
;;; vor jedem CSV-/Sivas-Export aufgerufen (siehe export.lsp,
;;; csv:run-export).
;;;
;;; label = Anzeigepraefix fuer die Konsolenausgabe (z.B. "EXPORTCSV").
;;; verbose = T -> zusaetzlich je Carrier eine Detailzeile ausgeben
;;; (nur fuer den interaktiven Befehl sinnvoll - der
;;; automatische Aufruf aus csv:run-export laesst dies aus,
;;; damit die Export-Konsole kompakt bleibt).
;;;
;;; Setzt als Nebenwirkung:
;;; *cs-scanner-ergaenzt* - Liste (scanner-id carrier-id
;;; distanz-mm strittig-p
;;; zweiter-carrier-id zweite-distanz-mm)
;;; je per Abstand (nicht per BBox)
;;; zugeordnetem Scanner.
;;; *cs-scanner-warnung-by-handle* - Assoc-Liste (handle . warnungstext)
;;; fuer strittige Scanner-Zuordnungen,
;;; von csv:block-to-json ausgelesen.
;;; *cs-korrekturen* - Liste (typ-wort sensor-id alt-id
;;; neu-id) je Sensor, dessen gespeicherte
;;; ZUORDNUNG nicht zur Geometrie passte
;;; und ueberschrieben wurde (Report).
;;; ============================================================
(defun cs-zuordnung-lauf (label verbose /
mss bloecke carriers scanlist seplist grid
scan-res sep-res scanCounts sepCounts
n-scan-unassigned n-sep-unassigned
n-strittig n-zuordnung-fehlt)
(setq *cs-scanner-ergaenzt* nil)
(setq *cs-scanner-warnung-by-handle* nil)
(setq *cs-korrekturen* nil)
(setq *senstol* (cs-senstol))
(if (> (+ n-scan-unassigned n-sep-unassigned) 0)
(princ (ssg-textf "sens-unassigned-marked"
(list label (itoa (+ n-scan-unassigned n-sep-unassigned)) *mark-layer*))))
(if (> n-zuordnung-fehlt 0)
(princ (ssg-textf "sens-zuordnung-fehlt" (list label (itoa n-zuordnung-fehlt)))))
;; Alte Markierungskreise entfernen (Idempotenz - Sensoren, die in
;; einem frueheren Lauf unzuordenbar waren, koennen inzwischen einen
;; Carrier bekommen haben oder umgekehrt).
(setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*))))
(if mss (command "_.ERASE" mss ""))
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
(princ (ssg-textf "sens-start" (list label)))
;; INSERTs in Carrier/Scanner/Separator einsortieren.
(setq bloecke (cs-sammle-bloecke))
(setq carriers (nth 0 bloecke)
scanlist (nth 1 bloecke)
seplist (nth 2 bloecke))
(if (and (null carriers) (null scanlist) (null seplist))
(princ (ssg-textf "sens-no-inserts" (list label)))
(progn
(setq grid (cs-grid-build carriers))
;; Scanner zuordnen (BBox, sonst naechster Carrier; Distanz-Fallback
;; + Strittig-Report). Zaehler kommen als Liste zurueck.
(setq scan-res (cs-scanner-zuordnen scanlist carriers grid))
(setq scanCounts (nth 0 scan-res)
n-scan-unassigned (nth 1 scan-res)
n-strittig (nth 2 scan-res)
n-zuordnung-fehlt (nth 3 scan-res))
;; Separatoren zuordnen (Vorgabe hat Vorrang vor der Geometrie).
(setq sep-res (cs-separatoren-zuordnen seplist carriers grid))
(setq sepCounts (nth 0 sep-res)
n-sep-unassigned (nth 1 sep-res)
n-zuordnung-fehlt (+ n-zuordnung-fehlt (nth 2 sep-res)))
;; ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben und Bericht.
(cs-anzahl-schreiben carriers scanCounts sepCounts verbose)
(cs-bericht-ausgeben label (length carriers)
(length scanlist) n-scan-unassigned
(length seplist) n-sep-unassigned
n-strittig n-zuordnung-fehlt)
)
)
(princ)
Lisp/export.lsp
+173 -81
View File
@@ -297,43 +297,76 @@
)
;; --- 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))
;; 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) (- (* lx c) (* ly s)))
(+ (cadr parent-pt) (+ (* lx s) (* ly c)))
(+ pz lz)
(+ (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/rot-rad = bereits ermittelte Welt-Position/-Rotation (radiant) des
;; Eltern-INSERT (siehe csv:block-to-json), keine erneute Abfrage.
;; 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
;; Eltern-Rotation (reine Z-Drehung) in Weltkoordinaten um. Es wird nur die
;; POSITION kodiert (12-Zeichen-String, csv:trans-encode) - keine Rotation.
;; 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).
(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)
;;
;; Gruppe-10 eines Sub-INSERTs ist OCS-lokal zu SEINER EIGENEN Extrusion
;; (Gruppe 210), nicht zwingend zur flachen XY-Ebene der Elterndefinition -
;; z.B. KS_AUS von SC_Entladung (BTMT-Entladung), das schraeg in 3D sitzt.
;; mat3-ocs-matrix/mat3-mul-vec3 (ssg_core.lsp, Arbitrary Axis Algorithm)
;; wandeln das erst in echte lokale Koordinaten um, bevor csv:local-to-world
;; mit der Eltern-Rotation weiterrechnet - derselbe Fix wie bereits in
;; ssg-collect-nested-inserts-rel (dort ausfuehrlich begruendet). Ohne diese
;; Umrechnung landete K2 tief unterhalb statt oberhalb des Elements (realer
;; Bug, sichtbar in der Materialfluss-Draufsicht sps_skel/HundM05_bbs.svg).
;; Fuer Extrusion=(0 0 1) (Normalfall, z.B. KS_EIN) reduziert sich das exakt
;; auf die alte reine Uebernahme - unveraendertes Verhalten dort. Denselben
;; Grund hat parent-R als VOLLE Matrix statt eines Z-Drehwinkels: ein
;; Elternblock (z.B. ein Separator-Proxy, ueber ssg-collect-nested-inserts
;; aus dem geneigten Abschnitt einer VF-/GF-Kette neu zusammengesetzt) kann
;; selbst eine gekippte Extrusion tragen - eine reine Z-Drehung des Eltern-
;; INSERT legte dessen K1/K2 dann an einen falschen, teils gespiegelten
;; Weltpunkt (realer Bug: K1 landete beim Vorzeichen von X/Y gespiegelt weit
;; ausserhalb der eigenen Boundingbox, sichtbar als fehlendes K-Kreuz in
;; sps_skel/HundM05_bbs.svg trotz gefuelltem K1 in der CSV).
(defun csv:get-k-kos-strings (ename pt parent-R / ed bname blk-tbl sub-ent sub-ed
sub-bname sub-pt sub-extrusion sub-pt-real world-pt
target is-real result)
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq blk-tbl (tblsearch "BLOCK" bname))
(setq result nil)
(if blk-tbl
(progn
(setq sub-ent (entnext (cdr (assoc -2 blk-tbl))))
;; (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")
@@ -352,7 +385,11 @@
(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))
(if (null (caddr sub-pt))
(setq sub-pt (list (car sub-pt) (cadr sub-pt) 0.0)))
(setq sub-extrusion (cond ((cdr (assoc 210 sub-ed))) ('(0.0 0.0 1.0))))
(setq sub-pt-real (mat3-mul-vec3 (mat3-ocs-matrix sub-extrusion) sub-pt))
(setq world-pt (csv:local-to-world pt parent-R sub-pt-real))
(setq result (cons
(cons target
(csv:trans-encode
@@ -483,14 +520,17 @@
(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).
;; Beide Enden im Wrapper-Frame holen und in Weltkoordinaten umrechnen.
;; VF_n/GF_n-Wrapper stehen an ihrem eigenen top-level INSERT immer flach
;; (Extrusion (0 0 1) - siehe csv:sep-proxies-erzeugen), darum genuegt hier
;; weiterhin die reine Z-Drehungsmatrix (mat3-rz) statt der vollen
;; Elternorientierung, die csv:get-k-kos-strings inzwischen braucht (siehe
;; dort). AS traegt das KS_EIN, ES das KS_AUS - jeweils aus dem RICHTIGEN
;; Element (csv:vfgf-ks-loc; beide Elemente fuehren beide KS-Typen).
(setq as-loc (csv:vfgf-ks-loc bname "AS_ELEMENT*" "KS_EIN,KSYS_EIN"))
(setq es-loc (csv:vfgf-ks-loc bname "ES_ELEMENT*" "KS_AUS,KSYS_AUS"))
(if as-loc (setq as-world (csv:local-to-world pt rot-rad as-loc)))
(if es-loc (setq es-world (csv:local-to-world pt rot-rad es-loc)))
(if as-loc (setq as-world (csv:local-to-world pt (mat3-rz rot-rad) as-loc)))
(if es-loc (setq es-world (csv:local-to-world pt (mat3-rz rot-rad) es-loc)))
;; Eingang/Ausgang festlegen (siehe Richtung im Kopfkommentar).
(cond
;; GF: Richtung ueber die Hoehe - hoeheres Z = Eingang, tieferes Z = Ausgang.
@@ -609,7 +649,8 @@
;; "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
(defun csv:block-to-json (ename include-bbox / ed blk-name layer pt rotation extrusion R-world
handle attribs bbox bbox-json
insert-quat insert-kos k-list warnung-json warnung-eintrag
zuordnung-fix-json zuordnung-fix-eintrag sepliste-json sepliste-app sepliste
sepliste-teile sepliste-first)
@@ -620,12 +661,27 @@
(setq rotation (cdr (assoc 50 ed)))
(setq handle (cdr (assoc 5 ed)))
(if (null rotation) (setq rotation 0.0))
(if (null (caddr pt)) (setq pt (list (car pt) (cadr pt) 0.0)))
;; Gruppe 10 ist OCS-lokal zur EIGENEN Extrusion dieses INSERT (Gruppe
;; 210) - fuer die allermeisten Bloecke (0 0 1) = Welt, aber ein Separator-
;; Proxy, der ueber ssg-collect-nested-inserts aus dem geneigten Abschnitt
;; einer VF-/GF-Kette neu zusammengesetzt wurde (csv:sep-proxies-erzeugen),
;; kann eine echt gekippte Extrusion tragen. Erst in echte Weltkoordinaten/
;; -orientierung umrechnen (Arbitrary Axis Algorithm, ssg_core.lsp), bevor
;; irgendetwas darauf aufbaut - sonst zeigt "x"/"y"/"z" (und darueber K1-K4,
;; siehe csv:get-k-kos-strings) einen falschen, teils spiegelverkehrten
;; Weltpunkt (realer Bug: Separator :4/6/8/10/12 in HundM05, K1 landete am
;; Vorzeichen gespiegelt weit ausserhalb der eigenen Boundingbox). Fuer
;; Extrusion=(0 0 1) reduziert sich das exakt auf die alte Uebernahme.
(setq extrusion (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0))))
(setq pt (mat3-mul-vec3 (mat3-ocs-matrix extrusion) pt))
(setq R-world (mat3-from-normal-rotation extrusion rotation))
(setq attribs (csv:read-attribs ename))
(setq insert-quat (csv:z-angle-to-quat (* (/ rotation pi) 180.0)))
(setq insert-kos (csv:kos-encode
(car pt) (cadr pt) (if (caddr pt) (caddr pt) 0.0)
(nth 0 insert-quat) (nth 1 insert-quat) (nth 2 insert-quat) (nth 3 insert-quat)))
(setq k-list (csv:get-k-kos-strings ename pt rotation))
(setq k-list (csv:get-k-kos-strings ename pt R-world))
;; Omniflo-Geraden fuehren keine echten K-Bloecke - K1/K2 aus der Geometrie
;; (Anfang/Ende ueber Laenge + Rotation) synthetisieren, damit sie im Export
;; wie echte Anschluss-Koordinatensysteme erscheinen und in der Nachbar-
@@ -1088,6 +1144,13 @@
;; 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
@@ -1111,6 +1174,8 @@
(wcmatch bname (export:pattern "pattern_scanner" "Scanner*"))
(wcmatch bname (export:pattern "pattern_btmt_beladung" "BTMT-Beladung*"))
(wcmatch bname (export:pattern "pattern_btmt_entladung" "SC_Entladung*"))
(wcmatch bname (export:pattern "pattern_eingang" "Eingang*"))
(wcmatch bname (export:pattern "pattern_ausgang" "Ausgang*"))
(wcmatch bname (export:pattern "pattern_geruest" "GR_*"))
;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen)
;; Rein LISP-intern (Python klassifiziert Omniflo stattdessen
@@ -1157,16 +1222,18 @@
;; --- 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)
;; --- Export-Vorbereitung: Zeichnungszustand fuer den Export herrichten ---
;; Aus csv:run-export ausgelagert: alle Schritte, die VOR dem Sammeln/Schreiben
;; den Zeichnungszustand herrichten - Separator-Proxies einpacken, IDs
;; sicherstellen, Proxy-Zuordnung setzen, Omniflo-Attribute (HOEHE/DREHUNG)
;; aktualisieren, Separator-/Scanner-Zuordnung pruefen, global regenerieren und
;; die bbox-Fehlerdiagnose zuruecksetzen. Rueckgabe: die Liste der erzeugten
;; Separator-Proxies (der Aufrufer entfernt sie am Ende wieder). label dient
;; nur den Meldungen.
(defun csv:export-vorbereiten (label / 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).
;; von csv:run-export wieder entfernt (csv:sep-proxies-loeschen).
;;
;; HINWEIS: csv:sepliste-proxies-erzeugen (echte Kopien fuer die nur noch in
;; der sepliste-XDATA gefuehrten SEP/AS/ES-Eintraege der VF_n/GF_n-Wrapper)
@@ -1226,6 +1293,76 @@
;; bbox-Fehlerdiagnose fuer diesen Lauf zuruecksetzen (siehe csv:get-bbox).
(setq *csv-bbox-fail-count* 0)
(setq *csv-bbox-fail-first* nil)
sep-proxies)
;; --- Python-Export-Skript aufrufen und Ergebnis auswerten ---------------
;; Aus csv:run-export ausgelagert: das fertige raw-JSON (out-pfad) an das
;; Python-Skript py-name uebergeben, synchron ausfuehren und den Exitcode
;; auswerten (kein stiller Fehlschlag). Arbeitet ausschliesslich ueber die
;; uebergebenen Pfade/Namen und die Umgebung (DXFM_LIB/DXFM_DATA/DXFM_LOG) -
;; keine Zeichnungs-/Sammel-Logik mehr, daher gut fuer sich testbar.
;; label/out-dir dienen nur den Meldungen bzw. dem Ergebnis-Pfad.
(defun csv:python-aufrufen (label out-dir out-pfad py-name csv-name
/ py-skript ergebnis-pfad py-exe log-pfad rc)
;; Python-Skript aufrufen. DXFM_LIB muss gesetzt sein - fehlt es
;; (z.B. weil BricsCAD nicht ueber bin/start_briscad.bat gestartet
;; wurde und die Umgebungsvariablen daher nie in diesen Prozess
;; vererbt wurden), wuerde das folgende strcat sonst mit einem
;; kryptischen Lisp-Fehler ("bad argument type <NIL>") abbrechen.
(if (null (getenv "DXFM_LIB"))
(princ (ssg-textf "exp-dxfm-lib-missing" (list label)))
(progn
(setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name))
(if (findfile py-skript)
(progn
(setq ergebnis-pfad (strcat out-dir "/" (export:dwg-praefix) csv-name))
(setq py-exe (export:python-exe))
(setq log-pfad (strcat (cond ((getenv "DXFM_LOG")) (out-dir))
"/export_python.log"))
(princ (ssg-textf "exp-python-exe" (list label py-exe)))
(princ (ssg-textf "exp-calling-python" (list label)))
;; Synchron ausfuehren und Exitcode auswerten - ein stiller
;; Fehlschlag (z.B. WindowsApps-Platzhalter statt Interpreter)
;; darf nicht mehr als "Export gestartet" durchgehen.
(setq rc (export:run-python py-exe py-skript
(list out-pfad (getenv "DXFM_DATA") ergebnis-pfad)
log-pfad))
(cond
((null rc)
(princ (ssg-textf "exp-python-call-failed" (list label))))
((/= rc 0)
(princ (ssg-textf "exp-python-error" (list label rc log-pfad)))
(export:log-ausgeben log-pfad 12)
;; Exitcode 49 (Store-Platzhalter direkt) bzw. 9009 (cmd.exe:
;; "Befehl nicht gefunden") = kein brauchbarer Interpreter.
;; Gezielter Hinweis, wie er korrekt gesetzt wird.
(if (or (= rc 49) (= rc 9009)
(export:python-store-stub-p py-exe))
(princ (ssg-text "exp-python-store-hint"))
))
((not (findfile ergebnis-pfad))
(princ (ssg-textf "exp-csv-missing" (list label ergebnis-pfad log-pfad)))
(export:log-ausgeben log-pfad 12))
(t
(princ (ssg-textf "exp-export-done" (list label ergebnis-pfad))))
)
)
(princ (ssg-textf "exp-python-not-found" (list label py-skript)))
)
)
)
)
;; py-name = Python-Skript-Name (z.B. "export_csv.py")
;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv")
;; include-bbox = T -> Bounding-Box je Block ermitteln und mit exportieren
;; (siehe csv:block-to-json); fuer EXPORTSIVAS nil.
(defun csv:run-export (label py-name csv-name include-bbox / ss i ename fh out-pfad
first-block count out-dir sep-proxies)
;; Zeichnungszustand fuer den Export herrichten (Proxies, IDs, Zuordnung,
;; Attribut-Update, Sep/Scan-Zaehlung, REGENALL, bbox-Reset) - ausgelagert.
;; Rueckgabe: die erzeugten Separator-Proxies (unten wieder zu entfernen).
(setq sep-proxies (csv:export-vorbereiten label))
(princ (ssg-textf "exp-collect-blocks" (list label)))
(setq ss (csv:collect-export-blocks))
@@ -1285,53 +1422,8 @@
(list (itoa *csv-bbox-fail-count*)
(cond (*csv-bbox-fail-first*) ("?"))))))
;; 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)))
)
)
)
;; Python-Export-Skript aufrufen (ausgelagert, siehe oben).
(csv:python-aufrufen label out-dir out-pfad py-name csv-name)
)
)
)
Lisp/list_blocks.lsp
+314
View File
@@ -0,0 +1,314 @@
;; ============================================================
;; list_blocks.lsp
;; Liest die (Sub-)Block-Definitionen aller DWG-Dateien in
;; data/ils aus und schreibt sie als JSON-Report
;; "blocks_collected.json" nach data/ils.
;;
;; Hintergrund: 2D- und 3D-Bloecke (z.B.
;; Vario_Bogen_ab_27_TEF_rechts_2D.dwg /
;; Vario_Bogen_ab_27_TEF_rechts_3D.dwg)
;; enthalten teilweise gleichnamige Sub-Bloecke (z.B.
;; "200000317_TEF_Bogen_vertikal_abwaerts__15"). Werden beide
;; DWGs in dieselbe Zeichnung eingefuegt, kollidieren diese
;; Definitionen (nur eine Referenz gewinnt). Dieses Skript LIEST
;; die Bloecke nur aus, damit manuell entschieden werden kann,
;; welche spaeter mit "_2D"/"_3D" umbenannt werden.
;;
;; Ausgabe:
;; - JSON data/ils/blocks_collected.json:
;; { "<Dateiname ohne .dwg>": { "dim": "2D"|"3D"|"-",
;; "blocks": ["Name", ...] }, ... }
;; - Konsolen-Report inkl. Kollisionsliste (gleicher Blockname
;; kommt sowohl in einer _2D- als auch in einer _3D-Datei vor)
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../Lisp/list_blocks.lsp")
;; ILS_BLOCK_LIST
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun lb-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
(setq docs (vla-get-Documents (vlax-get-acad-object))
anzahl (vla-get-Count docs)
i 0
treffer nil
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
)
(while (and (< i anzahl) (not treffer))
(setq doc (vla-item docs i))
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
(if (= full dwg-pfad) (setq treffer doc))
(setq i (1+ i))
)
treffer
)
;; ------------------------------------------------------------
;; String fuer JSON escapen (Anfuehrungszeichen/Backslash)
;; ------------------------------------------------------------
(defun lb-json-escape (s)
(if (null s) (setq s ""))
(setq s (vl-string-subst "\\\\" "\\" s))
(vl-string-subst "\\\"" "\"" s)
)
;; ------------------------------------------------------------
;; Strings mit Trennzeichen verbinden
;; ------------------------------------------------------------
(defun lb-strjoin (liste sep / erg erste s)
(setq erg "" erste T)
(foreach s liste
(if erste (setq erg s erste nil) (setq erg (strcat erg sep s)))
)
erg
)
;; ------------------------------------------------------------
;; Dimension aus dem Dateinamen ableiten ("2D"/"3D"/"-")
;; ------------------------------------------------------------
(defun lb-dim-aus-name (basisname / n)
(setq n (strcase basisname))
(cond
((wcmatch n "*_2D") "2D")
((wcmatch n "*_3D") "3D")
(t "-")
)
)
;; ------------------------------------------------------------
;; Alle echten (Sub-)Block-Definitionen des aktiven Dokuments
;; einsammeln (Symboltabelle BLOCK): keine Layouts (Model/Paper-
;; Space, "*..."), keine anonymen Bloecke (Flag 1), keine XRefs
;; (Flag 4). Alphabetisch sortiert.
;; ------------------------------------------------------------
(defun lb-collect-blocks-in-current-doc ( / def name flags ergebnis)
(setq ergebnis nil
def (tblnext "BLOCK" T)
)
(while def
(setq name (cdr (assoc 2 def))
flags (cdr (assoc 70 def))
)
(if (null flags) (setq flags 0))
(if (and name
(> (strlen name) 0)
(/= (substr name 1 1) "*") ; kein Model/Paper-Space
(= (logand flags 1) 0) ; nicht anonym
(= (logand flags 4) 0) ; kein XRef
)
(setq ergebnis (cons name ergebnis))
)
(setq def (tblnext "BLOCK"))
)
(vl-sort ergebnis (function (lambda (a b) (< (strcase a) (strcase b)))))
)
;; ------------------------------------------------------------
;; Eine DWG-Datei oeffnen (falls noetig), Bloecke einsammeln und
;; die Datei wieder schliessen (falls durch diese Funktion geoeffnet).
;; Rueckgabe: ('ok . ("Name" ...)) oder ('fehler . meldung)
;; ------------------------------------------------------------
(defun lb-collect-dwg (dwg-pfad / bereits-offen ergebnis fehler)
(setq bereits-offen (lb-find-open-doc dwg-pfad))
(setq ergebnis nil)
(setq fehler
(vl-catch-all-apply
(function
(lambda ()
(if bereits-offen
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
(command "_.OPEN" dwg-pfad)
)
(setq ergebnis (lb-collect-blocks-in-current-doc))
(if (not bereits-offen) (command "_.CLOSE"))
)
)
nil
)
)
(if (vl-catch-all-error-p fehler)
(cons 'fehler (vl-catch-all-error-message fehler))
(cons 'ok ergebnis)
)
)
;; ------------------------------------------------------------
;; Liste als JSON-Array-Text formatieren (["a", "b"]), eingerueckt
;; ------------------------------------------------------------
(defun lb-list-to-json (namen einruecken / innen zeilen)
(if (null namen)
"[]"
(progn
(setq innen (strcat einruecken " "))
(setq zeilen
(mapcar
(function (lambda (nm) (strcat innen "\"" (lb-json-escape nm) "\"")))
namen
)
)
(strcat "[\n"
(car zeilen)
(apply 'strcat (mapcar (function (lambda (z) (strcat ",\n" z))) (cdr zeilen)))
"\n" einruecken "]"
)
)
)
)
;; ------------------------------------------------------------
;; Kollisionen ermitteln: Bloecke, deren Name sowohl in einer
;; _2D- als auch in einer _3D-Datei vorkommt.
;; eintraege = (("<datei>" "2D"|"3D"|"-" ("blk" ...)) ...)
;; Rueckgabe: (("blockname" ("datei-2d" ...) ("datei-3d" ...)) ...)
;; ------------------------------------------------------------
(defun lb-finde-kollisionen (eintraege / tabelle e datei dim blks blk vorhanden coll)
;; tabelle: blockname -> (liste-2d-dateien . liste-3d-dateien)
(setq tabelle nil)
(foreach e eintraege
(setq datei (nth 0 e)
dim (nth 1 e)
blks (nth 2 e)
)
(foreach blk blks
(setq vorhanden (assoc blk tabelle))
(if (not vorhanden)
(setq vorhanden (list blk nil nil)
tabelle (cons vorhanden tabelle))
)
(cond
((= dim "2D") (setq vorhanden (subst (cons datei (nth 1 vorhanden)) (nth 1 vorhanden) vorhanden)))
((= dim "3D") (setq vorhanden (subst (cons datei (nth 2 vorhanden)) (nth 2 vorhanden) vorhanden)))
)
;; aktualisierten Eintrag zurueckschreiben
(setq tabelle (subst vorhanden (assoc blk tabelle) tabelle))
)
)
;; nur Bloecke mit mind. einer 2D- UND einer 3D-Datei
(setq coll nil)
(foreach e tabelle
(if (and (nth 1 e) (nth 2 e))
(setq coll (cons e coll))
)
)
(vl-sort coll (function (lambda (a b) (< (strcase (car a)) (strcase (car b))))))
)
;; ------------------------------------------------------------
;; Hauptbefehl - verarbeitet DXFM_DATA/ils
;; ------------------------------------------------------------
(defun c:ILS_BLOCK_LIST ( / data-dir dwg-dir json-pfad dateien datei dwg-pfad basisname
dim ergebnis orig-doc anzahl-ok anzahl-fehler fehler-liste
eintraege fh erste e kollisionen k)
(setq data-dir (getenv "DXFM_DATA"))
(if (not data-dir)
(progn
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
(exit)
)
)
(setq data-dir (vl-string-translate "\\" "/" data-dir)
dwg-dir (strcat data-dir "/ils")
json-pfad (strcat dwg-dir "/blocks_collected.json")
)
(setq dwg-dir (vl-string-right-trim "/" dwg-dir))
(if (not (findfile dwg-dir))
(progn
(princ (strcat "\n[BLOCK-LIST] Verzeichnis nicht gefunden: " dwg-dir))
(exit)
)
)
(setq dateien (vl-directory-files dwg-dir "*.dwg" 1))
(if (not dateien)
(progn
(princ (strcat "\n[BLOCK-LIST] Keine DWG-Dateien in: " dwg-dir))
(exit)
)
)
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-ok 0
anzahl-fehler 0
fehler-liste nil
eintraege nil
)
(foreach datei dateien
(setq basisname (vl-filename-base datei)
dwg-pfad (strcat dwg-dir "/" datei)
dim (lb-dim-aus-name basisname)
)
(princ (strcat "\n[BLOCK-LIST] Lese " datei " ..."))
(setq ergebnis (lb-collect-dwg dwg-pfad))
(if (equal (car ergebnis) 'fehler)
(progn
(princ (strcat "\n[BLOCK-LIST] FEHLER bei " datei ": " (cdr ergebnis)))
(setq anzahl-fehler (1+ anzahl-fehler))
(setq fehler-liste (cons datei fehler-liste))
)
(progn
(setq eintraege (cons (list basisname dim (cdr ergebnis)) eintraege))
(setq anzahl-ok (1+ anzahl-ok))
(princ (strcat " " (itoa (length (cdr ergebnis))) " Block(e)."))
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(setq eintraege (reverse eintraege))
;; JSON schreiben
(setq fh (open json-pfad "w"))
(if (null fh)
(princ (strcat "\n[BLOCK-LIST] FEHLER: Datei kann nicht geschrieben werden: " json-pfad))
(progn
(write-line "{" fh)
(setq erste T)
(foreach e eintraege
(if (not erste) (write-line "," fh))
(write-line (strcat " \"" (lb-json-escape (nth 0 e)) "\": {") fh)
(write-line (strcat " \"dim\": \"" (nth 1 e) "\",") fh)
(write-line (strcat " \"blocks\": " (lb-list-to-json (nth 2 e) " ")) fh)
(write-line " }" fh)
(setq erste nil)
)
(write-line "}" fh)
(close fh)
(princ (strcat "\n[BLOCK-LIST] " json-pfad " geschrieben ("
(itoa anzahl-ok) " Dateien)."))
)
)
;; Kollisionen ermitteln und ausgeben
(setq kollisionen (lb-finde-kollisionen eintraege))
(princ (strcat "\n[BLOCK-LIST] Fertig: " (itoa anzahl-ok) " gelesen, "
(itoa anzahl-fehler) " Fehler, "
(itoa (length kollisionen)) " Kollision(en) (Blockname in 2D UND 3D)."))
(if kollisionen
(progn
(princ "\n[BLOCK-LIST] --- Kollisionen (Kandidaten fuer _2D/_3D-Umbenennung) ---")
(foreach k kollisionen
(princ (strcat "\n * " (car k)))
(princ (strcat "\n 2D: " (lb-strjoin (reverse (nth 1 k)) ", ")))
(princ (strcat "\n 3D: " (lb-strjoin (reverse (nth 2 k)) ", ")))
)
)
)
(if fehler-liste
(progn
(princ "\n[BLOCK-LIST] WARNUNG: Fehler bei:")
(foreach datei (reverse fehler-liste)
(princ (strcat "\n - " datei))
)
)
)
(princ)
)
(princ "\nlist_blocks.lsp geladen. Befehl: ILS_BLOCK_LIST")
(princ)
Lisp/purge_blocks.lsp
+225
View File
@@ -0,0 +1,225 @@
;; ============================================================
;; purge_blocks.lsp
;; Entfernt in allen DWG-Dateien in data/ils die nicht
;; verwendeten Block-Definitionen und Layer (-PURGE Blocks/Layer).
;;
;; Ablauf je DWG:
;; - Datei oeffnen (falls noetig)
;; - Block- und Layer-Anzahl zaehlen
;; - -PURGE Blocks und -PURGE Layer in einer Schleife ausfuehren,
;; bis nichts mehr entfernt wird (verschachtelte Bloecke bzw.
;; nur von entfernten Bloecken benutzte Layer werden erst nach
;; dem ersten Durchlauf frei)
;; - nur speichern, wenn sich die Anzahl verringert hat
;; - schliessen (falls durch dieses Skript geoeffnet)
;;
;; Es werden AUSSCHLIESSLICH unbenutzte Bloecke und Layer entfernt.
;; Andere Objekttypen (Linientypen, Textstile, ...) bleiben
;; unangetastet.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../Lisp/purge_blocks.lsp")
;; ILS_BLOCK_PURGE
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun pb-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
(setq docs (vla-get-Documents (vlax-get-acad-object))
anzahl (vla-get-Count docs)
i 0
treffer nil
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
)
(while (and (< i anzahl) (not treffer))
(setq doc (vla-item docs i))
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
(if (= full dwg-pfad) (setq treffer doc))
(setq i (1+ i))
)
treffer
)
;; ------------------------------------------------------------
;; Anzahl aller Eintraege einer Symboltabelle zaehlen
;; (z.B. "BLOCK" inkl. Model/Paper-Space/anonyme, "LAYER").
;; ------------------------------------------------------------
(defun pb-count-table (tabelle / n def)
(setq n 0 def (tblnext tabelle T))
(while def
(setq n (1+ n))
(setq def (tblnext tabelle))
)
n
)
;; ------------------------------------------------------------
;; Im aktiven Dokument unbenutzte Bloecke UND Layer purgen, bis
;; stabil. Erst Bloecke, dann Layer (ein nur von einem entfernten
;; Block benutzter Layer wird erst danach frei) - daher Schleife
;; ueber beide Typen, bis sich nichts mehr aendert.
;; ------------------------------------------------------------
(defun pb-purge-current-doc ( / vorher aktuell durchlauf max-durchlauf)
(setq vorher (+ (pb-count-table "BLOCK") (pb-count-table "LAYER"))
aktuell vorher
durchlauf 1
max-durchlauf 20
)
(while (and (<= durchlauf max-durchlauf)
(progn
(command "_.-PURGE" "_B" "*" "_N") ; unbenutzte Bloecke
(command "_.-PURGE" "_LA" "*" "_N") ; unbenutzte Layer
(setq aktuell (+ (pb-count-table "BLOCK") (pb-count-table "LAYER")))
;; weiter, solange noch etwas entfernt wurde
(if (< aktuell vorher)
(progn (setq vorher aktuell) T)
nil
)
)
)
(setq durchlauf (1+ durchlauf))
)
aktuell
)
;; ------------------------------------------------------------
;; Eine DWG-Datei oeffnen (falls noetig), purgen, speichern (nur
;; bei Aenderung) und schliessen (falls hier geoeffnet).
;; Rueckgabe: ('ok blk-entfernt . lay-entfernt) oder ('fehler . meldung)
;; ------------------------------------------------------------
(defun pb-purge-dwg (dwg-pfad / bereits-offen blk-vor blk-nach lay-vor lay-nach
blk-entfernt lay-entfernt fehler)
(setq bereits-offen (pb-find-open-doc dwg-pfad))
(setq blk-entfernt 0 lay-entfernt 0)
(setq fehler
(vl-catch-all-apply
(function
(lambda ()
(if bereits-offen
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
(command "_.OPEN" dwg-pfad)
)
(setq blk-vor (pb-count-table "BLOCK")
lay-vor (pb-count-table "LAYER")
)
(pb-purge-current-doc)
(setq blk-nach (pb-count-table "BLOCK")
lay-nach (pb-count-table "LAYER")
blk-entfernt (- blk-vor blk-nach)
lay-entfernt (- lay-vor lay-nach)
)
(if (or (> blk-entfernt 0) (> lay-entfernt 0))
(command "_.QSAVE")
)
(if (not bereits-offen) (command "_.CLOSE"))
)
)
nil
)
)
(if (vl-catch-all-error-p fehler)
(cons 'fehler (vl-catch-all-error-message fehler))
(list 'ok blk-entfernt lay-entfernt)
)
)
;; ------------------------------------------------------------
;; Hauptbefehl - verarbeitet DXFM_DATA/ils
;; ------------------------------------------------------------
(defun c:ILS_BLOCK_PURGE ( / data-dir dwg-dir dateien datei dwg-pfad ergebnis
orig-doc anzahl-ok anzahl-fehler summe-blk summe-lay
blk lay fehler-liste geaendert-liste)
(setq data-dir (getenv "DXFM_DATA"))
(if (not data-dir)
(progn
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
(exit)
)
)
(setq data-dir (vl-string-translate "\\" "/" data-dir)
dwg-dir (vl-string-right-trim "/" (strcat data-dir "/ils"))
)
(if (not (findfile dwg-dir))
(progn
(princ (strcat "\n[BLOCK-PURGE] Verzeichnis nicht gefunden: " dwg-dir))
(exit)
)
)
(setq dateien (vl-directory-files dwg-dir "*.dwg" 1))
(if (not dateien)
(progn
(princ (strcat "\n[BLOCK-PURGE] Keine DWG-Dateien in: " dwg-dir))
(exit)
)
)
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-ok 0
anzahl-fehler 0
summe-blk 0
summe-lay 0
fehler-liste nil
geaendert-liste nil
)
(foreach datei dateien
(setq dwg-pfad (strcat dwg-dir "/" datei))
(princ (strcat "\n[BLOCK-PURGE] Bearbeite " datei " ..."))
(setq ergebnis (pb-purge-dwg dwg-pfad))
(if (equal (car ergebnis) 'fehler)
(progn
(princ (strcat "\n[BLOCK-PURGE] FEHLER bei " datei ": " (cdr ergebnis)))
(setq anzahl-fehler (1+ anzahl-fehler))
(setq fehler-liste (cons datei fehler-liste))
)
(progn
(setq anzahl-ok (1+ anzahl-ok)
blk (nth 1 ergebnis)
lay (nth 2 ergebnis)
)
(if (or (> blk 0) (> lay 0))
(progn
(princ (strcat " " (itoa blk) " Block(e), " (itoa lay) " Layer entfernt, gespeichert."))
(setq summe-blk (+ summe-blk blk)
summe-lay (+ summe-lay lay)
)
(setq geaendert-liste (cons (strcat datei " (B:" (itoa blk) " L:" (itoa lay) ")") geaendert-liste))
)
(princ " keine unbenutzten Bloecke/Layer.")
)
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(princ (strcat "\n[BLOCK-PURGE] Fertig: " (itoa anzahl-ok) " Datei(en) bearbeitet, "
(itoa summe-blk) " Block(e), "
(itoa summe-lay) " Layer entfernt, "
(itoa anzahl-fehler) " Fehler."))
(if geaendert-liste
(progn
(princ "\n[BLOCK-PURGE] Geaenderte Dateien:")
(foreach datei (reverse geaendert-liste)
(princ (strcat "\n - " datei))
)
)
)
(if fehler-liste
(progn
(princ "\n[BLOCK-PURGE] WARNUNG: Fehler bei:")
(foreach datei (reverse fehler-liste)
(princ (strcat "\n - " datei))
)
)
)
(princ)
)
(princ "\npurge_blocks.lsp geladen. Befehl: ILS_BLOCK_PURGE")
(princ)
Lisp/ssg_core.lsp
+44 -3
View File
@@ -787,7 +787,7 @@
;; und Foerderer-Tests) fuehrte das zu minutenlangen Laufzeiten.
;; Zum erzwungenen Neu-Einlesen: ssg-block-refresh-reset.
;; Rueckgabe: effektiver (suffigierter) Blockname oder nil (Datei nicht gefunden).
(defun ssg-ils-block-laden-dim (blockname dim / eff datei base temp-obj osm areq adia)
(defun ssg-ils-block-laden-dim (blockname dim / eff datei base temp-obj osm areq adia n)
(setq eff (ssg-ils-blockname-dim blockname dim))
(setq datei (ssg-ils-block-datei-dim blockname dim))
(if (null datei)
@@ -825,8 +825,22 @@
(if (tblsearch "BLOCK" eff)
(command "_.-INSERT" (strcat eff "=" datei) "_Y") ; Redefine bestehender Block
(command "_.-INSERT" (strcat eff "=" datei))) ; neu (kein Redefine-Prompt)
(if (> (getvar "CMDACTIVE") 0) (command))
(if (> (getvar "CMDACTIVE") 0) (command))
;; Robust statt fixer 2 Versuche abbrechen: manche Block-DWGs (z.B.
;; abweichende INSUNITS) schieben eine zusaetzliche Rueckfrage ein,
;; die zwei (command)-Aufrufe nicht immer leeren. Bleibt danach ein
;; Befehl aktiv, verschluckt der NAECHSTE (command ...)-Aufruf des
;; Aufrufers (die eigentliche Platzierung, z.B. hundm05:bau-sensor/
;; ils-insert-station) dessen Argumente als Antwort auf DIESEN noch
;; offenen Prompt - Ursache eines real beobachteten kaputten Blocks
;; (fehlende Attribute) beim letzten Element eines Testlaufs.
(setq n 0)
(while (and (> (getvar "CMDACTIVE") 0) (< n 10))
(command)
(setq n (1+ n)))
(if (> (getvar "CMDACTIVE") 0)
(princ (strcat "\n[SSG] WARNUNG: Laden von '" eff
"' hat einen Befehl aktiv gelassen (CMDACTIVE > 0) -"
" nachfolgende Einfuegungen sind evtl. beschaedigt.")))
(setvar "OSMODE" osm)(setvar "ATTREQ" areq)(setvar "ATTDIA" adia)))
;; Nur merken, wenn die Definition danach wirklich vorhanden ist -
;; sonst wuerde ein fehlgeschlagener Ladeversuch dauerhaft gesperrt.
@@ -1767,6 +1781,33 @@
(cdr (assoc key obj))
)
;; String fuer die Ausgabe in JSON maskieren (Gegenstueck zu ssg-json-string).
;; Der Backslash MUSS zuerst geprueft werden, sonst wuerde die Maskierung der
;; Anfuehrungszeichen gleich wieder mitmaskiert.
;; Hinweis: csv:json-escape in export.lsp leistet dasselbe, ist aber modul-lokal
;; am Export-Modul - bewusst nicht zusammengelegt, das waere ein eigener Schritt.
(defun ssg-json-escape (s / i c erg)
(if (null s) (setq s ""))
(setq erg "" i 1)
(while (<= i (strlen s))
(setq c (substr s i 1))
(setq erg
(strcat erg
(cond
((= c "\\") "\\\\")
((= c "\"") "\\\"")
((= c (chr 10)) "\\n")
((= c (chr 13)) "\\r")
((= c (chr 9)) "\\t")
(T c)
)
)
)
(setq i (1+ i))
)
erg
)
;; Verschachteltes JSON-Objekt parsen (1 Ebene tief)
;; {"section": {"key": val, ...}, ...}
Lisp/ssg_id.lsp
+6
View File
@@ -38,6 +38,11 @@
;; pattern_btmt_entladung in cfg/export.cfg) aus demselben Grund: sonst bleibt
;; ihre ID trotz ATTDEF leer und sie fehlen bei der zeichnungsweiten Duplikat-
;; pruefung/Maximum-Ermittlung (ssg-id-check-all).
;; Eingang*/Ausgang* (Materialfluss-Ein-/Ausgangssymbole, siehe
;; pattern_eingang/pattern_ausgang in cfg/export.cfg) ebenso: die DWGs haben
;; seit dem ID-Nachtrag (allocations.json) ein leeres ID-ATTDEF, das hier
;; gefuellt werden muss, damit sie eine stabile TeileId fuer die "TrackIds"-
;; Spalte (auch auf Kreiseln) bekommen.
;; GR_* (Geruest-Baugruppen, siehe pattern_geruest in cfg/export.cfg) ebenso -
;; das ID-ATTDEF steht seit *geruest-attrib-defs* zur Verfuegung.
(defun ssg-id-collect-blocks ( / ss-all ss-out i ename ed bname)
@@ -57,6 +62,7 @@
(wcmatch bname "Vario*,Staustrecke*,AUS_Element*,EIN_Element*,VF_*,GF_*")
(wcmatch bname "Separator_SP*,S-LP*,Scanner*")
(wcmatch bname "BTMT-Beladung*,SC_Entladung*")
(wcmatch bname "Eingang*,Ausgang*")
(wcmatch bname "GR_*")
(wcmatch bname "#*")
)
Lisp/ssg_ks_insert.lsp
+20 -1
View File
@@ -413,13 +413,32 @@
(reverse liste)
)
;; Koordinate mit GENAU 2 Nachkommastellen formatieren - bewusst OHNE rtos.
;; rtos haengt an den Zeichnungs-Systemvariablen DIMZIN (Nullunterdrueckung),
;; LUPREC und LUNITS: bei dem hier verbreiteten DIMZIN=8 wuerde rtos die
;; abschliessenden Nullen wegwerfen (10.00 -> 10), und dieselben Koordinaten
;; serialisierten je nach Zeichnungsprofil unterschiedlich. Die Sepliste
;; landet als XDATA/Journal PERSISTENT am Block - die Serialisierung muss
;; darum reproduzierbar und profilunabhaengig sein. Rundung kaufmaennisch,
;; mit Uebertrag (9.999 -> 10.00), Vorzeichen bleibt erhalten.
(defun ssg-sepliste-fmt-koord (x / neg i f s)
(setq neg (< x 0.0) x (abs x))
(setq i (fix x))
(setq f (fix (+ 0.5 (* 100.0 (- x i)))))
(if (>= f 100) (progn (setq i (1+ i)) (setq f (- f 100))))
(setq s (strcat (itoa i) "."
(if (< f 10) (strcat "0" (itoa f)) (itoa f))))
(if neg (strcat "-" s) s)
)
;; Serialisiert die Sepliste zu "TYP:LFDNR:X:Y,TYP:LFDNR:X:Y,...".
(defun ssg-sepliste->string (liste / eintrag out first)
(setq out "" first t)
(foreach eintrag liste
(setq eintrag
(strcat (nth 0 eintrag) ":" (itoa (nth 1 eintrag)) ":"
(rtos (nth 2 eintrag) 2 2) ":" (rtos (nth 3 eintrag) 2 2)))
(ssg-sepliste-fmt-koord (nth 2 eintrag)) ":"
(ssg-sepliste-fmt-koord (nth 3 eintrag))))
(if first (progn (setq out eintrag) (setq first nil))
(setq out (strcat out "," eintrag)))
)
Lisp/ssg_load.lsp
+1 -2
View File
@@ -35,12 +35,11 @@
(load (strcat base-path "VarioFoerderer.lsp") "VarioFoerderer.lsp nicht gefunden")
(load (strcat base-path "Gefaellestrecke.lsp") "Gefaellestrecke.lsp nicht gefunden")
(load (strcat base-path "export.lsp") "export.lsp nicht gefunden")
(load (strcat base-path "tests.lsp") "tests.lsp nicht gefunden")
(load (strcat base-path "OmniModulInsert.lsp") "OmniModulInsert.lsp nicht gefunden")
(load (strcat base-path "Tro_Edit.lsp") "Tro_Edit.lsp nicht gefunden")
(load (strcat base-path "Connection_Edit.lsp") "Connection_Edit.lsp nicht gefunden")
(load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, tests, OmniModulInsert, SSG_LIB_Commands")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, OmniModulInsert, SSG_LIB_Commands")
(princ)
)
Lisp/vf_etage.lsp
+5 -34
View File
@@ -138,40 +138,11 @@
;; [ sin(hz)*cos(vert) cos(hz) sin(hz)*sin(vert) ]
;; [ -sin(vert) 0 cos(vert) ]
(defun insert-hz-incl-scaled-block (blockname startpunkt laenge hz-winkel vert-winkel /
rad-hz rad-vert chz shz cv sv scale
matrix block-obj endpunkt)
(setq scale (/ (float laenge) 1000.0))
(setq rad-hz (* (float hz-winkel) (/ pi 180.0)))
(setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
(setq chz (cos rad-hz) shz (sin rad-hz))
(setq cv (cos rad-vert) sv (sin rad-vert))
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit)
)
)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0))
;; Einzelteil auf die eigene Ebene der Blockdefinition legen - wie in den
;; Zwillingen in ssg_ks_insert.lsp; hier fehlte der Aufruf bisher.
(ssg-ils-block-auf-ebene block-obj blockname)
(setq matrix (vf-rot-matrix chz shz cv sv))
(vla-TransformBy block-obj (vlax-tmatrix matrix))
(vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt))
(setq endpunkt (list
(+ (car startpunkt) (* laenge chz cv))
(+ (cadr startpunkt) (* laenge shz cv))
(+ (caddr startpunkt) (* (- sv) laenge))))
(princ (ssg-textf "vfe-hz-incl-status"
(list blockname (rtos laenge 2 0)
(strcat (rtos hz-winkel 2 0) (chr 176))
(strcat (rtos vert-winkel 2 0) (chr 176))
(rtos (caddr endpunkt) 2 1))))
endpunkt
)
;; HINWEIS: insert-hz-incl-scaled-block wurde entfernt (2026-09-18) - toter Code,
;; kein Aufrufer im Repo. Die verbleibenden drei insert-hz-*-Funktionen bleiben,
;; weil sie sich in der Platzierungssemantik (KS_EIN vs. Block-Ursprung) bzw. der
;; Skalierung+KS+Vertikale-Kombination von den ssg_ks_insert-Primitiven
;; unterscheiden und ein Ersatz die Geometrie verschoebe (byte-genaue Pruefung).
(defun insert-hz-rotated-block-with-ks (blockname startpunkt hz-winkel vert-winkel block-dx block-dz /
rad-hz rad-vert chz shz cv sv
Lisp/vf_konstanten.lsp
+11
View File
@@ -193,6 +193,17 @@
;; etage-foerderanlage-einfuegen (vf_etage.lsp).
(if (null *vfk-etage-auslauf-min-clamp*) (setq *vfk-etage-auslauf-min-clamp* 50.0))
;; Mindest-2D-Laenge (mm) eines Pfad-Segments (LINE-Laenge bzw. ARC-Sehne),
;; das der Linienzug-Modus 2/3 aus einer Objektauswahl akzeptiert. Kuerzere
;; Objekte sind Geister-/Artefakt-Elemente (z.B. ein von einer Rechteck-Auswahl
;; miterfasstes Mini-Segment) und werden VOR der Sortierung ausgeworfen, mit
;; Warnung an den Nutzer (vfl-in-segmente). Konservativ deutlich unter jedem
;; realen Bauteil (kleinstes Bauteil = Separator 300 mm; kleinster echter
;; Eck-Bogen R500/30 Grad hat eine Sehne von ~259 mm) und knapp ueber dem
;; allgemeinen Restlaengen-Clamp (100 mm), damit kein legitimes Segment
;; faelschlich verworfen wird.
(if (null *vfk-pfad-min-segmentlaenge*) (setq *vfk-pfad-min-segmentlaenge* 100.0))
;; ============================================================
;; TEIL 4: FALLBACK-VERSATZWERTE (mm) - AS-/ES-/Gefaellebogen-Masse, falls
;; die Blockdefinition/das Koordinatensystem nicht extrahierbar ist
Lisp/vf_linienzug.lsp
+435 -165
View File
@@ -2013,6 +2013,59 @@
(setq s (substr s (+ pos 1 (strlen sep)))))
(reverse (cons s out)))
;; --- SEGS: Segment-Essenz einer Modus-3-Kette (selbst-enthalten) ---
;; Ein SEGS-Wert ist die AUS DEN PFAD-OBJEKTEN ABGELEITETE Zahlenliste, die der
;; Modus-3-Bau ohnehin allein verwendet (gf-analysiere-kette + Start/Endpunkte
;; aus gf-sortiere-objekte). Sie ersetzt im Journal die frueheren OBJS-Handles:
;; dadurch ist die Kette im XDATA vollstaendig beschrieben und beim Doppelklick-
;; Replay unabhaengig davon, ob die urspruenglichen LINE/ARC noch existieren
;; (robuster als der OBJS-Weg von Modus 2). Siehe doc/variofoerderer.md.
;;
;; Ein Segment ist eine 9er-Liste, die die "Bau-Essenz" und die fuer die
;; AS-Trimmung/das Soll-Ende noetigen absoluten Punkte zusammenfuehrt:
;; (typ hz laenge bwinkel bseite spx spy epx epy)
;; typ "Linie"/"Bogen" (delimiter-frei, daher unquotiert serialisiert)
;; hz Eintritts-Horizontalwinkel (Grad)
;; laenge 2D-Laenge / Sehnenmass (mm)
;; bwinkel Bogenwinkel (0 bei Linie)
;; bseite "links"/"rechts"
;; spx spy Startpunkt (XY, mm) des Segments \ aus gf-sortiere-objekte,
;; epx epy Endpunkt (XY, mm) des Segments / fuer Trimmung + Soll-Ende
;;
;; Serialisierung: Segmente per ";" getrennt, Felder je Segment per "|". Beide
;; Trenner sind kollisionsfrei - die einzigen String-Felder (typ/bseite) sind
;; feste Schluesselwoerter ohne ";" oder "|", alle uebrigen Felder sind Zahlen
;; (rtos-Mode-2, wie PT/REAL). Ein leeres SEGS ("") ist eine leere Liste.
(defun vfl-seg->string (seg)
(vfl-strjoin
(list (nth 0 seg) ; typ (String)
(rtos (float (nth 1 seg)) 2 6) ; hz
(rtos (float (nth 2 seg)) 2 6) ; laenge
(rtos (float (nth 3 seg)) 2 6) ; bwinkel
(nth 4 seg) ; bseite (String)
(rtos (float (nth 5 seg)) 2 6) ; spx
(rtos (float (nth 6 seg)) 2 6) ; spy
(rtos (float (nth 7 seg)) 2 6) ; epx
(rtos (float (nth 8 seg)) 2 6)) ; epy
"|"))
(defun vfl-string->seg (s / f)
(setq f (vfl-strsplit s "|"))
(list (nth 0 f) ; typ
(atof (nth 1 f)) ; hz
(atof (nth 2 f)) ; laenge
(fix (atof (nth 3 f))) ; bwinkel (Ganzzahl, wie gf-analysiere-kette)
(nth 4 f) ; bseite
(atof (nth 5 f)) ; spx
(atof (nth 6 f)) ; spy
(atof (nth 7 f)) ; epx
(atof (nth 8 f)))) ; epy
(defun vfl-segs->string (segs)
(vfl-strjoin (mapcar 'vfl-seg->string segs) ";"))
(defun vfl-string->segs (s)
(if (= (strlen s) 0)
'()
(mapcar 'vfl-string->seg (vfl-strsplit s ";"))))
;; --- Serialisierung (tagged, selbstbeschreibend) ---
;; Zeilenformat "kind:payload", Eintraege per "\n" verkettet. getstring/getreal
;; liefern nie ein Newline, daher ist "\n" ein sicherer Record-Trenner.
@@ -2020,6 +2073,8 @@
;; Entity-Handles (Hex-Strings, kollidieren nie mit dem Komma-Trenner).
;; Handles bleiben - anders als Enames - ueber Sitzungen/Undo hinweg stabil
;; und sind damit die richtige Persistenzform fuer ssget-Ergebnisse.
;; "SEGS" (Segment-Essenz, Modus 3): Payload = ";"-getrennte Segmente, Felder
;; per "|" (siehe vfl-segs->string oben).
(defun vfl-entry->string (e / k v)
(setq k (car e) v (cdr e))
(cond
@@ -2031,6 +2086,7 @@
((= k "STR") (strcat "STR:" v))
((= k "STEP") (strcat "STEP:" v))
((= k "OBJS") (strcat "OBJS:" (vfl-strjoin v ",")))
((= k "SEGS") (strcat "SEGS:" (vfl-segs->string v)))
(t "NIL:")))
(defun vfl-string->entry (ln / p kind pay c)
(setq p (vl-string-search ":" ln))
@@ -2048,6 +2104,7 @@
((= kind "STR") (cons "STR" pay))
((= kind "STEP") (cons "STEP" pay))
((= kind "OBJS") (cons "OBJS" (if (> (strlen pay) 0) (vfl-strsplit pay ",") nil)))
((= kind "SEGS") (cons "SEGS" (vfl-string->segs pay)))
(t (cons "NIL" nil))))))
;; forward-journal ist bereits in Bau-Reihenfolge (nicht die umgekehrte
;; *vfl-journal*-Rohform) - gemeinsame Serialisierung fuer Ketten- UND
@@ -2086,6 +2143,21 @@
((= k "OBJS") (strcat "[" (vfl-strjoin
(mapcar (function (lambda (h) (strcat "\"" (vfl-json-escape h) "\"")))
v) ",") "]"))
((= k "SEGS") (strcat "["
(vfl-strjoin
(mapcar
(function (lambda (seg)
(strcat "[\"" (vfl-json-escape (nth 0 seg)) "\","
(vfl-json-num (float (nth 1 seg))) ","
(vfl-json-num (float (nth 2 seg))) ","
(vfl-json-num (float (nth 3 seg))) ",\""
(vfl-json-escape (nth 4 seg)) "\","
(vfl-json-num (float (nth 5 seg))) ","
(vfl-json-num (float (nth 6 seg))) ","
(vfl-json-num (float (nth 7 seg))) ","
(vfl-json-num (float (nth 8 seg))) "]")))
v) ",")
"]"))
(t "null"))
"}"))
;; forward-journal (Bau-Reihenfolge) als kompakter JSON-Array-String.
@@ -2133,7 +2205,7 @@
;; Rueckgabe: (marker . journal) oder nil (kein/unbekanntes Journal).
(defun vfl-journal-xdata-lesen (ent / xd)
(setq xd (vfs-xdata-lesen ent))
(if (and xd (member (car xd) '("linienzug" "linienzug2")))
(if (and xd (member (car xd) '("linienzug" "linienzug2" "linienzug3")))
(cons (car xd) (vfl-string->journal (apply 'strcat (cdr xd))))
nil))
@@ -2306,6 +2378,47 @@
;; sich um einen frischen Bau oder einen Editier-Neuaufbau handelte (kein
;; Sonderfall mehr noetig). Aufgerufen aus dem *error*-Handler von
;; vf-linienzug-modus.
;; Den scharfen Abbruch-Wickel-Handler als *error* installieren - gemeinsam
;; fuer alle drei Linienzug-Modi (frueher 3x wortgleich ausgeschrieben, nur der
;; Marker-String "linienzug"/"linienzug2"/"linienzug3" unterschied sich).
;;
;; Der Handler faengt jeden Abbruch (ESC / (exit) / Laufzeitfehler) ab, wickelt
;; die bis dahin gebaute Teil-Geometrie per vfl-modus-abbruch-sichern zu einem
;; VF_n-Block mit dem vollen Journal (Marker als XDATA) und stellt *error*
;; wieder her. Details/Begruendung (dynamic scoping, *ssg-ils-dim*-Reset,
;; ssg-end) siehe die ausfuehrlichen Kommentare an der frueheren Aufrufstelle
;; in vf-linienzug-modus.
;;
;; VERTRAG (dynamic scoping): Der Aufrufer MUSS als Locals gebunden haben und
;; VOR diesem Aufruf gesetzt haben: old-error (Ruecksprung-*error*), lastEnt,
;; vfl-nummer, anzahl-gf, anzahl-vf, startpunkt, frame, as-seite, es-seite,
;; dbg-an. Sie werden vom Handler-Lambda zur ABBRUCHZEIT dynamisch aufgeloest -
;; also gegen den dann noch aktiven Modus-Frame, nicht gegen diesen Konstruktor
;; (der ist beim Abbruch laengst zurueckgekehrt). marker wird dagegen ZUR
;; INSTALL-ZEIT als String-Literal in den Lambda eingebacken (list-Konstruktion),
;; damit der Handler ihn ohne globalen Zwischenzustand selbst traegt.
(defun vfl-abbruch-handler-installieren (marker)
;; *error* auf eine LAMBDA-LISTE setzen, in die der marker als String-Literal
;; eingebaut ist (list-Konstruktion). AutoLISP ruft *error* als Funktion auf,
;; egal ob (lambda ...) oder (function (lambda ...)) - die reine Lambda-Liste
;; genuegt und vermeidet eval/function-Feinheiten. Alle uebrigen Symbole
;; (old-error, lastEnt, ...) bleiben ungequotet-frei und werden zur Aufrufzeit
;; dynamisch aufgeloest.
(setq *error*
(list 'lambda '(msg)
'(setq *error* old-error)
'(setq *ssg-ils-dim* nil)
(list 'vfl-modus-abbruch-sichern 'lastEnt 'vfl-nummer 'anzahl-gf 'anzahl-vf
'startpunkt 'frame 'as-seite 'es-seite marker)
'(if dbg-an
(progn
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
(dbgreturn nil)
(dbgclose)))
'(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
'(princ)))
*error*)
(defun vfl-modus-abbruch-sichern (lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite marker /
e cnt vfl-ins wickel-erg grund fwd n trunc)
@@ -5943,6 +6056,60 @@
(vf-set-es-masse winkel seite)
seite)
;; AS-Winkel (30/90) + Seite abfragen. Gemeinsame Schale fuer die frueher
;; wortgleich in vf-linienzug-modus/-modus2/-modus3 UND vfl-qc-linie-mit-gf
;; ausgeschriebene AS-Praeambel (Winkel-Frage 30/90, Seiten-Frage links/rechts,
;; vf-set-as-masse) - Gegenstueck zu vfl-frage-es-seite. Setzt *vfl-as-winkel*
;; und die AS-Masse (aus-dx/dz) fuer die Variante. Rueckgabe: Seite (links/rechts).
;;
;; seiten-headerkey ist der EINZIGE Unterschied zwischen den Aufrufstellen
;; (modus1: "vfl-aus-seite-header", modus2: "gf-seite-aus-header") und daher
;; Parameter. Die je Modus unterschiedliche VORANGEHENDE Wizard-Vorbereitung
;; (vflw-gruppe-as-impl "AS setzen?" bzw. vflw-gruppe-winkel-seite-impl) bleibt
;; bewusst an der Aufrufstelle - die abzudeckende Winkel/Seite-Frage selbst ist
;; ueberall identisch. vf-frage-element-winkel/vflw-wahl zeigen den Wizard-
;; Winkeldialog bei aktivem Wizard-Modus schon selbst.
(defun vfl-frage-as-winkel-seite (seiten-headerkey / antwort as-seite)
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-as-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
(princ (ssg-text seiten-headerkey))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
seiten-headerkey))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
as-seite)
;; ES-Winkel (30/90) + Seite abfragen - MARKER-FREIE Schale fuer die Modi 2/3,
;; die das ES-Element als eigene Praeambel (Start/Ziel bereits fest) abfragen
;; und ihr eigenes Journal-/Masse-Schema fuehren. Unterscheidet sich bewusst
;; von vfl-frage-es-seite (Modus 1), das zusaetzlich einen Journal-Marker "ES"
;; setzt und ueber vfl-es-masse-setzen laeuft - das ist Teil des Modus-1-
;; Kettenglied-Replays und darf hier NICHT feuern. Setzt *vfl-es-winkel* und
;; die ES-Masse (ein-dx/dz). Rueckgabe: Seite (links/rechts).
(defun vfl-frage-es-winkel-seite (seiten-headerkey / antwort es-seite)
(princ (ssg-text "vf-winkel-ein-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-es-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite
(princ (ssg-text seiten-headerkey))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
seiten-headerkey))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vf-set-es-masse *vfl-es-winkel* es-seite) ; Masse fuer Variante
es-seite)
;; dialog-schon-gezeigt: T, wenn Winkel+Seite BEREITS ueber einen vorherigen
;; kombinierten Dialog (vflw-gruppe-as-impl, "ES-Element setzen?" + Winkel +
;; Seite in einem Bildschirm) abgefragt und in die Pending-Queue gelegt
@@ -6317,32 +6484,11 @@
(setq lastEnt (vf-lastent-ohne-attribute))
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
(setq old-error *error*)
;; Abbruch-Handler: zuerst *error* zuruecksetzen (kein rekursiver
;; Wiedereintritt bei einem Fehler waehrend des Wickelns), dann wickeln.
;; Laeuft der Aufruf innerhalb einer ssg-start-Sitzung (Editier-Pfad via
;; c:VARIOFOERDERER_EDIT -> vfl-edit-ent), wird diese mit ssg-end sauber
;; geschlossen (Undo-Gruppe, gesicherte Systemvariablen, *error* aus dem
;; Sitzungs-Frame) - sonst bliebe die von ssg-start geoeffnete Undo-Gruppe
;; offen.
;; *ssg-ils-dim*: der Editier-/Konverter-Pfad setzt vor dem Replay einen
;; Dimensions-Override und raeumt ihn NACH der Rueckkehr wieder ab. Bei einem
;; Abbruch kehrt der Aufruf nie dorthin zurueck (der Handler beendet den
;; Befehl), daher MUSS der Override hier zurueckgesetzt werden - sonst bliebe
;; er fuer den Rest der Sitzung stehen und alle folgenden Einfuegungen liefen
;; in der falschen Dimension.
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(setq *ssg-ils-dim* nil)
(vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite "linienzug")
(if dbg-an
(progn
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
(dbgreturn nil)
(dbgclose)))
(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
(princ))))
;; Scharfen Abbruch-Wickel-Handler installieren (gemeinsam fuer alle drei
;; Modi, siehe vfl-abbruch-handler-installieren). old-error/lastEnt/vfl-nummer/
;; anzahl-gf/anzahl-vf/startpunkt/frame/as-seite/es-seite/dbg-an sind hier als
;; Locals gebunden und werden vom Handler zur Abbruchzeit dynamisch gesehen.
(vfl-abbruch-handler-installieren "linienzug")
(if (vfl-wizard-aktiv)
(vl-catch-all-apply 'vflw-gruppe-punkt-hoehe-impl
@@ -6390,22 +6536,7 @@
;; tragen, wenn diesmal kein AS gewaehlt wird.
(setq *vfl-as-winkel* nil *vfl-es-winkel* nil)
(if as-vorhanden
(progn
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-as-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
(princ (ssg-text "vfl-aus-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"vfl-aus-seite-header"))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
)
(setq as-seite (vfl-frage-as-winkel-seite "vfl-aus-seite-header"))
)
;; ES-Seite wird erst am Kettenende abgefragt (siehe vfl-frage-es-seite),
;; da das ES-Element erst dort eingefuegt wird.
@@ -8183,22 +8314,29 @@
;; und der Override sicher zurueckgesetzt wird. Rueckgabe: T bei Erfolg, sonst nil.
;; Bekannte Grenze (nur Modus 2): das Replay von vfl-in-selection braucht die
;; Original-Pfadobjekte; wurden sie geloescht, schlaegt der Konverter fuer diesen
;; Block sauber fehl (sichtbar am nicht erhoehten Batch-Zaehler).
;; Block sauber fehl (sichtbar am nicht erhoehten Batch-Zaehler). Modus 3
;; ("linienzug3") hat diese Grenze NICHT: es replayt die Segment-Essenz (SEGS)
;; aus dem Journal, nicht die Objekt-Handles - unabhaengig von den Original-LINE/ARC.
(defun vfl-konvertiere-ent (ent ziel-dim / bname xd marker journal ok)
(setq bname (cdr (assoc 2 (entget ent))))
(setq xd (vfl-journal-xdata-lesen ent)) ; (marker . journal) oder nil
(setq marker (car xd) journal (cdr xd))
(if (and (wcmatch bname "VF_*")
(member marker '("linienzug" "linienzug2"))
journal)
(member marker '("linienzug" "linienzug2" "linienzug3"))
journal
;; Alte OBJS-"linienzug2"-Bloecke (ohne SEGS) NICHT konvertieren -
;; ihr Replay ist mit dem SEGS-Umbau nicht mehr fahrbar (harter
;; Schnitt, wie im Doppelklick-Pfad vfl-edit-ent). Sie ueberspringen
;; (nil zurueck), damit die Batch-Schleife sauber weiterlaeuft.
(or (/= marker "linienzug2") (vfl-journal-hat-segs-p journal)))
(progn
(setq *ssg-ils-dim* ziel-dim) ; Zieldim erzwingen
(entdel ent) ; alten Block weg
(vfl-journal-replay-start journal) ; volle Queue, KEIN Truncate
(setq ok (vl-catch-all-apply
(if (= marker "linienzug2")
'vf-linienzug-modus2
'vf-linienzug-modus)))
(cond ((= marker "linienzug2") 'vf-linienzug-modus2)
((= marker "linienzug3") 'vf-linienzug-modus3)
(t 'vf-linienzug-modus))))
(setq *ssg-ils-dim* nil) ; Override zuruecksetzen
;; Fehlgeschlagene Konvertierung NICHT stumm verschlucken: der alte Block
;; ist per entdel schon weg, die Teil-Geometrie liegt frei in der
@@ -8224,8 +8362,17 @@
;; Doppelklick kein *ssg-ils-dim*-Override aktiv ist). Wird VOR dem entdel
;; gelesen; der Override greift beim anschliessenden Replay/Weiterbau.
(setq dim (ssg-dim-xdata-lesen ent))
(if (= marker "linienzug2")
(vfl-edit-ent2 ent journal)
(cond
((= marker "linienzug2")
;; Harter Schnitt: nur SEGS-Bloecke (neue Fassung) sind per Doppelklick
;; neu aufbaubar. Alte OBJS-Bloecke (Objekt-Handles statt Segment-Essenz)
;; wuerden im Replay falsche Daten in den Bau geben - klar abweisen statt
;; zu crashen.
(if (vfl-journal-hat-segs-p journal)
(vfl-edit-ent2 ent journal)
(alert (ssg-text "vfl-edit-m2-obsolet"))))
((= marker "linienzug3") (vfl-edit-ent3 ent journal))
(t
(progn
(setq glieder (vfl-journal-glieder journal))
(setq n (length glieder))
@@ -8281,15 +8428,27 @@
;; Handler selbst (dort ebenfalls (setq *ssg-ils-dim* nil)), denn
;; die naechste Zeile wird dann nicht mehr erreicht.
(vf-linienzug-modus)
(setq *ssg-ils-dim* nil)))))
(setq *ssg-ils-dim* nil))))))
(princ))
;; Modus-2-Block per Doppelklick zuruecksetzen: voller Reset - die komplette
;; gespeicherte Eingabe (inkl. der gewaehlten Pfad-Objekte, siehe
;; vfl-in-selection) wird 1:1 stumm abgespielt, identischer Neuaufbau. Kein
;; T, wenn das Journal einen SEGS-Eintrag traegt (Modus 2 NEU / Modus 3 - die
;; Kette ist per Segment-Essenz selbst-enthalten). Alte Modus-2-Bloecke tragen
;; hier stattdessen einen OBJS-Eintrag (Objekt-Handles) - fuer die ist der
;; SEGS-Replay nicht mehr fahrbar (harter Schnitt, siehe vfl-edit-ent).
(defun vfl-journal-hat-segs-p (journal)
(and (vl-some (function (lambda (e) (equal (car e) "SEGS"))) journal) t))
;; Modus-2/3-Block per Doppelklick zuruecksetzen: voller Reset - die komplette
;; gespeicherte Eingabe wird 1:1 stumm abgespielt, identischer Neuaufbau. Kein
;; Sektions-Dialog; der Nutzer kann den neu entstandenen Block danach ganz
;; normal weiterbearbeiten oder loeschen.
(defun vfl-edit-ent2 (ent journal / dim)
;;
;; bau-fn = die Modus-Bau-Funktion, die das Journal abspielt: 'vf-linienzug-modus2
;; fuer Marker "linienzug2" (Pfad-Objekte per OBJS-Handles) bzw.
;; 'vf-linienzug-modus3 fuer "linienzug3" (Segment-Essenz per SEGS - unabhaengig
;; von den Original-Objekten). Beide Modi haben eine flache Klassifizierungs-
;; Schleife ohne editierbare Einzelglieder, daher derselbe volle Reset.
(defun vfl-edit-ent-voll (ent journal bau-fn / dim)
;; Dimension des Bestandsblocks VOR dem entdel merken und beim Neubau als
;; Override erzwingen (dimensionstreuer Doppelklick-Neubau, sonst globale
;; DXFM_DIM). Danach Override zuruecksetzen.
@@ -8300,12 +8459,17 @@
(vfl-journal-replay-start journal)
;; DIREKTER Aufruf, KEIN vl-catch-all-apply - identische Begruendung wie im
;; Sektions-Zweig von vfl-edit-ent (siehe dortiger Kommentar): der alte Block
;; ist per entdel schon weg, bei einem Abbruch muss der *error*-Handler von
;; vf-linienzug-modus2 die Teil-Geometrie wickeln. Den Dim-Override raeumt im
;; Abbruchfall der Handler ab.
(vf-linienzug-modus2)
;; ist per entdel schon weg, bei einem Abbruch muss der *error*-Handler der
;; Modus-Funktion die Teil-Geometrie wickeln. Den Dim-Override raeumt im
;; Abbruchfall der Handler ab. bau-fn ist ein Funktions-SYMBOL (quoted beim
;; Aufruf) - ueber apply aufrufen, nicht als (bau-fn) (das riefe die Funktion
;; namens "bau-fn" auf, nicht den durchgereichten Wert).
(apply bau-fn nil)
(setq *ssg-ils-dim* nil)
(princ))
;; Rueckwaertskompatibler Wrapper (Modus 2). vfl-edit-ent3 fuer Modus 3.
(defun vfl-edit-ent2 (ent journal) (vfl-edit-ent-voll ent journal 'vf-linienzug-modus2))
(defun vfl-edit-ent3 (ent journal) (vfl-edit-ent-voll ent journal 'vf-linienzug-modus3))
;; ============================================================
;; RECOVERY: Kette aus der Sektions-XDATA der Zeichnung neu aufbauen
@@ -8701,14 +8865,115 @@
(foreach x liste (setq d (abs (- x w))) (if (< d bd) (setq bd d best x)))
best)
;; --- Segment-Essenz einer selektierten Pfad-Kette (Modus 3) --------------
;; Fuehrt die 5-Feld-Bau-Segmente aus gf-analysiere-kette mit den absoluten
;; Start-/Endpunkten aus gf-sortiere-objekte (kette: (ent sp ep umk)) zu der
;; selbstbeschreibenden 9-Feld-Form zusammen, die das SEGS-Journal traegt:
;; (typ hz laenge bwinkel bseite spx spy epx epy)
;; Beide Listen sind gleich lang und in derselben Reihenfolge (segmente wurde
;; genau aus kette abgeleitet). spx/spy/epx/epy sind die planaren XY der
;; Segment-Enden - sie ersetzen den spaeteren direkten kette-Zugriff (AS-
;; Trimmung am ersten Segment, Soll-Ende-Report), sodass der Bau OHNE die
;; Original-Entities auskommt und beim Replay aus dem Journal gespeist wird.
(defun vfl-kette->segmente9 (kette segmente / out i seg item sp ep)
(setq out '() i 0)
(foreach seg segmente
(setq item (nth i kette) sp (cadr item) ep (caddr item))
(setq out (cons (list (nth 0 seg) (nth 1 seg) (nth 2 seg) (nth 3 seg) (nth 4 seg)
(car sp) (cadr sp) (car ep) (cadr ep))
out))
(setq i (1+ i)))
(reverse out))
;; 2D-Laenge eines Pfad-Objekts: LINE = Abstand Start-Endpunkt, ARC = Sehne
;; (Abstand Start-Endpunkt, dasselbe Mass wie gf-analysiere-kette es fuer die
;; Segmentlaenge nutzt). Nicht-LINE/ARC liefern 0.0 (werden dadurch als "zu
;; kurz" ausgewertet und verworfen). Rein lesend, ohne Nebeneffekt.
(defun vfl-obj-2d-laenge (obj / objname sp ep)
(setq objname (vla-get-ObjectName obj))
(if (or (= objname "AcDbLine") (= objname "AcDbArc"))
(progn
(setq sp (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint obj))))
(setq ep (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint obj))))
(gf-abstand-2d sp ep))
0.0))
;; Aus einer Objektliste alle Elemente unter *vfk-pfad-min-segmentlaenge*
;; herauswerfen (Geister-/Artefakt-Segmente, z.B. von einer Rechteck-Auswahl
;; miterfasste Mini-Objekte). Rueckgabe: (behalten-liste . verworfen-anzahl).
;; Reine Filterung, keine Meldung - der Aufrufer entscheidet ueber die Warnung.
(defun vfl-filter-mini-objekte (obj-liste / behalten verworfen)
(setq behalten '() verworfen 0)
(foreach obj obj-liste
(if (< (vfl-obj-2d-laenge obj) *vfk-pfad-min-segmentlaenge*)
(setq verworfen (1+ verworfen))
(setq behalten (cons obj behalten))))
(cons (reverse behalten) verworfen))
;; Objektauswahl + Analyse (Live) ODER Segment-Essenz aus dem Journal (Replay).
;; Gegenstueck zu vfl-in-selection, aber persistiert NICHT die Entity-Handles,
;; sondern die abgeleitete 9-Feld-Segmentliste (Journal-Art "SEGS"). Damit ist
;; der Modus-3-Block im XDATA vollstaendig beschrieben und der Doppelklick-Neubau
;; unabhaengig davon, ob die urspruenglichen LINE/ARC noch existieren.
;; Rueckgabe: die 9-Feld-Segmentliste oder nil (Abbruch/leer). filter/startpunkt
;; wie bei der Live-Auswahl; ecke-tol wird nur im Live-Zweig fuer die
;; Eck-Vorpruefung gebraucht (Replay-Daten sind bereits geprueft eingefroren).
(defun vfl-in-segmente (filter startpunkt ecke-tol / popped ss k obj-liste kette segmente ecke-bad segs9 filter-erg verworfen)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped
;; --- Replay: fertige Segment-Essenz direkt aus dem Journal ---
(progn
(setq segs9 (car popped))
(if (null segs9)
(if (vfl-headless-p) (vfl-headless-abbruch "SEGS-leer")))
segs9)
;; --- Live: Objekte waehlen, sortieren, analysieren, dann journalisieren ---
(progn
(if (vfl-headless-p) (vfl-headless-abbruch "SEGS"))
(setq ss (ssget filter))
(if (null ss)
(progn (vfl-journal-record "NIL" nil) nil)
(progn
;; Auswahlsatz -> VLA-Objektliste (wie im frueheren vfl-in-selection).
(setq obj-liste '() k 0)
(while (< k (sslength ss))
(setq obj-liste (cons (vlax-ename->vla-object (ssname ss k)) obj-liste))
(setq k (1+ k)))
(setq obj-liste (reverse obj-liste))
;; Geister-/Mini-Objekte VOR der Sortierung ausfiltern: ein von einer
;; Rechteck-Auswahl miterfasstes winziges Segment (unter
;; *vfk-pfad-min-segmentlaenge*) wuerde sonst per Nearest-Neighbor
;; stumm in die Kette gehaengt und ein Geister-Bauteil erzeugen (realer
;; Bug: 14-mm-Bogen am Kettenende). Verworfene mit Grund melden.
(setq filter-erg (vfl-filter-mini-objekte obj-liste))
(setq obj-liste (car filter-erg) verworfen (cdr filter-erg))
(if (> verworfen 0)
(vfl-meldung (ssg-textf "vfl-m3-mini-objekte-verworfen"
(list (itoa verworfen) (rtos *vfk-pfad-min-segmentlaenge* 2 0)))))
(setq kette (if obj-liste (gf-sortiere-objekte obj-liste startpunkt) nil))
(if (null kette)
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar"))
(vfl-journal-record "NIL" nil) nil)
(progn
(setq segmente (gf-analysiere-kette kette))
(setq ecke-bad (vfl2-pruefe-eckwinkel kette ecke-tol))
(if ecke-bad
(progn
(vfl-meldung (ssg-textf "vfl-vwnb-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
(vfl-journal-record "NIL" nil) nil)
(progn
(setq segs9 (vfl-kette->segmente9 kette segmente))
(vfl-journal-record "SEGS" segs9)
segs9)))))))))
(defun vf-linienzug-modus3 ( / ss obj-liste startpunkt start-hoehe as-seite
es-seite kette segmente n i seg seg-ent typ hz laenge
es-seite kette segmente segmente9 n i seg seg-ent typ hz laenge
bwinkel bseite frame antwort winkel deltaL
anzahl-gf anzahl-vf vfl-nummer lastEnt hoehe-bis
ecke-bad first-line last-line letzt-winkel
aus ein soll-ende ist-ende run-typ richtn best-w
kvariante L_VF ent-fp rad3 just-open
dbg-an old-error)
dbg-an old-error dbg-old-error vfl-ins)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-vwnb-titel"))
(princ "\n=========================================")
@@ -8720,34 +8985,40 @@
;; automatisch ueber vfl-journal-record mitgeloggt (siehe dort) - hier nur
;; noch Session-Start/-Ende + Zwischenergebnisse, die NICHT direkt aus einer
;; Nutzereingabe stammen (Analyse-Ergebnis, Segment-Header, Bau-Ergebnis).
;; *vfl-journal*/*vflw-pending* werden dabei nebenbei mitbefuellt, aber von
;; Modus 3 nirgends gelesen/persistiert (kein Replay/XDATA wie bei Modus 1/2
;; - das ist hier bewusst NICHT mit umgebaut, nur das Logging).
;; Der *error*-Handler schliesst die Datei bei Abbruch sauber.
;; *vfl-journal* wird - wie bei Modus 1/2 - als XDATA (Marker "linienzug3")
;; persistiert und ist damit per Doppelklick editierbar (vfl-edit-ent3, voller
;; Reset-Replay). Statt der Objekt-Handles traegt es die Segment-ESSENZ (SEGS,
;; siehe vfl-in-segmente): der Block ist selbst-enthalten und der Neubau
;; unabhaengig von den urspruenglichen LINE/ARC.
;; FRUEHER *error*-Handler: schliesst nur die dbg-Datei sauber, falls waehrend
;; der Pfad-/Praeambel-Phase (noch keine Geometrie) abgebrochen wird. Der
;; eigentliche Abbruch-WICKLER (Teil-Geometrie zu einem VF_n-Block sichern)
;; wird erst nach dem Setup scharf geschaltet (siehe unten), sobald
;; vfl-nummer/lastEnt feststehen - analog Modus 2.
(setq dbg-an (dbg-schalter-open "vfl-modus3" "vfl_modus3.dbg" "DXFM_LOG"))
(if dbg-an
(progn
(dbgf "vf-linienzug-modus3")
(dbgmsg "=== SESSION Modus 3 (Vorwaerts-Nachbau) START ===")
(dbgflush)))
(setq old-error *error*)
(setq dbg-old-error *error*)
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(setq *error* dbg-old-error)
(if dbg-an
(progn
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
(dbgreturn nil)
(dbgclose)))
(if old-error (old-error msg) (princ)))))
(if dbg-old-error (dbg-old-error msg) (princ)))))
(vfl-gf-abhaengigkeit-sicherstellen "vfl-m3-alert-gf-modul")
;; --- 1. Pfad-Objekte waehlen (LINE/ARC) ---
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq ss (vfl-in-selection '((0 . "LINE,ARC"))))
(if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
(setq obj-liste (mapcar 'vlax-ename->vla-object ss))
;; --- 1./3. Pfad-Objekte + Segment-Essenz: siehe Schritt 3 unten. ---
;; Auswahl UND Ableitung laufen zusammen in vfl-in-segmente, weil die
;; Sortierung den Startpunkt braucht (Schritt 2) - die Objektauswahl steht
;; daher NACH der Startpunkt-/AS-Praeambel, nicht mehr davor. Journalisiert
;; wird nur noch die abgeleitete Segment-Essenz (SEGS), nicht die Handles.
;; --- 2. Startpunkt (hoehere Seite) + Hoehe + AS-Seite ---
;; Wizard: Startpunkt+Hoehe als EIN Gruppen-Dialog (analog Modus 2). Die
@@ -8784,24 +9055,25 @@
(setq as-seite (if (= (vfl-in-string (ssg-text "prompt-wahl-1-2")) "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
;; --- 3. Sortieren + Analysieren ---
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
(if (null kette)
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit)))
(setq segmente (gf-analysiere-kette kette))
;; --- 3. Pfad waehlen + Sortieren + Analysieren + Eck-Vorpruefung ---
;; vfl-in-segmente kapselt Live (ssget -> gf-sortiere-objekte ->
;; gf-analysiere-kette -> Eck-Vorpruefung -> 9-Feld-Essenz) UND Replay
;; (fertige Essenz aus dem SEGS-Journal). Persistiert die Segment-Essenz
;; statt der Objekt-Handles - damit ist der Block selbst-enthalten und der
;; Doppelklick-Neubau (vfl-edit-ent3) braucht die Original-LINE/ARC nicht.
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq segmente9 (vfl-in-segmente '((0 . "LINE,ARC")) startpunkt *vfk-eckwinkel-toleranz*))
(if (null segmente9) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
;; segmente = 5-Feld-Bausicht (typ hz laenge bwinkel bseite), abgeleitet aus
;; der 9-Feld-Essenz - der bestehende Bau unten arbeitet unveraendert damit.
(setq segmente (mapcar (function (lambda (s) (list (nth 0 s) (nth 1 s) (nth 2 s) (nth 3 s) (nth 4 s))))
segmente9))
(if dbg-an
(progn
(dbgmsg (strcat "ANALYSE: " (itoa (length segmente)) " Segment(e) erkannt"))
(dbg 'segmente)
(dbgflush)))
;; --- 4. Eck-Winkel-Vorpruefung (vor dem Bau) ---
(setq ecke-bad (vfl2-pruefe-eckwinkel kette *vfk-eckwinkel-toleranz*))
(if ecke-bad
(progn
(vfl-meldung (ssg-textf "vfl-vwnb-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
(exit)))
;; --- 5. Setup ---
(setq aus (if aus-dx aus-dx *vfk-as-es-fallback-dx*) ein (if ein-dx ein-dx *vfk-as-es-fallback-dx*))
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
@@ -8811,7 +9083,19 @@
(setq vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
(vfl-acc-reset)
(setq anzahl-gf 0 anzahl-vf 0 frame nil n (length segmente))
(setq anzahl-gf 0 anzahl-vf 0 frame nil)
;; --- Abbruch-Sicherung ab hier scharf (analog Modus 1/2) ---
;; Ab Schritt 6 kann jederzeit Geometrie entstehen. Der Wickler sichert die
;; bis zum Abbruch gebaute Teil-Geometrie als VF_n-Block mit dem vollen
;; Journal (Marker "linienzug3") - sie bleibt stehen und ist per Doppelklick
;; fortsetz-/editierbar. Loest den fruehen dbg-Hook ab (Ruecksprungziel bleibt
;; dbg-old-error) und uebernimmt das dbgclose. *ssg-ils-dim* zuruecksetzen:
;; Begruendung siehe gleichlautende Stelle in vf-linienzug-modus.
(setq old-error dbg-old-error)
;; Scharfen Abbruch-Wickel-Handler installieren (gemeinsam, siehe
;; vfl-abbruch-handler-installieren).
(vfl-abbruch-handler-installieren "linienzug3")
(setq n (length segmente))
;; erste/letzte "Linie" fuer die Trimmung bestimmen
(setq first-line -1 last-line -1 i 0)
(while (< i n)
@@ -8830,13 +9114,19 @@
(setq i 0)
(while (< i n)
(setq seg (nth i segmente) typ (car seg) hz (cadr seg))
(setq seg-ent (car (nth i kette))) ; echte LINE/ARC-Entity dieses Segments
;; seg-ent: KEINE Live-Entity mehr - Modus 3 baut jetzt aus der Segment-
;; Essenz (SEGS), nicht aus durchgereichten LINE/ARC. Damit entfaellt das
;; kosmetische Pfad-Segment-Highlight (vfl-seg-highlight ist nil-sicher).
;; Der Wegfall ist bewusst: die Essenz macht den Bau/Replay unabhaengig von
;; den Original-Objekten, ein Highlight haette beim Doppelklick-Neubau ohnehin
;; keine Entity mehr zum Hervorheben.
(setq seg-ent nil)
;; Wizard: alle Fragen dieses Segments in EINEM Dialog erfassen (die
;; unveraenderten vfl-in-*-Aufrufe unten konsumieren die Antworten aus
;; *vflw-pending*). Segment vorher in der Zeichnung hervorheben. Bei einem
;; Bogen ist Vario-Kurve nur im offenen VF-Lauf erlaubt - deshalb die
;; Variante-Antwort nur mitschicken, wenn run-typ="VF" (sonst konsumiert
;; der Aufrufer sie nicht und sie wuerde ins naechste Segment lecken).
;; *vflw-pending*). Bei einem Bogen ist Vario-Kurve nur im offenen VF-Lauf
;; erlaubt - deshalb die Variante-Antwort nur mitschicken, wenn run-typ="VF"
;; (sonst konsumiert der Aufrufer sie nicht und sie wuerde ins naechste
;; Segment lecken).
(if (vfl-wizard-aktiv)
(progn
(vfl-seg-highlight seg-ent T)
@@ -8949,12 +9239,21 @@
(setq frame (vfl-insert-es-element "GF" frame (car (frame->hz-winkel frame))
(if letzt-winkel letzt-winkel *vfk-gefaelle-winkel*) (caddr (car frame)) es-seite)))
;; --- 8. Block + Ist-Ziel-Report ---
;; --- 8. Block + Journal-XDATA + Ist-Ziel-Report ---
(setq hoehe-bis (caddr (car frame)))
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt)
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite startpunkt lastEnt))
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug3") ->
;; spaeter per Doppelklick editierbar (vfl-edit-ent3: voller Reset-Replay wie
;; Modus 2, aus der Segment-Essenz statt aus Objekt-Handles).
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins "linienzug3"))
(setq soll-ende (caddr (last kette))) ; Endpunkt des letzten gezeichneten Segments
;; Endpunkt des letzten gezeichneten Segments - aus der Segment-Essenz
;; (epx/epy des letzten Segments), nicht mehr aus den Original-Entities.
;; Damit stimmt der Soll-Ende-Report auch beim Doppelklick-Neubau, wenn die
;; urspruenglichen LINE/ARC laengst weg sind.
(setq soll-ende (list (nth 7 (last segmente9)) (nth 8 (last segmente9))))
(setq ist-ende (car frame)) ; ES-KS_AUS
(princ "\n\n=========================================")
(princ (ssg-text "vfl-vwnb-eingefuegt"))
@@ -9199,7 +9498,7 @@
100.0))))
(defun vf-linienzug-modus2 ( / ss k obj-liste startpunkt start-hoehe as-seite
endpunkt end-hoehe es-seite kette segmente n i seg
endpunkt end-hoehe es-seite kette segmente segmente9 n i seg
seg-ent
typ hz laenge bwinkel bseite antwort winkel klass
plan e ecke-bad vf-start vf-ende dz z-front
@@ -9264,11 +9563,14 @@
(vfl-gf-abhaengigkeit-sicherstellen "vfl-m3-alert-gf-modul")
;; --- 1. Pfad-Objekte waehlen ---
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq ss (vfl-in-selection '((0 . "LINE,ARC"))))
(if (null ss) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
(setq obj-liste (mapcar 'vlax-ename->vla-object ss))
;; --- 1./4. Pfad-Objekte + Segment-Essenz: siehe Schritt 4 unten. ---
;; Auswahl UND Ableitung laufen zusammen in vfl-in-segmente (Live: ssget ->
;; gf-sortiere-objekte -> gf-analysiere-kette -> Eck-Vorpruefung -> SEGS;
;; Replay: fertige Essenz aus dem Journal). Persistiert die Segment-Essenz
;; statt der Objekt-Handles - der Block ist damit selbst-enthalten und der
;; Doppelklick-Neubau unabhaengig von den Original-LINE/ARC (behebt den
;; frueheren OBJS-Replay-Drift). Da vfl-in-segmente den startpunkt fuer die
;; Sortierung braucht, steht die Auswahl NACH der Startpunkt-Praeambel.
;; --- 2. Startpunkt + Z + AS-Seite ---
(if (vfl-wizard-aktiv)
@@ -9292,22 +9594,7 @@
;; Globals pro Lauf zuruecksetzen (siehe Kommentar in vf-linienzug-modus).
(setq *vfl-as-winkel* nil *vfl-es-winkel* nil)
(if as-vorhanden
(progn
(princ (ssg-text "vf-winkel-aus-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-as-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
(princ (ssg-text "gf-seite-aus-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"gf-seite-aus-header"))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
)
(setq as-seite (vfl-frage-as-winkel-seite "gf-seite-aus-header"))
)
;; --- 3. Endpunkt + Z + ES-Seite (NEU in Modus 3) ---
@@ -9330,34 +9617,19 @@
"vfl-es-setzen-frage"))
(setq es-vorhanden (/= antwort "2"))
(if es-vorhanden
(progn
(princ (ssg-text "vf-winkel-ein-header"))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(setq *vfl-es-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-menu (ssg-text "prompt-wahl-1-2")
(list (ssg-text "gf-seite-links") (ssg-text "gf-seite-rechts")) 1
"gf-seite-ein-header"))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vf-set-es-masse *vfl-es-winkel* es-seite) ; Masse fuer Variante
)
(setq es-seite (vfl-frage-es-winkel-seite "gf-seite-ein-header"))
)
;; --- 4. Sortieren + Analysieren + Eck-Vorpruefung ---
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
(if (null kette)
(progn (princ (ssg-text "vfl-m3-fehler-nicht-sortierbar")) (exit)))
(setq segmente (gf-analysiere-kette kette))
(setq ecke-bad (vfl2-pruefe-eckwinkel kette *vfk-eckwinkel-toleranz*))
(if ecke-bad
(progn
(vfl-meldung (ssg-textf "vfl-m3-alert-eckwinkel" (list (rtos ecke-bad 2 1))))
(exit)))
;; --- 4. Pfad waehlen + Sortieren + Analysieren + Eck-Vorpruefung ---
;; vfl-in-segmente kapselt Live + Replay und persistiert die Segment-Essenz
;; (SEGS) statt der Objekt-Handles - siehe Schritt 1 oben und Modus 3.
(princ (ssg-text "vfl-m3-pfad-waehlen"))
(setq segmente9 (vfl-in-segmente '((0 . "LINE,ARC")) startpunkt *vfk-eckwinkel-toleranz*))
(if (null segmente9) (progn (princ (ssg-text "vfl-m3-keine-objekte")) (exit)))
;; segmente = 5-Feld-Bausicht (typ hz laenge bwinkel bseite) aus der 9-Feld-
;; Essenz - die Klassifizierungs-Schleife unten arbeitet unveraendert damit.
(setq segmente (mapcar (function (lambda (s) (list (nth 0 s) (nth 1 s) (nth 2 s) (nth 3 s) (nth 4 s))))
segmente9))
;; --- 5. Klassifizierung (Phase A: nur speichern, nichts bauen) ---
;; Plan-Eintrag Gerade: ("Linie" hz laenge klass winkel) klass=GF/VF
@@ -9365,13 +9637,18 @@
(setq n (length segmente) i 0 plan '())
(while (< i n)
(setq seg (nth i segmente) typ (car seg) hz (cadr seg) laenge (caddr seg))
(setq seg-ent (car (nth i kette))) ; echte LINE/ARC-Entity dieses Segments
;; seg-ent: KEINE Live-Entity mehr - Modus 2 baut jetzt aus der Segment-
;; Essenz (SEGS), nicht aus durchgereichten LINE/ARC (siehe Modus 3). Damit
;; entfaellt das kosmetische Pfad-Segment-Highlight (vfl-seg-highlight ist
;; nil-sicher). Bewusst: die Essenz macht Bau/Replay unabhaengig von den
;; Original-Objekten, ein Highlight haette beim Doppelklick-Neubau ohnehin
;; keine Entity mehr.
(setq seg-ent nil)
;; Wizard: alle Fragen dieses Segments in EINEM Dialog erfassen (die
;; unveraenderten vfl-menu/vfl-in-*-Aufrufe unten konsumieren die Antworten
;; aus *vflw-pending*). Segment vorher in der Zeichnung hervorheben. Der
;; nach-kurve-Fall stellt keine Frage (auto-VF) -> kein Dialog. Ebenso
;; nach-vf bei einem Bogen: Vario-Kurve ist dann erzwungen (eine VF-
;; Einheit kann nicht in einen GF-Bogen auslaufen), auch kein Dialog.
;; aus *vflw-pending*). Der nach-kurve-Fall stellt keine Frage (auto-VF) ->
;; kein Dialog. Ebenso nach-vf bei einem Bogen: Vario-Kurve ist dann
;; erzwungen (eine VF-Einheit kann nicht in einen GF-Bogen auslaufen).
(if (and (vfl-wizard-aktiv)
(not (and (= typ "Linie") nach-kurve))
(not (and (= typ "Bogen") nach-vf)))
@@ -9470,9 +9747,14 @@
(if (/= vf-count 1)
(progn
;; Konsolen-Diagnose (fuer den Log / dbg-Nachvollzug) ...
(princ (ssg-textf "vfl-m3-vf-laeufe" (list (itoa vf-count))))
(princ (ssg-text "vfl-m3-vf-lauf-noetig"))
(princ (ssg-text "vfl-m3-vf-lauf-m3b"))
;; ... UND als sichtbare Meldung, damit die Abweisung nicht in der
;; Konsole untergeht (vfl-meldung zeigt bei erlaubter GUI ein alert,
;; headless nur princ - blockiert also einen Batch-Lauf nicht).
(vfl-meldung (ssg-textf "vfl-m3-vf-lauf-alert" (list (itoa vf-count))))
(exit)))
;; Traeger-Stueck = laengste VF-Gerade im Lauf (traegt die ganze Hoehe).
(setq carrier-idx -1 i vf-start)
@@ -9626,22 +9908,10 @@
;; dbg-Hook selbst) und uebernehmen das dbgclose gleich mit, sonst wuerde
;; bei einem Abbruch ab hier doppelt geschlossen.
(setq old-error dbg-old-error)
;; *ssg-ils-dim* hier zuruecksetzen - Begruendung siehe gleichlautende Stelle
;; im Handler von vf-linienzug-modus (Abbruch kehrt nie zum Aufrufer zurueck,
;; der den Override abraeumen wuerde).
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(setq *ssg-ils-dim* nil)
(vfl-modus-abbruch-sichern lastEnt vfl-nummer anzahl-gf anzahl-vf
startpunkt frame as-seite es-seite "linienzug2")
(if dbg-an
(progn
(dbgmsg (strcat "=== ABBRUCH: " (if msg msg "(exit)") " ==="))
(dbgreturn nil)
(dbgclose)))
(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
(princ))))
;; Scharfen Abbruch-Wickel-Handler installieren (loest den fruehen dbg-Hook ab,
;; Ruecksprungziel bleibt dbg-old-error via old-error). Gemeinsam fuer alle
;; Modi - siehe vfl-abbruch-handler-installieren.
(vfl-abbruch-handler-installieren "linienzug2")
;; erste/letzte Gerade fuer AS/ES-Trimmung bestimmen
(setq first-line -1 last-line -1 i 0)
(while (< i n)