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

die Variofoerderer.lsp umstruktiert. Gefaellstrecke kann nach einem Linienzug modeliert werden. Bei Kreiselinstert wurde die Blöck in 2D Pfad geladen.

Browse Source
This commit is contained in:
Yuelin Wang
2026-06-19 14:02:45 +02:00
parent fc38d4740f
commit cab9db526e
8 changed files with 3392 additions and 2613 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/EtageVarioFoerderer.lsp
+6 -1110
View File
File diff suppressed because it is too large Load Diff
Lisp/Gefaellestrecke.lsp
+1200 -133
View File
File diff suppressed because it is too large Load Diff
Lisp/KreiselInsert.lsp
+4 -4
View File
@@ -16,19 +16,19 @@
(setq #Eckrad_LetzteNr 0)
)
;; Block-Pfad
;; Block-Pfad (gesetzt durch bin/setenv.bat -> DXFM_BLOCKS = data\ils\2D)
(setq block-pfad (getenv "DXFM_BLOCKS"))
(if (or (null block-pfad) (= block-pfad ""))
(progn
(setq block-pfad "C:/Users/y.wang/Documents/dxfmakros/Blocks/")
(alert (strcat "Umgebungsvariable DXFM_BLOCKS nicht gefunden.\nNutze Standardpfad: " block-pfad))
(alert "DXFM_BLOCKS nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.")
(exit)
)
(setq block-pfad (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" block-pfad)) "/"))
)
(setq *block-path* block-pfad)
(princ (strcat "\nBlock-Pfad aktiv: " block-pfad))
(princ (strcat "\nBlock-Pfad: " block-pfad))
;; Kreisel-Geometrie-Konstanten (aus Config oder Fallback)
(setq *kreisel-durchmesser* (ssg-cfg-or "kreisel" "durchmesser" 800.0))
Lisp/VarioFoerderer.lsp
+5 -1366
View File
File diff suppressed because it is too large Load Diff
Lisp/vf_core.lsp
+894
View File
@@ -0,0 +1,894 @@
;; ============================================================
;; VF_CORE - VarioFoerderer Kern-Modul
;; Version: 26.0
;; Architektur: Plugin/Dispatcher
;; Laedt automatisch: vf_standard.lsp, vf_etage.lsp
;; Befehle: VarioFoerderer (Alias: FOERDERANLAGE, ETAGEVARIOFOERDERER)
;; ============================================================
(vl-load-com)
;; ============================================================
;; TEIL 1: ABHAENGIGKEITEN
;; ============================================================
(if (getenv "DXFM_BLOCKS")
(setq modul-pfad (strcat (getenv "DXFM_BLOCKS") "/"))
(progn
(alert "Umgebungsvariable DXFM_BLOCKS nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.")
(exit)
)
)
(setq block-pfad modul-pfad)
(if (not *ssg-core-loaded*)
(if (getenv "DXFM_LISP")
(progn
(load (strcat (getenv "DXFM_LISP") "/ssg_core.lsp"))
(ssg-load-config)
(setq *ssg-core-loaded* t)
)
(alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.")
)
)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq modelspace (vla-get-ModelSpace doc))
;; ============================================================
;; TEIL 2: TYP-REGISTRY
;; ============================================================
(if (null *vf-typ-registry*) (setq *vf-typ-registry* nil))
(if (null *vf-vorauswahl-typ*) (setq *vf-vorauswahl-typ* nil))
;; Registriert einen Foerderanlagen-Typ.
;; berechne-fn: '(lambda (deltaL deltaH richtung seite) ...)
;; Ruft init-Bibliothek und Winkelberechnung auf.
;; Gibt zurueck: (list best-winkel best-L_GF best-L_VF ergebnis-liste)
;; einfuege-fn: '(lambda (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite) ...)
;; Fuegt alle Bloecke ein. Gibt endpunkt zurueck.
(defun vf-typ-registrieren (typ-name berechne-fn einfuege-fn beschreibung)
(if (assoc typ-name *vf-typ-registry*)
(princ (strcat "\n Typ '" typ-name "' bereits registriert."))
(setq *vf-typ-registry*
(append *vf-typ-registry*
(list (list typ-name berechne-fn einfuege-fn beschreibung))))
)
)
;; ============================================================
;; TEIL 3: GLOBALE VARIABLEN
;; ============================================================
(if (null #VF_LetzteNr) (setq #VF_LetzteNr 0))
(setq *library-loaded* nil)
(setq *ks-cache* nil)
(setq grad-zeichen (chr 176))
;; 26 Attribut-Definitionen fuer VF_*-Block (alle Typen)
(setq *vf-attrib-defs*
'(("NUMMER" "0")
("MONTAGEHOEHE_m" "0.000")
("HOEHE_VON" "0")
("HOEHE_BIS" "0")
("DELTA_H" "0")
("DELTA_L" "0")
("L_VF_m" "0.000")
("L_GF_m" "0.000")
("ANTRIEBFAHRTRICHTUNG" "Auf")
("WINKEL" "0")
("ANZAHL_SEPARATOR" "2")
("ANZAHL_SCANNER" "0")
("TYP" "standard")
("SEITE" "rechts")
("GF_Bogen_L_90" "0")
("GF_Bogen_L_60" "0")
("GF_Bogen_L_30" "0")
("GF_Bogen_R_90" "0")
("GF_Bogen_R_60" "0")
("GF_Bogen_R_30" "0")
("VF_Bogen_A_90" "0")
("VF_Bogen_A_60" "0")
("VF_Bogen_A_30" "0")
("VF_Bogen_I_90" "0")
("VF_Bogen_I_60" "0")
("VF_Bogen_I_30" "0")))
;; ============================================================
;; TEIL 4: HILFSFUNKTIONEN
;; ============================================================
(defun vec-length (v)
(sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v)))))
(defun ks-line-axis (len)
(cond
((and (> len 0.5) (< len 1.5)) "X")
((and (> len 99) (< len 101)) "X")
((and (> len 1.5) (< len 2.5)) "Y")
((and (> len 2.5) (< len 3.5)) "Z")
(t nil)))
(defun fmt (x)
(if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---"))
(defun punkt-differenz (p1 p2)
(list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1))))
(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))
(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 5: KS_EIN/KS_AUS EXTRAKTION
;; ============================================================
(defun ensure-block-loaded (blockname / lib-datei block-datei temp-obj)
(if (not (tblsearch "BLOCK" blockname))
(progn
(if *library-loaded* (setq *library-loaded* nil))
(if (not *library-loaded*)
(progn
(setq lib-datei
(strcat (vl-string-translate "\\" "/" (getenv "DXFM_DATA"))
"/block_libraries/ils_library.dxf"))
(if (findfile lib-datei)
(progn
(princ "\n Lade ils_library.dxf ...")
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
lib-datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj)
(setq *library-loaded* T)
(princ " OK")
)
(princ (strcat "\n WARNUNG: Bibliothek nicht gefunden: " lib-datei))
)
)
)
(if (not (tblsearch "BLOCK" blockname))
(progn
(setq block-datei (strcat block-pfad blockname ".dxf"))
(if (findfile block-datei)
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
block-datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj)
)
(princ (strcat "\n FEHLER: Block nicht gefunden: " blockname))
)
)
)
)
)
)
(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)
(setq ks-results '())
(setq sub-entities (vlax-invoke block-obj 'Explode))
(foreach sub-obj sub-entities
(if (and (not (vlax-erased-p sub-obj))
(= (vla-get-ObjectName sub-obj) "AcDbBlockReference")
(or (= (vla-get-Name sub-obj) "KS_EIN")
(= (vla-get-Name sub-obj) "KS_AUS")))
(progn
(setq ks-ref (vla-get-Name sub-obj))
(setq inner-entities (vlax-invoke sub-obj 'Explode))
(setq origin nil x-end nil y-end nil z-end nil)
(foreach inner-obj inner-entities
(if (and (not (vlax-erased-p inner-obj))
(= (vla-get-ObjectName inner-obj) "AcDbLine"))
(progn
(setq line-start (vlax-safearray->list
(vlax-variant-value (vla-get-StartPoint inner-obj))))
(setq line-end (vlax-safearray->list
(vlax-variant-value (vla-get-EndPoint inner-obj))))
(setq line-vec (list (- (car line-end) (car line-start))
(- (cadr line-end) (cadr line-start))
(- (caddr line-end) (caddr line-start))))
(setq line-len (vec-length line-vec))
(setq axis (ks-line-axis line-len))
(if (null origin) (setq origin line-start))
(cond
((= axis "X") (setq x-end line-end))
((= axis "Y") (setq y-end line-end))
((= axis "Z") (setq z-end line-end))
)
)
)
(if (not (vlax-erased-p inner-obj)) (vla-Delete inner-obj))
)
(if (and origin x-end y-end z-end)
(setq ks-results (cons (list ks-ref (list origin x-end y-end z-end)) ks-results))
)
)
)
)
(foreach sub-obj sub-entities
(if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj))
)
ks-results
)
(defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel)
(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
(ks-absolutize (cdr cached) insert-pt)
(progn
(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*))
)
)
result
)
)
)
;; ============================================================
;; TEIL 6: PUNKTE-AUSWAHL
;; ============================================================
(defun get-3d-point-from-object (msg / ent obj pt variant)
(princ msg)
(princ "\n >> Objekt (Block) waehlen: ")
(setq ent (entsel))
(if ent
(progn
(setq obj (vlax-ename->vla-object (car ent)))
(if (vlax-property-available-p obj 'InsertionPoint)
(progn
(setq variant (vla-get-InsertionPoint obj))
(setq pt (vlax-safearray->list (vlax-variant-value variant)))
(princ (strcat "\n Block-Einfuegepunkt: X=" (rtos (car pt) 2 3)
" Y=" (rtos (cadr pt) 2 3) " Z=" (rtos (caddr pt) 2 3)))
)
(progn
(setq pt (cadr ent))
(princ (strcat "\n Punkt auf Objekt: Z=" (rtos (caddr pt) 2 2) " mm"))
)
)
)
(progn
(princ "\n Kein Objekt gewaehlt.")
(setq pt nil)
)
)
pt
)
(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt)
(princ msg)
(princ "\n >> 3D-Linie oder Polylinie waehlen: ")
(setq ent (entsel))
(if ent
(progn
(setq obj (vlax-ename->vla-object (car ent)))
(setq obj-name (vla-get-ObjectName obj))
(cond
((= obj-name "AcDbLine")
(setq start-pt (vlax-safearray->list
(vlax-variant-value (vla-get-StartPoint obj))))
(setq end-pt (vlax-safearray->list
(vlax-variant-value (vla-get-EndPoint obj))))
(princ (strcat "\n 3D-Linie:"
"\n Start: X=" (rtos (car start-pt) 2 2)
" Y=" (rtos (cadr start-pt) 2 2)
" Z=" (rtos (caddr start-pt) 2 2)
"\n Ende: X=" (rtos (car end-pt) 2 2)
" Y=" (rtos (cadr end-pt) 2 2)
" Z=" (rtos (caddr end-pt) 2 2)))
)
((= obj-name "AcDbPolyline")
(setq start-pt (vlax-curve-getStartPoint obj))
(setq end-pt (vlax-curve-getEndPoint obj))
(princ (strcat "\n 3D-Polylinie:"
"\n Start Z=" (rtos (caddr start-pt) 2 2)
" Ende Z=" (rtos (caddr end-pt) 2 2)))
)
(t
(princ "\n FEHLER: Keine Linie oder Polylinie ausgewaehlt!")
(setq start-pt nil end-pt nil)
)
)
)
(progn
(princ "\n Kein Objekt gewaehlt.")
(setq start-pt nil end-pt nil)
)
)
(if (and start-pt end-pt) (list start-pt end-pt) nil)
)
;; ============================================================
;; TEIL 7: VF-NUMMERIERUNG
;; ============================================================
(defun vf-next-number ( / ss i nr maxnr attribs)
(setq maxnr 0)
(setq ss (ssget "X" '((0 . "INSERT") (2 . "VF_*"))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq attribs (ssg-attrib-read (ssname ss i)))
(foreach pair attribs
(if (= (car pair) "NUMMER")
(progn
(setq nr (atoi (cdr pair)))
(if (> nr maxnr) (setq maxnr nr))
)
)
)
(setq i (1+ i))
)
)
)
(setq #VF_LetzteNr (max #VF_LetzteNr maxnr))
(setq #VF_LetzteNr (1+ #VF_LetzteNr))
#VF_LetzteNr
)
;; ============================================================
;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen)
;; ============================================================
(defun insert-block-by-ks (blockname einfuegepunkt / block-obj ks-data ks-ein ks-aus offset ausgang)
(if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
(progn
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
(exit)
)
)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(exit)
)
)
(princ (strcat "\n Fuege Block '" blockname "' ein..."))
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point einfuegepunkt)
blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block block-obj))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(if (and ks-ein ks-aus)
(progn
(setq offset (list (- (car einfuegepunkt) (car (car ks-ein)))
(- (cadr einfuegepunkt) (cadr (car ks-ein)))
(- (caddr einfuegepunkt) (caddr (car ks-ein)))))
(vla-Move block-obj
(vlax-3D-point (car ks-ein))
(vlax-3D-point einfuegepunkt))
(setq ausgang (list (+ (car (car ks-aus)) (car offset))
(+ (cadr (car ks-aus)) (cadr offset))
(+ (caddr (car ks-aus)) (caddr offset))))
(princ (strcat "\n KS_AUS: X=" (rtos (car ausgang) 2 2)
" Z=" (rtos (caddr ausgang) 2 2)))
ausgang
)
(progn
(princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!")
einfuegepunkt
)
)
)
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel /
rad matrix block-obj endpunkt scale)
(if (<= laenge 0.1)
(progn
(princ (strcat "\n Laenge=" (rtos laenge 2 2) " mm -> uebersprungen"))
startpunkt
)
(progn
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(exit)
)
)
(princ (strcat "\n Fuege '" blockname "' ein"
" (L=" (rtos laenge 2 2) " mm, W=" (itoa winkel) (chr 176) ")"))
(setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0)))
(setq rad (* winkel (/ pi 180.0)))
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname scale 1.0 1.0 0))
(setq matrix (list
(list (cos rad) 0 (sin rad) 0)
(list 0 1 0 0)
(list (- (sin rad)) 0 (cos rad) 0)
(list 0 0 0 1)
))
(vla-TransformBy block-obj (vlax-tmatrix matrix))
(vla-Move block-obj
(vlax-3D-point '(0 0 0))
(vlax-3D-point startpunkt))
(setq endpunkt (list (+ (car startpunkt) (* laenge (cos rad)))
(cadr startpunkt)
(+ (caddr startpunkt) (* (- (sin rad)) laenge))))
(princ (strcat "\n Endpunkt: Z=" (rtos (caddr endpunkt) 2 2)))
endpunkt
)
)
)
(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz /
rad matrix block-obj endpunkt)
(if (or (null startpunkt) (not (listp startpunkt)))
(progn
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
startpunkt
)
(progn
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(exit)
)
)
(princ (strcat "\n Fuege Block '" blockname "' ein"
" (Rotation " (itoa winkel) (chr 176) ")"))
(setq rad (* winkel (/ pi 180.0)))
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(setq matrix (list
(list (cos rad) 0 (sin rad) 0)
(list 0 1 0 0)
(list (- (sin rad)) 0 (cos rad) 0)
(list 0 0 0 1)
))
(vla-TransformBy block-obj (vlax-tmatrix matrix))
(vla-Move block-obj
(vlax-3D-point '(0 0 0))
(vlax-3D-point startpunkt))
(setq endpunkt (list
(+ (car startpunkt) (+ (* block-dx (cos rad)) (* block-dz (sin rad))))
(cadr startpunkt)
(+ (caddr startpunkt) (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz)))))
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2)
" Z=" (rtos (caddr endpunkt) 2 2)))
endpunkt
)
)
)
;; ============================================================
;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE
;; ============================================================
(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
deltaL deltaH deltaX deltaY richtung antwort)
(princ "\n\nEingabemodus waehlen:")
(princ "\n 1 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)")
(princ "\n 2 - Werte manuell eingeben")
(setq antwort (getstring "\nIhre Wahl (1/2): "))
(cond
((= antwort "1") (setq eingabe-modus "Linie"))
((= antwort "2") (setq eingabe-modus "Wert"))
(t (setq eingabe-modus "Linie") (princ "\nModus: 3D-Linie"))
)
(if (= eingabe-modus "Linie")
(progn
(princ "\n\n>>> MODUS: 3D-Linie auswaehlen <<<")
(command "BKS" "W")
(princ "\n BKS auf Weltkoordinaten gesetzt.")
(setq line-points
(get-line-start-end-points "\nBitte 3D-Linie fuer die Foerderstrecke auswaehlen:"))
(if (null line-points)
(progn (alert "Keine gueltige Linie ausgewaehlt!") (exit))
)
(setq startpunkt (car line-points)
endpunkt (cadr line-points))
(setq differenz (punkt-differenz startpunkt endpunkt))
(setq deltaX (abs (car differenz))
deltaY (abs (cadr differenz))
deltaH (caddr differenz))
(setq deltaL (max deltaX deltaY))
(princ (strcat "\n △L=" (rtos deltaL 2 2) " mm"
" △H=" (rtos deltaH 2 2) " mm"))
(if (>= deltaH 0)
(progn (setq richtung "Auf") (princ "\n Foerderrichtung: AUF"))
(progn (setq richtung "Ab") (setq deltaH (abs deltaH))
(princ "\n Foerderrichtung: AB"))
)
)
(progn
(princ "\n\n>>> MODUS: Manuelle Werteingabe <<<")
(setq deltaL (getreal "\n△L - Horizontale Distanz (mm): "))
(if (null deltaL) (setq deltaL 15000))
(setq deltaH (getreal "\n△H - Hoehenunterschied (mm): "))
(if (null deltaH) (setq deltaH 3000))
(princ "\nFoerderrichtung:\n 1 - AUF\n 2 - AB")
(setq antwort (getstring "\nIhre Wahl (1/2): "))
(if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf"))
(setq startpunkt (getpoint "\nStartpunkt fuer AUS_Element waehlen: "))
(if (null startpunkt) (setq startpunkt '(0 0 0)))
)
)
(list deltaL deltaH richtung startpunkt)
)
;; ============================================================
;; TEIL 10: VF_*-BLOCK-SYSTEM (gemeinsam fuer alle Typen)
;; ============================================================
(defun vf-make-label (vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
richtung best-winkel n-separator n-scanner startpunkt /
label-txt label-pt L_VF_str L_GF_str delta-sym)
(setq delta-sym (chr 916))
(setq L_VF_str (vl-string-subst "," "." (rtos (/ L_VF 1000.0) 2 3)))
(setq L_GF_str (vl-string-subst "," "." (rtos (/ L_GF 1000.0) 2 3)))
(setq label-txt
(strcat "VF" (itoa vf-nummer)
": von " (itoa (fix hoehe-von)) "mm bis " (itoa (fix hoehe-bis)) "mm, "
delta-sym "H=" (itoa (fix deltaH)) "mm; "
delta-sym "L=" (itoa (fix deltaL)) "mm; "
"VF:" L_VF_str "m; GF:" L_GF_str "m; "
richtung ": " (itoa best-winkel) grad-zeichen "; "
"Sep: " (itoa n-separator) "; Scan: " (itoa n-scanner)))
(setq label-pt (list
(+ (car startpunkt) (/ deltaL 2.0))
(- (cadr startpunkt) 200.0)
(caddr startpunkt)))
(entmake (list
'(0 . "TEXT")
(cons 8 "VF_Beschriftung")
'(67 . 0)
(cons 10 label-pt)
(cons 40 100.0)
(cons 1 label-txt)
(cons 50 0.0)
'(72 . 1)
'(73 . 2)
(cons 11 label-pt)
))
)
;; Erstellt VF_N-Block aus allen seit lastEnt erzeugten Entities.
;; Setzt Attributwerte entsprechend Typ, Seite und Geometrieparametern.
(defun vf-block-erstellen (anlage-typ seite vf-nummer n-scanner
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
richtung best-winkel startpunkt lastEnt
/ vf-bname vf-ss vf-e vf-insert montagehoehe-m attdef-ypos)
;; Beschriftungstext erzeugen
(vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
richtung best-winkel 2 n-scanner startpunkt)
;; Unsichtbare ATTDEFs am Startpunkt erzeugen
(setq attdef-ypos (cadr startpunkt))
(foreach def *vf-attrib-defs*
(entmake (list
'(0 . "ATTDEF")
'(8 . "0")
'(67 . 0)
(cons 10 (list (car startpunkt) attdef-ypos (caddr startpunkt)))
'(40 . 50.0)
(cons 1 (cadr def))
(cons 3 (car def))
(cons 2 (car def))
'(70 . 1)
))
(setq attdef-ypos (- attdef-ypos 100.0))
)
;; Alle neuen Entities seit lastEnt sammeln
(setq vf-ss (ssadd))
(if lastEnt
(setq vf-e (entnext lastEnt))
(setq vf-e (entnext))
)
(while vf-e
(ssadd vf-e vf-ss)
(setq vf-e (entnext vf-e))
)
;; Block erstellen, einfuegen, Attribute setzen
(setq vf-bname (strcat "VF_" (itoa vf-nummer)))
(if (> (sslength vf-ss) 0)
(progn
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(command "_.-BLOCK" vf-bname startpunkt vf-ss "")
(command "_.INSERT" vf-bname startpunkt 1.0 1.0 0.0)
(setvar "ATTREQ" 1)
(setq vf-insert (entlast))
(setq montagehoehe-m (/ (+ hoehe-von hoehe-bis) 2000.0))
(ssg-attrib-set-on vf-insert
(list
(cons "NUMMER" (itoa vf-nummer))
(cons "MONTAGEHOEHE_m" (rtos montagehoehe-m 2 3))
(cons "HOEHE_VON" (itoa (fix hoehe-von)))
(cons "HOEHE_BIS" (itoa (fix hoehe-bis)))
(cons "DELTA_H" (itoa (fix deltaH)))
(cons "DELTA_L" (itoa (fix deltaL)))
(cons "L_VF_m" (rtos (/ L_VF 1000.0) 2 3))
(cons "L_GF_m" (rtos (/ L_GF 1000.0) 2 3))
(cons "ANTRIEBFAHRTRICHTUNG" richtung)
(cons "WINKEL" (itoa best-winkel))
(cons "ANZAHL_SEPARATOR" "2")
(cons "ANZAHL_SCANNER" (itoa n-scanner))
(cons "TYP" anlage-typ)
(cons "SEITE" seite)
)
)
;; Typ-spezifische Bogen-Zaehler (Etage: 2x Gefaellebogen je Seite)
(if (= anlage-typ "etage")
(if (= seite "rechts")
(ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_R_60" "2")))
(ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_L_60" "2")))
)
)
(princ (strcat "\n>>> Block '" vf-bname "' erstellt und eingefuegt."))
)
(princ "\n>>> FEHLER: Keine Entities fuer Block gefunden!")
)
)
;; ============================================================
;; TEIL 11: UNTERMODULE LADEN
;; ============================================================
;; Guard: Untermodule nur beim ersten Laden von vf_core.lsp ausfuehren.
(if (not *ssg-vf-submodule-loaded*)
(if (getenv "DXFM_LISP")
(progn
(load (strcat (getenv "DXFM_LISP") "/vf_standard.lsp"))
(load (strcat (getenv "DXFM_LISP") "/vf_etage.lsp"))
(setq *ssg-vf-submodule-loaded* t)
)
(alert "DXFM_LISP nicht gesetzt - Untermodule konnten nicht geladen werden!")
)
)
;; ============================================================
;; TEIL 12: DISPATCHER c:VarioFoerderer
;; ============================================================
(defun c:VarioFoerderer ( / typ-eintr anlage-typ berechne-fn einfuege-fn
eingabe deltaL deltaH richtung startpunkt seite
ergebnis ergebnis-liste gueltige-winkel
best-winkel L_GF L_GF1 L_GF2 L_VF
idx eintrag wahl antwort verteilung-modus
n-scanner vf-nummer hoehe-von hoehe-bis lastEnt
staustrecke-basis)
(princ "\n=========================================")
(princ "\n VARIOFOERDERER GENERATOR v26.0")
(princ "\n=========================================")
;; 1. Typ aus Registry waehlen
(if (null *vf-typ-registry*)
(progn
(alert "Keine Typen registriert!\nvf_standard.lsp und vf_etage.lsp pruefen.")
(exit)
)
)
(if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
(progn
(setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
(princ (strcat "\n>>> Typ vorgewaehlt: " *vf-vorauswahl-typ*))
(setq *vf-vorauswahl-typ* nil)
)
(progn
(setq *vf-vorauswahl-typ* nil)
(princ "\n\nAnlagen-Typ waehlen:")
(setq idx 1)
(foreach eintr *vf-typ-registry*
(princ (strcat "\n " (itoa idx) " - " (nth 3 eintr)))
(setq idx (1+ idx))
)
(setq wahl (getint (strcat "\nIhre Wahl (1-"
(itoa (length *vf-typ-registry*)) ") [1]: ")))
(if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*)))
(setq wahl 1))
(setq typ-eintr (nth (1- wahl) *vf-typ-registry*))
)
)
(setq anlage-typ (nth 0 typ-eintr))
(setq berechne-fn (nth 1 typ-eintr))
(setq einfuege-fn (nth 2 typ-eintr))
(princ (strcat "\n>>> Typ: " anlage-typ))
;; 2. VF-Nummer automatisch ermitteln
(setq vf-nummer (vf-next-number))
(princ (strcat "\n>>> Naechste VF-Nummer: VF" (itoa vf-nummer)))
;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt)
(setq eingabe (vf-eingabe-abfragen))
(setq deltaL (nth 0 eingabe)
deltaH (nth 1 eingabe)
richtung (nth 2 eingabe)
startpunkt (nth 3 eingabe))
;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht)
(princ "\n\nSeite waehlen:")
(princ "\n 1 - Rechts")
(princ "\n 2 - Links")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(if (= antwort "2") (setq seite "links") (setq seite "rechts"))
(princ (strcat "\n>>> Seite: " seite))
;; 5. Typ-spezifische Berechnung (init + berechne)
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
(setq ergebnis-liste (cadddr ergebnis))
;; 6. Konfiguration (nach ssg_core-Init verfuegbar)
(setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
;; 7. Gueltige Winkel ermitteln
(setq gueltige-winkel
(mapcar 'car
(vl-remove-if-not
(function (lambda (e) (and (nth 3 e)
(numberp (nth 1 e)) (numberp (nth 2 e))
(>= (nth 1 e) 0) (>= (nth 2 e) 0))))
ergebnis-liste)))
(if (null gueltige-winkel)
(progn
(alert (strcat "Kein passender Winkel gefunden!\n"
"△L=" (rtos deltaL 2 0) " mm, △H="
(rtos deltaH 2 0) " mm, Richtung=" richtung))
(exit)
)
)
;; 8. Winkelauswahl (automatisch oder interaktiv)
(if (= (length gueltige-winkel) 1)
(progn
(setq best-winkel (car gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(princ (strcat "\n\n>>> Einziger gueltiger Winkel: "
(itoa best-winkel) (chr 176)))
)
(progn
(princ "\n\nMehrere gueltige Winkel verfuegbar. Bitte waehlen:")
(setq idx 1)
(foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste))
(princ (strcat "\n " (itoa idx) " - " (itoa w) (chr 176)
" (L_GF=" (rtos (nth 1 eintrag) 2 1)
" mm, L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
(setq idx (1+ idx))
)
(setq wahl (getint (strcat "Winkel waehlen (1-"
(itoa (length gueltige-winkel)) ") [1]: ")))
(if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
(setq wahl 1))
(setq best-winkel (nth (1- wahl) gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
)
)
(princ "\n\n=========================================")
(princ (strcat "\n>>> Winkel: " (itoa best-winkel) (chr 176)
" L_GF: " (rtos L_GF 2 2) " mm"
" L_VF: " (rtos L_VF 2 2) " mm"))
(princ "\n=========================================")
;; 9. L_GF Verteilung
(princ "\n\nVerteilung der Gefaellestrecken (vorne/hinten):")
(princ "\n 1 - Gleichmaessig (L_GF1 = L_GF2 = L_GF/2)")
(princ "\n 2 - Vorne Minimum, hinten Rest")
(princ "\n 3 - Hinten Minimum, vorne Rest")
(princ "\n 4 - Eigene Werte eingeben")
(setq verteilung-modus (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
(if (= verteilung-modus "") (setq verteilung-modus "1"))
(cond
((= verteilung-modus "1")
(setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
((= verteilung-modus "2")
(setq L_GF1 (float staustrecke-basis))
(setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "3")
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "4")
(setq L_GF1 (getreal (strcat "\nL_GF1 vorne (mm) ["
(rtos (/ L_GF 2.0) 2 2) "]: ")))
(if (null L_GF1) (setq L_GF1 (/ L_GF 2.0)))
(setq L_GF2 (max 0.0 (- L_GF L_GF1)))
(princ (strcat "\n L_GF2 hinten: " (rtos L_GF2 2 2) " mm")))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(princ (strcat "\n>>> L_GF1=" (rtos L_GF1 2 2)
" mm L_GF2=" (rtos L_GF2 2 2) " mm"))
;; 10. Anzahl Scanner
(setq n-scanner (getint "\nAnzahl Scanner [0]: "))
(if (null n-scanner) (setq n-scanner 0))
;; 11. Bestaetigung
(princ "\n\nMoechten Sie die Foerderanlage einfuegen?")
(princ "\n 1 - Ja, Module einfuegen\n 2 - Nein, abbrechen")
(setq antwort (getstring "\nIhre Wahl (1/2): "))
(if (= antwort "1")
(progn
;; Hoehenangaben fuer Attribute und Beschriftung
(setq hoehe-von (caddr startpunkt))
(setq hoehe-bis (cond
((= richtung "Auf") (+ hoehe-von deltaH))
((= richtung "Ab") (- hoehe-von deltaH))
(t hoehe-von)))
;; lastEnt VOR der Einfuegung merken
(setq lastEnt (entlast))
(if (and lastEnt
(= (cdr (assoc 0 (entget lastEnt))) "INSERT")
(= (cdr (assoc 66 (entget lastEnt))) 1))
(progn
(setq lastEnt (entnext lastEnt))
(while (and lastEnt
(/= (cdr (assoc 0 (entget lastEnt))) "SEQEND"))
(setq lastEnt (entnext lastEnt))
)
)
)
;; Typ-spezifische Einfuegung
(apply einfuege-fn
(list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite))
;; Gemeinsame VF_*-Block-Erstellung
(vf-block-erstellen anlage-typ seite vf-nummer n-scanner
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
richtung best-winkel startpunkt lastEnt)
(princ "\n=========================================")
)
(princ "\nVorgang abgebrochen.")
)
nil
)
;; ============================================================
;; START & ALIASES
;; ============================================================
(defun c:FOERDERANLAGE () (c:VarioFoerderer))
(defun c:ETAGEVARIOFOERDERER ()
(setq *vf-vorauswahl-typ* "etage")
(c:VarioFoerderer)
)
;; ssg-ensure-Flags fuer beide Wrapper-Dateien setzen,
;; damit ein zweiter Ladeaufruf uebersprungen wird.
(setq *ssg-VarioFoerderer-loaded* t)
(setq *ssg-EtageVarioFoerderer-loaded* t)
(princ "\n=========================================")
(princ "\n>>> VF_CORE v26.0 geladen <<<")
(princ "\n=========================================")
(princ "\nBefehle:")
(princ "\n VarioFoerderer - Foerderanlage erstellen (Typ-Auswahl)")
(princ "\n FOERDERANLAGE - Alias fuer VarioFoerderer")
(princ "\n ETAGEVARIOFOERDERER - Etage-Foerderanlage direkt")
(princ "\nRegistrierte Typen:")
(foreach eintr *vf-typ-registry*
(princ (strcat "\n " (car eintr) " - " (nth 3 eintr)))
)
(princ "\n=========================================")
(princ)
Lisp/vf_etage.lsp
+784
View File
@@ -0,0 +1,784 @@
;; ============================================================
;; VF_ETAGE - Etage VarioFoerderer (Typ: "etage")
;; Version: 26.0
;; Abhaengigkeit: vf_core.lsp muss zuerst geladen sein
;; Geometrie: AS/ES 30 Grad, direkt uebereinander (60 Grad Hz-Winkel)
;; 15-Schritt-Einfuegung
;; ============================================================
;; Sicherstellen, dass vf_core.lsp geladen ist
(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN"))))
(if (getenv "DXFM_LISP")
(load (strcat (getenv "DXFM_LISP") "/vf_core.lsp"))
(progn
(alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.")
(exit)
)
)
)
;; ============================================================
;; TEIL 1: ETAGE-SPEZIFISCHE GLOBALE VARIABLEN
;; ============================================================
(setq etage-aus-dx nil etage-aus-dz nil)
(setq etage-ein-dx nil etage-ein-dz nil)
(setq etage-gef-dx nil etage-gef-dy nil etage-gef-dz nil)
(setq etage-gef-dx-rechts nil etage-gef-dz-rechts nil)
(setq etage-gef-dx-links nil etage-gef-dz-links nil)
(setq *etage-lib-initialized* nil)
(setq FESTE_ETAGE_MITTE 1000)
(setq ETAGE_SCHRAEG_LAENGE 700)
(setq ETAGE_HZ_WINKEL 60)
;; ============================================================
;; TEIL 2: BIBLIOTHEK INITIALISIEREN (ETAGE-SPEZIFISCH)
;; ============================================================
(defun init-bibliothek-etage ( / temp-obj ks-data ks-ein-pos ks-aus-pos
gefaelle-blockname)
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts")))
(setq *etage-lib-initialized* nil))
(if *etage-lib-initialized*
(progn (princ "\n Etage-Bibliothek bereits initialisiert.") t)
(progn
(princ "\n Initialisiere Etage-Bibliothek...")
;; Standard-Bogen-Daten laden (bogen-auf/bogen-ab benoetigt)
(if (not *lib-initialized*)
(init-bibliothek)
)
;; AS_30_rechts Masse extrahieren
(princ "\n Extrahiere AS_30_rechts Masse...")
(ensure-block-loaded "_3D_AS_30_rechts")
(ensure-block-loaded "_3D_AS_30_links")
(if (tblsearch "BLOCK" "_3D_AS_30_rechts")
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"_3D_AS_30_rechts" 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 (strcat "\n AS_30_rechts: dx=" (rtos etage-aus-dx 2 1)
" mm, dz=" (rtos etage-aus-dz 2 1) " mm"))
)
(progn
(princ "\n WARNUNG: KS fehlt - Standardwerte")
(setq etage-aus-dx 525.8 etage-aus-dz -72.9)
)
)
)
(progn
(princ "\n WARNUNG: Block _3D_AS_30_rechts fehlt - Standardwerte")
(setq etage-aus-dx 525.8 etage-aus-dz -72.9)
)
)
;; ES_30_rechts Masse extrahieren
(princ "\n Extrahiere ES_30_rechts Masse...")
(ensure-block-loaded "_3D_ES_30_rechts")
(ensure-block-loaded "_3D_ES_30_links")
(if (tblsearch "BLOCK" "_3D_ES_30_rechts")
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"_3D_ES_30_rechts" 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 (strcat "\n ES_30_rechts: dx=" (rtos etage-ein-dx 2 1)
" mm, dz=" (rtos etage-ein-dz 2 1) " mm"))
)
(progn
(princ "\n WARNUNG: KS fehlt - Standardwerte")
(setq etage-ein-dx 576.2 etage-ein-dz -54.6)
)
)
)
(progn
(princ "\n WARNUNG: Block _3D_ES_30_rechts fehlt - Standardwerte")
(setq etage-ein-dx 576.2 etage-ein-dz -54.6)
)
)
;; Gefaellebogen_links_60 Masse extrahieren
(setq gefaelle-blockname
(strcat "Gefaellebogen_links_60" grad-zeichen "_R500"))
(princ (strcat "\n Extrahiere " gefaelle-blockname " Masse..."))
(ensure-block-loaded gefaelle-blockname)
(if (tblsearch "BLOCK" gefaelle-blockname)
(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 "\n WARNUNG: kein KS - Standardwerte (links)")
(setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0)
)
)
)
(progn
(princ "\n WARNUNG: Block fehlt - Standardwerte (links)")
(setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0)
)
)
(princ (strcat "\n Gefaellebogen links: dx=" (rtos etage-gef-dx-links 2 2)
" dz=" (rtos etage-gef-dz-links 2 2) " mm"))
;; Gefaellebogen_rechts_60 Masse extrahieren
(setq gefaelle-blockname
(strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500"))
(princ (strcat "\n Extrahiere " gefaelle-blockname " Masse..."))
(ensure-block-loaded gefaelle-blockname)
(if (tblsearch "BLOCK" gefaelle-blockname)
(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 "\n WARNUNG: kein KS - Standardwerte (rechts)")
(setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
)
)
)
(progn
(princ "\n WARNUNG: Block fehlt - Standardwerte (rechts)")
(setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
)
)
(princ (strcat "\n Gefaellebogen rechts: dx=" (rtos etage-gef-dx-rechts 2 2)
" dz=" (rtos etage-gef-dz-rechts 2 2) " mm"))
(setq *etage-lib-initialized* t)
(princ "\n Etage-Bibliothek erfolgreich initialisiert.")
t
)
)
)
;; ============================================================
;; TEIL 3: EINFUEGEFUNKTIONEN MIT KOMBINIERTER HZ+VERT ROTATION
;; ============================================================
;; Transformationsmatrix: Rz(hz) * Ry(vert)
;; [ cos(hz)*cos(vert) -sin(hz) cos(hz)*sin(vert) ]
;; [ sin(hz)*cos(vert) cos(hz) sin(hz)*sin(vert) ]
;; [ -sin(vert) 0 cos(vert) ]
(defun insert-hz-incl-scaled-block (blockname startpunkt laenge hz-winkel vert-winkel /
rad-hz rad-vert chz shz cv sv scale
matrix block-obj endpunkt)
(setq scale (/ (float laenge) 1000.0))
(setq rad-hz (* (float hz-winkel) (/ pi 180.0)))
(setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
(setq chz (cos rad-hz) shz (sin rad-hz))
(setq cv (cos rad-vert) sv (sin rad-vert))
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(exit)
)
)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0))
(setq matrix (list
(list (* chz cv) (- shz) (* chz sv) 0)
(list (* shz cv) chz (* shz sv) 0)
(list (- sv) 0 cv 0)
(list 0 0 0 1)
))
(vla-TransformBy block-obj (vlax-tmatrix matrix))
(vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt))
(setq endpunkt (list
(+ (car startpunkt) (* laenge chz cv))
(+ (cadr startpunkt) (* laenge shz cv))
(+ (caddr startpunkt) (* (- sv) laenge))))
(princ (strcat "\n HzIncl " blockname " L=" (rtos laenge 2 0)
" hz=" (rtos hz-winkel 2 0) (chr 176)
" v=" (rtos vert-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr endpunkt) 2 1)))
endpunkt
)
(defun insert-hz-rotated-block-with-ks (blockname startpunkt hz-winkel vert-winkel block-dx block-dz /
rad-hz rad-vert chz shz cv sv
matrix block-obj endpunkt)
(setq rad-hz (* (float hz-winkel) (/ pi 180.0)))
(setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
(setq chz (cos rad-hz) shz (sin rad-hz))
(setq cv (cos rad-vert) sv (sin rad-vert))
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(exit)
)
)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(setq matrix (list
(list (* chz cv) (- shz) (* chz sv) 0)
(list (* shz cv) chz (* shz sv) 0)
(list (- sv) 0 cv 0)
(list 0 0 0 1)
))
(vla-TransformBy block-obj (vlax-tmatrix matrix))
(vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt))
(setq endpunkt (list
(+ (car startpunkt) (+ (* block-dx chz cv) (* block-dz chz sv)))
(+ (cadr startpunkt) (+ (* block-dx shz cv) (* block-dz shz sv)))
(+ (caddr startpunkt) (+ (* (- sv) block-dx) (* cv block-dz)))))
(princ (strcat "\n HzRot " blockname
" hz=" (rtos hz-winkel 2 0) (chr 176)
" v=" (rtos vert-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr endpunkt) 2 1)))
endpunkt
)
(defun insert-hz-rotated-block-by-ks (blockname startpunkt hz-winkel vert-winkel /
rad-hz rad-vert chz shz cv sv
temp-obj block-obj ks-data ks-ein ks-aus
p-ein p-aus p-ein-rot p-aus-rot
offset ausgang)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(exit)
)
)
(setq rad-hz (* (float hz-winkel) (/ pi 180.0)))
(setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
(setq chz (cos rad-hz) shz (sin rad-hz))
(setq cv (cos rad-vert) sv (sin rad-vert))
;; KS-Positionen aus Cache (Block bei 0 Grad am Ursprung)
(setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
;; Block einfuegen und rotieren
(setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(vla-TransformBy block-obj (vlax-tmatrix
(list (list (* chz cv) (- shz) (* chz sv) 0)
(list (* shz cv) chz (* shz sv) 0)
(list (- sv) 0 cv 0)
(list 0 0 0 1))))
(if (and ks-ein ks-aus)
(progn
(setq p-ein (car ks-ein))
(setq p-aus (car ks-aus))
;; Rotation auf KS-Punkte anwenden: p' = Rz(hz)*Ry(vert) * p
(setq p-ein-rot
(list (+ (* chz cv (car p-ein)) (- (* shz (cadr p-ein))) (* chz sv (caddr p-ein)))
(+ (* shz cv (car p-ein)) (* chz (cadr p-ein)) (* shz sv (caddr p-ein)))
(+ (* (- sv) (car p-ein)) (* cv (caddr p-ein)))))
(setq p-aus-rot
(list (+ (* chz cv (car p-aus)) (- (* shz (cadr p-aus))) (* chz sv (caddr p-aus)))
(+ (* shz cv (car p-aus)) (* chz (cadr p-aus)) (* shz sv (caddr p-aus)))
(+ (* (- sv) (car p-aus)) (* cv (caddr p-aus)))))
;; Block verschieben: rotiertes KS_EIN auf startpunkt
(vla-Move block-obj
(vlax-3D-point p-ein-rot)
(vlax-3D-point startpunkt))
(setq offset (list (- (car startpunkt) (car p-ein-rot))
(- (cadr startpunkt) (cadr p-ein-rot))
(- (caddr startpunkt) (caddr p-ein-rot))))
(setq ausgang (list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n HzRotKS " blockname
" hz=" (rtos hz-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr ausgang) 2 1)))
ausgang
)
(progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt"))
startpunkt
)
)
)
(defun insert-hz-scaled-block-by-ks (blockname startpunkt laenge hz-winkel vert-winkel /
rad-hz rad-vert chz shz cv sv scale
temp-obj block-obj ks-data ks-ein ks-aus
p-ein p-aus p-ein-s p-aus-s
p-ein-rot p-aus-rot offset ausgang)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(exit)
)
)
(setq scale (/ (float laenge) 1000.0))
(setq rad-hz (* (float hz-winkel) (/ pi 180.0)))
(setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
(setq chz (cos rad-hz) shz (sin rad-hz))
(setq cv (cos rad-vert) sv (sin rad-vert))
;; KS bei Massstab 1
(setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
;; Block mit XScale einfuegen und rotieren
(setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0))
(vla-TransformBy block-obj (vlax-tmatrix
(list (list (* chz cv) (- shz) (* chz sv) 0)
(list (* shz cv) chz (* shz sv) 0)
(list (- sv) 0 cv 0)
(list 0 0 0 1))))
(if (and ks-ein ks-aus)
(progn
(setq p-ein (car ks-ein))
(setq p-aus (car ks-aus))
;; X-Skalierung anwenden
(setq p-ein-s (list (* scale (car p-ein)) (cadr p-ein) (caddr p-ein)))
(setq p-aus-s (list (* scale (car p-aus)) (cadr p-aus) (caddr p-aus)))
;; Rotation: p' = Rz(hz)*Ry(vert) * p
(setq p-ein-rot
(list (+ (* chz cv (car p-ein-s)) (- (* shz (cadr p-ein-s))) (* chz sv (caddr p-ein-s)))
(+ (* shz cv (car p-ein-s)) (* chz (cadr p-ein-s)) (* shz sv (caddr p-ein-s)))
(+ (* (- sv) (car p-ein-s)) (* cv (caddr p-ein-s)))))
(setq p-aus-rot
(list (+ (* chz cv (car p-aus-s)) (- (* shz (cadr p-aus-s))) (* chz sv (caddr p-aus-s)))
(+ (* shz cv (car p-aus-s)) (* chz (cadr p-aus-s)) (* shz sv (caddr p-aus-s)))
(+ (* (- sv) (car p-aus-s)) (* cv (caddr p-aus-s)))))
;; Block verschieben
(vla-Move block-obj
(vlax-3D-point p-ein-rot)
(vlax-3D-point startpunkt))
(setq offset (list (- (car startpunkt) (car p-ein-rot))
(- (cadr startpunkt) (cadr p-ein-rot))
(- (caddr startpunkt) (caddr p-ein-rot))))
(setq ausgang (list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n HzScaleKS " blockname
" " (rtos laenge 2 0) "mm"
" hz=" (rtos hz-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr ausgang) 2 1)))
ausgang
)
(progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt"))
startpunkt
)
)
)
;; ============================================================
;; TEIL 4: WINKELBERECHNUNG (ETAGE)
;; ============================================================
(defun berechne-winkel-etage (deltaL deltaH richtung /
winkel-list ergebnis-liste A B cos3 sin3
bogen-x1 bogen-z1 bogen-x2 bogen-z2
abs-dz-AUS abs-dz-EIN abs-dz-GEF
L_GF L_VF cosα sinα
winkel-eff cosEff sinEff rad5 rad7
winkel mass1 mass2 gueltig
best-winkel best-L_GF best-L_VF
feste-gesamt-cos feste-gesamt-sin
schraeg-hz-rad schraeg-cos schraeg-z)
(if (not *etage-lib-initialized*)
(progn
(alert "Etage-Bibliothek nicht initialisiert!")
(exit)
)
)
(setq abs-dz-AUS (abs etage-aus-dz)
abs-dz-EIN (abs etage-ein-dz)
abs-dz-GEF (abs etage-gef-dz))
(setq winkel-list '(3 6 9 12 15 18 21 27 33 39 45 51))
(setq ergebnis-liste '())
(setq cos3 (cos (* 3.0 (/ pi 180.0)))
sin3 (sin (* 3.0 (/ pi 180.0))))
(setq feste-gesamt-cos (* FESTE_ETAGE_MITTE cos3))
(setq feste-gesamt-sin (* FESTE_ETAGE_MITTE sin3))
(setq schraeg-hz-rad (* (float ETAGE_HZ_WINKEL) (/ pi 180.0)))
(setq schraeg-cos (* (cos schraeg-hz-rad) cos3))
(princ "\n\n=========================================")
(princ "\n ETAGE-BERECHNUNG FUER ALLE WINKEL")
(princ "\n=========================================")
(princ (strcat "\n△L=" (rtos deltaL 2 2) " mm"
" △H=" (rtos deltaH 2 2) " mm"
" Richtung=" richtung))
(foreach winkel winkel-list
(if (= richtung "Auf")
(progn
(setq mass1 (get-bogen-mass bogen-auf winkel))
(setq mass2 (get-bogen-mass bogen-ab winkel))
)
(progn
(setq mass1 (get-bogen-mass bogen-ab winkel))
(setq mass2 (get-bogen-mass bogen-auf winkel))
)
)
(if (or (null mass1) (null mass2))
(progn
(princ (strcat "\n " (itoa winkel) (chr 176) " -> Bogen nicht vorhanden"))
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
)
(progn
(setq rad5 (* 3.0 (/ pi 180.0)))
(setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3)))
(/ pi 180.0)))
(setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5))))
(setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5))))
(setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7))))
(setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7))))
(setq cosα (cos (* winkel (/ pi 180.0)))
sinα (sin (* winkel (/ pi 180.0))))
(setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3)))
(setq cosEff (cos (* winkel-eff (/ pi 180.0)))
sinEff (sin (* winkel-eff (/ pi 180.0))))
;; A: horizontaler Rest nach Abzug aller festen Teile
(setq A (- deltaL
etage-aus-dx
etage-ein-dx
(* 2.0 ETAGE_SCHRAEG_LAENGE schraeg-cos)
(* 2.0 etage-gef-dx)
bogen-x1
bogen-x2
(* 2.0 feste-gesamt-cos)))
;; B: vertikaler Rest (Vorzeichen analog Standard)
(setq schraeg-z (* ETAGE_SCHRAEG_LAENGE sin3))
(if (= richtung "Auf")
(setq B (+ deltaH
abs-dz-AUS
abs-dz-EIN
(* 2.0 schraeg-z)
(* 2.0 abs-dz-GEF)
(- bogen-z1)
(- bogen-z2)
(* 2.0 feste-gesamt-sin)))
(setq B (+ (- deltaH
abs-dz-AUS
abs-dz-EIN
(* 2.0 schraeg-z)
(* 2.0 abs-dz-GEF)
(* 2.0 feste-gesamt-sin))
bogen-z1
bogen-z2))
)
(if (> (abs sinα) 0.0001)
(progn
(setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα))
(if (= richtung "Auf")
(setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα))
(setq L_VF (/ (- (* B cos3) (* A sin3)) sinα))
)
(if (and (numberp L_GF) (numberp L_VF))
(progn
(setq gueltig (and (>= L_GF 0) (>= L_VF 0)))
(setq ergebnis-liste
(cons (list winkel L_GF L_VF gueltig) ergebnis-liste))
)
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
)
)
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
)
)
)
)
(setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================")
(princ "\n ERGEBNISTABELLE (L_GF = gesamt beider GF-Strecken)")
(princ "\n=================================================================================")
(princ "\n Winkel L_GF (mm) L_VF (mm) Status")
(princ "\n=================================================================================")
(setq best-winkel nil best-L_GF nil best-L_VF nil)
(foreach item ergebnis-liste
(setq winkel (car item)
L_GF (cadr item)
L_VF (caddr item)
gueltig (cadddr item))
(if (and (numberp L_GF) (numberp L_VF))
(progn
(princ (strcat "\n " (itoa winkel) (chr 176)
" " (fmt L_GF) " mm " (fmt L_VF) " mm "))
(if gueltig
(progn
(princ "GUELTIG")
(if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
)
)
(princ "UNGUELTIG (negative Laenge)")
)
)
(princ (strcat "\n " (itoa winkel) (chr 176)
" --- --- FEHLER"))
)
)
(princ "\n=================================================================================")
(if best-winkel
(princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176)))
(princ "\n>>> KEIN passender Winkel gefunden!")
)
(list best-winkel best-L_GF best-L_VF ergebnis-liste)
)
;; ============================================================
;; TEIL 5: BERECHNE-WRAPPER (Schnittstelle fuer Registry)
;; ============================================================
;; Initialisiert Etage-Bibliothek, aktiviert Gefaellebogen-Masse
;; passend zur gewaehlten Seite (benoetigt fuer Geometrieberechnung).
(defun berechne-etage (deltaL deltaH richtung seite)
(init-bibliothek-etage)
(if (= seite "rechts")
(progn
(setq etage-gef-dx etage-gef-dx-rechts)
(setq etage-gef-dz etage-gef-dz-rechts))
(progn
(setq etage-gef-dx etage-gef-dx-links)
(setq etage-gef-dz etage-gef-dz-links))
)
(princ (strcat "\n Gefaellebogen " seite
": dx=" (rtos etage-gef-dx 2 2) " mm"))
(berechne-winkel-etage deltaL deltaH richtung)
)
;; ============================================================
;; TEIL 6: EINFUEGEN (15 Schritte, ohne VF_*-Block-Erstellung)
;; ============================================================
;; Gibt endpunkt zurueck.
;; VF_*-Block-Erstellung erfolgt zentral im Dispatcher (vf_core.lsp).
(defun etage-foerderanlage-einfuegen (deltaL deltaH richtung
best-winkel L_GF1 L_GF2 L_VF
startpunkt seite
/ aktueller-punkt bogen-name endpunkt
bogen-mass bogen-dx bogen-dz
as-block es-block gefaelle-blockname
hz-vorzeichen hz-anfang hz-ende)
(setq aktueller-punkt startpunkt)
;; Horizontalwinkel-Vorzeichen je nach Seite:
;; rechts: Anfang +60 Grad (links), Ende -60 Grad (rechts)
;; links: Anfang -60 Grad, Ende +60 Grad
(setq hz-vorzeichen (if (= seite "rechts") 1 -1))
(setq hz-anfang (* hz-vorzeichen ETAGE_HZ_WINKEL))
(setq hz-ende (* (- hz-vorzeichen) ETAGE_HZ_WINKEL))
(setq as-block (strcat "_3D_AS_30_" seite))
(setq es-block (strcat "_3D_ES_30_" seite))
(setq gefaelle-blockname
(if (= seite "rechts")
(strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500")
(strcat "Gefaellebogen_links_60" grad-zeichen "_R500")
))
;; Sentinel: Bibliothek neu initialisieren wenn Bloecke fehlen
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts")))
(setq *etage-lib-initialized* nil))
(if (not *etage-lib-initialized*) (init-bibliothek-etage))
;; 1. AS_30
(princ (strcat "\n\n1/15: " as-block " (0 Grad)"))
(setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt))
;; 2. Staustrecke 400mm (hz-anfang, 3 Grad vert, KS_EIN)
(princ (strcat "\n\n2/15: Staustrecke 400mm ("
(itoa hz-anfang) " Grad hz, 3 Grad vert, KS_EIN)"))
(setq aktueller-punkt
(insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
400 hz-anfang 3))
;; 3. Separator (hz-anfang, 3 Grad vert)
(princ (strcat "\n\n3/15: Separator (300mm, "
(itoa hz-anfang) " Grad hz, 3 Grad vert)"))
(setq aktueller-punkt
(insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
hz-anfang 3 300 0))
;; 4. Gefaellebogen Anfang (hz-anfang, 0 Grad vert, KS_EIN)
(princ (strcat "\n\n4/15: " gefaelle-blockname
" (Anfang, " (itoa hz-anfang) " Grad hz, 0 Grad vert, KS_EIN)"))
(setq aktueller-punkt
(insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt hz-anfang 0))
;; 5. L_GF1 (3 Grad geneigt)
(if (> L_GF1 0.1)
(progn
(princ (strcat "\n\n5/15: Gefaellestrecke (3 Grad, L=" (rtos L_GF1 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3))
)
(princ "\n\n5/15: L_GF1 (uebersprungen)")
)
;; 6. Umlenkstation (3 Grad geneigt)
(princ "\n\n6/15: Umlenkstation (500mm, 3 Grad geneigt)")
(setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3 500 0))
;; 7. 1. Vertikalbogen (3 Grad geneigt)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (strcat "\n\n7/15: " bogen-name " (3 Grad geneigt)"))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz))
;; 8. Variable Strecke L_VF
(if (> L_VF 0.1)
(progn
(if (= richtung "Auf")
(progn
(princ (strcat "\n\n8/15: Steigungsstrecke ("
(itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (- (- best-winkel 3))))
)
(progn
(princ (strcat "\n\n8/15: Gefaellestrecke ("
(itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (+ best-winkel 3)))
)
)
)
(princ "\n\n8/15: L_VF (uebersprungen)")
)
;; 9. 2. Vertikalbogen
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(if (= richtung "Auf")
(progn
(princ (strcat "\n\n9/15: " bogen-name
" (" (itoa (- 3 best-winkel)) " Grad geneigt)"))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(- 3 best-winkel) bogen-dx bogen-dz))
)
(progn
(princ (strcat "\n\n9/15: " bogen-name
" (" (itoa (+ best-winkel 3)) " Grad geneigt)"))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(+ best-winkel 3) bogen-dx bogen-dz))
)
)
;; 10. Motorstation (3 Grad geneigt)
(princ "\n\n10/15: Motorstation (500mm, 3 Grad geneigt)")
(setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 3 500 0))
;; 11. L_GF2 (3 Grad geneigt)
(if (> L_GF2 0.1)
(progn
(princ (strcat "\n\n11/15: Gefaellestrecke (3 Grad, L=" (rtos L_GF2 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF2 3))
)
(princ "\n\n11/15: L_GF2 (uebersprungen)")
)
;; 12. Gefaellebogen Ende (via KS_EIN, 0 Grad vert)
(princ (strcat "\n\n12/15: " gefaelle-blockname " (Ende, KS_EIN)"))
(setq aktueller-punkt (insert-block-by-ks gefaelle-blockname aktueller-punkt))
;; 13. Separator Ende (hz-ende, 3 Grad vert)
(princ (strcat "\n\n13/15: Separator (300mm, "
(itoa hz-ende) " Grad hz, 3 Grad vert)"))
(setq aktueller-punkt
(insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
hz-ende 3 300 0))
;; 14. Staustrecke 400mm Ende (hz-ende, 3 Grad vert, KS_EIN)
(princ (strcat "\n\n14/15: Staustrecke 400mm ("
(itoa hz-ende) " Grad hz, 3 Grad vert, KS_EIN)"))
(setq aktueller-punkt
(insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
400 hz-ende 3))
;; 15. ES_30 (hz-ende, 0 Grad vert)
(princ (strcat "\n\n15/15: " es-block
" (Ende, " (itoa hz-ende) " Grad hz, 0 Grad vert)"))
(setq endpunkt
(insert-hz-rotated-block-with-ks es-block aktueller-punkt
hz-ende 0 etage-ein-dx etage-ein-dz))
(princ "\n\n=========================================")
(princ "\n>>> Etage-VarioFoerderer eingefuegt! <<<")
endpunkt
)
;; ============================================================
;; REGISTRIERUNG
;; ============================================================
(vf-typ-registrieren
"etage"
'berechne-etage
'etage-foerderanlage-einfuegen
"Etage VarioFoerderer (AS/ES 30 Grad, direkt uebereinander)")
(princ "\n>>> vf_etage.lsp geladen - Typ 'etage' registriert")
(princ)
Lisp/vf_standard.lsp
+499
View File
@@ -0,0 +1,499 @@
;; ============================================================
;; VF_STANDARD - Standard VarioFoerderer (Typ: "standard")
;; Version: 26.0
;; Abhaengigkeit: vf_core.lsp muss zuerst geladen sein
;; Geometrie: AS/ES 90 Grad, horizontal versetzt
;; 11-Schritt-Einfuegung
;; ============================================================
;; Sicherstellen, dass vf_core.lsp geladen ist
(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN"))))
(if (getenv "DXFM_LISP")
(load (strcat (getenv "DXFM_LISP") "/vf_core.lsp"))
(progn
(alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.")
(exit)
)
)
)
;; ============================================================
;; TEIL 1: STANDARD-SPEZIFISCHE GLOBALE VARIABLEN
;; ============================================================
(setq aus-dx nil aus-dy nil aus-dz nil)
(setq ein-dx nil ein-dy nil ein-dz nil)
(setq separator-laenge nil umlenk-laenge nil motorstation-laenge nil)
(setq staustrecke-basis 1000)
(setq FESTE_HORIZONTAL 1600)
(setq bogen-auf '())
(setq bogen-ab '())
(setq *lib-initialized* nil)
(setq *bogen-cache-loaded* nil)
(setq *modul-cache* nil)
;; ============================================================
;; TEIL 2: BIBLIOTHEK INITIALISIEREN
;; ============================================================
(defun init-bibliothek ( / temp-obj bogen-winkel ks-data ks-ein-pos ks-aus-pos
dx dy dz bogen-name)
(if (and *lib-initialized* (tblsearch "BLOCK" "_3D_AS_90_links"))
(progn
(princ "\n Standard-Bibliothek bereits initialisiert.")
t
)
(progn
(setq *lib-initialized* nil)
(setq *ks-cache* nil)
(princ "\n Initialisiere Standard-Bibliothek...")
;; AS_90 Masse extrahieren
(princ "\n Extrahiere AUS_Element Masse...")
(ensure-block-loaded "_3D_AS_90_links")
(ensure-block-loaded "_3D_AS_90_rechts")
(if (tblsearch "BLOCK" "_3D_AS_90_links")
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"_3D_AS_90_links" 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-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 (strcat "\n AS_90: dx=" (rtos aus-dx 2 0)
" dz=" (rtos aus-dz 2 0)))
)
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im AS_90!")
)
)
(princ "\n FEHLER: Block _3D_AS_90_links nicht geladen!")
)
;; ES_90 Masse extrahieren
(princ "\n Extrahiere EIN_Element Masse...")
(ensure-block-loaded "_3D_ES_90_links")
(ensure-block-loaded "_3D_ES_90_rechts")
(if (tblsearch "BLOCK" "_3D_ES_90_links")
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"_3D_ES_90_links" 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-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 (strcat "\n ES_90: dx=" (rtos ein-dx 2 0)
" dz=" (rtos ein-dz 2 0)))
)
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im ES_90!")
)
)
(princ "\n FEHLER: Block _3D_ES_90_links nicht geladen!")
)
;; Bogen-Masse extrahieren
(princ "\n Extrahiere Bogen-Masse...")
(setq bogen-auf '())
(setq bogen-ab '())
(setq bogen-winkel (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(foreach w bogen-winkel
;; Aufwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) grad-zeichen))
(ensure-block-loaded bogen-name)
(if (tblsearch "BLOCK" 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)
(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 (strcat "\n OK auf_" (itoa w)
": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
)
(princ (strcat "\n FEHLER auf_" (itoa w) ": KS fehlt!"))
)
)
(princ (strcat "\n FEHLER auf_" (itoa w) ": Block nicht geladen!"))
)
;; Abwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) grad-zeichen))
(ensure-block-loaded bogen-name)
(if (tblsearch "BLOCK" 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)
(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 (strcat "\n OK ab_" (itoa w)
": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
)
(princ (strcat "\n FEHLER ab_" (itoa w) ": KS fehlt!"))
)
)
(princ (strcat "\n FEHLER ab_" (itoa w) ": Block nicht geladen!"))
)
)
(setq bogen-auf (reverse bogen-auf))
(setq bogen-ab (reverse bogen-ab))
(setq *lib-initialized* t)
(princ "\n Standard-Bibliothek erfolgreich initialisiert.")
t
)
)
)
;; ============================================================
;; TEIL 3: BOGEN-MASSE
;; ============================================================
(defun get-bogen-mass (tabelle winkel)
(setq result nil)
(foreach item tabelle
(if (= (car item) winkel) (setq result (cdr item)))
)
(if (null result)
(princ (strcat "\n FEHLER: Winkel " (itoa winkel)
" nicht in Bogen-Tabelle!"))
)
result
)
;; ============================================================
;; TEIL 4: WINKELBERECHNUNG
;; ============================================================
(defun berechne-alle-winkel (deltaL deltaH richtung /
winkel-list ergebnis-liste A B cos3 sin3
bogen-x1 bogen-z1 bogen-x2 bogen-z2
abs-dz-AUS abs-dz-EIN L_GF L_VF cosα sinα
winkel-eff cosEff sinEff rad5 rad7
winkel mass1 mass2 gueltig
best-winkel best-L_GF best-L_VF)
(if (not *lib-initialized*)
(progn
(alert "Bibliothek nicht initialisiert!")
(exit)
)
)
(setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz))
(setq winkel-list (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq ergebnis-liste '())
(setq cos3 (cos (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0)))
sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))))
(princ "\n\n=========================================")
(princ "\n BERECHNUNG FUER ALLE WINKEL (Standard)")
(princ "\n=========================================")
(princ (strcat "\n△L=" (rtos deltaL 2 2) " mm"
" △H=" (rtos deltaH 2 2) " mm"
" Richtung=" richtung))
(foreach winkel winkel-list
(if (= richtung "Auf")
(progn
(setq mass1 (get-bogen-mass bogen-auf winkel))
(setq mass2 (get-bogen-mass bogen-ab winkel))
)
(progn
(setq mass1 (get-bogen-mass bogen-ab winkel))
(setq mass2 (get-bogen-mass bogen-auf winkel))
)
)
(if (or (null mass1) (null mass2))
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
(progn
(setq rad5 (* 3.0 (/ pi 180.0)))
(setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3)))
(/ pi 180.0)))
(setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5))))
(setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5))))
(setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7))))
(setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7))))
(setq cosα (cos (* winkel (/ pi 180.0)))
sinα (sin (* winkel (/ pi 180.0))))
(setq A (- deltaL aus-dx ein-dx bogen-x1 bogen-x2
(* FESTE_HORIZONTAL cos3)))
(setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3)))
(setq cosEff (cos (* winkel-eff (/ pi 180.0)))
sinEff (sin (* winkel-eff (/ pi 180.0))))
(if (= richtung "Auf")
(setq B (+ deltaH abs-dz-AUS abs-dz-EIN
(- bogen-z1) (- bogen-z2)
(* FESTE_HORIZONTAL sin3)))
(setq B (+ (- deltaH abs-dz-AUS abs-dz-EIN
(* FESTE_HORIZONTAL sin3))
bogen-z1 bogen-z2))
)
(if (> (abs sinα) 0.0001)
(progn
(setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα))
(if (= richtung "Auf")
(setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα))
(setq L_VF (/ (- (* B cos3) (* A sin3)) sinα))
)
(if (and (numberp L_GF) (numberp L_VF))
(progn
(setq gueltig (and (>= L_GF 0) (>= L_VF 0)))
(setq ergebnis-liste
(cons (list winkel L_GF L_VF gueltig) ergebnis-liste))
)
(setq ergebnis-liste
(cons (list winkel nil nil nil) ergebnis-liste))
)
)
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
)
)
)
)
(setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================")
(princ "\n ERGEBNISTABELLE")
(princ "\n=================================================================================")
(princ "\n Winkel L_GF (mm) L_VF (mm) Status")
(princ "\n=================================================================================")
(setq best-winkel nil best-L_GF nil best-L_VF nil)
(foreach item ergebnis-liste
(setq winkel (car item) L_GF (cadr item) L_VF (caddr item) gueltig (cadddr item))
(if (and (numberp L_GF) (numberp L_VF))
(progn
(princ (strcat "\n " (itoa winkel) (chr 176)
" " (fmt L_GF) " mm " (fmt L_VF) " mm "))
(if gueltig
(progn
(princ "GUELTIG")
(if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
)
)
(princ "UNGUELTIG (negative Laenge)")
)
)
(princ (strcat "\n " (itoa winkel) (chr 176)
" --- --- FEHLER"))
)
)
(princ "\n=================================================================================")
(if best-winkel
(princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176)))
(princ "\n>>> KEIN passender Winkel gefunden!")
)
(list best-winkel best-L_GF best-L_VF ergebnis-liste)
)
;; ============================================================
;; TEIL 5: BERECHNE-WRAPPER (Schnittstelle fuer Registry)
;; ============================================================
;; Initialisiert Standard-Bibliothek und berechnet Winkel.
;; seite-Parameter wird fuer Standard-Typ nicht benoetigt (keine Vorab-Geometrie).
(defun berechne-standard (deltaL deltaH richtung seite)
(setq FESTE_HORIZONTAL (ssg-cfg-or "vario" "feste_horizontal" 1600))
(setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
(init-bibliothek)
(berechne-alle-winkel deltaL deltaH richtung)
)
;; ============================================================
;; TEIL 6: EINFUEGEN (11 Schritte, ohne VF_*-Block-Erstellung)
;; ============================================================
;; Gibt endpunkt zurueck (letzter KS_AUS nach ES_90).
;; VF_*-Block-Erstellung erfolgt zentral im Dispatcher (vf_core.lsp).
(defun variofoerderer-einfuegen (deltaL deltaH richtung best-winkel
L_GF1 L_GF2 L_VF startpunkt seite
/ aktueller-punkt bogen-name endpunkt
bogen-mass bogen-dx bogen-dz
as-block es-block)
(setq aktueller-punkt startpunkt)
(setq as-block (strcat "_3D_AS_90_" seite))
(setq es-block (strcat "_3D_ES_90_" seite))
(if (not *lib-initialized*) (init-bibliothek))
;; 1. AUS_Element
(princ (strcat "\n\n1/11: " as-block " (0 Grad)"))
(setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt))
;; 2. 1. Gefaellestrecke
(if (> L_GF1 0.1)
(progn
(princ (strcat "\n\n2/11: Gefaellestrecke (3 Grad, L=" (rtos L_GF1 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_GF1 (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
)
(princ "\n\n2/11: (uebersprungen)")
)
;; 3. Separator
(princ "\n\n3/11: Separator (300 mm, 3 Grad geneigt)")
(setq aktueller-punkt
(insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "separator_block_dx" 300)
(ssg-cfg-or "vario" "separator_block_dz" 0)))
;; 4. Umlenkstation
(princ "\n\n4/11: Umlenkstation (500 mm, 3 Grad geneigt)")
(setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "station_block_dx" 500)
(ssg-cfg-or "vario" "station_block_dz" 0)))
;; 5. 1. Vertikalbogen
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (strcat "\n\n5/11: " bogen-name " (3 Grad geneigt)"))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz))
;; 6. Variable Strecke L_VF
(if (> L_VF 0.1)
(progn
(if (= richtung "Auf")
(progn
(princ (strcat "\n\n6/11: Steigungsstrecke ("
(itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (- (- best-winkel 3))))
)
(progn
(princ (strcat "\n\n6/11: Gefaellestrecke ("
(itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (+ best-winkel 3)))
)
)
)
(princ "\n\n6/11: (uebersprungen)")
)
;; 7. 2. Vertikalbogen
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(if (= richtung "Auf")
(progn
(princ (strcat "\n\n7/11: " bogen-name
" (" (itoa (- 3 best-winkel)) " Grad geneigt)"))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(- 3 best-winkel) bogen-dx bogen-dz))
)
(progn
(princ (strcat "\n\n7/11: " bogen-name
" (" (itoa (+ best-winkel 3)) " Grad geneigt)"))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(+ best-winkel 3) bogen-dx bogen-dz))
)
)
;; 8. Motorstation
(princ "\n\n8/11: Motorstation (500 mm, 3 Grad geneigt)")
(setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "station_block_dx" 500)
(ssg-cfg-or "vario" "station_block_dz" 0)))
;; 9. 2. Gefaellestrecke
(if (> L_GF2 0.1)
(progn
(princ (strcat "\n\n9/11: Gefaellestrecke (3 Grad, L=" (rtos L_GF2 2 2) " mm)"))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_GF2 (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
)
(princ "\n\n9/11: (uebersprungen)")
)
;; 10. Separator 2
(princ "\n\n10/11: Separator (300 mm, 3 Grad geneigt)")
(setq aktueller-punkt
(insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "separator_block_dx" 300)
(ssg-cfg-or "vario" "separator_block_dz" 0)))
;; 11. EIN_Element
(princ (strcat "\n\n11/11: " es-block " (0 Grad)"))
(setq endpunkt (insert-block-by-ks es-block aktueller-punkt))
(princ "\n\n=========================================")
(princ "\n>>> Standard VarioFoerderer eingefuegt!")
endpunkt
)
;; ============================================================
;; REGISTRIERUNG
;; ============================================================
(vf-typ-registrieren
"standard"
'berechne-standard
'variofoerderer-einfuegen
"Standard VarioFoerderer (AS/ES 90 Grad, horizontal versetzt)")
(princ "\n>>> vf_standard.lsp geladen - Typ 'standard' registriert")
(princ)