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

cs-zuordnung-lauf zerlegen + LISP-Testarchitektur vereinheitlichen

Browse Source 
cs-zuordnung-lauf (~230 Zeilen, ~26 Locals) in sieben benannte
Routinen zerlegt (cs-sammle-bloecke, cs-scanner-zuordnen,
cs-separatoren-zuordnen, cs-korrektur-vermerken, cs-scanner-distanz-
melden, cs-anzahl-schreiben, cs-bericht-ausgeben); die Engine ist
jetzt ein schlanker Orchestrator. Verhalten unveraendert.

Dadurch ist die rein geometrische Zuordnungslogik von den Entity-
Zugriffen getrennt und unittest-faehig: neuer Block tu-tests-sepscan
mit 30 Tests fuer cs-in-box/cs-bump/cs-carrier-by-id/cs-assign/
cs-nearest-two/cs-resolve-sensor (Carrier-Records als plain Listen,
keine Zeichnung noetig).

Testarchitektur (Laden) vereinheitlicht: lazy Feature-Module
(GeruestInsert, count_sep_scan) werden AUSSCHLIESSLICH in test_unit.scr
auf .scr-Top-Level geladen. Grund: in BricsCAD werden per load
definierte Funktionen erst nach Rueckkehr zum Top-Level sichtbar - ein
load in c:TEST_UNIT oder einem gecatchten Testblock bindet sie im
selben Durchlauf nicht. Die Testbloecke laden nichts mehr, sie pruefen
nur per atoms-family. Runner gehaertet (tu-run-block faengt harte
Fehler je Block ab -> FAIL statt Suite-Abbruch, Report immer da).

Nebenbei aufgeraeumt: tote tests.lsp-Referenz in ssg_load.lsp entfernt
(Datei laengst geloescht, blockierte headless den kompletten Testlauf).

Voller LISP-Unit-Lauf jetzt 226/226 gruen.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
Michael Stangl
2026-09-18 14:31:35 +02:00
co-authored by Claude Opus 4.8
parent 52d92f0da6
commit dbc6c585bf
4 changed files with 446 additions and 219 deletions
Download Patch File Download Diff File Expand all files Collapse all files
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/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)
)