1795 lines
72 KiB
Common Lisp
1795 lines
72 KiB
Common Lisp
;; ============================================================
|
||
;; Gefaellestrecke.lsp - Gefaelle-Foerderanlage Generator
|
||
;; v2.0 - Standalone-Modul
|
||
;;
|
||
;; Modus 1: Manuelle Werteingabe (einfache Gefaellestrecke)
|
||
;; Modus 2: 3D-Linie als Referenz
|
||
;; Modus 3: Linienzug aus LINE- und ARC-Objekten
|
||
;; ARC-Segmente werden durch Gefaellebogen-Bloecke ersetzt.
|
||
;; Vor jedem Bogen wird automatisch ein Separator eingefuegt.
|
||
;; Gefaellewinkel wird aus deltaH und Geometrie berechnet.
|
||
;;
|
||
;; Verfuegbare Gefaellebogen-Bloecke (aus data/ils/3D/ als einzelne DWG):
|
||
;; Gefaellebogen_links_30(Grad)_R500 (30 Grad Linkskurve)
|
||
;; Gefaellebogen_links_60(Grad)_R500 (60 Grad Linkskurve)
|
||
;; Gefaellebogen_links_90(Grad)_R500 (90 Grad Linkskurve)
|
||
;; Gefaellebogen_rechts_30(Grad)_R500 (30 Grad Rechtskurve)
|
||
;; Gefaellebogen_rechts_60(Grad)_R500 (60 Grad Rechtskurve)
|
||
;; Gefaellebogen_rechts_90(Grad)_R500 (90 Grad Rechtskurve)
|
||
;;
|
||
;; Befehl: GEFAELLESTRECKE
|
||
;; ============================================================
|
||
|
||
(vl-load-com)
|
||
|
||
;; ============================================================
|
||
;; TEIL 1: INITIALISIERUNG
|
||
;; ============================================================
|
||
|
||
(if (null grad-zeichen) (setq grad-zeichen (chr 176)))
|
||
(if (null delta-sym) (setq delta-sym (chr 916)))
|
||
|
||
(if (null *gf-ks-cache*) (setq *gf-ks-cache* nil))
|
||
(if (null *gf-lib-geladen*)(setq *gf-lib-geladen* nil))
|
||
|
||
;; COM-Objekte (Guard: nicht ueberschreiben wenn von vf_core gesetzt)
|
||
(if (null doc)
|
||
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
|
||
(if (null modelspace)
|
||
(setq modelspace (vla-get-ModelSpace doc)))
|
||
|
||
;; Fallback-Werte fuer AS/ES-Blockabmessungen (Modus 1+2)
|
||
;; Werden von vf_standard.lsp ueberschrieben, falls geladen.
|
||
(if (null aus-dx) (setq aus-dx 526.0))
|
||
(if (null ein-dx) (setq ein-dx 576.0))
|
||
;; Z-Versatz KS_EIN->KS_AUS in Neutrallage (positiv = nach unten)
|
||
;; Werden in gf-init-bibliothek gemessen.
|
||
(if (null aus-dz) (setq aus-dz 0.0))
|
||
(if (null ein-dz) (setq ein-dz 0.0))
|
||
;; Lokale KS_EIN-Positionen (Blockursprung-relative Koordinaten, fuer Modus 3)
|
||
;; Werden in init-bibliothek gesetzt.
|
||
(if (null *aus-ks-ein-local*) (setq *aus-ks-ein-local* nil))
|
||
(if (null *ein-ks-ein-local*) (setq *ein-ks-ein-local* nil))
|
||
(if (null *lib-initialized*) (setq *lib-initialized* nil))
|
||
;; Laufende GF-Blocknummer (sitzungspersistent)
|
||
(if (null #GF_LetzteNr) (setq #GF_LetzteNr 0))
|
||
;; Hilfs-Globals fuer Winkelkorrektur (gesetzt von gf-winkel-berechnen)
|
||
(if (null *gf-L-ohne-as-es*) (setq *gf-L-ohne-as-es* nil))
|
||
(if (null *gf-sum-dz-bogen*) (setq *gf-sum-dz-bogen* 0.0))
|
||
|
||
;; DXFM_DIM lesen; 2D wird auf 3D korrigiert (Gefaellestrecke benoetigt Z-Geometrie)
|
||
(setq *gf-dxfm-dim* (getenv "DXFM_DIM"))
|
||
(if (or (not (= (type *gf-dxfm-dim*) 'STR)) (= *gf-dxfm-dim* "2D"))
|
||
(setq *gf-dxfm-dim* "3D"))
|
||
;; Block-Pfad: data/ils/3D/ wenn DXFM_DIM nicht gesetzt oder 2D
|
||
(if (null block-pfad)
|
||
(setq block-pfad
|
||
(cond
|
||
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
|
||
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
|
||
"/data/ils/" *gf-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/" *gf-dxfm-dim* "/"))
|
||
(t nil)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 2: KERN-FUNKTIONEN (Guard: nicht doppelt definieren)
|
||
;; ============================================================
|
||
|
||
;; --- ssg-cfg-or Ersatz ---
|
||
(if (null (car (atoms-family 1 '("SSG-CFG-OR"))))
|
||
(defun ssg-cfg-or (kategorie schluessel standard) standard)
|
||
)
|
||
|
||
;; --- Vektor-Laenge ---
|
||
(if (null (car (atoms-family 1 '("VEC-LENGTH"))))
|
||
(defun vec-length (v)
|
||
(sqrt (+ (* (car v) (car v))
|
||
(* (cadr v) (cadr v))
|
||
(* (caddr v) (caddr v)))))
|
||
)
|
||
|
||
;; --- Achsenkennung aus Linienlaenge fuer KS-Extraktion ---
|
||
(if (null (car (atoms-family 1 '("KS-LINE-AXIS"))))
|
||
(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)))
|
||
)
|
||
|
||
;; --- Punkt-Differenz ---
|
||
(if (null (car (atoms-family 1 '("PUNKT-DIFFERENZ"))))
|
||
(defun punkt-differenz (p1 p2)
|
||
(list (- (car p2) (car p1))
|
||
(- (cadr p2) (cadr p1))
|
||
(- (caddr p2) (caddr p1))))
|
||
)
|
||
|
||
;; --- Block als einzelne DWG-Datei aus block-pfad laden ---
|
||
(if (null (car (atoms-family 1 '("ENSURE-BLOCK-LOADED"))))
|
||
(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))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Rohe KS-Extraktion aus Block ---
|
||
(if (null (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK-RAW"))))
|
||
(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 line-vec line-len axis)
|
||
(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
|
||
)
|
||
)
|
||
|
||
;; --- KS-Extraktion mit Cache ---
|
||
(if (null (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK"))))
|
||
(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 *gf-ks-cache*))
|
||
(if cached
|
||
;; Aus Cache: relative Koordinaten + Einfuegepunkt
|
||
(mapcar '(lambda (item)
|
||
(list (car item)
|
||
(mapcar '(lambda (pt)
|
||
(list (+ (car pt) (car insert-pt))
|
||
(+ (cadr pt) (cadr insert-pt))
|
||
(+ (caddr pt) (caddr insert-pt))))
|
||
(cadr item))))
|
||
(cdr cached))
|
||
(progn
|
||
(setq result (extract-ks-from-block-raw block-obj))
|
||
(if result
|
||
(progn
|
||
(setq ks-rel
|
||
(mapcar '(lambda (item)
|
||
(list (car item)
|
||
(mapcar '(lambda (pt)
|
||
(list (- (car pt) (car insert-pt))
|
||
(- (cadr pt) (cadr insert-pt))
|
||
(- (caddr pt) (caddr insert-pt))))
|
||
(cadr item))))
|
||
result))
|
||
(setq *gf-ks-cache*
|
||
(cons (cons blockname ks-rel) *gf-ks-cache*))
|
||
)
|
||
)
|
||
result
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Block per KS_EIN/KS_AUS einfuegen ---
|
||
(if (null (car (atoms-family 1 '("INSERT-BLOCK-BY-KS"))))
|
||
(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)
|
||
(ensure-block-loaded blockname)
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
(progn
|
||
(princ (strcat "\n FEHLER: Block '" blockname "' fehlt"))
|
||
(exit)
|
||
)
|
||
)
|
||
(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), siehe vf_core.lsp.
|
||
(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)))
|
||
(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 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)))
|
||
(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))
|
||
(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 Z=" (rtos (caddr ausgang) 2 2)))
|
||
ausgang
|
||
)
|
||
(progn
|
||
(princ "\n WARNUNG: KS_EIN/KS_AUS fehlt!")
|
||
einfuegepunkt
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Skalierter geneigter Block (Staustrecke, Richtung X) ---
|
||
(if (null (car (atoms-family 1 '("INSERT-INCLINED-SCALED-BLOCK"))))
|
||
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz /
|
||
rad-v rad-h chv shv cvv svv scale block-obj endpunkt)
|
||
(if (<= laenge 0.1)
|
||
(progn (princ "\n (Laenge 0 - uebersprungen)") startpunkt)
|
||
(progn
|
||
(ensure-block-loaded blockname)
|
||
(setq scale (/ (float laenge) 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))
|
||
(vla-TransformBy block-obj (vlax-tmatrix
|
||
(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-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 " blockname " L=" (rtos laenge 2 1)
|
||
" -> Z=" (rtos (caddr endpunkt) 2 1)))
|
||
endpunkt
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Rotierter Block mit manuellem dx/dz ---
|
||
;; KS_EIN (nicht der Block-Ursprung) wird auf startpunkt ausgerichtet, siehe
|
||
;; Kommentar an der kanonischen Definition in vf_core.lsp.
|
||
(if (null (car (atoms-family 1 '("INSERT-ROTATED-BLOCK-WITH-KS"))))
|
||
;; block-dx/block-dz: Fallback, nur falls KS_AUS nicht extrahierbar.
|
||
;; Ist KS_AUS vorhanden, wird der echte Versatz KS_AUS-KS_EIN verwendet
|
||
;; (schuetzt vor veralteten Config-Zahlen), siehe vf_core.lsp.
|
||
(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz hz /
|
||
rad-v rad-h chv shv cvv svv 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)
|
||
(ensure-block-loaded blockname)
|
||
(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))
|
||
;; Lokale KS_EIN/KS_AUS-Position ueber EIGENES Temp-Objekt ermitteln
|
||
;; (nicht am spaeter tatsaechlich platzierten block-obj), siehe vf_core.lsp.
|
||
(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)))
|
||
)
|
||
(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))
|
||
(vla-TransformBy block-obj (vlax-tmatrix
|
||
(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))))
|
||
(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))
|
||
(list
|
||
(+ (car startpunkt) (+ (* dx chv cvv) (* dz chv svv)))
|
||
(+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv)))
|
||
(+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv))))
|
||
)
|
||
)
|
||
|
||
;; --- KS-Rahmen aus Fahrtrichtungsvektor (Fallback wenn vf_core nicht geladen) ---
|
||
(if (null (car (atoms-family 1 '("MAKE-FRAME-FROM-DIR"))))
|
||
(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
|
||
(list (- (* (cadr xu-unit)(caddr yu)) (* (caddr xu-unit)(cadr yu)))
|
||
(- (* (caddr xu-unit)(car yu)) (* (car xu-unit)(caddr yu)))
|
||
(- (* (car xu-unit)(cadr yu)) (* (cadr xu-unit)(car yu)))))
|
||
(list P xu-unit yu zu))
|
||
)
|
||
|
||
;; --- Linie/Polylinie-Endpunkte lesen ---
|
||
(if (null (car (atoms-family 1 '("GET-LINE-START-END-POINTS"))))
|
||
(defun get-line-start-end-points (msg / ent obj obj-name sp ep)
|
||
(princ msg)
|
||
(setq ent (entsel "\n >> Linie waehlen: "))
|
||
(if ent
|
||
(progn
|
||
(setq obj (vlax-ename->vla-object (car ent)))
|
||
(setq obj-name (vla-get-ObjectName obj))
|
||
(cond
|
||
((= obj-name "AcDbLine")
|
||
(setq sp (vlax-safearray->list
|
||
(vlax-variant-value (vla-get-StartPoint obj))))
|
||
(setq ep (vlax-safearray->list
|
||
(vlax-variant-value (vla-get-EndPoint obj))))
|
||
(princ (strcat "\n 3D-Linie: Z_start=" (rtos (caddr sp) 2 2)
|
||
" Z_end=" (rtos (caddr ep) 2 2)))
|
||
(list sp ep)
|
||
)
|
||
(t (princ "\n Fehler: keine Linie!") nil)
|
||
)
|
||
)
|
||
nil
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Bibliothek initialisieren: AS/ES-Masse aus einzelnen DWG-Dateien extrahieren ---
|
||
(if (null (car (atoms-family 1 '("GF-INIT-BIBLIOTHEK"))))
|
||
(defun gf-init-bibliothek ( / temp-obj ks-data ks-ein ks-aus)
|
||
(if *lib-initialized*
|
||
t
|
||
(progn
|
||
;; AS-Block laden und Masse extrahieren
|
||
(ensure-block-loaded "AS_Element_90_links")
|
||
(if (tblsearch "BLOCK" "AS_Element_90_links")
|
||
(progn
|
||
(setq temp-obj
|
||
(vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
"AS_Element_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 (cadr (assoc "KS_EIN" ks-data)))
|
||
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
|
||
(if (and ks-ein ks-aus)
|
||
(progn
|
||
(setq aus-dx (- (caar ks-aus) (caar ks-ein)))
|
||
(setq aus-dz (- (caddr (car ks-ein)) (caddr (car ks-aus))))
|
||
(setq *aus-ks-ein-local* (car ks-ein))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
;; ES-Block laden und Masse extrahieren
|
||
(ensure-block-loaded "ES_Element_90_links")
|
||
(if (tblsearch "BLOCK" "ES_Element_90_links")
|
||
(progn
|
||
(setq temp-obj
|
||
(vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
"ES_Element_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 (cadr (assoc "KS_EIN" ks-data)))
|
||
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
|
||
(if (and ks-ein ks-aus)
|
||
(progn
|
||
(setq ein-dx (- (caar ks-aus) (caar ks-ein)))
|
||
(setq ein-dz (- (caddr (car ks-ein)) (caddr (car ks-aus))))
|
||
(setq *ein-ks-ein-local* (car ks-ein))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(princ (strcat "\n[GF-Lib] AS: dx=" (rtos (float aus-dx) 2 1)
|
||
" dz=" (rtos (float aus-dz) 2 1)))
|
||
(princ (strcat "\n[GF-Lib] ES: dx=" (rtos (float ein-dx) 2 1)
|
||
" dz=" (rtos (float ein-dz) 2 1)))
|
||
(setq *lib-initialized* t)
|
||
(setq *gf-lib-geladen* t)
|
||
t
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 3: HZ-ROTATIONS-EINFUEGEFUNKTIONEN (fuer Modus 3)
|
||
;;
|
||
;; Transformationsmatrix: Rz(hz) * Ry(-vert)
|
||
;; [ cos(hz)*cos(v) -sin(hz) cos(hz)*sin(v) 0 ]
|
||
;; [ sin(hz)*cos(v) cos(hz) sin(hz)*sin(v) 0 ]
|
||
;; [ -sin(v) 0 cos(v) 0 ]
|
||
;; [ 0 0 0 1 ]
|
||
;; ============================================================
|
||
|
||
;; Staustrecke skaliert mit Hz-Rotation + Gefaelleneigung
|
||
;; laenge: Schraeglaenge in mm
|
||
;; hz-grad: Horizontalwinkel in Grad (0=+X, CCW)
|
||
;; vert-grad: Neigungswinkel in Grad (positiv = abwaerts)
|
||
(defun gf-insert-hz-incl-scaled (blockname pt laenge hz-grad vert-grad /
|
||
chz shz cv sv scale block-obj endpunkt)
|
||
(if (<= laenge 0.1)
|
||
(progn (princ "\n (Laenge 0 - uebersprungen)") pt)
|
||
(progn
|
||
(ensure-block-loaded blockname)
|
||
(setq scale (/ (float laenge) 1000.0))
|
||
(setq chz (cos (* (float hz-grad) (/ pi 180.0))))
|
||
(setq shz (sin (* (float hz-grad) (/ pi 180.0))))
|
||
(setq cv (cos (* (float vert-grad) (/ pi 180.0))))
|
||
(setq sv (sin (* (float vert-grad) (/ pi 180.0))))
|
||
(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))))
|
||
(vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point pt))
|
||
(setq endpunkt
|
||
(list (+ (car pt) (* laenge chz cv))
|
||
(+ (cadr pt) (* laenge shz cv))
|
||
(+ (caddr pt) (* (- sv) laenge))))
|
||
(princ (strcat "\n HzIncl " blockname
|
||
" L=" (rtos laenge 2 0)
|
||
" hz=" (rtos hz-grad 2 0) grad-zeichen
|
||
" v=" (rtos vert-grad 2 1) grad-zeichen
|
||
" -> Z=" (rtos (caddr endpunkt) 2 1)))
|
||
endpunkt
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Block mit Hz + Neigung, Endpunkt per manuellem dx/dz
|
||
;; dx: Laenge entlang Vorwaertsrichtung (mm)
|
||
;; dz: vertikaler Offset im Block (mm, 0 fuer gerade Bloecke)
|
||
(defun gf-insert-hz-with-ks (blockname pt hz-grad vert-grad dx dz /
|
||
chz shz cv sv block-obj endpunkt)
|
||
(ensure-block-loaded blockname)
|
||
(setq chz (cos (* (float hz-grad) (/ pi 180.0))))
|
||
(setq shz (sin (* (float hz-grad) (/ pi 180.0))))
|
||
(setq cv (cos (* (float vert-grad) (/ pi 180.0))))
|
||
(setq sv (sin (* (float vert-grad) (/ pi 180.0))))
|
||
(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))))
|
||
(vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point pt))
|
||
(setq endpunkt
|
||
(list (+ (car pt) (+ (* dx chz cv) (* dz chz sv)))
|
||
(+ (cadr pt) (+ (* dx shz cv) (* dz shz sv)))
|
||
(+ (caddr pt) (+ (* (- sv) dx) (* cv dz)))))
|
||
(princ (strcat "\n HzKS " blockname
|
||
" hz=" (rtos hz-grad 2 0) grad-zeichen
|
||
" v=" (rtos vert-grad 2 1) grad-zeichen
|
||
" -> Z=" (rtos (caddr endpunkt) 2 1)))
|
||
endpunkt
|
||
)
|
||
|
||
;; Gefaellebogen-Block per KS_EIN/KS_AUS einfuegen.
|
||
;; Nur Hz-Rotation (vert=0): Block hat eigene 3D-Geometrie fuer die Neigung.
|
||
;; hz-grad: Eingangsrichtung in Grad
|
||
(defun gf-insert-gefaellebogen-by-ks (blockname pt hz-grad /
|
||
chz shz
|
||
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 "' fehlt!"))
|
||
(exit)
|
||
)
|
||
)
|
||
(setq chz (cos (* (float hz-grad) (/ pi 180.0))))
|
||
(setq shz (sin (* (float hz-grad) (/ pi 180.0))))
|
||
;; KS-Daten bei hz=0 (Block 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 nur um Z-Achse drehen (Rz)
|
||
(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 (- shz) 0 0)
|
||
(list shz chz 0 0)
|
||
(list 0 0 1 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))
|
||
;; Rz auf KS-Punkte anwenden (Z bleibt unveraendert)
|
||
(setq p-ein-rot
|
||
(list (- (* chz (car p-ein)) (* shz (cadr p-ein)))
|
||
(+ (* shz (car p-ein)) (* chz (cadr p-ein)))
|
||
(caddr p-ein)))
|
||
(setq p-aus-rot
|
||
(list (- (* chz (car p-aus)) (* shz (cadr p-aus)))
|
||
(+ (* shz (car p-aus)) (* chz (cadr p-aus)))
|
||
(caddr p-aus)))
|
||
;; Block verschieben: rotiertes KS_EIN -> pt
|
||
(vla-Move block-obj (vlax-3D-point p-ein-rot) (vlax-3D-point pt))
|
||
(setq offset
|
||
(list (- (car pt) (car p-ein-rot))
|
||
(- (cadr pt) (cadr p-ein-rot))
|
||
(- (caddr pt) (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 Gefaellebogen " blockname
|
||
" hz=" (rtos hz-grad 2 0) grad-zeichen
|
||
" -> Z=" (rtos (caddr ausgang) 2 1)))
|
||
ausgang
|
||
)
|
||
(progn
|
||
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "'"))
|
||
pt
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 4: MODUS 3 - LINIENZUG-ANALYSE
|
||
;; ============================================================
|
||
|
||
;; Horizontalwinkel von p1 nach p2 (Grad, 0=+X, CCW positiv)
|
||
(defun gf-hz-winkel (p1 p2)
|
||
(* (atan (- (cadr p2) (cadr p1))
|
||
(- (car p2) (car p1)))
|
||
(/ 180.0 pi)))
|
||
|
||
;; 2D-Abstand (XY-Ebene)
|
||
(defun gf-abstand-2d (p1 p2)
|
||
(sqrt (+ (* (- (car p2) (car p1)) (- (car p2) (car p1)))
|
||
(* (- (cadr p2) (cadr p1)) (- (cadr p2) (cadr p1))))))
|
||
|
||
;; Bogensweep (Grad, positiv) -> naechster Gefaellebogen-Winkel
|
||
(defun gf-snap-bogenwinkel (d)
|
||
(cond ((< d 45) 30)
|
||
((< d 75) 60)
|
||
(t 90)))
|
||
|
||
;; Blockname fuer Gefaellebogen
|
||
(defun gf-bogen-blockname (bwinkel bseite)
|
||
(strcat "Gefaellebogen_" bseite "_" (itoa bwinkel) "_R500"))
|
||
|
||
;; dx und dz eines Gefaellebogen-Blocks extrahieren (KS_EIN -> KS_AUS)
|
||
;; Rueckgabe: (dx dz) dx = horizontale, dz = vertikale Verschiebung
|
||
(defun gf-bogen-masse (bwinkel bseite /
|
||
blockname temp-obj ks-data
|
||
ks-ein-pos ks-aus-pos dx dz)
|
||
(setq blockname (gf-bogen-blockname bwinkel bseite))
|
||
(ensure-block-loaded blockname)
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
(progn
|
||
(princ (strcat "\n WARNUNG: " blockname " fehlt - Nullwerte"))
|
||
'(0 0)
|
||
)
|
||
(progn
|
||
(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))
|
||
(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 dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
|
||
(princ (strcat "\n " blockname
|
||
": dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1)))
|
||
(list dx dz)
|
||
)
|
||
(progn
|
||
(princ (strcat "\n WARNUNG: KS fehlt in " blockname))
|
||
'(0 0)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Verbundene Objektkette sortieren ab startpunkt.
|
||
;; Rueckgabe: Liste von (obj sp ep umgekehrt)
|
||
;; umgekehrt=t wenn Objekt rueckwaerts traversiert wird
|
||
(defun gf-sortiere-objekte (obj-liste startpunkt /
|
||
kette aktuell rest
|
||
best best-d best-sp best-ep best-umk
|
||
item objname sp ep d1 d2)
|
||
(setq kette '())
|
||
(setq aktuell startpunkt)
|
||
(setq rest obj-liste)
|
||
(while rest
|
||
(setq best nil best-d 1e99)
|
||
(foreach item rest
|
||
(setq objname (vla-get-ObjectName item))
|
||
(if (or (= objname "AcDbLine") (= objname "AcDbArc"))
|
||
(progn
|
||
(setq sp (vlax-safearray->list
|
||
(vlax-variant-value (vla-get-StartPoint item))))
|
||
(setq ep (vlax-safearray->list
|
||
(vlax-variant-value (vla-get-EndPoint item))))
|
||
(setq d1 (gf-abstand-2d aktuell sp))
|
||
(setq d2 (gf-abstand-2d aktuell ep))
|
||
(if (< d1 best-d)
|
||
(setq best item best-d d1
|
||
best-sp sp best-ep ep best-umk nil)
|
||
)
|
||
(if (< d2 best-d)
|
||
(setq best item best-d d2
|
||
best-sp ep best-ep sp best-umk t)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(if best
|
||
(progn
|
||
(setq kette
|
||
(append kette (list (list best best-sp best-ep best-umk))))
|
||
(setq aktuell best-ep)
|
||
(setq rest (vl-remove best rest))
|
||
)
|
||
(progn
|
||
(princ "\n WARNUNG: Kette unterbrochen!")
|
||
(setq rest nil)
|
||
)
|
||
)
|
||
)
|
||
kette
|
||
)
|
||
|
||
;; Kette analysieren -> Segment-Daten
|
||
;; Segment: (typ hz-eingang laenge-2d bogen-winkel seite)
|
||
;; typ: "Linie" oder "Bogen"
|
||
;; hz-eingang: Horizontalwinkel bei Eintritt (Grad)
|
||
;; laenge-2d: 2D XY-Laenge (fuer LINE), Sehnenmass (fuer ARC)
|
||
;; bogen-winkel: 30/60/90 (nur fuer Bogen)
|
||
;; seite: "links"/"rechts" (nur fuer Bogen)
|
||
(defun gf-analysiere-kette (kette /
|
||
segmente item obj objname sp ep umk
|
||
hz start-a end-a sweep delta
|
||
bwinkel bseite prev-hz)
|
||
(setq segmente '())
|
||
(setq prev-hz nil)
|
||
(foreach item kette
|
||
(setq obj (car item))
|
||
(setq sp (cadr item))
|
||
(setq ep (caddr item))
|
||
(setq umk (nth 3 item))
|
||
(setq objname (vla-get-ObjectName obj))
|
||
(cond
|
||
((= objname "AcDbLine")
|
||
(setq hz (gf-hz-winkel sp ep))
|
||
(setq segmente
|
||
(append segmente
|
||
(list (list "Linie" hz (gf-abstand-2d sp ep) 0 "links"))))
|
||
(setq prev-hz hz)
|
||
)
|
||
((= objname "AcDbArc")
|
||
;; Sweep des Bogens in Grad (immer positiv, CCW)
|
||
(setq start-a (vla-get-StartAngle obj))
|
||
(setq end-a (vla-get-EndAngle obj))
|
||
(if (>= end-a start-a)
|
||
(setq sweep (* (- end-a start-a) (/ 180.0 pi)))
|
||
(setq sweep (* (+ (* 2 pi) (- end-a start-a)) (/ 180.0 pi)))
|
||
)
|
||
;; Traversierungsrichtung: vorwaerts=CCW=Linkskurve, rueckwaerts=CW=Rechtskurve
|
||
(if umk
|
||
(setq delta (- sweep))
|
||
(setq delta sweep)
|
||
)
|
||
(setq bwinkel (gf-snap-bogenwinkel (abs delta)))
|
||
(setq bseite (if (>= delta 0) "links" "rechts"))
|
||
;; Eingangsrichtung: vorheriger Richtungswinkel (oder Chord-Winkel)
|
||
(setq hz (if prev-hz prev-hz (gf-hz-winkel sp ep)))
|
||
(setq segmente
|
||
(append segmente
|
||
(list (list "Bogen" hz (gf-abstand-2d sp ep) bwinkel bseite))))
|
||
;; Ausgangsrichtung nach dem Bogen
|
||
(setq prev-hz
|
||
(+ hz (* (if (>= delta 0) 1.0 -1.0) (float bwinkel))))
|
||
)
|
||
)
|
||
)
|
||
segmente
|
||
)
|
||
|
||
;; Gefaellewinkel (Grad) aus Segmentliste und deltaH berechnen.
|
||
;; deltaH: positiver Hoehenunterschied in mm (Gesamt-Abfall)
|
||
;; extra-sep: zusaetzliche Separatoren ausserhalb der Bogen (z.B. 1 vor EIN-Element)
|
||
;; Formel (Naeherung): sin(v) = (deltaH - aus-dz - ein-dz - sum(|dz_bogen|))
|
||
;; / (L_gerade + aus-dx + ein-dx + sum(dx_bogen))
|
||
;; Setzt Globals fuer Korrekturschritt:
|
||
;; *gf-L-ohne-as-es* - Laenge ohne AS/ES-dx (fuer gemessene Korrektur)
|
||
;; *gf-sum-dz-bogen* - Summe dz-Anteile der Bogen
|
||
(defun gf-winkel-berechnen (segmente deltaH extra-sep /
|
||
L-gerade sum-dz-bogen sum-dx-bogen n-bogen
|
||
seg bwinkel bseite masse sin-alpha alpha deltaH-eff)
|
||
(setq L-gerade 0.0 sum-dz-bogen 0.0 sum-dx-bogen 0.0 n-bogen 0)
|
||
(foreach seg segmente
|
||
(if (= (car seg) "Linie")
|
||
(setq L-gerade (+ L-gerade (caddr seg)))
|
||
(progn
|
||
(setq bwinkel (nth 3 seg) bseite (nth 4 seg))
|
||
(setq masse (gf-bogen-masse bwinkel bseite))
|
||
(setq sum-dx-bogen (+ sum-dx-bogen (car masse)))
|
||
(setq sum-dz-bogen (+ sum-dz-bogen (abs (cadr masse))))
|
||
(setq n-bogen (1+ n-bogen))
|
||
)
|
||
)
|
||
)
|
||
;; Separator (300mm): je einen vor jedem Bogen + extra-sep weitere
|
||
(setq L-gerade (+ L-gerade (* (+ (float n-bogen) (float extra-sep)) 300.0)))
|
||
;; L ohne AS/ES-dx fuer Korrekturschritt exportieren
|
||
(setq *gf-L-ohne-as-es* (+ L-gerade (float sum-dx-bogen)))
|
||
(setq *gf-sum-dz-bogen* sum-dz-bogen)
|
||
;; Gesamter Nenn-Laengenanteil: Gerade + AS/ES-dx + Bogen-dx
|
||
;; dH_grade = L_total * sin(v); dH_fix = aus-dz + ein-dz + sum-dz-bogen
|
||
(setq L-gerade (+ L-gerade (float aus-dx) (float ein-dx) (float sum-dx-bogen)))
|
||
(setq deltaH-eff (- (float deltaH) (float aus-dz) (float ein-dz) sum-dz-bogen))
|
||
(princ (strcat "\n Gesamte Nennlaenge (inkl. Bogen-dx): " (rtos L-gerade 2 1) " mm"))
|
||
(princ (strcat "\n Feste Hoehenanteile (AS/ES-dz + Bogen-dz): "
|
||
(rtos (+ (float aus-dz) (float ein-dz) sum-dz-bogen) 2 1) " mm"))
|
||
(princ (strcat "\n aus-dz=" (rtos (float aus-dz) 2 2)
|
||
" ein-dz=" (rtos (float ein-dz) 2 2)
|
||
" Bogen-dz=" (rtos sum-dz-bogen 2 2)))
|
||
(princ (strcat "\n Effektive Resthoehe fuer Grade: " (rtos deltaH-eff 2 1) " mm"))
|
||
(cond
|
||
((<= L-gerade 0.1)
|
||
(princ "\n WARNUNG: keine geraden Strecken -> Fallback 3 Grad")
|
||
3.0)
|
||
((< deltaH-eff 0)
|
||
(princ "\n WARNUNG: feste Anteile > deltaH -> Fallback 1 Grad")
|
||
1.0)
|
||
(t
|
||
(setq sin-alpha (/ deltaH-eff L-gerade))
|
||
(if (> sin-alpha 1.0) (setq sin-alpha 1.0))
|
||
(setq alpha (* (asin sin-alpha) (/ 180.0 pi)))
|
||
(princ (strcat "\n>>> Naeherungswinkel: " (rtos alpha 2 3) grad-zeichen))
|
||
alpha
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Misst die tatsaechliche Z-Absenkung eines Blocks bei gegebener Eingangsrichtung.
|
||
;; Fuegt den Block temporaer an Ursprung ein, liest KS_AUS.Z, loescht den Block.
|
||
;; xu-dir: normierter 3D-Einheitsvektor der Eingangsrichtung (inkl. Neigung v)
|
||
;; Rueckgabe: Z-Absenkung in mm (positiv = nach unten)
|
||
(defun gf-messe-dz-block (blockname xu-dir / testframe frame-aus ent-vor ent-nach dz)
|
||
(setq testframe (make-frame-from-dir '(0 0 0) xu-dir))
|
||
(setq ent-vor (entlast))
|
||
(setq frame-aus (insert-block-ks-to-ks blockname testframe))
|
||
(setq ent-nach (entlast))
|
||
;; Temporaer eingefuegten INSERT-Block loeschen
|
||
(if (and ent-nach (not (eq ent-nach ent-vor)))
|
||
(entdel ent-nach)
|
||
)
|
||
;; dz: KS_EIN war bei Z=0, KS_AUS.Z ist der Rueckgabewert
|
||
(setq dz (- 0.0 (caddr (car frame-aus))))
|
||
dz
|
||
)
|
||
|
||
;; Alle Segmente des Linienzugs einfuegen.
|
||
;; segmente : Ergebnis von gf-analysiere-kette
|
||
;; grade : Gefaellewinkel in Grad
|
||
;; startframe : Vollstaendiger Rahmen (P xu yu zu) am Kettenanfang
|
||
;; Rueckgabe : Vollstaendiger Rahmen (P xu yu zu) am Kettenende
|
||
(defun gf-linienzug-einfuegen (segmente grade startframe /
|
||
aktuell-frame i n seg naechstes
|
||
typ hz laenge bwinkel bseite blockname
|
||
rad-h rad-v xu-incl endpunkt)
|
||
(setq aktuell-frame startframe)
|
||
(setq n (length segmente))
|
||
(setq i 0)
|
||
(while (< i n)
|
||
(setq seg (nth i segmente))
|
||
(setq naechstes (if (< (1+ i) n) (nth (1+ i) segmente) nil))
|
||
(setq typ (car seg))
|
||
(setq hz (cadr seg))
|
||
(setq laenge (caddr seg))
|
||
(setq bwinkel (nth 3 seg))
|
||
(setq bseite (nth 4 seg))
|
||
(cond
|
||
((= typ "Linie")
|
||
(princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
|
||
": Staustrecke L=" (rtos laenge 2 1) " mm"
|
||
" hz=" (rtos hz 2 1) grad-zeichen
|
||
" v=" (rtos grade 2 2) grad-zeichen))
|
||
(setq endpunkt
|
||
(gf-insert-hz-incl-scaled
|
||
"Staustrecke_SP_1000_mm" (car aktuell-frame) laenge hz grade))
|
||
;; Ausgangsrahmen: geneigte Fahrtrichtung
|
||
(setq rad-h (* (float hz) (/ pi 180.0)))
|
||
(setq rad-v (* (float grade) (/ pi 180.0)))
|
||
(setq xu-incl (list (* (cos rad-h)(cos rad-v))
|
||
(* (sin rad-h)(cos rad-v))
|
||
(- (sin rad-v))))
|
||
(setq aktuell-frame (make-frame-from-dir endpunkt xu-incl))
|
||
;; Separator am Ende dieser Linie, falls naechstes Segment ein Bogen ist
|
||
(if (and naechstes (= (car naechstes) "Bogen"))
|
||
(progn
|
||
(princ (strcat "\n\n" (itoa (1+ i)) "S/" (itoa n)
|
||
": Separator 300mm (vor Bogen)"
|
||
" hz=" (rtos hz 2 1) grad-zeichen
|
||
" v=" (rtos grade 2 2) grad-zeichen))
|
||
(setq endpunkt
|
||
(gf-insert-hz-with-ks
|
||
"Staustrecke_Separator_SP_300_mm" (car aktuell-frame) hz grade 300 0))
|
||
(setq aktuell-frame (make-frame-from-dir endpunkt xu-incl))
|
||
)
|
||
)
|
||
)
|
||
((= typ "Bogen")
|
||
(setq blockname (gf-bogen-blockname bwinkel bseite))
|
||
(princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
|
||
": " blockname
|
||
" hz=" (rtos hz 2 1) grad-zeichen))
|
||
;; Gefaellebogen: KS_EIN an aktuellem Rahmen ausrichten (volle 3D-Rotation)
|
||
(setq aktuell-frame (insert-block-ks-to-ks blockname aktuell-frame))
|
||
)
|
||
)
|
||
(setq i (1+ i))
|
||
)
|
||
(princ "\n\n=========================================")
|
||
(princ "\n>>> Linienzug-Gefaellestrecke eingefuegt! <<<")
|
||
(princ "\n=========================================")
|
||
aktuell-frame)
|
||
|
||
;; Listenelement an Position idx durch val ersetzen.
|
||
(defun gf-replace-nth (lst idx val / i result)
|
||
(setq result '() i 0)
|
||
(foreach item lst
|
||
(setq result (append result (list (if (= i idx) val item))))
|
||
(setq i (1+ i))
|
||
)
|
||
result
|
||
)
|
||
|
||
;; Ausgangsrichtung (hz in Grad) nach dem letzten Segment berechnen.
|
||
;; Fuer Linie: hz des Segments; fuer Bogen: hz-eingang +/- bwinkel.
|
||
(defun gf-exit-hz (segmente / i n seg bseite prev-hz)
|
||
(setq prev-hz 0.0 n (length segmente) i 0)
|
||
(while (< i n)
|
||
(setq seg (nth i segmente))
|
||
(cond
|
||
((= (car seg) "Linie")
|
||
(setq prev-hz (cadr seg)))
|
||
((= (car seg) "Bogen")
|
||
(setq bseite (nth 4 seg))
|
||
(setq prev-hz (+ (cadr seg)
|
||
(* (if (= bseite "links") 1.0 -1.0)
|
||
(float (nth 3 seg))))))
|
||
)
|
||
(setq i (1+ i))
|
||
)
|
||
prev-hz
|
||
)
|
||
|
||
;; Hauptfunktion Modus 3
|
||
(defun gf-linienzug-modus ( /
|
||
ss n i j obj obj-liste kette segmente seg
|
||
startpunkt endpunkt-ref deltaH grade antwort idx
|
||
as-seite es-seite as-block es-block
|
||
entry-hz exit-hz
|
||
first-idx last-idx neu-l
|
||
aktuell-frame nach-aus-pt
|
||
gf-nummer last-ent
|
||
L-gf-str delta-l-gf laengen-liste first-l l-item
|
||
bL90 bL60 bL30 bR90 bR60 bR30 n-bogen-gf
|
||
ein-hz-as rad-h-as rad-v-as xu-entry
|
||
sep-endpunkt rad-h-es rad-v-es xu-exit sep-frame
|
||
es-aus-frame
|
||
rad-v-korr ein-hz-as-k rad-h-as-k xu-as-meas
|
||
rad-h-es-k xu-es-meas dz-as-ist dz-es-ist
|
||
dH-korr grade-prev iter)
|
||
(princ "\n\n>>> MODUS 3: Linienzug auswaehlen <<<")
|
||
(princ "\nBitte alle Linien (LINE) und Boegen (ARC) des Pfades auswaehlen,")
|
||
(princ "\ndann ENTER druecken:")
|
||
|
||
;; Selektion
|
||
(setq ss (ssget (list (cons 0 "LINE,ARC"))))
|
||
(if (null ss)
|
||
(progn (princ "\nKeine Objekte ausgewaehlt!") (exit))
|
||
)
|
||
(setq n (sslength ss))
|
||
(princ (strcat "\n " (itoa n) " Objekte ausgewaehlt."))
|
||
|
||
;; Objekte in Liste
|
||
(setq obj-liste '() i 0)
|
||
(while (< i n)
|
||
(setq obj (vlax-ename->vla-object (ssname ss i)))
|
||
(setq obj-liste (append obj-liste (list obj)))
|
||
(setq i (1+ i))
|
||
)
|
||
|
||
;; Startpunkt: Kettenanfang (Sortierung) + KS_EIN-Position des AUS-Elements
|
||
;; Z-Hoehe = Anschlusshoehe der Gesamtstrecke (deltaH-Referenz oben)
|
||
(setq startpunkt
|
||
(getpoint "\nStartpunkt (3D) waehlen - KS_EIN AUS-Element / Kettenanfang: "))
|
||
(if (null startpunkt)
|
||
(progn (princ "\nKein Startpunkt!") (exit))
|
||
)
|
||
|
||
;; Endpunkt: KS_AUS-Position des EIN-Elements (Z-Referenz unten)
|
||
;; deltaH = |startpunkt.Z - endpunkt-ref.Z|
|
||
(setq endpunkt-ref
|
||
(getpoint "\nEndpunkt (3D) waehlen - KS_AUS EIN-Element / Kettenende: "))
|
||
(if (null endpunkt-ref)
|
||
(progn (princ "\nKein Endpunkt!") (exit))
|
||
)
|
||
|
||
;; DeltaH aus Z-Koordinaten
|
||
(setq deltaH (abs (- (caddr startpunkt) (caddr endpunkt-ref))))
|
||
(princ (strcat "\n " delta-sym "H aus 3D-Punkten: " (rtos deltaH 2 1) " mm"))
|
||
|
||
;; Kette sortieren
|
||
(princ "\n Sortiere Segmente ...")
|
||
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
|
||
(if (null kette)
|
||
(progn (alert "Keine verbundene Kette gefunden!") (exit))
|
||
)
|
||
(princ (strcat " " (itoa (length kette)) " Segmente gefunden."))
|
||
|
||
;; Segmente analysieren
|
||
(setq segmente (gf-analysiere-kette kette))
|
||
|
||
;; Eingangs- und Ausgangsrichtung bestimmen
|
||
(setq entry-hz (cadr (car segmente)))
|
||
(setq exit-hz (gf-exit-hz segmente))
|
||
|
||
;; Seite fuer AUS-Element (vor Winkelberechnung, da Laengenanpassung davon abhaengt)
|
||
(princ "\n\nAUS-Element (AS_Element_90_*) - Seite waehlen:")
|
||
(princ "\n 1 - Links")
|
||
(princ "\n 2 - Rechts")
|
||
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
|
||
(setq as-seite (if (= antwort "2") "rechts" "links"))
|
||
|
||
;; Seite fuer EIN-Element
|
||
(princ "\n\nEIN-Element (ES_Element_90_*) - Seite waehlen:")
|
||
(princ "\n 1 - Links")
|
||
(princ "\n 2 - Rechts")
|
||
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
|
||
(setq es-seite (if (= antwort "2") "rechts" "links"))
|
||
|
||
(setq as-block (strcat "AS_Element_90_" as-seite))
|
||
(setq es-block (strcat "ES_Element_90_" es-seite))
|
||
|
||
;; Segmentlaengen anpassen.
|
||
;; Die gezeichneten Linien enthalten die Laengen von AUS-/EIN-Element UND Separatoren.
|
||
;; Abzugsregel pro LINE-Segment:
|
||
;; Erstes LINE-Segment: - aus-dx
|
||
;; LINE gefolgt von BOGEN: - 300 mm (Separator vor Bogen)
|
||
;; Letztes LINE-Segment: - 300 mm (Separator vor EIN) - ein-dx
|
||
(setq first-idx -1 j 0)
|
||
(while (and (< j (length segmente)) (< first-idx 0))
|
||
(if (= (car (nth j segmente)) "Linie") (setq first-idx j))
|
||
(setq j (1+ j))
|
||
)
|
||
(setq last-idx -1 j (1- (length segmente)))
|
||
(while (and (>= j 0) (< last-idx 0))
|
||
(if (= (car (nth j segmente)) "Linie") (setq last-idx j))
|
||
(setq j (1- j))
|
||
)
|
||
(if (>= first-idx 0)
|
||
(progn
|
||
(setq i 0)
|
||
(while (< i (length segmente))
|
||
(setq seg (nth i segmente))
|
||
(if (= (car seg) "Linie")
|
||
(progn
|
||
(setq neu-l (caddr seg))
|
||
;; Erstes LINE-Segment: AUS-Element abziehen
|
||
(if (= i first-idx) (setq neu-l (- neu-l aus-dx)))
|
||
;; Naechstes Segment ist BOGEN: Separator (300 mm) abziehen
|
||
(if (and (< (1+ i) (length segmente))
|
||
(= (car (nth (1+ i) segmente)) "Bogen"))
|
||
(setq neu-l (- neu-l 300.0))
|
||
)
|
||
;; Letztes LINE-Segment: Separator vor EIN (300 mm) + EIN-Element abziehen
|
||
(if (= i last-idx) (setq neu-l (- neu-l 300.0 ein-dx)))
|
||
(setq neu-l (max 100.0 neu-l))
|
||
(setq segmente (gf-replace-nth segmente i
|
||
(list (car seg) (cadr seg) neu-l (nth 3 seg) (nth 4 seg))))
|
||
)
|
||
)
|
||
(setq i (1+ i))
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Segmente nach Laengenanpassung anzeigen
|
||
(princ "\n\n--- Segment-Analyse (Laengen nach Kuerzung) ---")
|
||
(setq idx 0)
|
||
(foreach seg segmente
|
||
(setq idx (1+ idx))
|
||
(if (= (car seg) "Linie")
|
||
(princ (strcat "\n " (itoa idx) ". Linie L=" (rtos (caddr seg) 2 1)
|
||
" mm hz=" (rtos (cadr seg) 2 1) grad-zeichen))
|
||
(princ (strcat "\n " (itoa idx) ". Bogen " (itoa (nth 3 seg))
|
||
grad-zeichen " " (nth 4 seg)
|
||
" hz-Eingang=" (rtos (cadr seg) 2 1) grad-zeichen))
|
||
)
|
||
)
|
||
(princ (strcat "\n Seg " (itoa (1+ first-idx)) " (1. Linie): -" (rtos aus-dx 2 1) " mm (AUS-Element)"))
|
||
(princ "\n Jede Linie vor Bogen: -300 mm (Bogen-Separator)")
|
||
(princ (strcat "\n Seg " (itoa (1+ last-idx)) " (letzte Linie): -300 mm (EIN-Sep) -" (rtos ein-dx 2 1) " mm (EIN-Element)"))
|
||
(princ (strcat "\n Eintrittsrichtung: " (rtos entry-hz 2 1) grad-zeichen))
|
||
(princ (strcat "\n Austrittsrichtung: " (rtos exit-hz 2 1) grad-zeichen))
|
||
|
||
;; Gefaellewinkel berechnen (1 Extra-Separator vor EIN-Element)
|
||
(princ "\n\n Berechne Gefaellewinkel aus Geometrie ...")
|
||
(setq grade (gf-winkel-berechnen segmente deltaH 1))
|
||
|
||
;; Manuelle Anpassung
|
||
(setq antwort
|
||
(getstring (strcat "\nBerechneten Winkel "
|
||
(rtos grade 2 3) grad-zeichen
|
||
" verwenden? (j/n) [j]: ")))
|
||
(if (= (strcase antwort) "N")
|
||
(progn
|
||
(setq grade (getreal "\nGefaellewinkel (Grad): "))
|
||
(if (or (null grade) (<= grade 0)) (setq grade 3.0))
|
||
)
|
||
)
|
||
(setq grade (float grade))
|
||
|
||
;; Winkelkorrektur: iterative Messung der tatsaechlichen AS/ES-Absenkung.
|
||
;; Jede Iteration misst dz_AS und dz_ES beim aktuellen Winkel und berechnet
|
||
;; einen neuen Winkel. Konvergiert in 2-3 Schritten auf < 0.001 Grad.
|
||
;; Garantiert: dz_AS(v) + L_stau*sin(v) + dz_ES(v) + dz_bogen = deltaH
|
||
(if (and *gf-L-ohne-as-es* (> *gf-L-ohne-as-es* 0.1))
|
||
(progn
|
||
(princ "\n Messe tatsaechliche AS/ES-Absenkung (iterativ) ...")
|
||
(setq grade-prev -999.0 iter 0)
|
||
(while (and (< iter 4) (> (abs (- grade grade-prev)) 0.001))
|
||
(setq grade-prev grade)
|
||
(setq rad-v-korr (* grade (/ pi 180.0)))
|
||
;; AS-Element: KS_EIN zeigt 90 Grad zur Fahrtrichtung
|
||
(setq ein-hz-as-k (if (= as-seite "rechts") (+ entry-hz 90.0) (- entry-hz 90.0)))
|
||
(setq rad-h-as-k (* (float ein-hz-as-k) (/ pi 180.0)))
|
||
(setq xu-as-meas (list (* (cos rad-h-as-k)(cos rad-v-korr))
|
||
(* (sin rad-h-as-k)(cos rad-v-korr))
|
||
(- (sin rad-v-korr))))
|
||
;; ES-Element: KS_EIN zeigt in Fahrtrichtung (exit-hz)
|
||
(setq rad-h-es-k (* (float exit-hz) (/ pi 180.0)))
|
||
(setq xu-es-meas (list (* (cos rad-h-es-k)(cos rad-v-korr))
|
||
(* (sin rad-h-es-k)(cos rad-v-korr))
|
||
(- (sin rad-v-korr))))
|
||
(setq dz-as-ist (gf-messe-dz-block as-block xu-as-meas))
|
||
(setq dz-es-ist (gf-messe-dz-block es-block xu-es-meas))
|
||
;; sin(v) = (dH - dz_as - dz_es - dz_bogen) / L_stau
|
||
(setq dH-korr (- (float deltaH) dz-as-ist dz-es-ist (float *gf-sum-dz-bogen*)))
|
||
(if (and (> dH-korr 0.0) (< (/ dH-korr *gf-L-ohne-as-es*) 1.0))
|
||
(setq grade (* (asin (/ dH-korr *gf-L-ohne-as-es*)) (/ 180.0 pi)))
|
||
(progn
|
||
(princ "\n WARNUNG: Korrektur ausserhalb Bereich, Winkel unveraendert")
|
||
(setq grade-prev grade)
|
||
)
|
||
)
|
||
(setq iter (1+ iter))
|
||
)
|
||
(princ (strcat "\n AS: " (rtos dz-as-ist 2 2) " mm"
|
||
" ES: " (rtos dz-es-ist 2 2) " mm"))
|
||
(princ (strcat "\n>>> Korrigierter Gefaellewinkel: " (rtos grade 2 3) grad-zeichen
|
||
" (nach " (itoa iter) " Iter.)"))
|
||
)
|
||
)
|
||
|
||
;; Horizontaldistanz Start->Ende fuer Zusammenfassung und Label
|
||
(setq delta-l-gf
|
||
(sqrt (+ (expt (- (car endpunkt-ref) (car startpunkt)) 2)
|
||
(expt (- (cadr endpunkt-ref) (cadr startpunkt)) 2))))
|
||
|
||
;; Zusammenfassung
|
||
(princ "\n\n=========================================")
|
||
(princ (strcat "\n>>> Segmente: " (itoa (length segmente))))
|
||
(princ (strcat "\n>>> " delta-sym "H: " (rtos deltaH 2 2) " mm"))
|
||
(princ (strcat "\n>>> " delta-sym "L: " (rtos delta-l-gf 2 1) " mm"))
|
||
(princ (strcat "\n>>> Gefaellewinkel: " (rtos grade 2 3) grad-zeichen))
|
||
(princ (strcat "\n>>> Eintrittswinkel: " (rtos entry-hz 2 1) grad-zeichen))
|
||
(princ (strcat "\n>>> Austrittswinkel: " (rtos exit-hz 2 1) grad-zeichen))
|
||
(princ (strcat "\n>>> AUS-Element: " as-block))
|
||
(princ (strcat "\n>>> EIN-Element: " es-block))
|
||
(princ "\n=========================================")
|
||
|
||
;; Bestaetigung
|
||
(setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
|
||
(if (not (= antwort "2"))
|
||
(progn
|
||
;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern.
|
||
;; vf-lastent-ohne-attribute ueberspringt Attribut-Entities/SEQEND
|
||
;; eines vorherigen GF_N/VF_N-Blocks, sonst rutschen sie in die
|
||
;; naechste Blockerstellung hinein.
|
||
(setq gf-nummer (gf-next-number))
|
||
(setq last-ent (vf-lastent-ohne-attribute))
|
||
|
||
;; AUS-Element: KS_EIN so ausrichten, dass KS_AUS in Fahrtrichtung entry-hz zeigt.
|
||
;; Beweis: KS_AUS.xu = -yu(target-frame). Fuer KS_AUS||entry-hz gilt:
|
||
;; rechts (Rechtskurve): KS_EIN = entry-hz + 90deg
|
||
;; links (Linkskurve): KS_EIN = entry-hz - 90deg
|
||
(setq ein-hz-as (if (= as-seite "rechts")
|
||
(+ entry-hz 90.0)
|
||
(- entry-hz 90.0)))
|
||
(setq rad-h-as (* (float ein-hz-as) (/ pi 180.0)))
|
||
(setq rad-v-as (* (float grade) (/ pi 180.0)))
|
||
(setq xu-entry (list (* (cos rad-h-as)(cos rad-v-as))
|
||
(* (sin rad-h-as)(cos rad-v-as))
|
||
(- (sin rad-v-as))))
|
||
(princ (strcat "\n\n>>> AUS-Element: " as-block
|
||
" Fahrtrichtung=" (rtos entry-hz 2 1) grad-zeichen
|
||
" KS_EIN-hz=" (rtos ein-hz-as 2 1) grad-zeichen
|
||
" Z=" (rtos (caddr startpunkt) 2 1)))
|
||
;; Block-Ursprung (nicht KS_EIN!) in X/Y auf startpunkt setzen, damit die
|
||
;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den
|
||
;; ausgewaehlten Startpunkt verlaeuft. KS_EIN sitzt seitlich versetzt
|
||
;; (Drehteller-Anschluss) und darf daher nicht direkt auf startpunkt liegen.
|
||
;; Die Z-Hoehe wird weiterhin an KS_EIN gemessen (konsistent mit Modus 1+2
|
||
;; und der Gefaellewinkel-Korrektur), damit KS_EIN.Z = startpunkt.Z gilt.
|
||
(setq aktuell-frame
|
||
(insert-block-mixed-to-ks as-block (make-frame-from-dir startpunkt xu-entry)
|
||
(caddr startpunkt) nil "KS_EIN"))
|
||
(setq nach-aus-pt (car aktuell-frame))
|
||
|
||
;; Linienzug mit Gefaellebogen und Separatoren (Frame-basiert)
|
||
(setq aktuell-frame (gf-linienzug-einfuegen segmente grade aktuell-frame))
|
||
|
||
;; Separator vor EIN-Element
|
||
(princ "\n>>> Separator vor EIN-Element")
|
||
(setq sep-endpunkt
|
||
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
|
||
(car aktuell-frame) exit-hz grade 300 0))
|
||
;; Ausgangsrahmen nach Separator fuer ES-Element
|
||
(setq rad-h-es (* (float exit-hz) (/ pi 180.0)))
|
||
(setq rad-v-es (* (float grade) (/ pi 180.0)))
|
||
(setq xu-exit (list (* (cos rad-h-es)(cos rad-v-es))
|
||
(* (sin rad-h-es)(cos rad-v-es))
|
||
(- (sin rad-v-es))))
|
||
(setq sep-frame (make-frame-from-dir sep-endpunkt xu-exit))
|
||
|
||
;; EIN-Element: KS_EIN bleibt in X/Y auf dem Ketten-Pfad (sep-frame),
|
||
;; seine eigene Achse verlaeuft damit trivial durch diesen Punkt.
|
||
;; Die Z-Hoehe wird jedoch an KS_AUS gemessen, damit KS_AUS.Z exakt
|
||
;; auf endpunkt-ref.Z landet (garantiert die gewuenschte DeltaH).
|
||
(princ (strcat "\n>>> EIN-Element: " es-block
|
||
" Ziel-Z=" (rtos (caddr endpunkt-ref) 2 1)))
|
||
(setq es-aus-frame
|
||
(insert-block-mixed-to-ks es-block sep-frame
|
||
(caddr endpunkt-ref) "KS_EIN" "KS_AUS"))
|
||
(princ (strcat "\n Z-Hoehe KS_AUS: " (rtos (caddr (car es-aus-frame)) 2 1) " mm"))
|
||
|
||
;; --- GF_N-Block erstellen ---
|
||
|
||
;; L_GF_m: kommagetrennte Segment-Laengen in Metern (angepasste Staustrecke)
|
||
(setq laengen-liste '() first-l t)
|
||
(foreach seg segmente
|
||
(if (= (car seg) "Linie")
|
||
(setq laengen-liste
|
||
(append laengen-liste
|
||
(list (rtos (/ (caddr seg) 1000.0) 2 3))))
|
||
)
|
||
)
|
||
(setq L-gf-str "")
|
||
(foreach l-item laengen-liste
|
||
(if first-l
|
||
(progn (setq L-gf-str l-item) (setq first-l nil))
|
||
(setq L-gf-str (strcat L-gf-str "," l-item))
|
||
)
|
||
)
|
||
|
||
;; Bogen-Typen zaehlen
|
||
(setq bL90 0 bL60 0 bL30 0 bR90 0 bR60 0 bR30 0)
|
||
(foreach seg segmente
|
||
(if (= (car seg) "Bogen")
|
||
(progn
|
||
(cond
|
||
((and (= (nth 4 seg) "links") (= (nth 3 seg) 90)) (setq bL90 (1+ bL90)))
|
||
((and (= (nth 4 seg) "links") (= (nth 3 seg) 60)) (setq bL60 (1+ bL60)))
|
||
((and (= (nth 4 seg) "links") (= (nth 3 seg) 30)) (setq bL30 (1+ bL30)))
|
||
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 90)) (setq bR90 (1+ bR90)))
|
||
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 60)) (setq bR60 (1+ bR60)))
|
||
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 30)) (setq bR30 (1+ bR30)))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(setq n-bogen-gf (+ bL90 bL60 bL30 bR90 bR60 bR30))
|
||
|
||
;; delta-l-gf bereits vor der Zusammenfassung berechnet
|
||
|
||
;; Block mit allen Attributen erstellen
|
||
(gf-block-erstellen
|
||
"gruppe" as-seite gf-nummer
|
||
(caddr startpunkt)
|
||
(caddr endpunkt-ref)
|
||
deltaH
|
||
delta-l-gf
|
||
L-gf-str
|
||
grade
|
||
(1+ n-bogen-gf)
|
||
0
|
||
bL90 bL60 bL30
|
||
bR90 bR60 bR30
|
||
startpunkt last-ent nach-aus-pt entry-hz
|
||
(caddr (nth first-idx segmente)))
|
||
|
||
(princ "\n\n=========================================")
|
||
(princ "\n>>> Fertig! <<<")
|
||
(princ "\n=========================================")
|
||
)
|
||
(princ "\nAbgebrochen.")
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 4.5: GF-BLOCK-SYSTEM (Nummerierung, Label, Attribute)
|
||
;; ============================================================
|
||
|
||
;; Attribut-Definitionen fuer GF_N-Bloecke
|
||
(setq *gf-attrib-defs*
|
||
'(("NUMMER" "0")
|
||
("TYP" "standard")
|
||
("SEITE" "rechts")
|
||
("MONTAGEHOEHE_m" "0.000")
|
||
("HOEHE_VON" "0")
|
||
("HOEHE_BIS" "0")
|
||
("DELTA_H" "0")
|
||
("DELTA_L" "0")
|
||
("L_GF_m" "0.000")
|
||
("WINKEL" "0.000")
|
||
("ANZAHL_SEPARATOR" "0")
|
||
("ANZAHL_SCANNER" "0")
|
||
("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")
|
||
)
|
||
)
|
||
|
||
;; Naechste freie GF-Nummer
|
||
;; Stufe 1: NUMMER-Attribut aller GF_*-Inserts lesen
|
||
;; Stufe 2: Block-Tabelle pruefen – GF_N darf noch nicht als Definition existieren
|
||
(defun gf-next-number ( / ss i nr maxnr attribs)
|
||
(setq maxnr 0)
|
||
(setq ss (ssget "X" '((0 . "INSERT") (2 . "GF_*"))))
|
||
(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 #GF_LetzteNr (max #GF_LetzteNr maxnr))
|
||
(setq #GF_LetzteNr (1+ #GF_LetzteNr))
|
||
;; Sicherstellen, dass GF_N noch nicht als Block-Definition existiert
|
||
(while (tblsearch "BLOCK" (strcat "GF_" (itoa #GF_LetzteNr)))
|
||
(princ (strcat "\n [GF-Nr] GF_" (itoa #GF_LetzteNr) " existiert bereits, naechste..."))
|
||
(setq #GF_LetzteNr (1+ #GF_LetzteNr))
|
||
)
|
||
#GF_LetzteNr
|
||
)
|
||
|
||
;; Sichtbare Beschriftung auf Layer GF_Beschriftung erzeugen.
|
||
;; nach-aus-pt: KS_AUS des AUS-Elements (Beginn der ersten Geraden).
|
||
;; entry-hz: Horizontalwinkel der Foerderrichtung in Grad.
|
||
;; L-first-seg: Laenge der ersten geraden Staustrecke in mm.
|
||
;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht rechts versetzt.
|
||
(defun gf-make-label (gf-nummer hoehe-von hoehe-bis deltaH deltaL
|
||
L-gf-str winkel n-separator nach-aus-pt entry-hz L-first-seg /
|
||
label-txt label-pt chz-l shz-l halb basis-winkel)
|
||
(setq chz-l (cos (* entry-hz (/ pi 180.0))))
|
||
(setq shz-l (sin (* entry-hz (/ pi 180.0))))
|
||
(setq halb (/ (float L-first-seg) 2.0))
|
||
(setq label-pt
|
||
(list (+ (car nach-aus-pt) (* halb chz-l) (* 400.0 shz-l))
|
||
(+ (cadr nach-aus-pt) (* halb shz-l) (* -400.0 chz-l))
|
||
(caddr nach-aus-pt)))
|
||
(setq label-txt
|
||
(strcat "GF" (itoa gf-nummer)
|
||
" von:" (itoa (fix hoehe-von)) " bis:" (itoa (fix hoehe-bis)) "mm"
|
||
" " delta-sym "H=" (itoa (fix (abs deltaH))) "mm"
|
||
" " delta-sym "L=" (itoa (fix deltaL)) "mm"
|
||
" L=[" L-gf-str "]m"
|
||
" W=" (rtos (float winkel) 2 2) grad-zeichen
|
||
" Sep=" (itoa n-separator)))
|
||
;; Basiswinkel: Text immer lesbar auf 0 Grad (X-Achse, links->rechts) oder
|
||
;; 90 Grad (Y-Achse) einrasten - unabhaengig von der tatsaechlichen
|
||
;; Fahrtrichtung (nie 180/270, damit der Text nie auf dem Kopf steht).
|
||
(setq basis-winkel (float entry-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 10 label-pt)
|
||
(cons 11 label-pt)
|
||
'(40 . 100.0)
|
||
(cons 1 label-txt)
|
||
'(7 . "Standard")
|
||
'(8 . "GF_Beschriftung")
|
||
(cons 50 (* basis-winkel (/ pi 180.0)))
|
||
'(72 . 1)
|
||
'(73 . 2)))
|
||
)
|
||
|
||
;; GF_N-Block aus allen seit last-ent erzeugten Entities erstellen
|
||
;; und alle 18 Attribute setzen.
|
||
(defun gf-block-erstellen (typ seite gf-nummer
|
||
hoehe-von hoehe-bis deltaH deltaL
|
||
L-gf-str winkel n-separator n-scanner
|
||
bogen-L90 bogen-L60 bogen-L30
|
||
bogen-R90 bogen-R60 bogen-R30
|
||
startpunkt last-ent nach-aus-pt entry-hz L-first-seg /
|
||
gf-bname gf-ss ent gf-insert)
|
||
;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht versetzt
|
||
(gf-make-label gf-nummer hoehe-von hoehe-bis deltaH deltaL
|
||
L-gf-str winkel n-separator nach-aus-pt entry-hz L-first-seg)
|
||
;; ATTDEFs (unsichtbar, am Startpunkt)
|
||
(foreach def *gf-attrib-defs*
|
||
(entmake
|
||
(list '(0 . "ATTDEF")
|
||
(cons 10 startpunkt)
|
||
(cons 11 startpunkt)
|
||
'(40 . 50.0)
|
||
(cons 1 (cadr def))
|
||
(cons 2 (car def))
|
||
(cons 3 (car def))
|
||
'(70 . 1)
|
||
'(72 . 0)
|
||
'(74 . 0)))
|
||
)
|
||
;; Alle Entities seit last-ent in Selektionssatz sammeln
|
||
(setq gf-ss (ssadd))
|
||
(setq ent (if last-ent (entnext last-ent) (entnext)))
|
||
(while ent
|
||
(ssadd ent gf-ss)
|
||
(setq ent (entnext ent))
|
||
)
|
||
;; Block definieren und einfuegen
|
||
(setq gf-bname (strcat "GF_" (itoa gf-nummer)))
|
||
(command "_.-BLOCK" gf-bname startpunkt gf-ss "")
|
||
(command "_.INSERT" gf-bname startpunkt 1.0 1.0 0.0)
|
||
;; Attribute auf das eingefuegte INSERT-Objekt setzen
|
||
(setq gf-insert (entlast))
|
||
(ssg-attrib-set-on gf-insert
|
||
(list
|
||
(cons "NUMMER" (itoa gf-nummer))
|
||
(cons "TYP" typ)
|
||
(cons "SEITE" seite)
|
||
(cons "MONTAGEHOEHE_m" "0.000")
|
||
(cons "HOEHE_VON" (itoa (fix hoehe-von)))
|
||
(cons "HOEHE_BIS" (itoa (fix hoehe-bis)))
|
||
(cons "DELTA_H" (itoa (fix (abs deltaH))))
|
||
(cons "DELTA_L" (itoa (fix deltaL)))
|
||
(cons "L_GF_m" L-gf-str)
|
||
(cons "WINKEL" (rtos (float winkel) 2 3))
|
||
(cons "ANZAHL_SEPARATOR" (itoa n-separator))
|
||
(cons "ANZAHL_SCANNER" (itoa n-scanner))
|
||
(cons "GF_Bogen_L_90" (itoa bogen-L90))
|
||
(cons "GF_Bogen_L_60" (itoa bogen-L60))
|
||
(cons "GF_Bogen_L_30" (itoa bogen-L30))
|
||
(cons "GF_Bogen_R_90" (itoa bogen-R90))
|
||
(cons "GF_Bogen_R_60" (itoa bogen-R60))
|
||
(cons "GF_Bogen_R_30" (itoa bogen-R30))
|
||
)
|
||
)
|
||
(princ (strcat "\n>>> GF-Block erstellt: " gf-bname))
|
||
gf-insert
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 5: MODUS 1+2 - EINFACHE GEFAELLESTRECKE
|
||
;; ============================================================
|
||
|
||
;; deltaL-total: gesamte Horizontaldistanz (fuer DELTA_L-Attribut)
|
||
;; hz: Fahrtrichtung in Grad (0=Ost, 90=Nord, 180=West, 270=Sued)
|
||
(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt as-seite es-seite hz deltaL-total /
|
||
as-block es-block endpunkt
|
||
gf-nummer last-ent rad-hz rad-v xu-incl
|
||
ein-hz rad-ein xu-ein
|
||
startframe aktuell-frame
|
||
stau-endpunkt sep-endpunkt sep-frame
|
||
gf-deltaH L-gf-str nach-aus-pt gf-insert)
|
||
(setq as-block (strcat "AS_Element_90_" as-seite))
|
||
(setq es-block (strcat "ES_Element_90_" es-seite))
|
||
(if (not *lib-initialized*) (gf-init-bibliothek))
|
||
|
||
;; GF-Nummer und Entity-Grenze vor erster Einfuegung
|
||
(setq gf-nummer (gf-next-number))
|
||
(setq last-ent (vf-lastent-ohne-attribute))
|
||
|
||
;; Fahrtrichtungsvektor (KS_AUS-Richtung, Basis fuer Staustrecke/Separator/ES)
|
||
(setq rad-hz (* (float hz) (/ pi 180.0)))
|
||
(setq rad-v (* (float winkel) (/ pi 180.0)))
|
||
(setq xu-incl (list (* (cos rad-hz)(cos rad-v))
|
||
(* (sin rad-hz)(cos rad-v))
|
||
(- (sin rad-v))))
|
||
|
||
;; KS_EIN-Richtung fuer AS-Element: so dass KS_AUS in Fahrtrichtung hz zeigt.
|
||
;; Beweis: KS_AUS.xu = -yu (target-frame), yu = links-senkrecht zu xu.
|
||
;; rechts (Rechtskurve): KS_AUS = KS_EIN - 90deg => KS_EIN = hz + 90deg
|
||
;; links (Linkskurve): KS_AUS = KS_EIN + 90deg => KS_EIN = hz - 90deg
|
||
(setq ein-hz (if (= as-seite "rechts") (+ hz 90.0) (- hz 90.0)))
|
||
(setq rad-ein (* (float ein-hz) (/ pi 180.0)))
|
||
(setq xu-ein (list (* (cos rad-ein)(cos rad-v))
|
||
(* (sin rad-ein)(cos rad-v))
|
||
(- (sin rad-v))))
|
||
|
||
;; 1/4: AUS-Element (KS_EIN an xu-ein ausrichten, damit KS_AUS in hz zeigt)
|
||
;; Block-Ursprung (nicht KS_EIN!) in X/Y auf startpunkt setzen, damit die
|
||
;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den
|
||
;; ausgewaehlten Startpunkt verlaeuft (analog Modus 3). Die Z-Hoehe wird
|
||
;; weiterhin an KS_EIN gemessen, damit KS_EIN.Z = startpunkt.Z gilt.
|
||
(princ (strcat "\n\n1/4: " as-block
|
||
" Fahrtrichtung=" (rtos hz 2 1) grad-zeichen
|
||
" KS_EIN-hz=" (rtos ein-hz 2 1) grad-zeichen
|
||
" v=" (rtos winkel 2 1) grad-zeichen))
|
||
(setq startframe (make-frame-from-dir startpunkt xu-ein))
|
||
(setq aktuell-frame
|
||
(insert-block-mixed-to-ks as-block startframe (caddr startpunkt) nil "KS_EIN"))
|
||
(setq nach-aus-pt (car aktuell-frame))
|
||
|
||
;; 2/4: Staustrecke (skalierbar, hz+vert)
|
||
(princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1)
|
||
" mm hz=" (rtos hz 2 1) grad-zeichen
|
||
" v=" (rtos winkel 2 1) grad-zeichen))
|
||
(setq stau-endpunkt
|
||
(gf-insert-hz-incl-scaled
|
||
"Staustrecke_SP_1000_mm" (car aktuell-frame) L_stau hz winkel))
|
||
(setq aktuell-frame (make-frame-from-dir stau-endpunkt xu-incl))
|
||
|
||
;; 3/4: Separator 300mm
|
||
(princ (strcat "\n\n3/4: Separator 300mm"
|
||
" hz=" (rtos hz 2 1) grad-zeichen
|
||
" v=" (rtos winkel 2 1) grad-zeichen))
|
||
(setq sep-endpunkt
|
||
(gf-insert-hz-with-ks
|
||
"Staustrecke_Separator_SP_300_mm" (car aktuell-frame) hz winkel 300 0))
|
||
(setq sep-frame (make-frame-from-dir sep-endpunkt xu-incl))
|
||
|
||
;; 4/4: EIN-Element (KS-zu-KS)
|
||
(princ (strcat "\n\n4/4: " es-block))
|
||
(setq endpunkt (car (insert-block-ks-to-ks es-block sep-frame)))
|
||
|
||
;; Abgeleitete Werte: echte Endhoehe aus tatsaechlicher Ketten-Platzierung
|
||
;; (AS_Element + Staustrecke + Separator + ES_Element zusammen)
|
||
(setq gf-deltaH (- (caddr startpunkt) (caddr endpunkt)))
|
||
(setq L-gf-str (rtos (/ L_stau 1000.0) 2 3))
|
||
|
||
;; GF_N-Block mit Attributen erstellen; Rueckgabe: ename des GF_N-INSERT
|
||
(setq gf-insert
|
||
(gf-block-erstellen
|
||
"standard" as-seite gf-nummer
|
||
(caddr startpunkt)
|
||
(caddr endpunkt)
|
||
gf-deltaH
|
||
(float deltaL-total)
|
||
L-gf-str
|
||
winkel
|
||
1 0
|
||
0 0 0 0 0 0
|
||
startpunkt last-ent nach-aus-pt (float hz) (float L_stau)))
|
||
|
||
(princ "\n\n=========================================")
|
||
(princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<")
|
||
(princ "\n=========================================")
|
||
;; Rueckgabe: (ename echtes-deltaH echtes-deltaL) - volle Fliesskomma-
|
||
;; Genauigkeit, unabhaengig von der auf ganze mm gerundeten HOEHE_VON/
|
||
;; HOEHE_BIS-Attribut-Darstellung im GF_N-Block.
|
||
(list gf-insert gf-deltaH (float deltaL-total))
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 6: HAUPTBEFEHL
|
||
;; ============================================================
|
||
|
||
(defun c:GEFAELLESTRECKE ( / antwort eingabe-modus deltaL winkel rad L_stau sep-x
|
||
as-seite es-seite
|
||
line-points startpunkt endpunkt differenz
|
||
deltaX deltaY startpunkt-fuer-einfuegen hz-winkel)
|
||
|
||
(princ "\n=========================================")
|
||
(princ "\n GEFAELLESTRECKE GENERATOR v2.0")
|
||
(princ "\n Richtung: immer AB (nach unten)")
|
||
(princ "\n=========================================")
|
||
|
||
;; Bibliothek initialisieren
|
||
(if (not (gf-init-bibliothek))
|
||
(progn
|
||
(alert "Fehler beim Initialisieren der Bibliothek!\nBitte DXFM_DATA pruefen.")
|
||
(exit)
|
||
)
|
||
)
|
||
|
||
;; Eingabemodus
|
||
(princ "\n\nEingabemodus waehlen:")
|
||
(princ "\n 1 - Werte manuell eingeben (einfache Strecke)")
|
||
(princ "\n 2 - 3D-Linie auswaehlen (einfache Strecke)")
|
||
(princ "\n 3 - Linienzug (LINE + ARC) auswaehlen mit Gefaellebogen")
|
||
(setq antwort (getstring "\nIhre Wahl (1/2/3) [1]: "))
|
||
|
||
(cond
|
||
;; Modus 3: Linienzug mit Bogen
|
||
((= antwort "3")
|
||
(gf-linienzug-modus)
|
||
)
|
||
|
||
;; Modus 1+2: einfache Gefaellestrecke
|
||
(t
|
||
(if (= antwort "2")
|
||
(setq eingabe-modus "Linie")
|
||
(setq eingabe-modus "Manuell")
|
||
)
|
||
|
||
;; Modus 1: Manuelle Eingabe
|
||
(if (= eingabe-modus "Manuell")
|
||
(progn
|
||
(princ "\n\n>>> MODUS 1: Manuelle Werteingabe <<<")
|
||
(setq startpunkt-fuer-einfuegen
|
||
(getpoint "\nStartpunkt fuer AUS_Element waehlen: "))
|
||
(if (null startpunkt-fuer-einfuegen)
|
||
(setq startpunkt-fuer-einfuegen '(0 0 0)))
|
||
(setq deltaL (getreal (strcat "\n" delta-sym "L - Abstand (mm): ")))
|
||
(if (or (null deltaL) (<= deltaL 0))
|
||
(setq deltaL (ssg-cfg-or "gefaelle" "default_delta_l" 5000.0)))
|
||
)
|
||
;; Modus 2: 3D-Linie
|
||
(progn
|
||
(princ "\n\n>>> MODUS 2: 3D-Linie auswaehlen <<<")
|
||
(command "BKS" "W")
|
||
(princ "\n BKS auf Weltkoordinaten gesetzt.")
|
||
(setq line-points
|
||
(get-line-start-end-points
|
||
"\nBitte 3D-Linie fuer Richtung und Laenge 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 (car differenz)
|
||
deltaY (cadr differenz))
|
||
;; deltaL: horizontale 2D-Projektion entlang Fahrtrichtung
|
||
(setq deltaL (sqrt (+ (* deltaX deltaX) (* deltaY deltaY))))
|
||
;; hz-Winkel: Fahrtrichtung aus Linienpunkten (in Grad, 0=Ost)
|
||
(setq hz-winkel (* (angle '(0.0 0.0) (list deltaX deltaY)) (/ 180.0 pi)))
|
||
(princ (strcat "\n Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen
|
||
" (aus Linie)"))
|
||
(princ (strcat "\n " delta-sym "L = " (rtos deltaL 2 2) " mm"))
|
||
;; Startpunkt separat waehlen (unabhaengig von Linie)
|
||
(setq startpunkt-fuer-einfuegen
|
||
(getpoint "\nStartpunkt fuer AUS-Element waehlen: "))
|
||
(if (null startpunkt-fuer-einfuegen)
|
||
(progn (princ "\nKein Startpunkt!") (exit))
|
||
)
|
||
)
|
||
)
|
||
|
||
(princ "\n\n=========================================")
|
||
(princ (strcat "\n " delta-sym "L = " (rtos deltaL 2 2) " mm"))
|
||
(princ "\n=========================================")
|
||
|
||
;; Winkelabfrage (beide Modi: manuell)
|
||
(setq winkel (getreal "\n\nGefaellewinkel (Grad) [3]: "))
|
||
(if (or (null winkel) (<= winkel 0))
|
||
(setq winkel (ssg-cfg-or "gefaelle" "default_winkel" 3.0)))
|
||
(setq winkel (float winkel))
|
||
(setq rad (* winkel (/ pi 180.0)))
|
||
(princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen))
|
||
|
||
;; Fahrtrichtung waehlen (nur Modus 1; Modus 2 berechnet hz aus Linie)
|
||
(if (= eingabe-modus "Manuell")
|
||
(progn
|
||
(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))
|
||
)
|
||
)
|
||
|
||
;; Seite AUS-Element waehlen
|
||
(princ "\n\nAUS-Element (AS_Element_90_*) - Seite waehlen:")
|
||
(princ "\n 1 - Links")
|
||
(princ "\n 2 - Rechts")
|
||
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
|
||
(setq as-seite (if (= antwort "2") "rechts" "links"))
|
||
|
||
;; Seite EIN-Element waehlen
|
||
(princ "\n\nEIN-Element (ES_Element_90_*) - Seite waehlen:")
|
||
(princ "\n 1 - Links")
|
||
(princ "\n 2 - Rechts")
|
||
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
|
||
(setq es-seite (if (= antwort "2") "rechts" "links"))
|
||
|
||
;; Laengenberechnung
|
||
;; deltaL = aus_dx + L_stau*cos(rad) + sep*cos(rad) + ein_dx
|
||
(setq sep-x (* (ssg-cfg-or "gefaelle" "separator_breite" 300.0) (cos rad)))
|
||
(setq L_stau (/ (- deltaL aus-dx ein-dx sep-x) (cos rad)))
|
||
|
||
;; Validierung
|
||
(if (<= L_stau 0.1)
|
||
(progn
|
||
(alert (strcat "Berechnete Staustreckenlaenge ungueltig: "
|
||
(rtos L_stau 2 2) " mm\n"
|
||
"Bitte groesseres deltaL oder kleineren Winkel waehlen."))
|
||
(exit)
|
||
)
|
||
)
|
||
|
||
;; Zusammenfassung
|
||
(princ "\n\n=========================================")
|
||
(princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen))
|
||
(princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen))
|
||
(princ (strcat "\n>>> AUS-Seite: " as-seite))
|
||
(princ (strcat "\n>>> EIN-Seite: " es-seite))
|
||
(princ (strcat "\n>>> L_stau: " (rtos L_stau 2 2) " mm"))
|
||
(princ "\n=========================================")
|
||
|
||
;; Bestaetigung
|
||
(setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
|
||
(if (not (= antwort "2"))
|
||
(gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen as-seite es-seite hz-winkel deltaL)
|
||
(princ "\nAbgebrochen.")
|
||
)
|
||
)
|
||
)
|
||
nil
|
||
)
|
||
|
||
;; ============================================================
|
||
;; START
|
||
;; ============================================================
|
||
(princ "\n>>> GEFAELLESTRECKE v2.0 geladen <<<")
|
||
(princ "\n>>> Befehl: Gefaellestrecke")
|
||
(princ "\n Modus 1: Manuelle Eingabe")
|
||
(princ "\n Modus 2: 3D-Linie")
|
||
(princ "\n Modus 3: Linienzug mit Gefaellebogen")
|
||
(if block-pfad (princ (strcat "\n Block-Pfad: " block-pfad)))
|
||
(princ "\n=========================================")
|
||
(princ)
|