1385 lines
58 KiB
Common Lisp
1385 lines
58 KiB
Common Lisp
;; ============================================================
|
|
;; VF_CORE - VarioFoerderer Kern-Modul
|
|
;; Version: 26.0
|
|
;; Architektur: Plugin/Dispatcher
|
|
;; Laedt automatisch: vf_standard.lsp, vf_etage.lsp, vf_linienzug.lsp
|
|
;; Befehle: VarioFoerderer (Alias: FOERDERANLAGE, ETAGEVARIOFOERDERER)
|
|
;; ============================================================
|
|
|
|
(vl-load-com)
|
|
|
|
;; ============================================================
|
|
;; TEIL 1: ABHAENGIGKEITEN
|
|
;; ============================================================
|
|
;; DXFM_DIM lesen; 2D wird auf 3D korrigiert (VF/GF benoetigen Z-Geometrie)
|
|
(setq *vf-dxfm-dim* (getenv "DXFM_DIM"))
|
|
(if (or (not (= (type *vf-dxfm-dim*) 'STR)) (= *vf-dxfm-dim* "2D"))
|
|
(setq *vf-dxfm-dim* "3D"))
|
|
;; Block-Pfad: data/ils/3D/ wenn DXFM_DIM nicht gesetzt oder 2D
|
|
(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))
|
|
|
|
;; Attribut-Definitionen fuer VF_*-Bloecke kommen aus dem gemeinsamen
|
|
;; Strecken-Schema in ssg_core.lsp (ssg-strecke-attrib-defs). VarioFoerderer
|
|
;; ist immer TYP "Streckengruppe" -> voller Attributsatz.
|
|
|
|
;; ============================================================
|
|
;; 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)))
|
|
|
|
;; Normalisiert die verschiedenen KS-Blocknamen auf "KS_EIN"/"KS_AUS".
|
|
;; Die aelteren Bloecke (AS/ES/Gefaellebogen) verwenden KS_EIN/KS_AUS, die
|
|
;; Vario_Kurve-Bloecke KSYS_EIN/KSYS_AUS. Rueckgabe nil, wenn kein KS-Block.
|
|
(defun ks-normalize-name (nm)
|
|
(cond
|
|
((or (= nm "KS_EIN") (= nm "KSYS_EIN")) "KS_EIN")
|
|
((or (= nm "KS_AUS") (= nm "KSYS_AUS")) "KS_AUS")
|
|
(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 4b: KS-FRAME MATHEMATIK
|
|
;; ============================================================
|
|
|
|
;; Vektorkreuzprodukt a x b
|
|
(defun vec3-cross (a b)
|
|
(list (- (* (cadr a)(caddr b)) (* (caddr a)(cadr b)))
|
|
(- (* (caddr a)(car b)) (* (car a)(caddr b)))
|
|
(- (* (car a)(cadr b)) (* (cadr a)(car b)))))
|
|
|
|
;; Vektor auf Einheitslaenge normieren
|
|
(defun vec3-normalize (v / len)
|
|
(setq len (vec-length v))
|
|
(if (> len 1e-10)
|
|
(list (/ (car v) len) (/ (cadr v) len) (/ (caddr v) len))
|
|
'(1.0 0.0 0.0)))
|
|
|
|
;; 3x3-Rotationsmatrix (Zeilenliste) mal 3D-Vektor
|
|
(defun mat3-mul-vec3 (R v / r0 r1 r2)
|
|
(setq r0 (car R) r1 (cadr R) r2 (caddr R))
|
|
(list (+ (* (car r0)(car v)) (* (cadr r0)(cadr v)) (* (caddr r0)(caddr v)))
|
|
(+ (* (car r1)(car v)) (* (cadr r1)(cadr v)) (* (caddr r1)(caddr v)))
|
|
(+ (* (car r2)(car v)) (* (cadr r2)(cadr v)) (* (caddr r2)(caddr v)))))
|
|
|
|
;; Rotationsmatrix R sodass: R*xe=xt, R*ye=yt, R*ze=zt
|
|
;; (xt yt zt) = Ziel-Achsen; (xe ye ze) = Quell-Achsen (je normierte Einheitsvektoren)
|
|
;; Formel: R = M_target * M_source^T
|
|
;; R[i][j] = xt[i]*xe[j] + yt[i]*ye[j] + zt[i]*ze[j]
|
|
(defun mat3-from-frames (xt yt zt xe ye ze)
|
|
(list
|
|
(list (+ (* (car xt)(car xe)) (* (car yt)(car ye)) (* (car zt)(car ze)))
|
|
(+ (* (car xt)(cadr xe)) (* (car yt)(cadr ye)) (* (car zt)(cadr ze)))
|
|
(+ (* (car xt)(caddr xe)) (* (car yt)(caddr ye)) (* (car zt)(caddr ze))))
|
|
(list (+ (* (cadr xt)(car xe)) (* (cadr yt)(car ye)) (* (cadr zt)(car ze)))
|
|
(+ (* (cadr xt)(cadr xe)) (* (cadr yt)(cadr ye)) (* (cadr zt)(cadr ze)))
|
|
(+ (* (cadr xt)(caddr xe)) (* (cadr yt)(caddr ye)) (* (cadr zt)(caddr ze))))
|
|
(list (+ (* (caddr xt)(car xe)) (* (caddr yt)(car ye)) (* (caddr zt)(car ze)))
|
|
(+ (* (caddr xt)(cadr xe)) (* (caddr yt)(cadr ye)) (* (caddr zt)(cadr ze)))
|
|
(+ (* (caddr xt)(caddr xe)) (* (caddr yt)(caddr ye)) (* (caddr zt)(caddr ze))))))
|
|
|
|
;; Normierter KS-Rahmen aus rohen KS-Daten (origin x-end y-end z-end)
|
|
;; Eingabe: Teilliste aus extract-ks-from-block-raw, z.B. (cadr (assoc "KS_EIN" ks-data))
|
|
;; Rueckgabe: (P xu yu zu) - Ursprung + 3 normierte Einheitsvektoren
|
|
(defun ks-frame-extract (ks-raw / origin x-end y-end z-end)
|
|
(setq origin (car ks-raw)
|
|
x-end (cadr ks-raw)
|
|
y-end (caddr ks-raw)
|
|
z-end (cadddr ks-raw))
|
|
(list origin
|
|
(vec3-normalize (list (- (car x-end)(car origin))
|
|
(- (cadr x-end)(cadr origin))
|
|
(- (caddr x-end)(caddr origin))))
|
|
(vec3-normalize (list (- (car y-end)(car origin))
|
|
(- (cadr y-end)(cadr origin))
|
|
(- (caddr y-end)(caddr origin))))
|
|
(vec3-normalize (list (- (car z-end)(car origin))
|
|
(- (cadr z-end)(cadr origin))
|
|
(- (caddr z-end)(caddr origin))))))
|
|
|
|
;; KS-Rahmen aus normiertem Fahrtrichtungsvektor mit horizontaler Senkrechtachse
|
|
;; Rueckgabe: (P xu yu zu)
|
|
;; Konvention: yu = horizontal senkrecht zu xu (links der Fahrtrichtung)
|
|
;; zu = xu x yu (senkrecht zur Gurtoberflaeche, nach oben)
|
|
(defun make-frame-from-dir (P xu-unit / hlen yu zu)
|
|
(setq hlen (sqrt (+ (* (car xu-unit)(car xu-unit))
|
|
(* (cadr xu-unit)(cadr xu-unit)))))
|
|
(setq yu
|
|
(if (> hlen 1e-6)
|
|
(list (/ (- (cadr xu-unit)) hlen)
|
|
(/ (car xu-unit) hlen)
|
|
0.0)
|
|
'(1.0 0.0 0.0)))
|
|
(setq zu (vec3-cross xu-unit yu))
|
|
(list P xu-unit yu zu))
|
|
|
|
;; --- Bruecke Frame <-> (hz, winkel) ---
|
|
;; Fuer vf-linienzug (gemischte GF/VF-Ketten, vf_linienzug.lsp): Gefaellestrecke
|
|
;; traegt den Kettenzustand als Frame (Position + Richtungsvektor xu) weiter,
|
|
;; waehrend die aelteren VF-Einfuegefunktionen (insert-block-by-ks,
|
|
;; insert-rotated-block-with-ks, insert-inclined-scaled-block) Position+hz+winkel
|
|
;; getrennt erwarten. Beide nutzen dieselbe Rz(hz)*Ry(winkel)-Rotation
|
|
;; (winkel positiv = abwaerts, xu = (cos(hz)cos(v), sin(hz)cos(v), -sin(v))),
|
|
;; daher sind Frame und (hz winkel) verlustfrei ineinander umrechenbar.
|
|
(defun frame->hz-winkel (frame / xu horiz-len)
|
|
(setq xu (cadr frame))
|
|
(setq horiz-len (sqrt (+ (* (car xu)(car xu)) (* (cadr xu)(cadr xu)))))
|
|
(list
|
|
(* (atan (cadr xu) (car xu)) (/ 180.0 pi))
|
|
(* (atan (- (caddr xu)) horiz-len) (/ 180.0 pi))
|
|
)
|
|
)
|
|
|
|
(defun hz-winkel->xu (hz winkel / rad-h rad-v)
|
|
(setq rad-h (* (float hz) (/ pi 180.0)))
|
|
(setq rad-v (* (float winkel) (/ pi 180.0)))
|
|
(list (* (cos rad-h)(cos rad-v))
|
|
(* (sin rad-h)(cos rad-v))
|
|
(- (sin rad-v)))
|
|
)
|
|
|
|
(defun punkt-hz-winkel->frame (punkt hz winkel)
|
|
(make-frame-from-dir punkt (hz-winkel->xu hz winkel))
|
|
)
|
|
|
|
;; ============================================================
|
|
;; 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
|
|
(setq ks-ref
|
|
(if (and (not (vlax-erased-p sub-obj))
|
|
(= (vla-get-ObjectName sub-obj) "AcDbBlockReference"))
|
|
(ks-normalize-name (vla-get-Name sub-obj))
|
|
nil))
|
|
(if ks-ref
|
|
(progn
|
|
(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
|
|
;; ============================================================
|
|
;; Naechste freie VF-Nummer aus den Blocknamen VF_<n> ableiten (der Blockname
|
|
;; ist die Bezeichnung/Zaehlung; ein separates NUMMER-Attribut gibt es nicht mehr).
|
|
(defun vf-next-number ( / ss i nr maxnr bname)
|
|
(setq maxnr 0)
|
|
(setq ss (ssget "X" '((0 . "INSERT") (2 . "VF_*"))))
|
|
(if ss
|
|
(progn
|
|
(setq i 0)
|
|
(while (< i (sslength ss))
|
|
(setq bname (cdr (assoc 2 (entget (ssname ss i)))))
|
|
(setq nr (atoi (substr bname 4))) ; "VF_" = 3 Zeichen -> ab Position 4
|
|
(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)
|
|
;; ============================================================
|
|
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...). Block
|
|
;; hat sonst keine Neigung, daher nur Rz-Rotation (keine Ry-Komponente).
|
|
(defun insert-block-by-ks (blockname einfuegepunkt hz / block-obj temp-obj ks-data ks-ein ks-aus
|
|
rad-h chv shv ein-x ein-y ein-z dx-loc dy-loc dz-loc 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... (hz=" (rtos (float hz) 2 1) (chr 176) ")"))
|
|
(setq rad-h (* (float hz) (/ pi 180.0)))
|
|
(setq chv (cos rad-h) shv (sin rad-h))
|
|
;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht am
|
|
;; spaeter tatsaechlich platzierten block-obj - extract-ks-from-block
|
|
;; exploded das uebergebene Objekt intern), siehe insert-block-ks-to-ks.
|
|
(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 am Ursprung einfuegen (nicht direkt am einfuegepunkt), damit die
|
|
;; Rz-Rotation um den Block-Ursprung dreht, nicht um die Weltachse.
|
|
(setq block-obj (vla-InsertBlock modelspace
|
|
(vlax-3D-point '(0 0 0))
|
|
blockname 1.0 1.0 1.0 0))
|
|
(if (> (abs hz) 0.0001)
|
|
(vla-TransformBy block-obj (vlax-tmatrix
|
|
(list (list chv (- shv) 0 0)
|
|
(list shv chv 0 0)
|
|
(list 0 0 1 0)
|
|
(list 0 0 0 1))))
|
|
)
|
|
(if (and ks-ein ks-aus)
|
|
(progn
|
|
(setq ein-x (car (car ks-ein)) ein-y (cadr (car ks-ein)) ein-z (caddr (car ks-ein)))
|
|
;; Block-Ursprung so verschieben, dass das ROTIERTE KS_EIN exakt auf
|
|
;; einfuegepunkt zu liegen kommt: Ursprung = einfuegepunkt - Rz(hz)*ks_ein_lokal
|
|
(setq offset (list
|
|
(- (car einfuegepunkt) (- (* chv ein-x) (* shv ein-y)))
|
|
(- (cadr einfuegepunkt) (+ (* shv ein-x) (* chv ein-y)))
|
|
(- (caddr einfuegepunkt) ein-z)))
|
|
(vla-Move block-obj
|
|
(vlax-3D-point '(0 0 0))
|
|
(vlax-3D-point offset))
|
|
;; KS_AUS = einfuegepunkt + Rz(hz)*(ks_aus_lokal - ks_ein_lokal)
|
|
(setq dx-loc (- (car (car ks-aus)) ein-x))
|
|
(setq dy-loc (- (cadr (car ks-aus)) ein-y))
|
|
(setq dz-loc (- (caddr (car ks-aus)) ein-z))
|
|
(setq ausgang (list
|
|
(+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc)))
|
|
(+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc)))
|
|
(+ (caddr einfuegepunkt) dz-loc)))
|
|
(princ (strcat "\n KS_AUS: X=" (rtos (car ausgang) 2 2)
|
|
" Y=" (rtos (cadr ausgang) 2 2)
|
|
" Z=" (rtos (caddr ausgang) 2 2)))
|
|
ausgang
|
|
)
|
|
(progn
|
|
(princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!")
|
|
einfuegepunkt
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Fuegt Block ein und richtet KS_EIN am Ziel-Rahmen aus (volle 3D-Rotation).
|
|
;; target-frame : (P xt yt zt) - Ziel-Rahmen, z.B. KS_AUS des Vorgaenger-Elements
|
|
;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks
|
|
(defun insert-block-ks-to-ks (blockname target-frame /
|
|
block-obj temp-obj ks-data ks-ein-raw ks-aus-raw
|
|
f-ein f-aus P-t xt yt zt
|
|
P-ein xe ye ze P-aus xu-aus yu-aus zu-aus
|
|
R R-Pein R-Paus tx ty tz T4
|
|
P-out xu-out yu-out zu-out)
|
|
(ensure-block-loaded blockname)
|
|
(if (not (tblsearch "BLOCK" blockname))
|
|
(progn
|
|
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek"))
|
|
(exit)))
|
|
;; Ziel-Rahmen auspacken
|
|
(setq P-t (car target-frame)
|
|
xt (cadr target-frame)
|
|
yt (caddr target-frame)
|
|
zt (cadddr target-frame))
|
|
;; KS_EIN/KS_AUS ueber EIGENES Temp-Objekt ermitteln (nicht am spaeter
|
|
;; tatsaechlich platzierten block-obj - extract-ks-from-block exploded
|
|
;; das uebergebene Objekt intern; das darf nicht das Objekt sein, das
|
|
;; anschliessend transformiert in der Zeichnung bleibt).
|
|
(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-raw (cadr (assoc "KS_EIN" ks-data)))
|
|
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
|
|
(if (not (and ks-ein-raw ks-aus-raw))
|
|
(progn
|
|
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'"))
|
|
(exit)))
|
|
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
|
|
;; bleibt tatsaechlich in der Zeichnung.
|
|
(setq block-obj (vla-InsertBlock modelspace
|
|
(vlax-3D-point '(0 0 0))
|
|
blockname 1.0 1.0 1.0 0))
|
|
;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
|
|
(setq f-ein (ks-frame-extract ks-ein-raw)
|
|
f-aus (ks-frame-extract ks-aus-raw))
|
|
(setq P-ein (car f-ein)
|
|
xe (cadr f-ein)
|
|
ye (caddr f-ein)
|
|
ze (cadddr f-ein))
|
|
(setq P-aus (car f-aus)
|
|
xu-aus (cadr f-aus)
|
|
yu-aus (caddr f-aus)
|
|
zu-aus (cadddr f-aus))
|
|
;; Rotationsmatrix: R * xe = xt, R * ye = yt, R * ze = zt
|
|
(setq R (mat3-from-frames xt yt zt xe ye ze))
|
|
;; Translation: t = P_target - R * P_ein
|
|
(setq R-Pein (mat3-mul-vec3 R P-ein))
|
|
(setq tx (- (car P-t) (car R-Pein))
|
|
ty (- (cadr P-t) (cadr R-Pein))
|
|
tz (- (caddr P-t) (caddr R-Pein)))
|
|
;; 4x4-Transformationsmatrix aufbauen und auf Block anwenden
|
|
(setq T4 (vlax-tmatrix
|
|
(list (list (car (car R)) (cadr (car R)) (caddr (car R)) tx)
|
|
(list (car (cadr R)) (cadr (cadr R)) (caddr (cadr R)) ty)
|
|
(list (car (caddr R)) (cadr (caddr R)) (caddr (caddr R)) tz)
|
|
(list 0.0 0.0 0.0 1.0))))
|
|
(vla-TransformBy block-obj T4)
|
|
;; Ausgabe-Rahmen fuer KS_AUS mathematisch berechnen (kein Re-Extrahieren noetig)
|
|
(setq R-Paus (mat3-mul-vec3 R P-aus))
|
|
(setq P-out (list (+ (car R-Paus) tx)
|
|
(+ (cadr R-Paus) ty)
|
|
(+ (caddr R-Paus) tz)))
|
|
(setq xu-out (mat3-mul-vec3 R xu-aus)
|
|
yu-out (mat3-mul-vec3 R yu-aus)
|
|
zu-out (mat3-mul-vec3 R zu-aus))
|
|
(princ (strcat "\n '" blockname "' eingefuegt"
|
|
"\n KS_AUS: X=" (rtos (car P-out) 2 2)
|
|
" Y=" (rtos (cadr P-out) 2 2)
|
|
" Z=" (rtos (caddr P-out) 2 2)))
|
|
(list P-out xu-out yu-out zu-out))
|
|
|
|
;; Fuegt Block ein: Orientierung wie insert-block-ks-to-ks (KS_EIN-Achsen werden
|
|
;; am Ziel-Rahmen ausgerichtet). Die POSITION wird jedoch fuer XY und Z aus
|
|
;; ZWEI VERSCHIEDENEN lokalen Referenzpunkten abgeleitet:
|
|
;; xy-ref : welcher lokale Punkt in X/Y exakt auf target-frame's P treffen soll
|
|
;; z-ref : welcher lokale Punkt in Z exakt auf z-ziel treffen soll
|
|
;; Werte fuer xy-ref/z-ref: "KS_EIN", "KS_AUS" oder nil (=Block-Ursprung 0,0,0).
|
|
;; Hintergrund: Bei seitlich angebundenen Elementen (z.B. AS_Element/ES_Element)
|
|
;; liegt KS_EIN bzw. KS_AUS seitlich versetzt vom Block-Ursprung (Drehteller-
|
|
;; Anschluss). Die Mittelachse der Foerderstrecke soll durch den Block-Ursprung
|
|
;; laufen (xy-ref), waehrend die Anschlusshoehe weiterhin exakt am jeweiligen
|
|
;; KS-Punkt (z-ref) gemessen werden muss (konsistent mit Modus 1+2 und der
|
|
;; Gefaellewinkel-Korrektur in gf-messe-dz-block).
|
|
;; target-frame : (P xt yt zt) - Ziel-Rahmen (Punkt auf der Mittelachse + Fahrtrichtung)
|
|
;; z-ziel : gewuenschte Welt-Z-Koordinate des z-ref-Punktes
|
|
;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks
|
|
(defun insert-block-mixed-to-ks (blockname target-frame z-ziel xy-ref z-ref /
|
|
block-obj temp-obj ks-data ks-ein-raw ks-aus-raw
|
|
f-ein f-aus P-t xt yt zt
|
|
xe ye ze P-ein P-aus xu-aus yu-aus zu-aus
|
|
R P-xyref P-zref R-xyref R-zref tx ty tz T4
|
|
R-Paus P-out xu-out yu-out zu-out)
|
|
(ensure-block-loaded blockname)
|
|
(if (not (tblsearch "BLOCK" blockname))
|
|
(progn
|
|
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek"))
|
|
(exit)))
|
|
;; Ziel-Rahmen auspacken
|
|
(setq P-t (car target-frame)
|
|
xt (cadr target-frame)
|
|
yt (caddr target-frame)
|
|
zt (cadddr target-frame))
|
|
;; KS_EIN/KS_AUS ueber EIGENES Temp-Objekt ermitteln (nicht am spaeter
|
|
;; tatsaechlich platzierten block-obj - extract-ks-from-block exploded
|
|
;; das uebergebene Objekt intern; das darf nicht das Objekt sein, das
|
|
;; anschliessend transformiert in der Zeichnung bleibt).
|
|
(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-raw (cadr (assoc "KS_EIN" ks-data)))
|
|
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
|
|
(if (not (and ks-ein-raw ks-aus-raw))
|
|
(progn
|
|
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'"))
|
|
(exit)))
|
|
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
|
|
;; bleibt tatsaechlich in der Zeichnung.
|
|
(setq block-obj (vla-InsertBlock modelspace
|
|
(vlax-3D-point '(0 0 0))
|
|
blockname 1.0 1.0 1.0 0))
|
|
;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
|
|
(setq f-ein (ks-frame-extract ks-ein-raw)
|
|
f-aus (ks-frame-extract ks-aus-raw))
|
|
(setq xe (cadr f-ein) ye (caddr f-ein) ze (cadddr f-ein))
|
|
(setq P-ein (car f-ein))
|
|
(setq P-aus (car f-aus)
|
|
xu-aus (cadr f-aus)
|
|
yu-aus (caddr f-aus)
|
|
zu-aus (cadddr f-aus))
|
|
;; Rotation identisch zu insert-block-ks-to-ks: R * xe = xt, R * ye = yt, R * ze = zt
|
|
(setq R (mat3-from-frames xt yt zt xe ye ze))
|
|
;; Lokale Referenzpunkte fuer XY- bzw. Z-Zielvorgabe bestimmen
|
|
(setq P-xyref
|
|
(cond ((= xy-ref "KS_EIN") P-ein)
|
|
((= xy-ref "KS_AUS") P-aus)
|
|
(t '(0.0 0.0 0.0))))
|
|
(setq P-zref
|
|
(cond ((= z-ref "KS_EIN") P-ein)
|
|
((= z-ref "KS_AUS") P-aus)
|
|
(t '(0.0 0.0 0.0))))
|
|
(setq R-xyref (mat3-mul-vec3 R P-xyref))
|
|
(setq R-zref (mat3-mul-vec3 R P-zref))
|
|
;; Translation: xy-ref -> P-t (X/Y), z-ref -> z-ziel (Z)
|
|
(setq tx (- (car P-t) (car R-xyref)))
|
|
(setq ty (- (cadr P-t) (cadr R-xyref)))
|
|
(setq tz (- (float z-ziel) (caddr R-zref)))
|
|
;; 4x4-Transformationsmatrix aufbauen und auf Block anwenden
|
|
(setq T4 (vlax-tmatrix
|
|
(list (list (car (car R)) (cadr (car R)) (caddr (car R)) tx)
|
|
(list (car (cadr R)) (cadr (cadr R)) (caddr (cadr R)) ty)
|
|
(list (car (caddr R)) (cadr (caddr R)) (caddr (caddr R)) tz)
|
|
(list 0.0 0.0 0.0 1.0))))
|
|
(vla-TransformBy block-obj T4)
|
|
;; Ausgabe-Rahmen fuer KS_AUS mathematisch berechnen (kein Re-Extrahieren noetig)
|
|
(setq R-Paus (mat3-mul-vec3 R P-aus))
|
|
(setq P-out (list (+ (car R-Paus) tx)
|
|
(+ (cadr R-Paus) ty)
|
|
(+ (caddr R-Paus) tz)))
|
|
(setq xu-out (mat3-mul-vec3 R xu-aus)
|
|
yu-out (mat3-mul-vec3 R yu-aus)
|
|
zu-out (mat3-mul-vec3 R zu-aus))
|
|
(princ (strcat "\n '" blockname "' eingefuegt (XY:" (if xy-ref xy-ref "Ursprung")
|
|
" Z:" (if z-ref z-ref "Ursprung") ")"
|
|
"\n KS_AUS: X=" (rtos (car P-out) 2 2)
|
|
" Y=" (rtos (cadr P-out) 2 2)
|
|
" Z=" (rtos (caddr P-out) 2 2)))
|
|
(list P-out xu-out yu-out zu-out))
|
|
|
|
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...),
|
|
;; winkel: vertikale Neigung in Grad. Rotation = Rz(hz)*Ry(winkel).
|
|
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz /
|
|
rad-v rad-h chv shv cvv svv 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)
|
|
" hz=" (rtos (float hz) 2 1) (chr 176) ")"))
|
|
(setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0)))
|
|
(setq rad-v (* (float winkel) (/ pi 180.0)))
|
|
(setq rad-h (* (float hz) (/ pi 180.0)))
|
|
(setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v))
|
|
(setq block-obj (vla-InsertBlock modelspace
|
|
(vlax-3D-point '(0 0 0))
|
|
blockname scale 1.0 1.0 0))
|
|
(setq matrix (list
|
|
(list (* chv cvv) (- shv) (* chv svv) 0)
|
|
(list (* shv cvv) chv (* shv svv) 0)
|
|
(list (- svv) 0 cvv 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 chv cvv))
|
|
(+ (cadr startpunkt) (* laenge shv cvv))
|
|
(+ (caddr startpunkt) (* laenge (- svv)))))
|
|
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2)
|
|
" Y=" (rtos (cadr endpunkt) 2 2)
|
|
" Z=" (rtos (caddr endpunkt) 2 2)))
|
|
endpunkt
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Fuegt Block ein und dreht ihn um die Y-Achse (Neigung, reine XZ-Ebene).
|
|
;; block-dx/block-dz: lokaler Versatz KS_AUS-KS_EIN (unrotiert), fuer den
|
|
;; zurueckgegebenen endpunkt.
|
|
;; WICHTIG: KS_EIN liegt nicht bei jedem Block exakt am Block-Ursprung
|
|
;; (z.B. bei Vario_Bogen). Damit KS_EIN und nicht der Block-Ursprung auf
|
|
;; startpunkt zu liegen kommt, wird der Ursprung um das rotierte lokale
|
|
;; KS_EIN-Versatz korrigiert. Fuer Bloecke mit KS_EIN=Ursprung (Separator,
|
|
;; Umlenk-/Motorstation) ist diese Korrektur 0 - Verhalten bleibt gleich.
|
|
;; block-dx/block-dz: Fallback-Laenge (aus Config), nur verwendet falls
|
|
;; KS_EIN/KS_AUS am Block nicht extrahiert werden koennen. Ist KS_AUS
|
|
;; vorhanden, wird der ECHTE gemessene Versatz KS_AUS-KS_EIN verwendet -
|
|
;; das schuetzt vor veralteten Config-Zahlen, die nicht mehr zur
|
|
;; tatsaechlichen Blockgeometrie passen (z.B. nach einer DWG-Bereinigung).
|
|
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...),
|
|
;; winkel: vertikale Neigung in Grad. Rotation = Rz(hz)*Ry(winkel).
|
|
(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz hz /
|
|
rad-v rad-h chv shv cvv svv matrix block-obj temp-obj ks-data
|
|
ks-ein-raw ks-aus-raw
|
|
ein-x ein-y ein-z aus-x aus-y aus-z
|
|
dx dz ins-pt 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)
|
|
" hz=" (rtos (float hz) 2 1) (chr 176) ")"))
|
|
(setq rad-v (* winkel (/ pi 180.0)))
|
|
(setq rad-h (* (float hz) (/ pi 180.0)))
|
|
(setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v))
|
|
;; Lokale KS_EIN/KS_AUS-Position ueber EIGENES Temp-Objekt ermitteln
|
|
;; (nicht am spaeter tatsaechlich platzierten block-obj -
|
|
;; extract-ks-from-block exploded das uebergebene Objekt intern; das
|
|
;; darf nicht das Objekt sein, das anschliessend gedreht/verschoben
|
|
;; in der Zeichnung bleibt).
|
|
(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-raw (cadr (assoc "KS_EIN" ks-data)))
|
|
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
|
|
(setq ein-x 0.0 ein-y 0.0 ein-z 0.0)
|
|
(if ks-ein-raw
|
|
(setq ein-x (car (car ks-ein-raw))
|
|
ein-y (cadr (car ks-ein-raw))
|
|
ein-z (caddr (car ks-ein-raw)))
|
|
)
|
|
;; Echten Versatz KS_AUS-KS_EIN verwenden, sofern messbar (statt der
|
|
;; ggf. veralteten Config-Werte block-dx/block-dz).
|
|
(setq dx block-dx dz block-dz)
|
|
(if ks-aus-raw
|
|
(progn
|
|
(setq aus-x (car (car ks-aus-raw))
|
|
aus-y (cadr (car ks-aus-raw))
|
|
aus-z (caddr (car ks-aus-raw)))
|
|
(setq dx (- aus-x ein-x) dz (- aus-z ein-z))
|
|
)
|
|
)
|
|
(setq block-obj (vla-InsertBlock modelspace
|
|
(vlax-3D-point '(0 0 0))
|
|
blockname 1.0 1.0 1.0 0))
|
|
(setq matrix (list
|
|
(list (* chv cvv) (- shv) (* chv svv) 0)
|
|
(list (* shv cvv) chv (* shv svv) 0)
|
|
(list (- svv) 0 cvv 0)
|
|
(list 0 0 0 1)
|
|
))
|
|
(vla-TransformBy block-obj (vlax-tmatrix matrix))
|
|
;; Block-Ursprung so verschieben, dass das ROTIERTE KS_EIN exakt auf
|
|
;; startpunkt liegt: Ursprung = startpunkt - Rz(hz)*Ry(winkel)*ks_ein_lokal
|
|
(setq ins-pt (list
|
|
(- (car startpunkt) (+ (* ein-x chv cvv) (* ein-y (- shv)) (* ein-z chv svv)))
|
|
(- (cadr startpunkt) (+ (* ein-x shv cvv) (* ein-y chv) (* ein-z shv svv)))
|
|
(- (caddr startpunkt) (+ (* ein-x (- svv)) (* ein-z cvv)))))
|
|
(vla-Move block-obj
|
|
(vlax-3D-point '(0 0 0))
|
|
(vlax-3D-point ins-pt))
|
|
(setq endpunkt (list
|
|
(+ (car startpunkt) (+ (* dx chv cvv) (* dz chv svv)))
|
|
(+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv)))
|
|
(+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv)))))
|
|
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2)
|
|
" Y=" (rtos (cadr endpunkt) 2 2)
|
|
" Z=" (rtos (caddr endpunkt) 2 2)
|
|
" (dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1) ")"))
|
|
endpunkt
|
|
)
|
|
)
|
|
)
|
|
|
|
;; ============================================================
|
|
;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE
|
|
;; ============================================================
|
|
(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
|
|
deltaL deltaH deltaX deltaY richtung antwort hz-winkel)
|
|
(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))
|
|
;; Fahrtrichtung aus der Linie ableiten (0=Ost, 90=Nord, ...)
|
|
(setq hz-winkel
|
|
(* (angle '(0.0 0.0) (list (car differenz) (cadr differenz))) (/ 180.0 pi)))
|
|
(princ (strcat "\n △L=" (rtos deltaL 2 2) " mm"
|
|
" △H=" (rtos deltaH 2 2) " mm"
|
|
" Fahrtrichtung=" (rtos hz-winkel 2 1) grad-zeichen))
|
|
(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))
|
|
;; Foerderrichtung bleibt eine einfache Auf/Ab-Frage - die horizontale
|
|
;; Zwischenstrecke ist geometrisch NUR bei "Ab" ueberhaupt erreichbar
|
|
;; (die festen 3-Grad-Elemente wirken immer absenkend) und wird daher
|
|
;; erst SPAETER, nach Bibliotheks-Init, als Zusatzoption in der
|
|
;; Winkel-Auswahl angeboten (siehe c:VarioFoerderer) - einheitlich fuer
|
|
;; Werteingabe UND 3D-Linie.
|
|
(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)))
|
|
;; Horizontale Fahrtrichtung waehlen (analog Gefaellestrecke Modus 1)
|
|
(princ "\n\nFahrtrichtung waehlen:")
|
|
(princ "\n 1 - 0° (X-Achse +, Ost)")
|
|
(princ "\n 2 - 90° (Y-Achse +, Nord)")
|
|
(princ "\n 3 - 180° (X-Achse -, West)")
|
|
(princ "\n 4 - 270° (Y-Achse -, Sued)")
|
|
(setq antwort (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
|
|
(cond
|
|
((= antwort "2") (setq hz-winkel 90.0))
|
|
((= antwort "3") (setq hz-winkel 180.0))
|
|
((= antwort "4") (setq hz-winkel 270.0))
|
|
(t (setq hz-winkel 0.0))
|
|
)
|
|
(princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen))
|
|
)
|
|
)
|
|
(list deltaL deltaH richtung startpunkt hz-winkel eingabe-modus)
|
|
)
|
|
|
|
;; ============================================================
|
|
;; TEIL 10: VF_*-BLOCK-SYSTEM (gemeinsam fuer alle Typen)
|
|
;; ============================================================
|
|
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...) - siehe
|
|
;; variofoerderer-einfuegen. Beschriftungsposition wird ENTLANG dieser
|
|
;; Richtung (halbe deltaL) und SENKRECHT dazu (200mm) versetzt, statt fest
|
|
;; von +X auszugehen. Der Textwinkel rastet wie bei Gefaellestrecke immer
|
|
;; auf 0 Grad (X-Achse) oder 90 Grad (Y-Achse) ein, damit er nie auf dem
|
|
;; Kopf steht - unabhaengig von der tatsaechlichen Fahrtrichtung.
|
|
;; L_GF1/L_GF2: die beiden Gefaellestrecken-Segmente (vorne/hinten) - werden
|
|
;; als kommagetrennte Meter-Werte dargestellt (Punkt=Dezimaltrennzeichen,
|
|
;; Komma=Segment-Trenner, analog L-gf-str in Gefaellestrecke.lsp), damit
|
|
;; beide Werte eindeutig unterscheidbar bleiben.
|
|
(defun vf-make-label (vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
|
|
richtung best-winkel n-separator n-scanner startpunkt hz /
|
|
label-txt label-pt L_VF_str L_GF_str delta-sym
|
|
chz-l shz-l halb basis-winkel)
|
|
(setq delta-sym (chr 916))
|
|
(setq L_VF_str (vl-string-subst "," "." (rtos (/ L_VF 1000.0) 2 3)))
|
|
(setq L_GF_str (strcat (rtos (/ L_GF1 1000.0) 2 3) "," (rtos (/ L_GF2 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 chz-l (cos (* (float hz) (/ pi 180.0))))
|
|
(setq shz-l (sin (* (float hz) (/ pi 180.0))))
|
|
(setq halb (/ (float deltaL) 2.0))
|
|
(setq label-pt (list
|
|
(+ (car startpunkt) (* halb chz-l) (* 200.0 shz-l))
|
|
(+ (cadr startpunkt) (* halb shz-l) (* -200.0 chz-l))
|
|
(caddr startpunkt)))
|
|
;; Textwinkel auf 0/90 Grad einrasten (nie kopfueber, unabhaengig von hz)
|
|
(setq basis-winkel (float hz))
|
|
(while (< basis-winkel 0.0) (setq basis-winkel (+ basis-winkel 360.0)))
|
|
(while (>= basis-winkel 360.0) (setq basis-winkel (- basis-winkel 360.0)))
|
|
(if (>= basis-winkel 180.0) (setq basis-winkel (- basis-winkel 180.0)))
|
|
(setq basis-winkel (if (or (< basis-winkel 45.0) (>= basis-winkel 135.0)) 0.0 90.0))
|
|
(entmake (list
|
|
'(0 . "TEXT")
|
|
(cons 8 "VF_Beschriftung")
|
|
'(67 . 0)
|
|
(cons 10 label-pt)
|
|
(cons 40 100.0)
|
|
(cons 1 label-txt)
|
|
(cons 50 (* basis-winkel (/ pi 180.0)))
|
|
'(72 . 1)
|
|
'(73 . 2)
|
|
(cons 11 label-pt)
|
|
))
|
|
)
|
|
|
|
;; Ermittelt den "letzten Entity" VOR einer neuen Einfuegung, so dass
|
|
;; nachfolgende Attribut-Entities/SEQEND eines vorherigen INSERT (z.B. eines
|
|
;; vorangegangenen VF_N-Blocks) nicht versehentlich in die naechste
|
|
;; vf-block-erstellen-Sammlung hineinfallen. Muss von JEDEM Aufrufer von
|
|
;; vf-block-erstellen anstelle eines nackten (entlast) verwendet werden.
|
|
(defun vf-lastent-ohne-attribute ( / ent)
|
|
(setq ent (entlast))
|
|
(if (and ent
|
|
(= (cdr (assoc 0 (entget ent))) "INSERT")
|
|
(= (cdr (assoc 66 (entget ent))) 1))
|
|
(progn
|
|
(setq ent (entnext ent))
|
|
(while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND"))
|
|
(setq ent (entnext ent))
|
|
)
|
|
)
|
|
)
|
|
ent
|
|
)
|
|
|
|
;; 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_GF1 L_GF2
|
|
richtung best-winkel startpunkt lastEnt hz
|
|
/ vf-bname vf-ss vf-e vf-insert montagehoehe-m attdef-ypos L_GF_m-str)
|
|
(if (null hz) (setq hz 0.0))
|
|
;; Beschriftungstext erzeugen
|
|
(vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
|
|
richtung best-winkel 2 n-scanner startpunkt hz)
|
|
|
|
;; Unsichtbare ATTDEFs am Startpunkt erzeugen (gemeinsames Strecken-Schema;
|
|
;; VarioFoerderer ist immer TYP "Streckengruppe" -> voller Attributsatz).
|
|
(setq attdef-ypos (cadr startpunkt))
|
|
(foreach def (ssg-strecke-attrib-defs "Streckengruppe")
|
|
(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))
|
|
;; L_GF_m: kommagetrennte Segmentlaengen in Metern (vorne,hinten),
|
|
;; analog L_GF_m in Gefaellestrecke.lsp.
|
|
(setq L_GF_m-str (strcat (rtos (/ L_GF1 1000.0) 2 3) "," (rtos (/ L_GF2 1000.0) 2 3)))
|
|
(ssg-attrib-set-on vf-insert
|
|
(list
|
|
(cons "Bezeichnung" vf-bname)
|
|
;; Artinr. bleibt auf Schema-Vorgabe "6220"
|
|
(cons "MONTAGEHOEHE_m" (rtos montagehoehe-m 2 3))
|
|
(cons "HOEHE_VON_mm" (itoa (fix hoehe-von)))
|
|
(cons "HOEHE_BIS_mm" (itoa (fix hoehe-bis)))
|
|
(cons "DELTA_H_mm" (itoa (fix deltaH)))
|
|
(cons "DELTA_L_mm" (itoa (fix deltaL)))
|
|
(cons "TYP" "Streckengruppe")
|
|
(cons "SEITE_AS" seite)
|
|
(cons "SEITE_ES" seite)
|
|
(cons "ANZAHL_GF" "2") ; GF1 + GF2
|
|
(cons "L_GF_m" L_GF_m-str)
|
|
;; GF_WINKEL: Neigung je GF-Segment (GF1,GF2 - beide feste Grundneigung)
|
|
(cons "GF_WINKEL" (strcat (rtos (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) 2 1)
|
|
"," (rtos (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) 2 1)))
|
|
(cons "ANZAHL_VF" "1") ; ein VF-Koerper
|
|
(cons "MOTORSEITE" "rechts")
|
|
(cons "L_VF_m" (rtos (/ L_VF 1000.0) 2 3))
|
|
(cons "ANTRIEBFAHRTRICHTUNG" richtung)
|
|
(cons "VF_WINKEL" (itoa best-winkel))
|
|
(cons "ANZAHL_SEPARATOR" "2")
|
|
(cons "ANZAHL_SCANNER" (itoa n-scanner))
|
|
)
|
|
)
|
|
;; 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")))
|
|
)
|
|
)
|
|
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
|
|
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
|
|
(ssg-id-generate vf-insert))
|
|
(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"))
|
|
(load (strcat *vf-lisp-pfad* "/vf_linienzug.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 hz
|
|
eingabe-modus ergebnis ergebnis-liste gueltige-winkel
|
|
horizontal-info
|
|
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))
|
|
|
|
;; Sonderfall "linienzug": eigener Befehlsablauf (interaktive Mehrsegment-
|
|
;; Kette mit gemischten GF/VF-Segmenten), passt nicht in das berechne-fn/
|
|
;; einfuege-fn-Schema fuer ein einzelnes durchgehendes Segment - siehe
|
|
;; vf_linienzug.lsp. Dispatcht hier direkt und beendet den Standard-Ablauf.
|
|
(if (= anlage-typ "linienzug")
|
|
(progn
|
|
(vf-linienzug-modus)
|
|
(exit)
|
|
)
|
|
)
|
|
|
|
;; 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) - richtung
|
|
;; steht bei beiden Eingabemodi (Werteingabe UND 3D-Linie) bereits fest.
|
|
(setq eingabe (vf-eingabe-abfragen))
|
|
(setq deltaL (nth 0 eingabe)
|
|
deltaH (nth 1 eingabe)
|
|
richtung (nth 2 eingabe)
|
|
startpunkt (nth 3 eingabe)
|
|
hz (nth 4 eingabe)
|
|
eingabe-modus (nth 5 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 + Winkelsuche)
|
|
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
|
|
(setq ergebnis-liste (cadddr ergebnis))
|
|
|
|
;; 5b. Horizontale Zwischenstrecke als Zusatzoption: geometrisch NUR bei
|
|
;; "Ab" ueberhaupt erreichbar (die festen 3-Grad-Elemente wirken immer
|
|
;; absenkend) - "Auf" wird deshalb gar nicht erst geprueft. Gilt einheitlich
|
|
;; fuer Werteingabe UND 3D-Linie, da richtung hier in jedem Fall feststeht.
|
|
;; Bibliothek ist durch den berechne-fn-Aufruf oben bereits initialisiert.
|
|
(if (and (= anlage-typ "standard") (= richtung "Ab"))
|
|
(progn
|
|
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab"))
|
|
(if (and horizontal-info (caddr horizontal-info))
|
|
(progn
|
|
(setq ergebnis-liste
|
|
(append ergebnis-liste
|
|
(list (list 0 (car horizontal-info) (cadr horizontal-info) T))))
|
|
(princ "\n\n>>> Hinweis: Ein horizontale Variofoerderer ( 0°) ist bei diesem △L/△H zusaetzlich moeglich!")
|
|
)
|
|
(setq horizontal-info nil)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; 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)
|
|
;; Sentinel-Winkel 0 = horizontale Zwischenstrecke (Schritt 6/11 bei 0
|
|
;; Grad, Boegen fest auf_3/ab_3) - siehe berechne-horizontale-mitte.
|
|
(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))
|
|
(if (= best-winkel 0)
|
|
(princ "\n\n>>> Einzige gueltige Variante: Horizontale Variofoerderer")
|
|
(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))
|
|
(if (= w 0)
|
|
(princ (strcat "\n " (itoa idx) " - Horizontale Variofoerderer (0"
|
|
(chr 176) ")"
|
|
" (L_GF=" (rtos (nth 1 eintrag) 2 1)
|
|
" mm, L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
|
|
(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=========================================")
|
|
(if (= best-winkel 0)
|
|
(princ (strcat "\n>>> Horizontale Variofoerderer"
|
|
" L_GF: " (rtos L_GF 2 2) " mm"
|
|
" L_VF: " (rtos L_VF 2 2) " mm"))
|
|
(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"))
|
|
|
|
;; Scanner-Anzahl wird nicht mehr abgefragt (Attribut ANZAHL_SCANNER bleibt 0).
|
|
(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 (vf-lastent-ohne-attribute))
|
|
|
|
;; Typ-spezifische Einfuegung
|
|
(apply einfuege-fn
|
|
(list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz))
|
|
|
|
;; Gemeinsame VF_*-Block-Erstellung
|
|
(vf-block-erstellen anlage-typ seite vf-nummer n-scanner
|
|
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
|
|
richtung best-winkel startpunkt lastEnt hz)
|
|
|
|
(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)
|