horizontale Fahrrichtung (0°/90°/180°/270°) fuer Variofoederer manuelle Werteingabe ergänzen. die Möglichkeit des Horizontal-Varioföerderes wurde bei Ab-Förderrichtung geprüft.

This commit is contained in:
2026-07-03 12:59:24 +02:00
parent 11555ace8e
commit cc3cb9f160
4 changed files with 395 additions and 163 deletions
+50 -35
View File
@@ -238,8 +238,10 @@
;; --- 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 temp-obj ks-data ks-ein ks-aus offset ausgang)
(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
@@ -247,6 +249,8 @@
(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
@@ -259,21 +263,30 @@
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(setq block-obj
(vla-InsertBlock modelspace
(vlax-3D-point einfuegepunkt)
(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 offset
(list (- (car (car ks-ein)))
(- (cadr (car ks-ein)))
(- (caddr (car ks-ein)))))
(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 ausgang
(list (+ (car einfuegepunkt) (car (car ks-aus)) (car offset))
(+ (cadr einfuegepunkt) (cadr (car ks-aus)) (cadr offset))
(+ (caddr einfuegepunkt) (caddr (car ks-aus)) (caddr 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
)
@@ -287,30 +300,32 @@
;; --- 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)
(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 (* (float winkel) (/ pi 180.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 (cos rad) 0 (sin rad) 0)
(list 0 1 0 0)
(list (- (sin rad)) 0 (cos rad) 0)
(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 (cos rad)))
(cadr startpunkt)
(+ (caddr startpunkt) (* (- (sin rad)) laenge))))
(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
@@ -319,20 +334,22 @@
)
)
;; --- Rotierter Block mit manuellem dx/dz (Richtung X) ---
;; --- 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 /
rad block-obj temp-obj ks-data
(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 (* (float winkel) (/ pi 180.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))
;; 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
@@ -363,23 +380,21 @@
(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 (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 (cos rad)) (* ein-z (sin rad))))
(- (cadr startpunkt) ein-y)
(- (caddr startpunkt) (+ (* (- (sin rad)) ein-x) (* (cos rad) ein-z)))))
(- (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 (cos rad)) (* dz (sin rad))))
(cadr startpunkt)
(+ (caddr startpunkt)
(+ (* (- (sin rad)) dx) (* (cos rad) dz))))
(+ (car startpunkt) (+ (* dx chv cvv) (* dz chv svv)))
(+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv)))
(+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv))))
)
)