diff --git a/Lisp/vf_etage.lsp b/Lisp/vf_etage.lsp index 8889bf8..5db7656 100644 --- a/Lisp/vf_etage.lsp +++ b/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 - (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) ) ) diff --git a/Lisp/vf_standard.lsp b/Lisp/vf_standard.lsp index 2c80281..6119310 100644 --- a/Lisp/vf_standard.lsp +++ b/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 - (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)))) )