From 676224b172e56c7665cdecdbc8f90ab9798753e6 Mon Sep 17 00:00:00 2001
From: Michael Stangl <m.stangl@schoenenberger.de>
Date: Mon, 1 Jun 2026 10:23:43 +0200
Subject: [PATCH] =?UTF-8?q?cache=20der=20aus=20den=20Koordinaten=20K=5FAUS?=
 =?UTF-8?q?=20und=20K=5FEIN=20geladenen=20Punkte=20eingef=C3=BChrt?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 Lisp/VarioFoerderer.lsp | 66 +++++++++++++++++++++++++++++++++++++----
 1 file changed, 61 insertions(+), 5 deletions(-)

diff --git a/Lisp/VarioFoerderer.lsp b/Lisp/VarioFoerderer.lsp
index a1cb886..73ed6b3 100644
--- a/Lisp/VarioFoerderer.lsp
+++ b/Lisp/VarioFoerderer.lsp
@@ -46,6 +46,7 @@
 (setq *lib-initialized* nil)
 (setq *bogen-cache-loaded* nil)
 (setq *modul-cache* nil)
+(setq *ks-cache* nil)  ;; KS-Daten Cache: (("blockname" ("KS_EIN" ...) ("KS_AUS" ...)) ...)
 
 ;; ============================================================
 ;; TEIL 3: HILFSFUNKTIONEN
@@ -72,6 +73,30 @@
   (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1)))
 )
 
+;; KS-Daten relativ zu einem Basispunkt machen (fuer Cache)
+(defun ks-relativize (ks-data base-pt)
+  (mapcar '(lambda (item)
+    (list (car item)
+          (mapcar '(lambda (pt)
+            (list (- (car pt) (car base-pt))
+                  (- (cadr pt) (cadr base-pt))
+                  (- (caddr pt) (caddr base-pt))))
+            (cadr item))))
+    ks-data)
+)
+
+;; Relative KS-Daten auf einen Basispunkt anwenden
+(defun ks-absolutize (ks-rel base-pt)
+  (mapcar '(lambda (item)
+    (list (car item)
+          (mapcar '(lambda (pt)
+            (list (+ (car pt) (car base-pt))
+                  (+ (cadr pt) (cadr base-pt))
+                  (+ (caddr pt) (caddr base-pt))))
+            (cadr item))))
+    ks-rel)
+)
+
 ;; ============================================================
 ;; TEIL 4: KS_EIN/KS_AUS EXTRAKTION (KERN-FUNKTION)
 ;; ============================================================
@@ -79,13 +104,14 @@
 ;; Grad-Zeichen für Blocknamen
 (setq grad-zeichen (chr 176))
 
-;; Extrahiert KS_EIN und KS_AUS aus einem Block
+;; Extrahiert KS_EIN und KS_AUS aus einem Block (intern, ohne Cache)
 ;; Rückgabe: (("KS_EIN" (origin x-end y-end z-end))
 ;;            ("KS_AUS" (origin x-end y-end z-end)))
-(defun extract-ks-from-block (block-obj / sub-entities sub-obj ks-results
-                               ks-ref inner-entities inner-obj origin x-end y-end z-end
-                               line-start line-end axis line-len line-vec)
-  (dbgf "extract-ks-from-block")
+(defun extract-ks-from-block-raw (block-obj / sub-entities sub-obj ks-results
+                                   ks-ref inner-entities inner-obj origin x-end y-end z-end
+                                   line-start line-end axis line-len line-vec)
+  (dbgf "extract-ks-from-block-raw")
+  (dbg block-obj)
   (setq ks-results '())
   
   ;; Block explodieren
@@ -144,6 +170,35 @@
   (dbgreturn ks-results)
 )
 
+;; Gecachte Version: prueft *ks-cache* anhand Blockname
+;; Beim ersten Aufruf wird explodiert und das Ergebnis relativ
+;; zum Einfuegepunkt im Cache gespeichert. Weitere Aufrufe
+;; desselben Blocktyps liefern die Daten ohne Explode.
+(defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel)
+  (dbgf "extract-ks-from-block")
+  (setq blockname (vla-get-Name block-obj))
+  (setq insert-pt (vlax-safearray->list
+                     (vlax-variant-value (vla-get-InsertionPoint block-obj))))
+  (setq cached (assoc blockname *ks-cache*))
+  (if cached
+    (progn
+      (dbg (strcat "  KS-Cache HIT: " blockname))
+      (dbgreturn (ks-absolutize (cdr cached) insert-pt))
+    )
+    (progn
+      (dbg (strcat "  KS-Cache MISS: " blockname))
+      (setq result (extract-ks-from-block-raw block-obj))
+      (if result
+        (progn
+          (setq ks-rel (ks-relativize result insert-pt))
+          (setq *ks-cache* (cons (cons blockname ks-rel) *ks-cache*))
+        )
+      )
+      (dbgreturn result)
+    )
+  )
+)
+
 ;; ============================================================
 ;; TEIL 5: PUNKTE-AUSWAHL MIT Z-HÖHE (HIER EINFÜGEN!)
 ;; ============================================================
@@ -197,6 +252,7 @@
       (dbgreturn t)
     )
     (progn
+      (setq *ks-cache* nil)
       (princ "\n  Lade Blockdefinitionen aus Bibliothek...")
       
       (if (findfile koordinaten-lib)