Samer AyadiandClaude Sonnet 5
618ff3d86c
Stufe 1 (LISP-Export-Pfad): export_raw.json enthaelt jetzt fuer jeden sepliste-Eintrag (AS/SEP/ES) einer VF_n/GF_n-Kette die ID des realen Bauteils, das ihn vertritt. - csv:sep-proxies-erzeugen (Separatoren) und die neuen AS/ES-Marker teilen sich csv:nested-welt-records/csv:block-einfuegen-welt zur Platzierung. - csv:sepliste-paare ordnet sepliste-Eintraege ihrem Bauteil exklusiv nach Abstand zu (kuerzester zuerst, dann verbraucht) statt "jeder Eintrag nimmt sich das naechste" - ein einzelner fehlerhafter Koordinatenwert (bekannter Bug: gespiegeltes x bei lfdnr=2) verschiebt dadurch keine andere Zuordnung mehr. - Neu: ZZ_ASES_MARKER - ein kleines Rechteck an jedem AS/ES-Kettenende, das nach dem Export STEHEN BLEIBT (anders als die temporaeren Separator-Kopien). Macht das sonst unsichtbare, in der Wrapper- Blockdefinition verpackte Kettenende in BricsCAD sichtbar/anklickbar und traegt seine ID unsichtbar am Attribut ID - dadurch behaelt ein AS/ES seine TeileId ueber Exportlaeufe hinweg. Wird bei jedem Export neu aufgebaut (Lage folgt der Kette), Wiederfund ueber ZUORDNUNG+TYP+ LFDNR, verwaiste Marker werden entfernt. In BricsCAD verifiziert (5 HundM05-Ketten, zwei Exportlaeufe: gleiche Marker-IDs, korrekte sepliste-"id"-Felder). Dabei einen realen Bug gefunden und behoben: die Blockdefinition des Markers uebernahm ueber einen ungefilterten entnext-Walk versehentlich auch die Attribute des zuletzt eingefuegten Blocks (VF_5 verlor dadurch alle Attribute inkl. ID) - jetzt auf LWPOLYLINE/ATTDEF gefiltert. 9 neue zeichnungsfreie Unit-Tests (csv:sepliste-paare/*, csv:asmark- finden/*, csv:proxy-typ/*), 4 neue de/en-Textschluessel (Paritaet geprueft). bin\run_tests.bat --lisp: 257/257 bestanden. Noch nicht enthalten (Stufe 2, Python): map_separator_kette_items nutzt das neue "id"-Feld noch nicht, build_strecke_schleus_items synthetisiert AS/ES-Zeilen weiterhin selbst statt die exportierten zu lesen. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
629 lines
27 KiB
Common Lisp
629 lines
27 KiB
Common Lisp
;; ============================================================
|
|
;; 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)))
|
|
(ssg-sepliste-dbg
|
|
(strcat "insert-block-by-ks " blockname
|
|
" hz=" (rtos (float hz) 2 2)
|
|
" einfuegepunkt=" (ssg-sepliste-dbg-pt einfuegepunkt)
|
|
" ks_ein_lokal=" (ssg-sepliste-dbg-pt (car ks-ein))
|
|
" ks_aus_lokal=" (ssg-sepliste-dbg-pt (car ks-aus))
|
|
" offset(=Gruppencode 10)=" (ssg-sepliste-dbg-pt offset)
|
|
" ausgang=" (ssg-sepliste-dbg-pt ausgang)))
|
|
(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 (fix 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)))))
|
|
(ssg-sepliste-dbg
|
|
(strcat "insert-inclined-scaled-block " blockname
|
|
" laenge=" (rtos laenge 2 2) " winkel=" (rtos (float winkel) 2 2)
|
|
" hz=" (rtos (float hz) 2 2) " scale=" (rtos scale 2 4)
|
|
" startpunkt(=Gruppencode 10)=" (ssg-sepliste-dbg-pt startpunkt)
|
|
" endpunkt=" (ssg-sepliste-dbg-pt endpunkt)))
|
|
(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 (fix 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)))))
|
|
(ssg-sepliste-dbg
|
|
(strcat "insert-rotated-block-with-ks " blockname
|
|
" winkel=" (rtos (float winkel) 2 2) " hz=" (rtos (float hz) 2 2)
|
|
" startpunkt=" (ssg-sepliste-dbg-pt startpunkt)
|
|
" ks_ein_lokal=" (ssg-sepliste-dbg-pt (list ein-x ein-y ein-z))
|
|
" ks_aus_lokal=" (if ks-aus-raw
|
|
(ssg-sepliste-dbg-pt (list aus-x aus-y aus-z))
|
|
"nil (Fallback dx/dz aus cfg)")
|
|
" dx=" (rtos dx 2 2) " dz=" (rtos dz 2 2)
|
|
" ins-pt(=Gruppencode 10)=" (ssg-sepliste-dbg-pt ins-pt)
|
|
" endpunkt=" (ssg-sepliste-dbg-pt endpunkt)))
|
|
(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
|
|
)
|
|
)
|
|
)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; SEPLISTE: Separator-/AS-/ES-Reihenfolge als XDATA am fertigen Wrapper
|
|
;; ------------------------------------------------------------
|
|
;; Sammelt beim Bau einer VF_n/GF_n-Kette die Weltposition + Baureihenfolge
|
|
;; aller "Staustrecke_Separator_SP_300_mm"/"AS_Element_*"/"ES_Element_*"-
|
|
;; Sub-Bloecke, BEVOR der abschliessende _.-BLOCK-Sweep (ssg-block-wrap-welt)
|
|
;; sie in die Wrapper-Blockdefinition einsaugt und ihre Modellraum-Existenz
|
|
;; damit beendet. Genutzt von vf-block-erstellen (vf_core.lsp),
|
|
;; vfl-block-erstellen (vf_linienzug.lsp) und gf-block-erstellen
|
|
;; (Gefaellestrecke.lsp) - an allen drei Stellen identisch aufgerufen, daher
|
|
;; hier zentral (vgl. Projektregel "Wiederverwendung vor Neuschaffung").
|
|
;;
|
|
;; Traegt bewusst KEINE ssg-id-generate-ID (kein ID-ATTDEF an diesen
|
|
;; Bloecken, Sinn/Zweck rein interne Geometrie-Traeger) - jeder Eintrag
|
|
;; bekommt nur eine laufende Nummer innerhalb der Liste. Der Export bildet
|
|
;; daraus bei Bedarf eigene, global fortlaufende TeileIds.
|
|
|
|
;; --- Diagnose-Protokoll (Schalter "vf-sepliste", siehe ssg_dbg.lsp) ---------
|
|
;; TEMPORAER fuer die Fehlersuche "gespiegelte Sepliste-Koordinate (lfdnr=2)" -
|
|
;; nach Abschluss mitsamt Schalter wieder entfernen.
|
|
;; Der Schalter ist in ssg_dbg.lsp mit Default 1 vorregistriert, das Protokoll
|
|
;; laeuft also nach einem BricsCAD-Neustart ohne weiteres Zutun. Es genuegt,
|
|
;; EINE VF-/GF-Kette zu bauen - das Protokoll landet in
|
|
;; DXFM_LOG/vf_sepliste.dbg. Protokolliert wird der komplette Weg der
|
|
;; Sepliste-Koordinaten: je Einfuegeprimitive der Startpunkt, die am Block
|
|
;; gemessenen KS_EIN/KS_AUS-Lokalpunkte, der daraus berechnete
|
|
;; Block-Einfuegepunkt (ins-pt = genau der Wert, den die Sepliste spaeter als
|
|
;; Gruppencode 10 einsammelt) und der Folgepunkt - sowie am Ende die
|
|
;; entnext-Wanderung von ssg-sepliste-sammeln mit JEDEM gefundenen INSERT.
|
|
;; Hintergrund: im Export tauchen Sepliste-Koordinaten auf, die nicht zur
|
|
;; sichtbaren Geometrie passen (x exakt negiert) - die Herkunft dieses Werts
|
|
;; ist ohne Laufzeit-Protokoll nicht zu klaeren.
|
|
;;
|
|
;; Nutzt NUR die Schalterverwaltung aus ssg_dbg.lsp, aber BEWUSST einen eigenen
|
|
;; Dateihandle statt dbgopen/dbgmsg: ssg_dbg fuehrt mit *dbg-path* genau EINE
|
|
;; global offene Datei. Der Linienzug-Bau (vfl-modus1, Schalter per Default EIN)
|
|
;; oeffnet seine vfl_modus1.dbg und haelt *dbg-path* damit besetzt - die
|
|
;; Sepliste-Zeilen waeren sonst stillschweigend dort gelandet statt in einer
|
|
;; eigenen Datei. Genau dieser Bau ist aber der zu protokollierende Vorgang.
|
|
(if (not (boundp '*ssg-sepliste-dbg-pfad*)) (setq *ssg-sepliste-dbg-pfad* nil))
|
|
|
|
;; Legt die Datei beim ERSTEN Aufruf je Sitzung an (leert sie dabei) und
|
|
;; liefert den Pfad; danach nur noch den gemerkten Pfad. nil = Schalter aus.
|
|
(defun ssg-sepliste-dbg-oeffnen ( / dir fh)
|
|
(if (and (car (atoms-family 1 '("DBG-SCHALTER-P")))
|
|
(dbg-schalter-p "vf-sepliste"))
|
|
(progn
|
|
(if (null *ssg-sepliste-dbg-pfad*)
|
|
(progn
|
|
(setq dir (getenv "DXFM_LOG"))
|
|
(if (or (null dir) (= dir "")) (setq dir "."))
|
|
(if (and (/= (substr dir (strlen dir) 1) "\\")
|
|
(/= (substr dir (strlen dir) 1) "/"))
|
|
(setq dir (strcat dir "\\")))
|
|
(setq *ssg-sepliste-dbg-pfad* (strcat dir "vf_sepliste.dbg"))
|
|
(setq fh (open *ssg-sepliste-dbg-pfad* "w"))
|
|
(if fh
|
|
(progn
|
|
(write-line "=== vf-sepliste Diagnose ===" fh)
|
|
(close fh)
|
|
(princ (strcat "\n[DBG] vf-sepliste-Protokoll: " *ssg-sepliste-dbg-pfad*)))
|
|
(progn
|
|
(princ (strcat "\n[DBG] FEHLER: " *ssg-sepliste-dbg-pfad*
|
|
" nicht schreibbar"))
|
|
(setq *ssg-sepliste-dbg-pfad* nil)))))
|
|
*ssg-sepliste-dbg-pfad*)
|
|
nil))
|
|
|
|
;; Eine Zeile anhaengen (kein Puffer - ein Bau erzeugt nur wenige hundert
|
|
;; Zeilen, dafuer geht keine Zeile verloren, wenn der Bau abbricht).
|
|
(defun ssg-sepliste-dbg (msg / pfad fh)
|
|
(if (setq pfad (ssg-sepliste-dbg-oeffnen))
|
|
(progn
|
|
(setq fh (open pfad "a"))
|
|
(if fh (progn (write-line msg fh) (close fh)))))
|
|
(princ))
|
|
|
|
;; Punkt (x y z) kompakt als "(x, y, z)" - nil-sicher.
|
|
(defun ssg-sepliste-dbg-pt (pt)
|
|
(if (and pt (listp pt))
|
|
(strcat "(" (rtos (car pt) 2 2) ", " (rtos (cadr pt) 2 2) ", "
|
|
(rtos (cond ((caddr pt)) (0.0)) 2 2) ")")
|
|
"nil"))
|
|
|
|
;; Einfaches Chunking eines Strings in Stuecke <= n Zeichen (DXF-Limit einer
|
|
;; 1000-Gruppe ist 255 Byte) - eigenstaendige Kopie statt vfl-chunk-string
|
|
;; (vf_linienzug.lsp), da diese Datei laut Lademechanismus VOR vf_linienzug
|
|
;; geladen wird und dessen Funktionen hier noch nicht existieren.
|
|
(defun ssg-sepliste-chunk-string (s n / out len)
|
|
(setq out '())
|
|
(while (> (setq len (strlen s)) n)
|
|
(setq out (cons (substr s 1 n) out))
|
|
(setq s (substr s (1+ n))))
|
|
(if (> (strlen s) 0) (setq out (cons s out)))
|
|
(reverse out))
|
|
|
|
;; Sammelt alle seit lastEnt neu erzeugten Separator-/AS-/ES-Entities in
|
|
;; Baureihenfolge (identische entnext-Wanderung wie die Auswahlsatz-Sammlung
|
|
;; der Aufrufer, nur mit wcmatch-Filter). Rueckgabe: Liste von
|
|
;; (typ lfdnr x y), typ = "SEP"/"AS"/"ES", lfdnr 1-basiert in Baureihenfolge.
|
|
(defun ssg-sepliste-sammeln (lastEnt / ent ed bname typ lfdnr pt liste)
|
|
(ssg-sepliste-dbg "=== ssg-sepliste-sammeln: entnext-Wanderung ab lastEnt ===")
|
|
(setq liste '() lfdnr 0)
|
|
(setq ent (if lastEnt (entnext lastEnt) (entnext)))
|
|
(while ent
|
|
(setq ed (entget ent))
|
|
(if (= (cdr (assoc 0 ed)) "INSERT")
|
|
(progn
|
|
(setq bname (cdr (assoc 2 ed)))
|
|
(setq typ (cond
|
|
((wcmatch bname "Staustrecke_Separator_SP_300_mm*") "SEP")
|
|
((wcmatch bname "AS_Element_*") "AS")
|
|
((wcmatch bname "ES_Element_*") "ES")
|
|
(t nil)))
|
|
(setq pt (cdr (assoc 10 ed)))
|
|
;; JEDEN INSERT protokollieren (auch die nicht klassifizierten) - nur so
|
|
;; laesst sich im .dbg nachvollziehen, welches Entity einen auffaelligen
|
|
;; Einfuegepunkt liefert und in welcher Reihenfolge es entstand.
|
|
(ssg-sepliste-dbg
|
|
(strcat "INSERT " bname
|
|
" handle=" (cond ((cdr (assoc 5 ed))) ("-"))
|
|
" typ=" (cond (typ) ("-"))
|
|
" pt=" (ssg-sepliste-dbg-pt pt)))
|
|
(if typ
|
|
(progn
|
|
(setq lfdnr (1+ lfdnr))
|
|
(setq liste (cons (list typ lfdnr (car pt) (cadr pt)) liste))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(setq ent (entnext ent))
|
|
)
|
|
(setq liste (reverse liste))
|
|
(ssg-sepliste-dbg (strcat "Ergebnis: " (itoa (length liste)) " Sepliste-Eintraege"))
|
|
(foreach e liste
|
|
(ssg-sepliste-dbg
|
|
(strcat " " (nth 0 e) " lfdnr=" (itoa (nth 1 e))
|
|
" x=" (rtos (nth 2 e) 2 2) " y=" (rtos (nth 3 e) 2 2))))
|
|
liste
|
|
)
|
|
|
|
;; Koordinate mit GENAU 2 Nachkommastellen formatieren - bewusst OHNE rtos.
|
|
;; rtos haengt an den Zeichnungs-Systemvariablen DIMZIN (Nullunterdrueckung),
|
|
;; LUPREC und LUNITS: bei dem hier verbreiteten DIMZIN=8 wuerde rtos die
|
|
;; abschliessenden Nullen wegwerfen (10.00 -> 10), und dieselben Koordinaten
|
|
;; serialisierten je nach Zeichnungsprofil unterschiedlich. Die Sepliste
|
|
;; landet als XDATA/Journal PERSISTENT am Block - die Serialisierung muss
|
|
;; darum reproduzierbar und profilunabhaengig sein. Rundung kaufmaennisch,
|
|
;; mit Uebertrag (9.999 -> 10.00), Vorzeichen bleibt erhalten.
|
|
(defun ssg-sepliste-fmt-koord (x / neg i f s)
|
|
(setq neg (< x 0.0) x (abs x))
|
|
(setq i (fix x))
|
|
(setq f (fix (+ 0.5 (* 100.0 (- x i)))))
|
|
(if (>= f 100) (progn (setq i (1+ i)) (setq f (- f 100))))
|
|
(setq s (strcat (itoa i) "."
|
|
(if (< f 10) (strcat "0" (itoa f)) (itoa f))))
|
|
(if neg (strcat "-" s) s)
|
|
)
|
|
|
|
;; Serialisiert die Sepliste zu "TYP:LFDNR:X:Y,TYP:LFDNR:X:Y,...".
|
|
(defun ssg-sepliste->string (liste / eintrag out first)
|
|
(setq out "" first t)
|
|
(foreach eintrag liste
|
|
(setq eintrag
|
|
(strcat (nth 0 eintrag) ":" (itoa (nth 1 eintrag)) ":"
|
|
(ssg-sepliste-fmt-koord (nth 2 eintrag)) ":"
|
|
(ssg-sepliste-fmt-koord (nth 3 eintrag))))
|
|
(if first (progn (setq out eintrag) (setq first nil))
|
|
(setq out (strcat out "," eintrag)))
|
|
)
|
|
out
|
|
)
|
|
|
|
;; Gegenstueck zu ssg-sepliste->string - Rueckgabe Liste von (typ lfdnr x y).
|
|
(defun ssg-sepliste-string->liste (s / out teile eintraege feld)
|
|
(setq out '())
|
|
(if (> (strlen s) 0)
|
|
(progn
|
|
(setq eintraege '() teile "")
|
|
(foreach c (ssg-sepliste-explode-chars s)
|
|
(if (= c ",")
|
|
(progn (setq eintraege (cons teile eintraege)) (setq teile ""))
|
|
(setq teile (strcat teile c))
|
|
)
|
|
)
|
|
(setq eintraege (reverse (cons teile eintraege)))
|
|
(foreach eintrag eintraege
|
|
(setq feld (ssg-sepliste-split-feld eintrag ":"))
|
|
(if (= (length feld) 4)
|
|
(setq out (cons (list (nth 0 feld) (atoi (nth 1 feld))
|
|
(atof (nth 2 feld)) (atof (nth 3 feld))) out))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(reverse out)
|
|
)
|
|
(defun ssg-sepliste-explode-chars (s / i n out)
|
|
(setq out '() i 1 n (strlen s))
|
|
(while (<= i n) (setq out (cons (substr s i 1) out)) (setq i (1+ i)))
|
|
(reverse out)
|
|
)
|
|
(defun ssg-sepliste-split-feld (s sep / pos out)
|
|
(setq out '())
|
|
(while (setq pos (vl-string-search sep s))
|
|
(setq out (cons (substr s 1 pos) out))
|
|
(setq s (substr s (+ pos 1 (strlen sep)))))
|
|
(reverse (cons s out))
|
|
)
|
|
|
|
;; Schreibt die Sepliste als XDATA (App app-name, z.B. "SSG_VF_SEP"/
|
|
;; "SSG_GF_SEP") auf den fertigen Wrapper-Block ent. Layout der 1000-Gruppen:
|
|
;; [0]="sepliste" (Marker), [1..]=serialisierte Liste in 250-Byte-Chunks
|
|
;; (DXF-Limit 255 Byte je 1000-Gruppe) - identisches Muster wie
|
|
;; vfl-journal-xdata-schreiben (vf_linienzug.lsp).
|
|
(defun ssg-sepliste-xdata-schreiben (ent app-name liste / chunks appentry)
|
|
(if (and ent liste)
|
|
(progn
|
|
(regapp app-name)
|
|
(setq chunks (ssg-sepliste-chunk-string (ssg-sepliste->string liste) 250))
|
|
(setq appentry
|
|
(cons app-name
|
|
(cons (cons 1000 "sepliste")
|
|
(mapcar (function (lambda (c) (cons 1000 c))) chunks))))
|
|
(entmod (append (entget ent) (list (list -3 appentry))))
|
|
)
|
|
)
|
|
ent
|
|
)
|
|
|
|
;; Liest die Sepliste-XDATA. Rueckgabe: Liste von (typ lfdnr x y), oder nil
|
|
;; (kein/unbekanntes Sepliste-XDATA am Entity).
|
|
(defun ssg-sepliste-xdata-lesen (ent app-name / xd app-data werte)
|
|
(setq xd (entget ent (list app-name)))
|
|
(setq app-data (cdr (assoc -3 xd)))
|
|
(if app-data
|
|
(progn
|
|
(setq werte (mapcar 'cdr (cdr (car app-data))))
|
|
(if (and werte (= (car werte) "sepliste"))
|
|
(ssg-sepliste-string->liste (apply 'strcat (cdr werte)))
|
|
nil))
|
|
nil
|
|
)
|
|
)
|
|
|
|
(princ)
|