diff --git a/Lisp/count_sep_scan.lsp b/Lisp/count_sep_scan.lsp index f4fb3f4..588f867 100644 --- a/Lisp/count_sep_scan.lsp +++ b/Lisp/count_sep_scan.lsp @@ -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) diff --git a/Lisp/ssg_load.lsp b/Lisp/ssg_load.lsp index d5ddc07..9228d76 100644 --- a/Lisp/ssg_load.lsp +++ b/Lisp/ssg_load.lsp @@ -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) ) diff --git a/tests/test_unit.lsp b/tests/test_unit.lsp index d998b62..a7cbc90 100644 --- a/tests/test_unit.lsp +++ b/tests/test_unit.lsp @@ -19,6 +19,20 @@ ;; Ergebnis: ;; Konsole: PASS/FAIL je Test + Zusammenfassung ;; Datei: tests/output/unit_results.txt (von run_tests.bat gelesen) +;; +;; Ladearchitektur (EINHEITLICH): +;; Das Laden der zu testenden Module passiert AUSSCHLIESSLICH auf .scr- +;; Top-Level in tests/test_unit.scr - die Core-Module ueber ssg_load.lsp, +;; die lazy Feature-Module (GeruestInsert, count_sep_scan) per explizitem +;; load. Die Testbloecke hier laden NICHTS nach; sie pruefen nur per +;; atoms-family, ob ihr Modul vorhanden ist, und ueberspringen sich sonst +;; mit einer FAIL-Meldung. +;; Grund: In BricsCAD werden per load definierte Funktionen erst nach +;; Rueckkehr zum Top-Level sichtbar. Ein load INNERHALB von c:TEST_UNIT +;; oder eines per vl-catch-all-apply gecatchten Testblocks bindet die +;; frisch definierten Funktionen im laufenden Durchlauf NICHT (beobachtet: +;; geruest-id-string/cs-in-box blieben ungebunden). Darum gehoert alles +;; Laden vor den (c:TEST_UNIT)-Aufruf ins .scr. ;; ============================================================ @@ -538,10 +552,9 @@ (defun tu-tests-geruest ( / _eintrag _gruppe _teile _konfig _rec _pfad _f _zurueck _bgtest _saeulen) (princ "\n[GeruestInsert]") - (if (and (null (atoms-family 1 '("GERUEST-ARTIKELNUMMERN"))) - (atoms-family 1 '("SSG-ENSURE"))) - (ssg-ensure "GeruestInsert") - ) + ;; GeruestInsert ist ein lazy Feature-Modul (nicht in der Core-Ladeliste). + ;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur + ;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur). (if (null (atoms-family 1 '("GERUEST-ARTIKELNUMMERN"))) (tu-record nil "geruest/modul" "GeruestInsert.lsp nicht geladen") (progn @@ -694,6 +707,127 @@ ) +;; ------------------------------------------------------------ +;; TESTS: count_sep_scan.lsp - geometrische Sensor-Zuordnung +;; +;; Testet die durch die Zerlegung von cs-zuordnung-lauf isolierte, +;; rein funktionale Kernlogik: Carrier-Records sind plain Listen +;; (ename tagS tagP minx miny maxx maxy cx cy id label), Sensoren +;; sind Punkte (x y). Kein ssget/entget/entmod - der ename an +;; Position 0 wird von den Geometrie-Routinen nie dereferenziert, +;; darum genuegt ein Symbol-Platzhalter. *senstol* wird fuer +;; deterministische Ergebnisse explizit gesetzt (sonst cfg-abhaengig). +;; ------------------------------------------------------------ +;; Record-Konstruktor fuers Testen: baut einen Carrier-Record so, wie +;; ihn cs-sammle-bloecke liefert - nur die Box-/Zentrum-/ID-Felder +;; (Index 3-9), die die Geometrie-Routinen lesen, sind relevant; ename +;; und label sind reine Platzhalter. +;; (name minx miny maxx maxy id) -> voller Carrier-Record +(defun tu-mk-carr (name minx miny maxx maxy id) + (list name "ANZAHL_SCANNER" "ANZAHL_SEPARATOR" + minx miny maxx maxy + (/ (+ minx maxx) 2.0) (/ (+ miny maxy) 2.0) + id (strcat "L-" name))) + +(defun tu-tests-sepscan ( / _senstol-alt _a _b _c _carr _grid _res) + (princ "\n[count_sep_scan]") + ;; count_sep_scan ist ein lazy Feature-Modul (nicht in der Core-Ladeliste). + ;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur + ;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur). + (if (null (atoms-family 1 '("CS-RESOLVE-SENSOR"))) + (tu-record nil "sepscan/modul" "count_sep_scan.lsp nicht geladen") + (progn + (setq _senstol-alt (if (boundp '*senstol*) *senstol*)) + (setq *senstol* 0.0) + + ;; --- cs-in-box: Punkt in Carrier-Box (X/Y, Z ignoriert) --- + (setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001")) + (tu-true "cs-in-box/mitte" (cs-in-box '(50.0 50.0) _a)) + (tu-true "cs-in-box/rand" (cs-in-box '(0.0 0.0) _a)) + (tu-nil "cs-in-box/ausserhalb-x" (cs-in-box '(150.0 50.0) _a)) + (tu-nil "cs-in-box/ausserhalb-y" (cs-in-box '(50.0 -1.0) _a)) + + ;; --- *senstol* vergroessert die Box --- + (setq *senstol* 10.0) + (tu-true "cs-in-box/toleranz-innen" (cs-in-box '(105.0 50.0) _a)) + (tu-nil "cs-in-box/toleranz-aussen" (cs-in-box '(111.0 50.0) _a)) + (setq *senstol* 0.0) + + ;; --- cs-bump: Zaehler je ename hochzaehlen --- + (tu-eq "cs-bump/neu" '(("k" . 1)) (cs-bump nil "k")) + (tu-eq "cs-bump/erhoeht" '(("k" . 2)) (cs-bump '(("k" . 1)) "k")) + (tu-eq "cs-bump/zweiter-key" + '(("m" . 1) ("k" . 1)) (cs-bump '(("k" . 1)) "m")) + + ;; --- cs-carrier-by-id: Record ueber ID (Feld 9) finden --- + (setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002")) + (setq _carr (list _a _b)) + (tu-eq "cs-carrier-by-id/treffer" _b (cs-carrier-by-id "0002" _carr)) + (tu-nil "cs-carrier-by-id/fehlt" (cs-carrier-by-id "9999" _carr)) + (tu-nil "cs-carrier-by-id/leer" (cs-carrier-by-id "" _carr)) + (tu-nil "cs-carrier-by-id/nil" (cs-carrier-by-id nil _carr)) + + ;; --- cs-assign: BBox-Zuordnung ueber das Grid --- + ;; Zwei getrennte Boxen: Punkt in genau einer -> diese. + (setq _grid (cs-grid-build _carr)) + (tu-eq "cs-assign/box-a" _a (cs-assign '(50.0 50.0) _grid)) + (tu-eq "cs-assign/box-b" _b (cs-assign '(250.0 50.0) _grid)) + (tu-nil "cs-assign/keine-box" (cs-assign '(1000.0 1000.0) _grid)) + + ;; Ueberlappende Boxen -> naechstes Box-Zentrum gewinnt (Tiebreak). + ;; C: 0..100, D: 40..200; Punkt (45,50) liegt in beiden, + ;; C-Zentrum (50,50) ist naeher als D-Zentrum (120,50). + (setq _a (tu-mk-carr "C" 0.0 0.0 100.0 100.0 "0003")) + (setq _b (tu-mk-carr "D" 40.0 0.0 200.0 100.0 "0004")) + (setq _grid (cs-grid-build (list _a _b))) + (tu-eq "cs-assign/overlap-naechstes-zentrum" + _a (cs-assign '(45.0 50.0) _grid)) + + ;; --- cs-nearest-two: die zwei naechsten Carrier nach Zentrum --- + ;; Zentren: A(50,50) B(250,50) C(50,250). Punkt (60,60): + ;; naechster A, zweiter B (dx 190 < dy 190? -> Abstand B=~194, C=~190). + (setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001")) + (setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002")) + (setq _c (tu-mk-carr "C" 0.0 200.0 100.0 300.0 "0003")) + (setq _res (cs-nearest-two '(60.0 60.0) (list _a _b _c))) + (tu-eq "cs-nearest-two/naechster" _a (nth 0 _res)) + (tu-true "cs-nearest-two/zweiter-vorhanden" (nth 2 _res)) + ;; Abstand zum naechsten (A-Zentrum 50,50) = sqrt(10^2+10^2) ~ 14.14 + (tu-eqf "cs-nearest-two/best-dist" + (distance '(60.0 60.0) '(50.0 50.0)) (nth 1 _res)) + + ;; Nur ein Carrier -> zweiter ist nil. + (setq _res (cs-nearest-two '(60.0 60.0) (list _a))) + (tu-eq "cs-nearest-two/einzeln-best" _a (nth 0 _res)) + (tu-nil "cs-nearest-two/einzeln-kein-zweiter" (nth 2 _res)) + + ;; --- cs-resolve-sensor: der Entscheider bbox/distance/none --- + ;; Punkt in einer Box -> modus 'bbox, kein Distanzfeld. + (setq _grid (cs-grid-build (list _a _b _c))) + (setq _res (cs-resolve-sensor '(50.0 50.0) (list _a _b _c) _grid)) + (tu-eq "cs-resolve/bbox-modus" 'bbox (nth 0 _res)) + (tu-eq "cs-resolve/bbox-rec" _a (nth 1 _res)) + (tu-nil "cs-resolve/bbox-kein-dist" (nth 2 _res)) + + ;; Punkt ausserhalb aller Boxen, aber Carrier vorhanden -> 'distance. + (setq _res (cs-resolve-sensor '(1000.0 1000.0) (list _a _b _c) _grid)) + (tu-eq "cs-resolve/distance-modus" 'distance (nth 0 _res)) + (tu-true "cs-resolve/distance-rec" (nth 1 _res)) + (tu-true "cs-resolve/distance-dist" (nth 2 _res)) + + ;; Gar keine Carrier -> 'none. + (setq _grid (cs-grid-build nil)) + (setq _res (cs-resolve-sensor '(50.0 50.0) nil _grid)) + (tu-eq "cs-resolve/none-modus" 'none (nth 0 _res)) + (tu-nil "cs-resolve/none-rec" (nth 1 _res)) + + ;; *senstol* wieder herstellen + (setq *senstol* _senstol-alt) + ) + ) +) + + ;; ------------------------------------------------------------ ;; REPORT SCHREIBEN ;; ------------------------------------------------------------ @@ -722,23 +856,27 @@ ;; ------------------------------------------------------------ ;; BEFEHL: TEST_UNIT ;; ------------------------------------------------------------ +;; Testblock geschuetzt aufrufen: ein harter LISP-Fehler in einem Block +;; wird als FAIL erfasst, statt c:TEST_UNIT abzubrechen und damit den +;; Report zu verhindern. Der Blockname (String) wird per read zur Funktion. +(defun tu-run-block (fn / res) + (setq res (vl-catch-all-apply (read fn) nil)) + (if (vl-catch-all-error-p res) + (tu-record nil (strcat fn "/ausfuehrung") + (strcat "harter Fehler: " (vl-catch-all-error-message res)))) +) + (defun c:TEST_UNIT ( / out-dir report) (tu-reset) (princ "\n================================================================") (princ "\n TEST_UNIT - LISP-Standardfunktionen") (princ "\n================================================================") - (tu-tests-core) - (tu-tests-lang) - (tu-tests-id) - (tu-tests-vfcore) - (tu-tests-export) - (tu-tests-gf) - (tu-tests-omni) - (tu-tests-kreisel) - (tu-tests-sepliste) - (tu-tests-json) - (tu-tests-geruest) + (foreach fn '("tu-tests-core" "tu-tests-lang" "tu-tests-id" "tu-tests-vfcore" + "tu-tests-export" "tu-tests-gf" "tu-tests-omni" "tu-tests-kreisel" + "tu-tests-sepliste" "tu-tests-json" "tu-tests-geruest" + "tu-tests-sepscan") + (tu-run-block fn)) (princ "\n\n----------------------------------------------------------------") (princ (strcat "\n Gesamt: " (itoa (+ *tu-pass* *tu-fail*)) diff --git a/tests/test_unit.scr b/tests/test_unit.scr index 4ed8245..8660b4d 100644 --- a/tests/test_unit.scr +++ b/tests/test_unit.scr @@ -2,6 +2,14 @@ ; Laedt SSG_LIB + die Unit-Tests, fuehrt TEST_UNIT aus und beendet BricsCAD. ; Pfadunabhaengig ueber DXFMAKRO (von setenv.bat gesetzt). (load (strcat (getenv "DXFMAKRO") "/Lisp/ssg_load.lsp")) +; Lazy Feature-Module, die einzelne Unit-Tests brauchen, hier auf .scr-Top- +; Level laden. In BricsCAD werden per load definierte Funktionen erst nach +; Rueckkehr zum Top-Level sichtbar - ein load INNERHALB von c:TEST_UNIT +; (oder eines gecatchten Testblocks) bindet sie im selben Durchlauf nicht. +; DIES ist die einzige Ladestelle: Testet ein neuer Block ein weiteres lazy +; Modul, gehoert dessen load-Zeile HIER dazu (nicht in test_unit.lsp). +(load (strcat (getenv "DXFM_LISP") "/GeruestInsert.lsp") "GeruestInsert.lsp nicht gefunden") +(load (strcat (getenv "DXFM_LISP") "/count_sep_scan.lsp") "count_sep_scan.lsp nicht gefunden") (load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp")) (c:TEST_UNIT) (command "_.QUIT")