[REFACTOR] KS-Extraktion + Einfuegeprimitiven zentral in ssg_ks_insert.lsp
Neun Funktionen waren doppelt gepflegt in vf_core.lsp (unbedingt) UND Gefaellestrecke.lsp (geguardet 'Fallback wenn vf_core nicht geladen'). Da vf_core im MNL immer nach Gefaellestrecke laedt, gewann bisher stillschweigend die vf_core-Version - die Gefaellestrecke-Kopien waren de facto tot und wichen leicht ab. Jetzt EINE Quelle: ssg_ks_insert.lsp: vec-length, ks-line-axis, ks-normalize-name, ks-relativize, ks-absolutize, ensure-block-loaded, extract-ks-from-block[-raw], insert-block-by-ks, insert-inclined-scaled-block, insert-rotated-block-with-ks - Kanonische vf_core-Variante uebernommen (inkl. Null-Check, ssg-ils-block-auf-ebene, hz-Guard, Statusmeldungen). Gefaellestrecke erhaelt dadurch dieselbe Behandlung wie im MNL-Fluss ohnehin schon aktiv. - Cache vereinheitlicht auf *ks-cache* (guarded init im Shared-File); *gf-ks-cache* entfaellt. - MNL laedt ssg_ks_insert als Core-Modul VOR Gefaellestrecke/VarioFoerderer. - vf_core + Gefaellestrecke: guarded Nachlade-Load fuer isoliertes Test/Dev-Laden. Paren-Balance geprueft; jede der 9 Funktionen jetzt genau 1x definiert. Beruehrt Block-Platzierung -> BricsCAD-Test Standard/Etage/Linienzug/Gefaelle (2D+3D) noetig. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
+24
-298
@@ -29,7 +29,8 @@
|
|||||||
(if (null grad-zeichen) (setq grad-zeichen (chr 176)))
|
(if (null grad-zeichen) (setq grad-zeichen (chr 176)))
|
||||||
(if (null delta-sym) (setq delta-sym (chr 916)))
|
(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))
|
(if (null *gf-lib-geladen*)(setq *gf-lib-geladen* nil))
|
||||||
|
|
||||||
;; COM-Objekte (Guard: nicht ueberschreiben wenn von vf_core gesetzt)
|
;; 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)
|
;; TEIL 2: KERN-FUNKTIONEN (Guard: nicht doppelt definieren)
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
@@ -86,25 +109,6 @@
|
|||||||
(defun ssg-cfg-or (kategorie schluessel standard) standard)
|
(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 ---
|
;; --- Punkt-Differenz ---
|
||||||
(if (null (car (atoms-family 1 '("PUNKT-DIFFERENZ"))))
|
(if (null (car (atoms-family 1 '("PUNKT-DIFFERENZ"))))
|
||||||
(defun punkt-differenz (p1 p2)
|
(defun punkt-differenz (p1 p2)
|
||||||
@@ -113,284 +117,6 @@
|
|||||||
(- (caddr p2) (caddr 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 / )
|
|
||||||
;; 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) ---
|
;; --- KS-Rahmen aus Fahrtrichtungsvektor (Fallback wenn vf_core nicht geladen) ---
|
||||||
(if (null (car (atoms-family 1 '("MAKE-FRAME-FROM-DIR"))))
|
(if (null (car (atoms-family 1 '("MAKE-FRAME-FROM-DIR"))))
|
||||||
|
|||||||
@@ -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)
|
||||||
+23
-333
@@ -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 doc (vla-get-ActiveDocument (vlax-get-acad-object)))
|
||||||
(setq modelspace (vla-get-ModelSpace doc))
|
(setq modelspace (vla-get-ModelSpace doc))
|
||||||
|
|
||||||
@@ -94,54 +107,15 @@
|
|||||||
;; ============================================================
|
;; ============================================================
|
||||||
;; TEIL 4: HILFSFUNKTIONEN
|
;; TEIL 4: HILFSFUNKTIONEN
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
(defun vec-length (v)
|
;; vec-length, ks-line-axis, ks-normalize-name, ks-relativize, ks-absolutize
|
||||||
(sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v)))))
|
;; liegen jetzt zentral in ssg_ks_insert.lsp (gemeinsam mit Gefaellestrecke,
|
||||||
|
;; siehe dort). Hier nur noch die vf_core-spezifischen Helfer.
|
||||||
(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)))
|
|
||||||
|
|
||||||
(defun fmt (x)
|
(defun fmt (x)
|
||||||
(if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---"))
|
(if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---"))
|
||||||
|
|
||||||
(defun punkt-differenz (p1 p2)
|
(defun punkt-differenz (p1 p2)
|
||||||
(list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1))))
|
(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
|
;; TEIL 4b: KS-FRAME MATHEMATIK
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
@@ -265,88 +239,9 @@
|
|||||||
;; ============================================================
|
;; ============================================================
|
||||||
;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION
|
;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
(defun ensure-block-loaded (blockname / )
|
;; ensure-block-loaded, extract-ks-from-block-raw und extract-ks-from-block
|
||||||
;; Zentraler Loader (flache Ablage). Laedt den Block in der AKTUELLEN Dimension
|
;; liegen jetzt zentral in ssg_ks_insert.lsp (gemeinsam mit den Einfuege-
|
||||||
;; (ssg-ils-dim-aktuell: *ssg-ils-dim*-Override -> DXFM_DIM) mit automatischem
|
;; primitiven und Gefaellestrecke). Wird ueber die MNL vor vf_core geladen.
|
||||||
;; 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
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
;; TEIL 6: PUNKTE-AUSWAHL
|
;; TEIL 6: PUNKTE-AUSWAHL
|
||||||
@@ -452,79 +347,10 @@
|
|||||||
;; ============================================================
|
;; ============================================================
|
||||||
;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen)
|
;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen)
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...). Block
|
;; insert-block-by-ks (nur Rz), insert-inclined-scaled-block und
|
||||||
;; hat sonst keine Neigung, daher nur Rz-Rotation (keine Ry-Komponente).
|
;; insert-rotated-block-with-ks (beide Rz*Ry) liegen jetzt zentral in
|
||||||
(defun insert-block-by-ks (blockname einfuegepunkt hz / block-obj temp-obj ks-data ks-ein ks-aus
|
;; ssg_ks_insert.lsp (gemeinsam mit Gefaellestrecke). Die folgenden
|
||||||
rad-h chv shv ein-x ein-y ein-z dx-loc dy-loc dz-loc offset ausgang)
|
;; Frame-basierten Einfuegefunktionen bleiben vf_core-spezifisch.
|
||||||
(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
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
;; Fuegt Block ein und richtet KS_EIN am Ziel-Rahmen aus (volle 3D-Rotation).
|
;; 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
|
;; 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)))
|
(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))))
|
(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
|
;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE
|
||||||
|
|||||||
+4
-1
@@ -144,11 +144,14 @@
|
|||||||
(ssg-ensure "ssg_dialog")
|
(ssg-ensure "ssg_dialog")
|
||||||
(ssg-ensure "ssg_layer")
|
(ssg-ensure "ssg_layer")
|
||||||
(ssg-ensure "ssg_id")
|
(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
|
;; Allgemein-Zusammenfassung
|
||||||
(princ "\n=========================================")
|
(princ "\n=========================================")
|
||||||
(princ "\n[SSG_LIB] Core-Module geladen:")
|
(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 (strcat "\n Pfad: " *ssg-lisp-pfad*))
|
||||||
(princ "\n=========================================")
|
(princ "\n=========================================")
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user