diff --git a/Lisp/Gefaellestrecke.lsp b/Lisp/Gefaellestrecke.lsp index 40d764d..1f6ab82 100644 --- a/Lisp/Gefaellestrecke.lsp +++ b/Lisp/Gefaellestrecke.lsp @@ -29,7 +29,8 @@ (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)) +;; *gf-ks-cache* entfaellt - KS-Cache liegt zentral als *ks-cache* in +;; ssg_ks_insert.lsp (gemeinsame extract-ks-from-block). (if (null *gf-lib-geladen*)(setq *gf-lib-geladen* nil)) ;; COM-Objekte (Guard: nicht ueberschreiben wenn von vf_core gesetzt) @@ -77,6 +78,28 @@ ) ) +;; Gemeinsame KS-Extraktion + Einfuegeprimitiven (ssg_ks_insert.lsp) +;; sicherstellen. Im MNL-Fluss bereits vorgeladen; dieser Guard deckt das +;; isolierte Laden von Gefaellestrecke (Test/Dev) ab. ssg_ks_insert benoetigt +;; ssg_core-Funktionen (ssg-ils-block-laden etc.) - wie schon die frueheren +;; Gefaellestrecke-eigenen Kopien. +(if (not (car (atoms-family 1 '("INSERT-BLOCK-BY-KS")))) + (progn + (setq *gf-ksins-pfad* + (if (car (atoms-family 1 '("SSG-LISP-DATEI-PFAD"))) + (ssg-lisp-datei-pfad "ssg_ks_insert.lsp") + (cond + ((getenv "DXFM_LISP") + (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_ks_insert.lsp")) + ((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*) + (strcat *ssg-lisp-pfad* "/ssg_ks_insert.lsp")) + (t nil)))) + (if (and *gf-ksins-pfad* (findfile *gf-ksins-pfad*)) + (load *gf-ksins-pfad*) + (princ "\n[Gefaellestrecke] WARNUNG: ssg_ks_insert.lsp nicht gefunden!")) + ) +) + ;; ============================================================ ;; TEIL 2: KERN-FUNKTIONEN (Guard: nicht doppelt definieren) ;; ============================================================ @@ -86,25 +109,6 @@ (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) @@ -113,284 +117,6 @@ (- (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 / ) - ;; Zentraler Loader (flache Ablage). Laedt den Block in der AKTUELLEN Dimension - ;; (ssg-ils-dim-aktuell: *ssg-ils-dim*-Override -> DXFM_DIM) mit automatischem - ;; 3D-Fallback, sodass 2D- und 3D-Aufbau gleichermassen funktionieren. Laedt - ;; den Block unter seinem effektiven, dim-suffigierten Namen und GIBT DIESEN - ;; ZURUECK, damit Aufrufer ihn zum Einfuegen verwenden. Meldung nur bei - ;; Fehlschlag. - (if (not (ssg-ils-block-laden blockname)) - (progn - (princ (ssg-textf "gf-fehler-blockdatei-fehlt" (list blockname))) - ) - ) - (ssg-ils-blockname blockname) - ) -) - -;; --- 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 - ;; KS-Blocknamen normalisieren: Standard KS_EIN/KS_AUS; historische - ;; Bestandsbloecke koennen noch KSYS_EIN/KSYS_AUS fuehren (inline, damit - ;; diese Fallback-Kopie unabhaengig von vf_core.lsp funktioniert). - (setq ks-ref - (if (and (not (vlax-erased-p sub-obj)) - (= (vla-get-ObjectName sub-obj) "AcDbBlockReference")) - (cond - ((or (= (vla-get-Name sub-obj) "KS_EIN") (= (vla-get-Name sub-obj) "KSYS_EIN")) "KS_EIN") - ((or (= (vla-get-Name sub-obj) "KS_AUS") (= (vla-get-Name sub-obj) "KSYS_AUS")) "KS_AUS") - (t nil)) - nil)) - (if ks-ref - (progn - (setq inner-entities (vlax-invoke sub-obj 'Explode)) - (setq origin nil x-end nil y-end nil z-end nil) - (foreach inner-obj inner-entities - (if (and (not (vlax-erased-p inner-obj)) - (= (vla-get-ObjectName inner-obj) "AcDbLine")) - (progn - (setq line-start - (vlax-safearray->list - (vlax-variant-value (vla-get-StartPoint inner-obj)))) - (setq line-end - (vlax-safearray->list - (vlax-variant-value (vla-get-EndPoint inner-obj)))) - (setq line-vec - (list (- (car line-end) (car line-start)) - (- (cadr line-end) (cadr line-start)) - (- (caddr line-end) (caddr line-start)))) - (setq line-len (vec-length line-vec)) - (setq axis (ks-line-axis line-len)) - (if (null origin) (setq origin line-start)) - (cond - ((= axis "X") (setq x-end line-end)) - ((= axis "Y") (setq y-end line-end)) - ((= axis "Z") (setq z-end line-end)) - ) - ) - ) - (if (not (vlax-erased-p inner-obj)) (vla-Delete inner-obj)) - ) - (if (and origin x-end y-end z-end) - (setq ks-results - (cons (list ks-ref (list origin x-end y-end z-end)) - ks-results)) - ) - ) - ) - ) - (foreach sub-obj sub-entities - (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj)) - ) - ks-results - ) -) - -;; --- 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) - (setq blockname (ensure-block-loaded blockname)) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (ssg-textf "gf-fehler-block-fehlt" (list blockname))) - (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 (ssg-textf "gf-status-ks-aus-z" (list (rtos (caddr ausgang) 2 2)))) - ausgang - ) - (progn - (princ (ssg-text "gf-warnung-ks-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 (ssg-text "gf-laenge-null-uebersprungen")) startpunkt) - (progn - (setq blockname (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 (ssg-rot-matrix-zy chv shv cvv svv))) - (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 (ssg-textf "gf-status-block-l-z" - (list blockname (rtos laenge 2 1) (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) - (setq blockname (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 (ssg-rot-matrix-zy chv shv cvv svv))) - (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")))) diff --git a/Lisp/ssg_ks_insert.lsp b/Lisp/ssg_ks_insert.lsp new file mode 100644 index 0000000..460d308 --- /dev/null +++ b/Lisp/ssg_ks_insert.lsp @@ -0,0 +1,357 @@ +;; ============================================================ +;; SSG_KS_INSERT.LSP - Gemeinsame KS-Extraktion + Block-Einfuegeprimitiven +;; ============================================================ +;; Frueher doppelt gepflegt in vf_core.lsp (unbedingt) UND Gefaellestrecke.lsp +;; (geguardet als "Fallback wenn vf_core nicht geladen"). Da vf_core im MNL-Fluss +;; immer nach Gefaellestrecke laedt, gewann bisher STILLSCHWEIGEND die +;; vf_core-Version - die Gefaellestrecke-Fallbacks waren de facto tot und wichen +;; zudem leicht ab (Layer-Setzung, hz-Guard, Null-Check, Meldungs-Keys). Diese +;; Datei ist jetzt die EINZIGE Quelle (kanonische vf_core-Variante); beide +;; Cluster laden sie ueber die MNL VOR Gefaellestrecke/vf_core. +;; +;; Abhaengigkeiten (aus ssg_core, daher zuerst laden): ssg-ils-block-laden, +;; ssg-ils-blockname, ssg-ils-block-auf-ebene, ssg-rot-matrix-zy, ssg-text/-textf. +;; ============================================================ + +(vl-load-com) + +;; Cache fuer extract-ks-from-block (Blockname -> relative KS-Punkte). Guard, +;; damit ein Neu-Laden dieser Datei den Cache nicht verwirft. +(if (not (boundp '*ks-cache*)) (setq *ks-cache* nil)) + +;; ------------------------------------------------------------ +;; KS-MATHEMATIK (Basis) +;; ------------------------------------------------------------ +(defun vec-length (v) + (sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v))))) + +;; Achsenkennung aus Linienlaenge fuer die KS-Extraktion (X=1 bzw. 100, Y=2, Z=3). +(defun ks-line-axis (len) + (cond + ((and (> len 0.5) (< len 1.5)) "X") + ((and (> len 99) (< len 101)) "X") + ((and (> len 1.5) (< len 2.5)) "Y") + ((and (> len 2.5) (< len 3.5)) "Z") + (t nil))) + +;; Normalisiert die verschiedenen KS-Blocknamen auf "KS_EIN"/"KS_AUS". +;; Standard ist KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch +;; KSYS_EIN/KSYS_AUS fuehren. Rueckgabe nil, wenn kein KS-Block. +(defun ks-normalize-name (nm) + (cond + ((or (= nm "KS_EIN") (= nm "KSYS_EIN")) "KS_EIN") + ((or (= nm "KS_AUS") (= nm "KSYS_AUS")) "KS_AUS") + (t nil))) + +(defun ks-relativize (ks-data base-pt) + (mapcar '(lambda (item) + (list (car item) + (mapcar '(lambda (pt) + (list (- (car pt) (car base-pt)) + (- (cadr pt) (cadr base-pt)) + (- (caddr pt) (caddr base-pt)))) + (cadr item)))) + ks-data)) + +(defun ks-absolutize (ks-rel base-pt) + (mapcar '(lambda (item) + (list (car item) + (mapcar '(lambda (pt) + (list (+ (car pt) (car base-pt)) + (+ (cadr pt) (cadr base-pt)) + (+ (caddr pt) (caddr base-pt)))) + (cadr item)))) + ks-rel)) + +;; ------------------------------------------------------------ +;; BLOCK-LADER +;; ------------------------------------------------------------ +;; Zentraler Loader (flache Ablage). Laedt den Block in der AKTUELLEN Dimension +;; (ssg-ils-dim-aktuell: *ssg-ils-dim*-Override -> DXFM_DIM) mit automatischem +;; 3D-Fallback, sodass 2D- und 3D-Aufbau gleichermassen funktionieren. Laedt den +;; Block unter seinem effektiven, dim-suffigierten Namen und GIBT DIESEN ZURUECK, +;; damit Aufrufer ihn zum Einfuegen (vla-InsertBlock/tblsearch) verwenden. +;; Meldung nur bei Fehlschlag. +(defun ensure-block-loaded (blockname / ) + (if (not (ssg-ils-block-laden blockname)) + (princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname))) + ) + (ssg-ils-blockname blockname) +) + +;; ------------------------------------------------------------ +;; KS-EXTRAKTION (mit Cache *ks-cache*) +;; ------------------------------------------------------------ +(defun extract-ks-from-block-raw (block-obj / sub-entities sub-obj ks-results + ks-ref inner-entities inner-obj origin x-end y-end z-end + line-start line-end axis line-len line-vec) + (setq ks-results '()) + (setq sub-entities (vlax-invoke block-obj 'Explode)) + (foreach sub-obj sub-entities + (setq ks-ref + (if (and (not (vlax-erased-p sub-obj)) + (= (vla-get-ObjectName sub-obj) "AcDbBlockReference")) + (ks-normalize-name (vla-get-Name sub-obj)) + nil)) + (if ks-ref + (progn + (setq inner-entities (vlax-invoke sub-obj 'Explode)) + (setq origin nil x-end nil y-end nil z-end nil) + (foreach inner-obj inner-entities + (if (and (not (vlax-erased-p inner-obj)) + (= (vla-get-ObjectName inner-obj) "AcDbLine")) + (progn + (setq line-start (vlax-safearray->list + (vlax-variant-value (vla-get-StartPoint inner-obj)))) + (setq line-end (vlax-safearray->list + (vlax-variant-value (vla-get-EndPoint inner-obj)))) + (setq line-vec (list (- (car line-end) (car line-start)) + (- (cadr line-end) (cadr line-start)) + (- (caddr line-end) (caddr line-start)))) + (setq line-len (vec-length line-vec)) + (setq axis (ks-line-axis line-len)) + (if (null origin) (setq origin line-start)) + (cond + ((= axis "X") (setq x-end line-end)) + ((= axis "Y") (setq y-end line-end)) + ((= axis "Z") (setq z-end line-end)) + ) + ) + ) + (if (not (vlax-erased-p inner-obj)) (vla-Delete inner-obj)) + ) + (if (and origin x-end y-end z-end) + (setq ks-results (cons (list ks-ref (list origin x-end y-end z-end)) ks-results)) + ) + ) + ) + ) + (foreach sub-obj sub-entities + (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj)) + ) + ks-results +) + +(defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel) + (setq blockname (vla-get-Name block-obj)) + (setq insert-pt (vlax-safearray->list + (vlax-variant-value (vla-get-InsertionPoint block-obj)))) + (setq cached (assoc blockname *ks-cache*)) + (if cached + (ks-absolutize (cdr cached) insert-pt) + (progn + (setq result (extract-ks-from-block-raw block-obj)) + (if result + (progn + (setq ks-rel (ks-relativize result insert-pt)) + (setq *ks-cache* (cons (cons blockname ks-rel) *ks-cache*)) + ) + ) + result + ) + ) +) + +;; ------------------------------------------------------------ +;; EINFUEGEPRIMITIVEN +;; ------------------------------------------------------------ + +;; --- Block per KS_EIN/KS_AUS einfuegen (nur horizontale Rz-Rotation) --- +;; KS_EIN (nicht der Block-Ursprung) kommt auf einfuegepunkt zu liegen. +;; Rueckgabe: Weltpunkt von KS_AUS (fuer Verkettung), sonst einfuegepunkt. +(defun insert-block-by-ks (blockname einfuegepunkt hz / block-obj temp-obj ks-data ks-ein ks-aus + rad-h chv shv ein-x ein-y ein-z dx-loc dy-loc dz-loc offset ausgang) + (if (or (null einfuegepunkt) (not (listp einfuegepunkt))) + (progn + (princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname))) + (exit) + ) + ) + (setq blockname (ensure-block-loaded blockname)) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname))) + (exit) + ) + ) + (princ (ssg-textf "vfc-fuege-block-ein-hz" (list blockname (rtos (float hz) 2 1) (chr 176)))) + (setq rad-h (* (float hz) (/ pi 180.0))) + (setq chv (cos rad-h) shv (sin rad-h)) + ;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht am + ;; spaeter tatsaechlich platzierten block-obj - extract-ks-from-block + ;; exploded das uebergebene Objekt intern), siehe insert-block-ks-to-ks. + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (setq ks-data (extract-ks-from-block temp-obj)) + (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) + (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) + ;; Block am Ursprung einfuegen (nicht direkt am einfuegepunkt), damit die + ;; Rz-Rotation um den Block-Ursprung dreht, nicht um die Weltachse. + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (ssg-ils-block-auf-ebene block-obj blockname) + (if (> (abs hz) 0.0001) + (vla-TransformBy block-obj (vlax-tmatrix + (list (list chv (- shv) 0 0) + (list shv chv 0 0) + (list 0 0 1 0) + (list 0 0 0 1)))) + ) + (if (and ks-ein ks-aus) + (progn + (setq ein-x (car (car ks-ein)) ein-y (cadr (car ks-ein)) ein-z (caddr (car ks-ein))) + ;; Block-Ursprung so verschieben, dass das ROTIERTE KS_EIN exakt auf + ;; einfuegepunkt zu liegen kommt: Ursprung = einfuegepunkt - Rz(hz)*ks_ein_lokal + (setq offset (list + (- (car einfuegepunkt) (- (* chv ein-x) (* shv ein-y))) + (- (cadr einfuegepunkt) (+ (* shv ein-x) (* chv ein-y))) + (- (caddr einfuegepunkt) ein-z))) + (vla-Move block-obj + (vlax-3D-point '(0 0 0)) + (vlax-3D-point offset)) + ;; KS_AUS = einfuegepunkt + Rz(hz)*(ks_aus_lokal - ks_ein_lokal) + (setq dx-loc (- (car (car ks-aus)) ein-x)) + (setq dy-loc (- (cadr (car ks-aus)) ein-y)) + (setq dz-loc (- (caddr (car ks-aus)) ein-z)) + (setq ausgang (list + (+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc))) + (+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc))) + (+ (caddr einfuegepunkt) dz-loc))) + (princ (ssg-textf "vfc-ks-aus-xyz" + (list (rtos (car ausgang) 2 2) (rtos (cadr ausgang) 2 2) (rtos (caddr ausgang) 2 2)))) + ausgang + ) + (progn + (princ (ssg-text "vfc-warnung-ks-nicht-gefunden")) + einfuegepunkt + ) + ) +) + +;; --- Skalierter geneigter Block (Staustrecke, Richtung X), Rz(hz)*Ry(winkel) --- +(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz / + rad-v rad-h chv shv cvv svv scale block-obj matrix endpunkt) + (if (<= laenge 0.1) + (progn + (princ (ssg-textf "vfc-laenge-uebersprungen" (list (rtos laenge 2 2)))) + startpunkt + ) + (progn + (setq blockname (ensure-block-loaded blockname)) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname))) + (exit) + ) + ) + (princ (ssg-textf "vfc-fuege-ein-lwhz" + (list blockname (rtos laenge 2 2) (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176)))) + (setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0))) + (setq rad-v (* (float winkel) (/ pi 180.0))) + (setq rad-h (* (float hz) (/ pi 180.0))) + (setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v)) + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname scale 1.0 1.0 0)) + (ssg-ils-block-auf-ebene block-obj blockname) + (setq matrix (ssg-rot-matrix-zy chv shv cvv svv)) + (vla-TransformBy block-obj (vlax-tmatrix matrix)) + (vla-Move block-obj + (vlax-3D-point '(0 0 0)) + (vlax-3D-point startpunkt)) + (setq endpunkt (list + (+ (car startpunkt) (* laenge chv cvv)) + (+ (cadr startpunkt) (* laenge shv cvv)) + (+ (caddr startpunkt) (* laenge (- svv))))) + (princ (ssg-textf "vfc-endpunkt-xyz" + (list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2)))) + endpunkt + ) + ) +) + +;; --- Rotierter Block mit manuellem dx/dz-Fallback, Rz(hz)*Ry(winkel) --- +;; block-dx/block-dz: Fallback-Laenge (aus Config), nur verwendet falls +;; KS_EIN/KS_AUS am Block nicht extrahiert werden koennen. Ist KS_AUS +;; vorhanden, wird der ECHTE gemessene Versatz KS_AUS-KS_EIN verwendet - +;; das schuetzt vor veralteten Config-Zahlen. KS_EIN (nicht der Block-Ursprung) +;; kommt auf startpunkt zu liegen. +(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz hz / + rad-v rad-h chv shv cvv svv matrix block-obj temp-obj ks-data + ks-ein-raw ks-aus-raw + ein-x ein-y ein-z aus-x aus-y aus-z + dx dz ins-pt endpunkt) + (if (or (null startpunkt) (not (listp startpunkt))) + (progn + (princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname))) + startpunkt + ) + (progn + (setq blockname (ensure-block-loaded blockname)) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname))) + (exit) + ) + ) + (princ (ssg-textf "vfc-fuege-block-ein-rotation-hz" + (list blockname (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176)))) + (setq rad-v (* winkel (/ pi 180.0))) + (setq rad-h (* (float hz) (/ pi 180.0))) + (setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v)) + ;; Lokale KS_EIN/KS_AUS-Position ueber EIGENES Temp-Objekt ermitteln. + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (setq ks-data (extract-ks-from-block temp-obj)) + (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) + (setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data))) + (setq ein-x 0.0 ein-y 0.0 ein-z 0.0) + (if ks-ein-raw + (setq ein-x (car (car ks-ein-raw)) + ein-y (cadr (car ks-ein-raw)) + ein-z (caddr (car ks-ein-raw))) + ) + ;; Echten Versatz KS_AUS-KS_EIN verwenden, sofern messbar. + (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)) + (ssg-ils-block-auf-ebene block-obj blockname) + (setq matrix (ssg-rot-matrix-zy chv shv cvv svv)) + (vla-TransformBy block-obj (vlax-tmatrix matrix)) + ;; Block-Ursprung so verschieben, dass das ROTIERTE KS_EIN exakt auf + ;; startpunkt liegt: Ursprung = startpunkt - Rz(hz)*Ry(winkel)*ks_ein_lokal + (setq ins-pt (list + (- (car startpunkt) (+ (* ein-x chv cvv) (* ein-y (- shv)) (* ein-z chv svv))) + (- (cadr startpunkt) (+ (* ein-x shv cvv) (* ein-y chv) (* ein-z shv svv))) + (- (caddr startpunkt) (+ (* ein-x (- svv)) (* ein-z cvv))))) + (vla-Move block-obj + (vlax-3D-point '(0 0 0)) + (vlax-3D-point ins-pt)) + ;; KS_AUS-Weltpunkt = startpunkt + Rz(hz)*Ry(winkel)*(dx 0 dz) + (setq endpunkt (list + (+ (car startpunkt) (+ (* dx chv cvv) (* dz chv svv))) + (+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv))) + (+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv))))) + (princ (ssg-textf "vfc-endpunkt-xyz-dxdz" + (list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2) + (rtos dx 2 1) (rtos dz 2 1)))) + endpunkt + ) + ) +) + +(princ) diff --git a/Lisp/vf_core.lsp b/Lisp/vf_core.lsp index 412b6a8..bb2a471 100644 --- a/Lisp/vf_core.lsp +++ b/Lisp/vf_core.lsp @@ -55,6 +55,19 @@ ) ) +;; Gemeinsame KS-Extraktion + Einfuegeprimitiven (ssg_ks_insert.lsp) sicherstellen. +;; Im MNL-Fluss bereits vorgeladen; dieser Guard deckt das isolierte Laden von +;; vf_core (Test/Dev) ab. ssg-lisp-datei-pfad stammt aus dem oben geladenen ssg_core. +(if (and (not (car (atoms-family 1 '("INSERT-BLOCK-BY-KS")))) + (car (atoms-family 1 '("SSG-LISP-DATEI-PFAD")))) + (progn + (setq *vf-ksins-pfad* (ssg-lisp-datei-pfad "ssg_ks_insert.lsp")) + (if (and *vf-ksins-pfad* (findfile *vf-ksins-pfad*)) + (load *vf-ksins-pfad*) + (princ "\n[vf_core] WARNUNG: ssg_ks_insert.lsp nicht gefunden!")) + ) +) + (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq modelspace (vla-get-ModelSpace doc)) @@ -94,54 +107,15 @@ ;; ============================================================ ;; TEIL 4: HILFSFUNKTIONEN ;; ============================================================ -(defun vec-length (v) - (sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v))))) - -(defun ks-line-axis (len) - (cond - ((and (> len 0.5) (< len 1.5)) "X") - ((and (> len 99) (< len 101)) "X") - ((and (> len 1.5) (< len 2.5)) "Y") - ((and (> len 2.5) (< len 3.5)) "Z") - (t nil))) - -;; Normalisiert die verschiedenen KS-Blocknamen auf "KS_EIN"/"KS_AUS". -;; Standard ist KS_EIN/KS_AUS; historische Bestandsbloecke koennen noch -;; KSYS_EIN/KSYS_AUS fuehren (Vereinheitlichung via ILS_BLOCK_RENAME in -;; block_rename.lsp). Diese Normalisierung bleibt als Sicherheitsnetz fuer -;; solche Altzeichnungen. Rueckgabe nil, wenn kein KS-Block. -(defun ks-normalize-name (nm) - (cond - ((or (= nm "KS_EIN") (= nm "KSYS_EIN")) "KS_EIN") - ((or (= nm "KS_AUS") (= nm "KSYS_AUS")) "KS_AUS") - (t nil))) - +;; vec-length, ks-line-axis, ks-normalize-name, ks-relativize, ks-absolutize +;; liegen jetzt zentral in ssg_ks_insert.lsp (gemeinsam mit Gefaellestrecke, +;; siehe dort). Hier nur noch die vf_core-spezifischen Helfer. (defun fmt (x) (if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---")) (defun punkt-differenz (p1 p2) (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1)))) -(defun ks-relativize (ks-data base-pt) - (mapcar '(lambda (item) - (list (car item) - (mapcar '(lambda (pt) - (list (- (car pt) (car base-pt)) - (- (cadr pt) (cadr base-pt)) - (- (caddr pt) (caddr base-pt)))) - (cadr item)))) - ks-data)) - -(defun ks-absolutize (ks-rel base-pt) - (mapcar '(lambda (item) - (list (car item) - (mapcar '(lambda (pt) - (list (+ (car pt) (car base-pt)) - (+ (cadr pt) (cadr base-pt)) - (+ (caddr pt) (caddr base-pt)))) - (cadr item)))) - ks-rel)) - ;; ============================================================ ;; TEIL 4b: KS-FRAME MATHEMATIK ;; ============================================================ @@ -265,88 +239,9 @@ ;; ============================================================ ;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION ;; ============================================================ -(defun ensure-block-loaded (blockname / ) - ;; Zentraler Loader (flache Ablage). Laedt den Block in der AKTUELLEN Dimension - ;; (ssg-ils-dim-aktuell: *ssg-ils-dim*-Override -> DXFM_DIM) mit automatischem - ;; 3D-Fallback, sodass 2D- und 3D-Aufbau gleichermassen funktionieren. Laedt den - ;; Block unter seinem effektiven, dim-suffigierten Namen und GIBT DIESEN ZURUECK, - ;; damit Aufrufer ihn zum Einfuegen (vla-InsertBlock/tblsearch) verwenden. - ;; Meldung nur bei Fehlschlag. - (if (not (ssg-ils-block-laden blockname)) - (princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname))) - ) - (ssg-ils-blockname blockname) -) - -(defun extract-ks-from-block-raw (block-obj / sub-entities sub-obj ks-results - ks-ref inner-entities inner-obj origin x-end y-end z-end - line-start line-end axis line-len line-vec) - (setq ks-results '()) - (setq sub-entities (vlax-invoke block-obj 'Explode)) - (foreach sub-obj sub-entities - (setq ks-ref - (if (and (not (vlax-erased-p sub-obj)) - (= (vla-get-ObjectName sub-obj) "AcDbBlockReference")) - (ks-normalize-name (vla-get-Name sub-obj)) - nil)) - (if ks-ref - (progn - (setq inner-entities (vlax-invoke sub-obj 'Explode)) - (setq origin nil x-end nil y-end nil z-end nil) - (foreach inner-obj inner-entities - (if (and (not (vlax-erased-p inner-obj)) - (= (vla-get-ObjectName inner-obj) "AcDbLine")) - (progn - (setq line-start (vlax-safearray->list - (vlax-variant-value (vla-get-StartPoint inner-obj)))) - (setq line-end (vlax-safearray->list - (vlax-variant-value (vla-get-EndPoint inner-obj)))) - (setq line-vec (list (- (car line-end) (car line-start)) - (- (cadr line-end) (cadr line-start)) - (- (caddr line-end) (caddr line-start)))) - (setq line-len (vec-length line-vec)) - (setq axis (ks-line-axis line-len)) - (if (null origin) (setq origin line-start)) - (cond - ((= axis "X") (setq x-end line-end)) - ((= axis "Y") (setq y-end line-end)) - ((= axis "Z") (setq z-end line-end)) - ) - ) - ) - (if (not (vlax-erased-p inner-obj)) (vla-Delete inner-obj)) - ) - (if (and origin x-end y-end z-end) - (setq ks-results (cons (list ks-ref (list origin x-end y-end z-end)) ks-results)) - ) - ) - ) - ) - (foreach sub-obj sub-entities - (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj)) - ) - ks-results -) - -(defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel) - (setq blockname (vla-get-Name block-obj)) - (setq insert-pt (vlax-safearray->list - (vlax-variant-value (vla-get-InsertionPoint block-obj)))) - (setq cached (assoc blockname *ks-cache*)) - (if cached - (ks-absolutize (cdr cached) insert-pt) - (progn - (setq result (extract-ks-from-block-raw block-obj)) - (if result - (progn - (setq ks-rel (ks-relativize result insert-pt)) - (setq *ks-cache* (cons (cons blockname ks-rel) *ks-cache*)) - ) - ) - result - ) - ) -) +;; ensure-block-loaded, extract-ks-from-block-raw und extract-ks-from-block +;; liegen jetzt zentral in ssg_ks_insert.lsp (gemeinsam mit den Einfuege- +;; primitiven und Gefaellestrecke). Wird ueber die MNL vor vf_core geladen. ;; ============================================================ ;; TEIL 6: PUNKTE-AUSWAHL @@ -452,79 +347,10 @@ ;; ============================================================ ;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen) ;; ============================================================ -;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...). Block -;; hat sonst keine Neigung, daher nur Rz-Rotation (keine Ry-Komponente). -(defun insert-block-by-ks (blockname einfuegepunkt hz / block-obj temp-obj ks-data ks-ein ks-aus - rad-h chv shv ein-x ein-y ein-z dx-loc dy-loc dz-loc offset ausgang) - (if (or (null einfuegepunkt) (not (listp einfuegepunkt))) - (progn - (princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname))) - (exit) - ) - ) - (setq blockname (ensure-block-loaded blockname)) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname))) - (exit) - ) - ) - (princ (ssg-textf "vfc-fuege-block-ein-hz" (list blockname (rtos (float hz) 2 1) (chr 176)))) - (setq rad-h (* (float hz) (/ pi 180.0))) - (setq chv (cos rad-h) shv (sin rad-h)) - ;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht am - ;; spaeter tatsaechlich platzierten block-obj - extract-ks-from-block - ;; exploded das uebergebene Objekt intern), siehe insert-block-ks-to-ks. - (setq temp-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - blockname 1.0 1.0 1.0 0)) - (setq ks-data (extract-ks-from-block temp-obj)) - (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) - (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) - (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) - ;; Block am Ursprung einfuegen (nicht direkt am einfuegepunkt), damit die - ;; Rz-Rotation um den Block-Ursprung dreht, nicht um die Weltachse. - (setq block-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - blockname 1.0 1.0 1.0 0)) - (ssg-ils-block-auf-ebene block-obj blockname) - (if (> (abs hz) 0.0001) - (vla-TransformBy block-obj (vlax-tmatrix - (list (list chv (- shv) 0 0) - (list shv chv 0 0) - (list 0 0 1 0) - (list 0 0 0 1)))) - ) - (if (and ks-ein ks-aus) - (progn - (setq ein-x (car (car ks-ein)) ein-y (cadr (car ks-ein)) ein-z (caddr (car ks-ein))) - ;; Block-Ursprung so verschieben, dass das ROTIERTE KS_EIN exakt auf - ;; einfuegepunkt zu liegen kommt: Ursprung = einfuegepunkt - Rz(hz)*ks_ein_lokal - (setq offset (list - (- (car einfuegepunkt) (- (* chv ein-x) (* shv ein-y))) - (- (cadr einfuegepunkt) (+ (* shv ein-x) (* chv ein-y))) - (- (caddr einfuegepunkt) ein-z))) - (vla-Move block-obj - (vlax-3D-point '(0 0 0)) - (vlax-3D-point offset)) - ;; KS_AUS = einfuegepunkt + Rz(hz)*(ks_aus_lokal - ks_ein_lokal) - (setq dx-loc (- (car (car ks-aus)) ein-x)) - (setq dy-loc (- (cadr (car ks-aus)) ein-y)) - (setq dz-loc (- (caddr (car ks-aus)) ein-z)) - (setq ausgang (list - (+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc))) - (+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc))) - (+ (caddr einfuegepunkt) dz-loc))) - (princ (ssg-textf "vfc-ks-aus-xyz" - (list (rtos (car ausgang) 2 2) (rtos (cadr ausgang) 2 2) (rtos (caddr ausgang) 2 2)))) - ausgang - ) - (progn - (princ (ssg-text "vfc-warnung-ks-nicht-gefunden")) - einfuegepunkt - ) - ) -) +;; insert-block-by-ks (nur Rz), insert-inclined-scaled-block und +;; insert-rotated-block-with-ks (beide Rz*Ry) liegen jetzt zentral in +;; ssg_ks_insert.lsp (gemeinsam mit Gefaellestrecke). Die folgenden +;; Frame-basierten Einfuegefunktionen bleiben vf_core-spezifisch. ;; Fuegt Block ein und richtet KS_EIN am Ziel-Rahmen aus (volle 3D-Rotation). ;; target-frame : (P xt yt zt) - Ziel-Rahmen, z.B. KS_AUS des Vorgaenger-Elements @@ -804,142 +630,6 @@ (setq m (vf-element-masse (strcat "ES_Element_" winkel "_" seite))) (if m (setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m)))) -;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...), -;; winkel: vertikale Neigung in Grad. Rotation = Rz(hz)*Ry(winkel). -(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz / - rad-v rad-h chv shv cvv svv matrix block-obj endpunkt scale) - (if (<= laenge 0.1) - (progn - (princ (ssg-textf "vfc-laenge-uebersprungen" (list (rtos laenge 2 2)))) - startpunkt - ) - (progn - (setq blockname (ensure-block-loaded blockname)) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname))) - (exit) - ) - ) - (princ (ssg-textf "vfc-fuege-ein-lwhz" - (list blockname (rtos laenge 2 2) (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176)))) - (setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0))) - (setq rad-v (* (float winkel) (/ pi 180.0))) - (setq rad-h (* (float hz) (/ pi 180.0))) - (setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v)) - (setq block-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - blockname scale 1.0 1.0 0)) - (ssg-ils-block-auf-ebene block-obj blockname) - (setq matrix (vf-rot-matrix chv shv cvv svv)) - (vla-TransformBy block-obj (vlax-tmatrix matrix)) - (vla-Move block-obj - (vlax-3D-point '(0 0 0)) - (vlax-3D-point startpunkt)) - (setq endpunkt (list - (+ (car startpunkt) (* laenge chv cvv)) - (+ (cadr startpunkt) (* laenge shv cvv)) - (+ (caddr startpunkt) (* laenge (- svv))))) - (princ (ssg-textf "vfc-endpunkt-xyz" - (list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2)))) - endpunkt - ) - ) -) - -;; Fuegt Block ein und dreht ihn um die Y-Achse (Neigung, reine XZ-Ebene). -;; block-dx/block-dz: lokaler Versatz KS_AUS-KS_EIN (unrotiert), fuer den -;; zurueckgegebenen endpunkt. -;; WICHTIG: KS_EIN liegt nicht bei jedem Block exakt am Block-Ursprung -;; (z.B. bei Vario_Bogen). Damit KS_EIN und nicht der Block-Ursprung auf -;; startpunkt zu liegen kommt, wird der Ursprung um das rotierte lokale -;; KS_EIN-Versatz korrigiert. Fuer Bloecke mit KS_EIN=Ursprung (Separator, -;; Umlenk-/Motorstation) ist diese Korrektur 0 - Verhalten bleibt gleich. -;; block-dx/block-dz: Fallback-Laenge (aus Config), nur verwendet falls -;; KS_EIN/KS_AUS am Block nicht extrahiert werden koennen. Ist KS_AUS -;; vorhanden, wird der ECHTE gemessene Versatz KS_AUS-KS_EIN verwendet - -;; das schuetzt vor veralteten Config-Zahlen, die nicht mehr zur -;; tatsaechlichen Blockgeometrie passen (z.B. nach einer DWG-Bereinigung). -;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...), -;; winkel: vertikale Neigung in Grad. Rotation = Rz(hz)*Ry(winkel). -(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz hz / - rad-v rad-h chv shv cvv svv matrix block-obj temp-obj ks-data - ks-ein-raw ks-aus-raw - ein-x ein-y ein-z aus-x aus-y aus-z - dx dz ins-pt endpunkt) - (if (or (null startpunkt) (not (listp startpunkt))) - (progn - (princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname))) - startpunkt - ) - (progn - (setq blockname (ensure-block-loaded blockname)) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname))) - (exit) - ) - ) - (princ (ssg-textf "vfc-fuege-block-ein-rotation-hz" - (list blockname (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176)))) - (setq rad-v (* winkel (/ pi 180.0))) - (setq rad-h (* (float hz) (/ pi 180.0))) - (setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v)) - ;; Lokale KS_EIN/KS_AUS-Position ueber EIGENES Temp-Objekt ermitteln - ;; (nicht am spaeter tatsaechlich platzierten block-obj - - ;; extract-ks-from-block exploded das uebergebene Objekt intern; das - ;; darf nicht das Objekt sein, das anschliessend gedreht/verschoben - ;; in der Zeichnung bleibt). - (setq temp-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - blockname 1.0 1.0 1.0 0)) - (setq ks-data (extract-ks-from-block temp-obj)) - (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) - (setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data))) - (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data))) - (setq ein-x 0.0 ein-y 0.0 ein-z 0.0) - (if ks-ein-raw - (setq ein-x (car (car ks-ein-raw)) - ein-y (cadr (car ks-ein-raw)) - ein-z (caddr (car ks-ein-raw))) - ) - ;; Echten Versatz KS_AUS-KS_EIN verwenden, sofern messbar (statt der - ;; ggf. veralteten Config-Werte block-dx/block-dz). - (setq dx block-dx dz block-dz) - (if ks-aus-raw - (progn - (setq aus-x (car (car ks-aus-raw)) - aus-y (cadr (car ks-aus-raw)) - aus-z (caddr (car ks-aus-raw))) - (setq dx (- aus-x ein-x) dz (- aus-z ein-z)) - ) - ) - (setq block-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - blockname 1.0 1.0 1.0 0)) - (ssg-ils-block-auf-ebene block-obj blockname) - (setq matrix (vf-rot-matrix chv shv cvv svv)) - (vla-TransformBy block-obj (vlax-tmatrix matrix)) - ;; Block-Ursprung so verschieben, dass das ROTIERTE KS_EIN exakt auf - ;; startpunkt liegt: Ursprung = startpunkt - Rz(hz)*Ry(winkel)*ks_ein_lokal - (setq ins-pt (list - (- (car startpunkt) (+ (* ein-x chv cvv) (* ein-y (- shv)) (* ein-z chv svv))) - (- (cadr startpunkt) (+ (* ein-x shv cvv) (* ein-y chv) (* ein-z shv svv))) - (- (caddr startpunkt) (+ (* ein-x (- svv)) (* ein-z cvv))))) - (vla-Move block-obj - (vlax-3D-point '(0 0 0)) - (vlax-3D-point ins-pt)) - (setq endpunkt (list - (+ (car startpunkt) (+ (* dx chv cvv) (* dz chv svv))) - (+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv))) - (+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv))))) - (princ (ssg-textf "vfc-endpunkt-xyz-dxdz" - (list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2) - (rtos dx 2 1) (rtos dz 2 1)))) - endpunkt - ) - ) -) ;; ============================================================ ;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE diff --git a/menu/SSG_LIB.mnl b/menu/SSG_LIB.mnl index 0861d70..426d1d6 100644 --- a/menu/SSG_LIB.mnl +++ b/menu/SSG_LIB.mnl @@ -144,11 +144,14 @@ (ssg-ensure "ssg_dialog") (ssg-ensure "ssg_layer") (ssg-ensure "ssg_id") + ;; Gemeinsame KS-Extraktion + Block-Einfuegeprimitiven (von Gefaellestrecke + ;; UND VarioFoerderer genutzt) - MUSS vor beiden geladen sein. + (ssg-ensure "ssg_ks_insert") ;; Allgemein-Zusammenfassung (princ "\n=========================================") (princ "\n[SSG_LIB] Core-Module geladen:") - (princ "\n ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, ssg_id") + (princ "\n ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, ssg_id, ssg_ks_insert") (princ (strcat "\n Pfad: " *ssg-lisp-pfad*)) (princ "\n=========================================")