Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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>
This commit is contained in:
Michael Stangl
2026-08-29 07:59:08 +02:00
parent aa71d463cb
commit 6cf54f646b
2 changed files with 38 additions and 158 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/vf_etage.lsp
+20 -94
View File
@@ -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
(vlax-3D-point '(0 0 0))
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)
)
)
(setq etage-aus-dx (car m) etage-aus-dz (caddr m))
(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-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
(vlax-3D-point '(0 0 0))
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)
)
)
(setq etage-ein-dx (car m) etage-ein-dz (caddr m))
(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-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
(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"))
(princ (ssg-text (if (tblsearch "BLOCK" gefaelle-blockname) "vfe-warn-kein-ks-links" "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
(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"))
(princ (ssg-text (if (tblsearch "BLOCK" gefaelle-blockname) "vfe-warn-kein-ks-rechts" "vfe-warn-block-fehlt-rechts")))
(setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
)
)
Lisp/vf_standard.lsp
+18 -64
View File
@@ -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
(vlax-3D-point '(0 0 0))
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)
(setq m (vf-element-masse "AS_Element_90_links"))
(if m
(progn
(setq aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(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))))
(setq aus-dx (car m) aus-dy (cadr m) aus-dz (caddr m))
(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
(vlax-3D-point '(0 0 0))
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)
(setq m (vf-element-masse "ES_Element_90_links"))
(if m
(progn
(setq ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(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))))
(setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m))
(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" bogen-name)
(if (tblsearch "BLOCK" (ensure-block-loaded bogen-name))
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) bogen-name 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)
(setq m (vf-element-masse bogen-name))
(if m
(progn
(setq dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(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))))
(setq bogen-auf (cons (cons w m) bogen-auf))
(princ (ssg-textf "vfs-bogen-auf-ok" (list (itoa w) (rtos (car m) 2 0) (rtos (caddr m) 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" bogen-name)
(if (tblsearch "BLOCK" (ensure-block-loaded bogen-name))
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) bogen-name 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)
(setq m (vf-element-masse bogen-name))
(if m
(progn
(setq dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(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))))
(setq bogen-ab (cons (cons w m) bogen-ab))
(princ (ssg-textf "vfs-bogen-ab-ok" (list (itoa w) (rtos (car m) 2 0) (rtos (caddr m) 2 0))))
)
(princ (ssg-textf "vfs-bogen-ab-ks-fehlt" (list (itoa w))))
)