[REFACTOR] VF: KS-Extraktion in init-Bibliotheken ueber vf-element-masse

Der Block 'Temp-Objekt einfuegen -> extract-ks-from-block -> KS_EIN/KS_AUS ->
(dx dy dz)-Diff -> Temp loeschen' stand in init-bibliothek 4x (AS/ES/Bogen
auf/ab) und in init-bibliothek-etage 4x (AS30/ES30/Gefaellebogen l/r).

vf-element-masse (vf_core) kapselt exakt diese Sequenz bereits - init nutzt sie
jetzt statt eigener Kopien. Bogen-Tabellen-Eintraege via (cons w m) == altes
(list w dx dy dz), get-bogen-mass (cdr item) unveraendert. Etage-Fallbacks +
Block-vs-KS-Warnungen erhalten. Gemessene Bloecke identisch (_rechts bei Etage,
_links bei Standard).

-120 Zeilen netto. Paren-Balance geprueft.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

Lisp/vf_etage.lsp

@@ -50,7 +50,7 @@
 ;; TEIL 2: BIBLIOTHEK INITIALISIEREN (ETAGE-SPEZIFISCH)
 ;; ============================================================
 (defun init-bibliothek-etage ( / temp-obj ks-data ks-ein-pos ks-aus-pos
-                                  gefaelle-blockname as30-blk es30-blk)
+                                  gefaelle-blockname as30-blk es30-blk m)
   (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" (ssg-ils-blockname "AS_Element_30_rechts"))))
     (setq *etage-lib-initialized* nil))
   (if *etage-lib-initialized*
@@ -63,36 +63,18 @@
         (init-bibliothek)
       )
 
-      ;; AS_30_rechts Masse extrahieren
+      ;; AS_30_rechts Masse extrahieren (KS_EIN->KS_AUS (dx dy dz) via vf-element-masse)
       (princ (ssg-text "vfe-extrahiere-as30"))
       (setq as30-blk (ensure-block-loaded "AS_Element_30_rechts"))
       (ensure-block-loaded "AS_Element_30_links")
