1252 lines
46 KiB
Common Lisp
1252 lines
46 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 *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))
|
|
;; 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))
|
|
|
|
;; Block-Pfad: DXFM_BLOCKS → Heuristik (3D-Bloecke benoetigt)
|
|
(if (null block-pfad)
|
|
(setq block-pfad
|
|
(cond
|
|
((getenv "DXFM_BLOCKS")
|
|
(strcat (vl-string-translate "\\" "/" (getenv "DXFM_BLOCKS")) "/"))
|
|
((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*
|
|
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
|
|
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
|
|
"/data/ils/3D/"))
|
|
(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 /
|
|
block-obj ks-data ks-ein ks-aus offset ausgang)
|
|
(ensure-block-loaded blockname)
|
|
(if (not (tblsearch "BLOCK" blockname))
|
|
(progn
|
|
(princ (strcat "\n FEHLER: Block '" blockname "' fehlt"))
|
|
(exit)
|
|
)
|
|
)
|
|
(setq block-obj
|
|
(vla-InsertBlock modelspace
|
|
(vlax-3D-point einfuegepunkt)
|
|
blockname 1.0 1.0 1.0 0))
|
|
(setq ks-data (extract-ks-from-block block-obj))
|
|
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
|
|
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
|
|
(if (and ks-ein ks-aus)
|
|
(progn
|
|
(setq offset
|
|
(list (- (car einfuegepunkt) (car (car ks-ein)))
|
|
(- (cadr einfuegepunkt) (cadr (car ks-ein)))
|
|
(- (caddr einfuegepunkt) (caddr (car ks-ein)))))
|
|
(vla-Move block-obj
|
|
(vlax-3D-point (car ks-ein))
|
|
(vlax-3D-point einfuegepunkt))
|
|
(setq ausgang
|
|
(list (+ (car (car ks-aus)) (car offset))
|
|
(+ (cadr (car ks-aus)) (cadr offset))
|
|
(+ (caddr (car ks-aus)) (caddr offset))))
|
|
(princ (strcat "\n KS_AUS 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 /
|
|
rad 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 (* (float winkel) (/ 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 (cos rad) 0 (sin rad) 0)
|
|
(list 0 1 0 0)
|
|
(list (- (sin rad)) 0 (cos rad) 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 (cos rad)))
|
|
(cadr startpunkt)
|
|
(+ (caddr startpunkt) (* (- (sin rad)) laenge))))
|
|
(princ (strcat "\n " blockname " L=" (rtos laenge 2 1)
|
|
" -> Z=" (rtos (caddr endpunkt) 2 1)))
|
|
endpunkt
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; --- Rotierter Block mit manuellem dx/dz (Richtung X) ---
|
|
(if (null (car (atoms-family 1 '("INSERT-ROTATED-BLOCK-WITH-KS"))))
|
|
(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz /
|
|
rad block-obj endpunkt)
|
|
(ensure-block-loaded blockname)
|
|
(setq rad (* (float winkel) (/ 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 (cos rad) 0 (sin rad) 0)
|
|
(list 0 1 0 0)
|
|
(list (- (sin rad)) 0 (cos rad) 0)
|
|
(list 0 0 0 1))))
|
|
(vla-Move block-obj
|
|
(vlax-3D-point '(0 0 0))
|
|
(vlax-3D-point startpunkt))
|
|
(list
|
|
(+ (car startpunkt)
|
|
(+ (* block-dx (cos rad)) (* block-dz (sin rad))))
|
|
(cadr startpunkt)
|
|
(+ (caddr startpunkt)
|
|
(+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz))))
|
|
)
|
|
)
|
|
|
|
;; --- 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 '("INIT-BIBLIOTHEK"))))
|
|
(defun init-bibliothek ( / temp-obj ks-data ks-ein ks-aus)
|
|
(if *lib-initialized*
|
|
t
|
|
(progn
|
|
;; AS-Block laden und Masse extrahieren
|
|
(ensure-block-loaded "_3D_AS_90_links")
|
|
(if (tblsearch "BLOCK" "_3D_AS_90_links")
|
|
(progn
|
|
(setq temp-obj
|
|
(vla-InsertBlock modelspace
|
|
(vlax-3D-point '(0 0 0))
|
|
"_3D_AS_90_links" 1.0 1.0 1.0 0))
|
|
(setq ks-data (extract-ks-from-block temp-obj))
|
|
(vla-Delete temp-obj)
|
|
(setq ks-ein (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-ks-ein-local* (car ks-ein))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
;; ES-Block laden und Masse extrahieren
|
|
(ensure-block-loaded "_3D_ES_90_links")
|
|
(if (tblsearch "BLOCK" "_3D_ES_90_links")
|
|
(progn
|
|
(setq temp-obj
|
|
(vla-InsertBlock modelspace
|
|
(vlax-3D-point '(0 0 0))
|
|
"_3D_ES_90_links" 1.0 1.0 1.0 0))
|
|
(setq ks-data (extract-ks-from-block temp-obj))
|
|
(vla-Delete temp-obj)
|
|
(setq ks-ein (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-ks-ein-local* (car ks-ein))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(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) grad-zeichen "_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: deltaH = (L_gerade + (n_bogen+extra_sep)*300) * sin(alpha) + sum(|dz_bogen|)
|
|
(defun gf-winkel-berechnen (segmente deltaH extra-sep /
|
|
L-gerade sum-dz-bogen n-bogen
|
|
seg bwinkel bseite masse sin-alpha alpha)
|
|
(setq L-gerade 0.0 sum-dz-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-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)))
|
|
(princ (strcat "\n Gerade + Separatoren: " (rtos L-gerade 2 1) " mm"))
|
|
(princ (strcat "\n Bogen-dZ gesamt: " (rtos sum-dz-bogen 2 1) " mm"))
|
|
(princ (strcat "\n Resthoehe fuer Grade: "
|
|
(rtos (- (float deltaH) sum-dz-bogen) 2 1) " mm"))
|
|
(cond
|
|
((<= L-gerade 0.1)
|
|
(princ "\n WARNUNG: keine geraden Strecken -> Fallback 3 Grad")
|
|
3.0)
|
|
((< (- (float deltaH) sum-dz-bogen) 0)
|
|
(princ "\n WARNUNG: Bogen-dZ > deltaH -> Fallback 1 Grad")
|
|
1.0)
|
|
(t
|
|
(setq sin-alpha
|
|
(/ (- (float deltaH) sum-dz-bogen) L-gerade))
|
|
(if (> sin-alpha 1.0) (setq sin-alpha 1.0))
|
|
(setq alpha (* (asin sin-alpha) (/ 180.0 pi)))
|
|
(princ (strcat "\n>>> Berechneter Gefaellewinkel: "
|
|
(rtos alpha 2 3) grad-zeichen))
|
|
alpha
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Alle Segmente des Linienzugs einfuegen.
|
|
;; segmente: Ergebnis von gf-analysiere-kette
|
|
;; grade: Gefaellewinkel in Grad
|
|
;; startpunkt: 3D-Einfuegepunkt des ersten Blocks
|
|
;;
|
|
;; Reihenfolge bei Bogen:
|
|
;; ... Staustrecke (Linie) → Separator am Ende der Linie → Gefaellebogen ...
|
|
(defun gf-linienzug-einfuegen (segmente grade startpunkt /
|
|
aktuell i n seg naechstes
|
|
typ hz laenge bwinkel bseite blockname)
|
|
(setq aktuell startpunkt)
|
|
(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 aktuell
|
|
(gf-insert-hz-incl-scaled
|
|
"Staustrecke_SP_1000_mm" aktuell laenge hz grade))
|
|
;; 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 aktuell
|
|
(gf-insert-hz-with-ks
|
|
"Staustrecke_Separator_SP_300_mm" aktuell hz grade 300 0))
|
|
)
|
|
)
|
|
)
|
|
((= typ "Bogen")
|
|
(setq blockname (gf-bogen-blockname bwinkel bseite))
|
|
;; Gefaellebogen (nur Hz-Rotation, Block hat eigene 3D-Geometrie)
|
|
(princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
|
|
": " blockname
|
|
" hz=" (rtos hz 2 1) grad-zeichen))
|
|
(setq aktuell
|
|
(gf-insert-gefaellebogen-by-ks blockname aktuell hz))
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
(princ "\n\n=========================================")
|
|
(princ "\n>>> Linienzug-Gefaellestrecke eingefuegt! <<<")
|
|
(princ "\n=========================================")
|
|
aktuell
|
|
)
|
|
|
|
;; 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
|
|
chz shz as-target
|
|
aktuell-pt)
|
|
(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: gleichzeitig Kettenanfang (Sortierung) UND Einfuegepunkt AUS-Element
|
|
(setq startpunkt
|
|
(getpoint "\nStartpunkt (3D) waehlen - AUS-Element / Kettenanfang: "))
|
|
(if (null startpunkt)
|
|
(progn (princ "\nKein Startpunkt!") (exit))
|
|
)
|
|
|
|
;; Endpunkt: Z-Koordinate fuer deltaH-Berechnung
|
|
(setq endpunkt-ref
|
|
(getpoint "\nEndpunkt (3D) waehlen - 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 DeltaH 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 (_3D_AS_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 (_3D_ES_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 "_3D_AS_90_" as-seite))
|
|
(setq es-block (strcat "_3D_ES_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))
|
|
|
|
;; Zusammenfassung
|
|
(princ "\n\n=========================================")
|
|
(princ (strcat "\n>>> Segmente: " (itoa (length segmente))))
|
|
(princ (strcat "\n>>> DeltaH: " (rtos deltaH 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
|
|
;; AUS-Element: Block-Ursprung an startpunkt ausrichten.
|
|
;; KS_EIN liegt im Block seitlich (Delta-Y = Drehteller-Anschluss).
|
|
;; Damit KS_AUS auf der gezeichneten Linie liegt, muss der Einfuegepunkt
|
|
;; um Rz(entry-hz) * ks_ein_local gegenueber startpunkt verschoben werden.
|
|
(setq chz (cos (* entry-hz (/ pi 180.0))))
|
|
(setq shz (sin (* entry-hz (/ pi 180.0))))
|
|
(if *aus-ks-ein-local*
|
|
(setq as-target
|
|
(list (+ (car startpunkt)
|
|
(- (* chz (car *aus-ks-ein-local*))
|
|
(* shz (cadr *aus-ks-ein-local*))))
|
|
(+ (cadr startpunkt)
|
|
(+ (* shz (car *aus-ks-ein-local*))
|
|
(* chz (cadr *aus-ks-ein-local*))))
|
|
(+ (caddr startpunkt)
|
|
(caddr *aus-ks-ein-local*))))
|
|
(setq as-target startpunkt)
|
|
)
|
|
(princ (strcat "\n\n>>> AUS-Element: " as-block
|
|
" (hz=" (rtos entry-hz 2 1) grad-zeichen ")"))
|
|
(setq aktuell-pt (gf-insert-gefaellebogen-by-ks as-block as-target entry-hz))
|
|
|
|
;; Linienzug mit Gefaellebogen und Separatoren (gekuerzte Laengen)
|
|
(setq aktuell-pt (gf-linienzug-einfuegen segmente grade aktuell-pt))
|
|
|
|
;; Separator vor EIN-Element
|
|
(princ "\n>>> Separator vor EIN-Element")
|
|
(setq aktuell-pt
|
|
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
|
|
aktuell-pt exit-hz grade 300 0))
|
|
|
|
;; EIN-Element mit Austrittsrichtung ausrichten (Rz um exit-hz)
|
|
(princ (strcat "\n>>> EIN-Element: " es-block
|
|
" (hz=" (rtos exit-hz 2 1) grad-zeichen ")"))
|
|
(gf-insert-gefaellebogen-by-ks es-block aktuell-pt exit-hz)
|
|
|
|
(princ "\n\n=========================================")
|
|
(princ "\n>>> Fertig! <<<")
|
|
(princ "\n=========================================")
|
|
)
|
|
(princ "\nAbgebrochen.")
|
|
)
|
|
)
|
|
|
|
;; ============================================================
|
|
;; TEIL 5: MODUS 1+2 - EINFACHE GEFAELLESTRECKE
|
|
;; ============================================================
|
|
|
|
(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt seite /
|
|
aktueller-punkt as-block es-block endpunkt)
|
|
(setq aktueller-punkt startpunkt)
|
|
(setq as-block (strcat "_3D_AS_90_" seite))
|
|
(setq es-block (strcat "_3D_ES_90_" seite))
|
|
(if (not *lib-initialized*) (init-bibliothek))
|
|
|
|
(princ (strcat "\n\n1/4: " as-block))
|
|
(setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt))
|
|
|
|
(princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1)
|
|
" mm " (itoa winkel) grad-zeichen))
|
|
(setq aktueller-punkt
|
|
(insert-inclined-scaled-block
|
|
"Staustrecke_SP_1000_mm" aktueller-punkt L_stau winkel))
|
|
|
|
(princ (strcat "\n\n3/4: Separator 300mm " (itoa winkel) grad-zeichen))
|
|
(setq aktueller-punkt
|
|
(insert-rotated-block-with-ks
|
|
"Staustrecke_Separator_SP_300_mm" aktueller-punkt winkel 300 0))
|
|
|
|
(princ (strcat "\n\n4/4: " es-block))
|
|
(setq endpunkt (insert-block-by-ks es-block aktueller-punkt))
|
|
|
|
(princ "\n\n=========================================")
|
|
(princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<")
|
|
(princ "\n=========================================")
|
|
endpunkt
|
|
)
|
|
|
|
;; ============================================================
|
|
;; TEIL 6: HAUPTBEFEHL
|
|
;; ============================================================
|
|
|
|
(defun c:GEFAELLESTRECKE ( / antwort eingabe-modus deltaL winkel rad L_stau sep-x seite
|
|
line-points startpunkt endpunkt differenz
|
|
deltaX deltaY startpunkt-fuer-einfuegen)
|
|
|
|
(princ "\n=========================================")
|
|
(princ "\n GEFAELLESTRECKE GENERATOR v2.0")
|
|
(princ "\n Richtung: immer AB (nach unten)")
|
|
(princ "\n=========================================")
|
|
|
|
;; Bibliothek initialisieren
|
|
(if (not (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 "\nAbstand deltaL (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 die Gefaellestrecke 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)))
|
|
(setq deltaL (max deltaX deltaY))
|
|
(princ (strcat "\n deltaX=" (rtos deltaX 2 2)
|
|
" mm, deltaY=" (rtos deltaY 2 2) " mm"))
|
|
(princ (strcat "\n deltaL = " (rtos deltaL 2 2) " mm"))
|
|
(setq startpunkt-fuer-einfuegen startpunkt)
|
|
)
|
|
)
|
|
|
|
(princ "\n\n=========================================")
|
|
(princ (strcat "\n deltaL = " (rtos deltaL 2 2) " mm"))
|
|
(princ "\n=========================================")
|
|
|
|
;; Winkelabfrage
|
|
(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))
|
|
|
|
;; Seite waehlen
|
|
(princ "\n\nEin-/Auselement - Seite waehlen:")
|
|
(princ "\n 1 - Links (_3D_AS_90_links / _3D_ES_90_links)")
|
|
(princ "\n 2 - Rechts (_3D_AS_90_rechts / _3D_ES_90_rechts)")
|
|
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
|
|
(if (= antwort "2") (setq seite "rechts") (setq seite "links"))
|
|
(princ (strcat "\n>>> Seite: " seite))
|
|
|
|
;; 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>>> Winkel: " (rtos winkel 2 1) grad-zeichen))
|
|
(princ (strcat "\n>>> Seite: " 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 seite)
|
|
(princ "\nAbgebrochen.")
|
|
)
|
|
)
|
|
)
|
|
nil
|
|
)
|
|
|
|
;; ============================================================
|
|
;; START
|
|
;; ============================================================
|
|
(princ "\n=========================================")
|
|
(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")
|
|
(princ "\n=========================================")
|
|
(princ)
|