905 lines
33 KiB
Common Lisp
905 lines
33 KiB
Common Lisp
;; ============================================================
|
|
;; 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
|
|
;; ============================================================
|
|
;; DXFM_DIM sicher lesen (type-Guard gegen nicht-String Rueckgabewerte)
|
|
(setq *vf-dxfm-dim* (getenv "DXFM_DIM"))
|
|
(if (not (= (type *vf-dxfm-dim*) 'STR)) (setq *vf-dxfm-dim* "3D"))
|
|
;; Block-Pfad: primaer aus DXFMAKRO + DXFM_DIM, dann *ssg-lisp-pfad*-Heuristik
|
|
(setq modul-pfad
|
|
(cond
|
|
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
|
|
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
|
|
"/data/ils/" *vf-dxfm-dim* "/"))
|
|
((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
|
|
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
|
|
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
|
|
"/data/ils/" *vf-dxfm-dim* "/"))
|
|
(t
|
|
(princ "\n[vf_core] WARNUNG: Block-Pfad nicht ermittelbar!")
|
|
nil)
|
|
)
|
|
)
|
|
(setq block-pfad modul-pfad)
|
|
|
|
;; ssg_core laden falls noch nicht geschehen: 1) DXFM_LISP, 2) *ssg-lisp-pfad*
|
|
(if (not *ssg-core-loaded*)
|
|
(progn
|
|
(setq *vf-core-lisp-pfad*
|
|
(cond
|
|
((getenv "DXFM_LISP")
|
|
(vl-string-translate "\\" "/" (getenv "DXFM_LISP")))
|
|
((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*)
|
|
*ssg-lisp-pfad*)
|
|
(t nil)
|
|
)
|
|
)
|
|
(if *vf-core-lisp-pfad*
|
|
(progn
|
|
(load (strcat *vf-core-lisp-pfad* "/ssg_core.lsp"))
|
|
(ssg-load-config)
|
|
(setq *ssg-core-loaded* t)
|
|
)
|
|
(princ "\n[vf_core] WARNUNG: DXFM_LISP nicht gesetzt - ssg_core konnte nicht geladen werden!")
|
|
)
|
|
)
|
|
)
|
|
|
|
(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 / block-datei temp-obj)
|
|
(if (not (tblsearch "BLOCK" blockname))
|
|
(progn
|
|
(setq block-datei (strcat block-pfad blockname ".dwg"))
|
|
(if (findfile block-datei)
|
|
(progn
|
|
(princ (strcat "\n Lade Block: " blockname " ..."))
|
|
(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 " OK")
|
|
)
|
|
(princ (strcat "\n FEHLER: Block-Datei nicht gefunden: " block-datei))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(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*)
|
|
(progn
|
|
(princ "\n>>> VARIOFOERDERER v26.0 geladen <<<")
|
|
;; Lisp-Pfad ermitteln: 1) DXFM_LISP, 2) *ssg-lisp-pfad* (vom MNL gesetzt)
|
|
(setq *vf-lisp-pfad*
|
|
(cond
|
|
((getenv "DXFM_LISP")
|
|
(vl-string-translate "\\" "/" (getenv "DXFM_LISP")))
|
|
((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*)
|
|
*ssg-lisp-pfad*)
|
|
(t nil)
|
|
)
|
|
)
|
|
(if *vf-lisp-pfad*
|
|
(progn
|
|
(load (strcat *vf-lisp-pfad* "/vf_standard.lsp"))
|
|
(load (strcat *vf-lisp-pfad* "/vf_etage.lsp"))
|
|
(setq *ssg-vf-submodule-loaded* t)
|
|
)
|
|
(princ "\n[vf_core] WARNUNG: 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>>> Befehle: VarioFoerderer, Foerderanlage, EtageVarioFoerderer")
|
|
(princ "\n Typen:")
|
|
(setq *vf-typ-idx* 1)
|
|
(foreach eintr *vf-typ-registry*
|
|
(princ (strcat "\n " (itoa *vf-typ-idx*) ". " (car eintr) " - " (nth 3 eintr)))
|
|
(setq *vf-typ-idx* (1+ *vf-typ-idx*))
|
|
)
|
|
(if block-pfad (princ (strcat "\n Block-Pfad: " block-pfad)))
|
|
(princ "\n=========================================")
|
|
(princ)
|