-      (if (tblsearch "BLOCK" as30-blk)
+      (setq m (if (tblsearch "BLOCK" as30-blk) (vf-element-masse "AS_Element_30_rechts")))
+      (if m
         (progn
-          (setq temp-obj (vla-InsertBlock modelspace
+          (setq etage-aus-dx (car m)  etage-aus-dz (caddr m))
-                           (vlax-3D-point '(0 0 0))
+          (princ (ssg-textf "vfe-as30-mass" (list (rtos etage-aus-dx 2 1) (rtos etage-aus-dz 2 1))))
-                           as30-blk 1.0 1.0 1.0 0))
-          (setq ks-data (extract-ks-from-block temp-obj))
-          (vla-Delete temp-obj)
-          (setq ks-ein-pos nil ks-aus-pos nil)
-          (foreach item ks-data
-            (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-            (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-          )
-          (if (and ks-ein-pos ks-aus-pos)
-            (progn
-              (setq etage-aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
-              (setq etage-aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
-              (princ (ssg-textf "vfe-as30-mass" (list (rtos etage-aus-dx 2 1) (rtos etage-aus-dz 2 1))))
-            )
-            (progn
-              (princ (ssg-text "vfe-warn-ks-fehlt-standard"))
-              (setq etage-aus-dx 525.8  etage-aus-dz -72.9)
-            )
-          )
         )
         (progn
-          (princ (ssg-text "vfe-warn-block-as30-fehlt"))
+          (princ (ssg-text (if (tblsearch "BLOCK" as30-blk) "vfe-warn-ks-fehlt-standard" "vfe-warn-block-as30-fehlt")))
           (setq etage-aus-dx 525.8  etage-aus-dz -72.9)
         )
       )
@@ -101,32 +83,14 @@
       (princ (ssg-text "vfe-extrahiere-es30"))
       (setq es30-blk (ensure-block-loaded "ES_Element_30_rechts"))
       (ensure-block-loaded "ES_Element_30_links")
-      (if (tblsearch "BLOCK" es30-blk)
+      (setq m (if (tblsearch "BLOCK" es30-blk) (vf-element-masse "ES_Element_30_rechts")))
+      (if m
         (progn
-          (setq temp-obj (vla-InsertBlock modelspace
+          (setq etage-ein-dx (car m)  etage-ein-dz (caddr m))
-                           (vlax-3D-point '(0 0 0))
+          (princ (ssg-textf "vfe-es30-mass" (list (rtos etage-ein-dx 2 1) (rtos etage-ein-dz 2 1))))
-                           es30-blk 1.0 1.0 1.0 0))
-          (setq ks-data (extract-ks-from-block temp-obj))
-          (vla-Delete temp-obj)
-          (setq ks-ein-pos nil ks-aus-pos nil)
-          (foreach item ks-data
-            (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-            (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-          )
-          (if (and ks-ein-pos ks-aus-pos)
-            (progn
-              (setq etage-ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
-              (setq etage-ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
-              (princ (ssg-textf "vfe-es30-mass" (list (rtos etage-ein-dx 2 1) (rtos etage-ein-dz 2 1))))
-            )
-            (progn
-              (princ (ssg-text "vfe-warn-ks-fehlt-standard"))
-              (setq etage-ein-dx 576.2  etage-ein-dz -54.6)
-            )
-          )
         )
         (progn
-          (princ (ssg-text "vfe-warn-block-es30-fehlt"))
+          (princ (ssg-text (if (tblsearch "BLOCK" es30-blk) "vfe-warn-ks-fehlt-standard" "vfe-warn-block-es30-fehlt")))
           (setq etage-ein-dx 576.2  etage-ein-dz -54.6)
         )
       )
@@ -135,30 +99,11 @@
       (setq gefaelle-blockname "Gefaellebogen_links_30_R500")
       (princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
       (setq gefaelle-blockname (ensure-block-loaded gefaelle-blockname))
-      (if (tblsearch "BLOCK" gefaelle-blockname)
+      (setq m (if (tblsearch "BLOCK" gefaelle-blockname) (vf-element-masse "Gefaellebogen_links_30_R500")))
+      (if m
+        (setq etage-gef-dx-links (car m)  etage-gef-dz-links (caddr m))
         (progn
-          (setq temp-obj (vla-InsertBlock modelspace
+          (princ (ssg-text (if (tblsearch "BLOCK" gefaelle-blockname) "vfe-warn-kein-ks-links" "vfe-warn-block-fehlt-links")))
-                           (vlax-3D-point '(0 0 0)) gefaelle-blockname 1.0 1.0 1.0 0))
-          (setq ks-data (extract-ks-from-block temp-obj))
-          (vla-Delete temp-obj)
-          (setq ks-ein-pos nil ks-aus-pos nil)
-          (foreach item ks-data
-            (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-            (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-          )
-          (if (and ks-ein-pos ks-aus-pos)
-            (progn
-              (setq etage-gef-dx-links (- (caar  ks-aus-pos) (caar  ks-ein-pos)))
-              (setq etage-gef-dz-links (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
-            )
-            (progn
-              (princ (ssg-text "vfe-warn-kein-ks-links"))
-              (setq etage-gef-dx-links 0.0  etage-gef-dz-links -10.0)
-            )
-          )
-        )
-        (progn
-          (princ (ssg-text "vfe-warn-block-fehlt-links"))
           (setq etage-gef-dx-links 0.0  etage-gef-dz-links -10.0)
         )
       )
@@ -168,30 +113,11 @@
       (setq gefaelle-blockname "Gefaellebogen_rechts_30_R500")
       (princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
       (setq gefaelle-blockname (ensure-block-loaded gefaelle-blockname))
-      (if (tblsearch "BLOCK" gefaelle-blockname)
+      (setq m (if (tblsearch "BLOCK" gefaelle-blockname) (vf-element-masse "Gefaellebogen_rechts_30_R500")))
+      (if m
+        (setq etage-gef-dx-rechts (car m)  etage-gef-dz-rechts (caddr m))
         (progn
-          (setq temp-obj (vla-InsertBlock modelspace
+          (princ (ssg-text (if (tblsearch "BLOCK" gefaelle-blockname) "vfe-warn-kein-ks-rechts" "vfe-warn-block-fehlt-rechts")))
-                           (vlax-3D-point '(0 0 0)) gefaelle-blockname 1.0 1.0 1.0 0))
-          (setq ks-data (extract-ks-from-block temp-obj))
-          (vla-Delete temp-obj)
-          (setq ks-ein-pos nil ks-aus-pos nil)
-          (foreach item ks-data
-            (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-            (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-          )
-          (if (and ks-ein-pos ks-aus-pos)
-            (progn
-              (setq etage-gef-dx-rechts (- (caar  ks-aus-pos) (caar  ks-ein-pos)))
-              (setq etage-gef-dz-rechts (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
-            )
-            (progn
-              (princ (ssg-text "vfe-warn-kein-ks-rechts"))
-              (setq etage-gef-dx-rechts 0.0  etage-gef-dz-rechts -10.0)
-            )
-          )
-        )
-        (progn
-          (princ (ssg-text "vfe-warn-block-fehlt-rechts"))
           (setq etage-gef-dx-rechts 0.0  etage-gef-dz-rechts -10.0)
         )
       )

Lisp/vf_standard.lsp

@@ -96,7 +96,7 @@
 ;; TEIL 3: BIBLIOTHEK INITIALISIEREN
 ;; ============================================================
 (defun init-bibliothek ( / temp-obj bogen-winkel ks-data ks-ein-pos ks-aus-pos
-                           dx dy dz bogen-name as-blk es-blk)
+                           dx dy dz bogen-name as-blk es-blk m)
   ;; "bereits initialisiert" nur, wenn das Flag gesetzt UND die Bogen-Tabelle
   ;; tatsaechlich befuellt ist. Sonst (Stuck-State: Flag gesetzt, aber bogen-auf
   ;; leer - z.B. nach einer fehlgeschlagenen Extraktion) neu initialisieren.
@@ -113,27 +113,16 @@
         (setq *ks-cache* nil)
         (princ (ssg-text "vfs-lib-init-start"))
 
-      ;; AS_90 Masse extrahieren
+      ;; AS_90 Masse extrahieren (KS_EIN->KS_AUS als (dx dy dz) via vf-element-masse)
       (princ (ssg-text "vfs-extrahiere-aus"))
       (setq as-blk (ensure-block-loaded "AS_Element_90_links"))
       (ensure-block-loaded "AS_Element_90_rechts")
       (if (tblsearch "BLOCK" as-blk)
         (progn
-          (setq temp-obj (vla-InsertBlock modelspace
+          (setq m (vf-element-masse "AS_Element_90_links"))
-                           (vlax-3D-point '(0 0 0))
+          (if m
-                           as-blk 1.0 1.0 1.0 0))
-          (setq ks-data (extract-ks-from-block temp-obj))
-          (vla-Delete temp-obj)
-          (setq ks-ein-pos nil ks-aus-pos nil)
-          (foreach item ks-data
-            (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-            (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-          )
-          (if (and ks-ein-pos ks-aus-pos)
             (progn
-              (setq aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
+              (setq aus-dx (car m) aus-dy (cadr m) aus-dz (caddr m))
-              (setq aus-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
-              (setq aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
               (princ (ssg-textf "vfs-as90-mass" (list (rtos aus-dx 2 0) (rtos aus-dz 2 0))))
             )
             (princ (ssg-text "vfs-fehler-ks-as90"))
@@ -148,21 +137,10 @@
       (ensure-block-loaded "ES_Element_90_rechts")
       (if (tblsearch "BLOCK" es-blk)
         (progn
-          (setq temp-obj (vla-InsertBlock modelspace
+          (setq m (vf-element-masse "ES_Element_90_links"))
-                           (vlax-3D-point '(0 0 0))
+          (if m
-                           es-blk 1.0 1.0 1.0 0))
-          (setq ks-data (extract-ks-from-block temp-obj))
-          (vla-Delete temp-obj)
-          (setq ks-ein-pos nil ks-aus-pos nil)
-          (foreach item ks-data
-            (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-            (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-          )
-          (if (and ks-ein-pos ks-aus-pos)
             (progn
-              (setq ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
+              (setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m))
-              (setq ein-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
-              (setq ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
               (princ (ssg-textf "vfs-es90-mass" (list (rtos ein-dx 2 0) (rtos ein-dz 2 0))))
             )
             (princ (ssg-text "vfs-fehler-ks-es90"))
@@ -180,25 +158,13 @@
       (foreach w bogen-winkel
         ;; Aufwaertsbogen
         (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) "_TEF_rechts"))
-        (setq bogen-name (ensure-block-loaded bogen-name))
+        (if (tblsearch "BLOCK" (ensure-block-loaded bogen-name))
-        (if (tblsearch "BLOCK" bogen-name)
           (progn
-            (setq temp-obj (vla-InsertBlock modelspace
+            (setq m (vf-element-masse bogen-name))
-                             (vlax-3D-point '(0 0 0)) bogen-name 1.0 1.0 1.0 0))
+            (if m
-            (setq ks-data (extract-ks-from-block temp-obj))
-            (vla-Delete temp-obj)
-            (setq ks-ein-pos nil ks-aus-pos nil)
-            (foreach item ks-data
-              (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-              (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-            )
-            (if (and ks-ein-pos ks-aus-pos)
               (progn
-                (setq dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
+                (setq bogen-auf (cons (cons w m) bogen-auf))
-                (setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
+                (princ (ssg-textf "vfs-bogen-auf-ok" (list (itoa w) (rtos (car m) 2 0) (rtos (caddr m) 2 0))))
-                (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
-                (setq bogen-auf (cons (list w dx dy dz) bogen-auf))
-                (princ (ssg-textf "vfs-bogen-auf-ok" (list (itoa w) (rtos dx 2 0) (rtos dz 2 0))))
               )
               (princ (ssg-textf "vfs-bogen-auf-ks-fehlt" (list (itoa w))))
             )
@@ -207,25 +173,13 @@
         )
         ;; Abwaertsbogen
         (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) "_TEF_rechts"))
-        (setq bogen-name (ensure-block-loaded bogen-name))
+        (if (tblsearch "BLOCK" (ensure-block-loaded bogen-name))
-        (if (tblsearch "BLOCK" bogen-name)
           (progn
-            (setq temp-obj (vla-InsertBlock modelspace
+            (setq m (vf-element-masse bogen-name))
-                             (vlax-3D-point '(0 0 0)) bogen-name 1.0 1.0 1.0 0))
+            (if m
-            (setq ks-data (extract-ks-from-block temp-obj))
-            (vla-Delete temp-obj)
-            (setq ks-ein-pos nil ks-aus-pos nil)
-            (foreach item ks-data
-              (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
-              (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
-            )
-            (if (and ks-ein-pos ks-aus-pos)
               (progn
-                (setq dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
+                (setq bogen-ab (cons (cons w m) bogen-ab))
-                (setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
+                (princ (ssg-textf "vfs-bogen-ab-ok" (list (itoa w) (rtos (car m) 2 0) (rtos (caddr m) 2 0))))
-                (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
-                (setq bogen-ab (cons (list w dx dy dz) bogen-ab))
-                (princ (ssg-textf "vfs-bogen-ab-ok" (list (itoa w) (rtos dx 2 0) (rtos dz 2 0))))
               )
               (princ (ssg-textf "vfs-bogen-ab-ks-fehlt" (list (itoa w))))
             )