[MERGE] Merge für 30 Grad AE / EE

Lisp/ks_pruefung.lsp

@@ -0,0 +1,131 @@
+;; ============================================================
+;; 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)

Lisp/ssg_core.lsp

@@ -436,6 +436,40 @@
 (defun ssg-ils-block-laden (blockname / )
   (ssg-ils-block-laden-dim blockname (ssg-ils-dim-aktuell)))
 
+;; ------------------------------------------------------------
+;; AUTO-LAYER: INSERT-Referenz auf die eigene Ebene ihres Blocks setzen
+;; ------------------------------------------------------------
+;; Ermittelt die "eigene" Ebene eines geladenen Blocks (haeufigste Ebene ausser
+;; "0" seiner Definition-Entities); nil, wenn nur "0".
+(defun ssg-ils-block-ebene (realname / blocks blk e lay pair counts best best-n c)
+  (if (and realname (tblsearch "BLOCK" realname))
+    (progn
+      (setq blocks (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
+      (setq blk (vla-item blocks realname))
+      (setq counts '())
+      (vlax-for e blk
+        (setq lay (vla-get-Layer e))
+        (if (and lay (/= lay "0"))
+          (progn
+            (setq pair (assoc lay counts))
+            (if pair
+              (setq counts (subst (cons lay (1+ (cdr pair))) pair counts))
+              (setq counts (cons (cons lay 1) counts))))))
+      (setq best nil best-n 0)
+      (foreach c counts (if (> (cdr c) best-n) (setq best (car c) best-n (cdr c))))
+      best)
+    nil))
+
+;; Setzt die INSERT-Referenz (VLA-Objekt) auf die eigene Ebene ihres Blocks
+;; (legt die Ebene an, falls noetig). No-op, wenn keine eigene Ebene ermittelbar.
+(defun ssg-ils-block-auf-ebene (obj realname / eb)
+  (setq eb (ssg-ils-block-ebene realname))
+  (if (and eb obj)
+    (progn
+      (if (not (tblsearch "LAYER" eb)) (ssg-make-layer eb 7 nil))
+      (vl-catch-all-apply (function (lambda () (vla-put-Layer obj eb))))))
+  obj)
+
 ;; ------------------------------------------------------------
 ;; DIMENSIONS-XDATA (2D/3D) je Block - App "SSG_DIM"
 ;; ------------------------------------------------------------

Lisp/vf_core.lsp

@@ -480,6 +480,7 @@
   (setq block-obj (vla-InsertBlock modelspace
                     (vlax-3D-point '(0 0 0))
                     blockname 1.0 1.0 1.0 0))
+  (ssg-ils-block-auf-ebene block-obj blockname)
   (if (> (abs hz) 0.0001)
     (vla-TransformBy block-obj (vlax-tmatrix
       (list (list chv (- shv) 0 0)
@@ -557,6 +558,7 @@
   (setq block-obj (vla-InsertBlock modelspace
                     (vlax-3D-point '(0 0 0))
                     blockname 1.0 1.0 1.0 0))
+  (ssg-ils-block-auf-ebene block-obj blockname)
   ;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
   (setq f-ein  (ks-frame-extract ks-ein-raw)
         f-aus  (ks-frame-extract ks-aus-raw))
@@ -645,6 +647,7 @@
   (setq block-obj (vla-InsertBlock modelspace
                     (vlax-3D-point '(0 0 0))
                     blockname 1.0 1.0 1.0 0))
+  (ssg-ils-block-auf-ebene block-obj blockname)
   ;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
   (setq f-ein  (ks-frame-extract ks-ein-raw)
         f-aus  (ks-frame-extract ks-aus-raw))
@@ -801,6 +804,7 @@
       (setq block-obj (vla-InsertBlock modelspace
                         (vlax-3D-point '(0 0 0))
                         blockname scale 1.0 1.0 0))
+      (ssg-ils-block-auf-ebene block-obj blockname)
       (setq matrix (list
         (list (* chv cvv) (- shv) (* chv svv) 0)
         (list (* shv cvv)   chv   (* shv svv) 0)
@@ -892,6 +896,7 @@
       (setq block-obj (vla-InsertBlock modelspace
                         (vlax-3D-point '(0 0 0))
                         blockname 1.0 1.0 1.0 0))
+      (ssg-ils-block-auf-ebene block-obj blockname)
       (setq matrix (list
         (list (* chv cvv) (- shv) (* chv svv) 0)
         (list (* shv cvv)   chv   (* shv svv) 0)