From 328b62ceecea53faa5bbc892e23e3bff05cb6ffb Mon Sep 17 00:00:00 2001 From: Yuelin Wang Date: Fri, 24 Jul 2026 13:58:31 +0200 Subject: [PATCH] feat: LISP-Diagnosebefehl KS_PRUEFEN (KS_EIN/KS_AUS 2D vs 3D + dx/dy/dz als CSV) Vergleicht je Basisblock die KS_EIN/KS_AUS-Urspruenge der _2D- und _3D-Variante (via extract-ks-from-block) und listet dx/dy/dz. Ausgabe ks_pruefung.csv. Menuepunkt unter Tests ergaenzt. Co-Authored-By: Claude Opus 4.8 --- Lisp/ks_pruefung.lsp | 121 +++++++++++++++++++++++++++++++++++++++++++ menu/SSG_LIB.mnu | 1 + 2 files changed, 122 insertions(+) create mode 100644 Lisp/ks_pruefung.lsp diff --git a/Lisp/ks_pruefung.lsp b/Lisp/ks_pruefung.lsp new file mode 100644 index 0000000..8f3c7f4 --- /dev/null +++ b/Lisp/ks_pruefung.lsp @@ -0,0 +1,121 @@ +;; ============================================================ +;; ks_pruefung.lsp - Diagnose: KS_EIN/KS_AUS der 2D/3D-Bloecke pruefen +;; ============================================================ +;; Befehl: KS_PRUEFEN +;; +;; Laedt jede _2D-/_3D-Blockdatei aus data/ils, liest die Urspruenge von +;; KS_EIN und KS_AUS (ueber die vorhandene extract-ks-from-block, wie im +;; Bau-Code), vergleicht die 2D- gegen die 3D-Variante und berechnet je +;; Variante dx/dy/dz = KS_AUS - KS_EIN. Ergebnis als CSV (Semikolon). +;; +;; Zweck: Abweichungen zwischen 2D und 3D schnell erkennen (Spalten +;; EIN_diff/AUS_diff = groesste Betragsdifferenz der Komponenten; Status +;; OK/ABWEICHUNG/KS_FEHLT/NUR_2D/NUR_3D). +;; +;; Hinweis: am besten in einer LEEREN Zeichnung ausfuehren - der Befehl legt +;; je Block temporaer eine Blockdefinition an (die Geometrie wird nicht +;; sichtbar platziert, nur zur Messung geladen). +;; ============================================================ + +;; Punkt als "x/y/z" (oder "-") +(defun ksp-pt-str (p) + (if p (strcat (rtos (car p) 2 3) "/" (rtos (cadr p) 2 3) "/" (rtos (caddr p) 2 3)) "-")) + +;; groesste Betragsdifferenz der Komponenten zweier Punkte (nil wenn einer fehlt) +(defun ksp-diff-max (a b) + (if (and a b) + (max (abs (- (car a) (car b))) (abs (- (cadr a) (cadr b))) (abs (- (caddr a) (caddr b)))) + nil)) + +;; (dx dy dz) = aus - ein (nil wenn einer fehlt) +(defun ksp-delta (ein aus) + (if (and ein aus) + (list (- (car aus) (car ein)) (- (cadr aus) (cadr ein)) (- (caddr aus) (caddr ein))) + nil)) + +;; Laedt eine DWG-Datei als Block, liefert (KS_EIN-Ursprung KS_AUS-Ursprung). +;; Fehlt eine Komponente -> nil an der Stelle. Raeumt das Mess-Objekt wieder auf. +(defun ksp-origins (fpath / o ks ein aus) + (setq ein nil aus nil) + (if (findfile fpath) + (progn + (setq o (vl-catch-all-apply + (function (lambda () + (vla-InsertBlock modelspace (vlax-3D-point (list 0.0 0.0 0.0)) + fpath 1.0 1.0 1.0 0))))) + (if (and o (not (vl-catch-all-error-p o))) + (progn + (setq ks (vl-catch-all-apply (function (lambda () (extract-ks-from-block o))))) + (if (and o (not (vlax-erased-p o))) (vla-Delete o)) + (if (and ks (not (vl-catch-all-error-p ks))) + (progn + (if (assoc "KS_EIN" ks) (setq ein (car (cadr (assoc "KS_EIN" ks))))) + (if (assoc "KS_AUS" ks) (setq aus (car (cadr (assoc "KS_AUS" ks))))))))))) + (list ein aus)) + +;; Eine Zeile fuer einen Basisblock erzeugen (base ohne _2D/_3D-Suffix). +(defun ksp-zeile (base basis / f2 f3 o2 o3 e2 a2 e3 a3 ediff adiff d2 d3 status) + (setq f2 (strcat basis base "_2D.dwg") + f3 (strcat basis base "_3D.dwg")) + (setq o2 (if (findfile f2) (ksp-origins f2) (list nil nil)) + o3 (if (findfile f3) (ksp-origins f3) (list nil nil))) + (setq e2 (car o2) a2 (cadr o2) e3 (car o3) a3 (cadr o3)) + (setq ediff (ksp-diff-max e2 e3) adiff (ksp-diff-max a2 a3)) + (setq d2 (ksp-delta e2 a2) d3 (ksp-delta e3 a3)) + (setq status + (cond + ((not (findfile f2)) "NUR_3D") + ((not (findfile f3)) "NUR_2D") + ((or (null e2) (null a2) (null e3) (null a3)) "KS_FEHLT") + ((and (<= ediff 0.01) (<= adiff 0.01)) "OK") + (t "ABWEICHUNG"))) + (strcat base ";" + (ksp-pt-str e2) ";" (ksp-pt-str e3) ";" (if ediff (rtos ediff 2 3) "-") ";" + (ksp-pt-str a2) ";" (ksp-pt-str a3) ";" (if adiff (rtos adiff 2 3) "-") ";" + (ksp-pt-str d2) ";" (ksp-pt-str d3) ";" status)) + +(defun c:KS_PRUEFEN ( / basis dir dat2 dat3 basen f base rows fh fpath n) + ;; vf_core (extract-ks-from-block) sicherstellen + (if (not (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK")))) + (if (car (atoms-family 1 '("SSG-ENSURE"))) (ssg-ensure "VarioFoerderer"))) + (if (not (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK")))) + (progn (alert "vf_core (extract-ks-from-block) ist nicht geladen - bitte Menue/Modul laden.") (exit))) + (if (not (car (atoms-family 1 '("SSG-ILS-BASIS")))) + (progn (alert "ssg_core (ssg-ils-basis) ist nicht geladen.") (exit))) + (setq *ks-cache* nil) + (setq basis (ssg-ils-basis)) + (if (null basis) (progn (alert "data/ils nicht gefunden (DXFMAKRO gesetzt?).") (exit))) + (setq dir (vl-string-right-trim "/" basis)) + ;; alle Basisnamen sammeln (Vereinigung aus _2D- und _3D-Dateien, ohne Suffix) + (setq dat2 (vl-directory-files dir "*_2D.dwg" 1) + dat3 (vl-directory-files dir "*_3D.dwg" 1)) + (setq basen '()) + (foreach f dat2 + (setq base (substr f 1 (- (strlen f) 7))) ; "_2D.dwg" = 7 + (if (not (member base basen)) (setq basen (cons base basen)))) + (foreach f dat3 + (setq base (substr f 1 (- (strlen f) 7))) ; "_3D.dwg" = 7 + (if (not (member base basen)) (setq basen (cons base basen)))) + (if (car (atoms-family 1 '("ACAD_STRLSORT"))) + (setq basen (acad_strlsort basen))) + (princ (strcat "\n>>> Pruefe " (itoa (length basen)) " Bloecke ...")) + (setq rows '()) + (foreach base basen + (setq rows (cons (ksp-zeile base basis) rows))) + (setq rows (reverse rows)) + ;; Ausgabedatei + (setq fpath (strcat (cond ((getenv "DXFM_RESULTS")) ((getenv "DXFM_LOG")) ((getenv "DXFMAKRO")) (".")) + "/ks_pruefung.csv")) + (setq fh (open fpath "w")) + (if (null fh) (progn (alert (strcat "Kann Ausgabedatei nicht schreiben: " fpath)) (exit))) + (write-line "Block;KS_EIN_2D;KS_EIN_3D;EIN_diff;KS_AUS_2D;KS_AUS_3D;AUS_diff;dxyz_2D(aus-ein);dxyz_3D(aus-ein);Status" fh) + (setq n 0) + (foreach r rows (write-line r fh) (setq n (1+ n))) + (close fh) + (princ (strcat "\n>>> KS-Pruefung fertig: " (itoa n) " Bloecke -> " fpath)) + (princ (strcat "\n (Spalten: KS_EIN/KS_AUS je 2D u. 3D, *_diff=groesste Komponentenabweichung, dxyz=KS_AUS-KS_EIN, Status)")) + (princ) +) + +(princ "\n>>> ks_pruefung.lsp geladen - Befehl: KS_PRUEFEN") +(princ) diff --git a/menu/SSG_LIB.mnu b/menu/SSG_LIB.mnu index 660bf73..c5977b8 100644 --- a/menu/SSG_LIB.mnu +++ b/menu/SSG_LIB.mnu @@ -141,6 +141,7 @@ [Foerderer-Linienzug]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_linienzug.lsp")) TEST_LINIENZUG [Omniflo]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_omniflo.lsp")) TEST_OMNIFLO [Gefaellestrecke]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_gefaellestrecke.lsp")) TEST_GEFAELLESTRECKE +[KS 2D/3D pruefen (CSV)]^C^C(load (strcat (getenv "DXFMAKRO") "/Lisp/ks_pruefung.lsp")) KS_PRUEFEN [<-Export CSV/Sivas ALL]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_export_all.lsp")) TEST_EXPORT_ALL ***DOUBLECLICK