132 lines
6.2 KiB
Common Lisp
132 lines
6.2 KiB
Common Lisp
;; ============================================================
|
|
;; 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))
|
|
|
|
;; i-te Komponente (0=x,1=y,2=z) eines Punktes als String, oder "-"
|
|
(defun ksp-comp (p i)
|
|
(if p (rtos (nth i p) 2 3) "-"))
|
|
|
|
;; (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-comp d2 0) ";" (ksp-comp d2 1) ";" (ksp-comp d2 2) ";"
|
|
(ksp-comp d3 0) ";" (ksp-comp d3 1) ";" (ksp-comp d3 2) ";" 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;dx_2D;dy_2D;dz_2D;dx_3D;dy_3D;dz_3D;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)"))
|
|
;; CSV direkt mit dem Standardprogramm (z.B. Excel) oeffnen; fehlertolerant.
|
|
(vl-catch-all-apply
|
|
(function (lambda ()
|
|
(startapp "cmd.exe"
|
|
(strcat "/c start \"\" \"" (vl-string-translate "/" "\\" fpath) "\"")))))
|
|
(princ)
|
|
)
|
|
|
|
(princ "\n>>> ks_pruefung.lsp geladen - Befehl: KS_PRUEFEN")
|
|
(princ)
|