;; ============================================================
;; 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.
;; Sonderfall Bloecke OHNE Dimensionssuffix (data/omniflo/<Dim>/, z.B. die
;; Kettenfoerderer-Bausteine): ssg-ils-blockname wuerde "KF_UM_26" zu
;; "KF_UM_26_2D" machen - das ist die Konvention der FLACHEN Ablage data/ils,
;; die Omniflo-Ordner arbeiten stattdessen mit getrennten Verzeichnissen und
;; unsuffigierten Namen. Liegt die Definition unter dem Rohnamen bereits in
;; der Zeichnung und gibt es KEINE suffigierte Variante, wird der Rohname
;; unveraendert verwendet. Die Bedingung ist bewusst eng gefasst (BEIDE Teile
;; muessen zutreffen), damit die Dim-Aufloesung fuer alle data/ils-Bloecke
;; unberuehrt bleibt: dort existiert die suffigierte Variante, sobald der
;; Block geladen ist, und der erste Zweig greift nie.
;; Realer Fehler, den das behebt: die KS-Messung eines KF-Bausteins lief ins
;; Leere und meldete "KS_EIN/KS_AUS fehlt", obwohl beide KS im Block vorhanden
;; waren - gesucht wurde nur ein Blockname, den es nicht gibt.
(defun ensure-block-loaded (blockname / eff)
  (setq eff (ssg-ils-blockname blockname))
  (if (and (not (tblsearch "BLOCK" eff))
           (tblsearch "BLOCK" blockname))
    blockname
    (progn
      (if (not (ssg-ils-block-laden blockname))
        (princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname)))
      )
      eff
    )
  )
)

;; ------------------------------------------------------------
;; 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
    )
  )
)

;; ------------------------------------------------------------
;; KS-ORIENTIERUNG + SKALIERTE KS-EINFUEGUNG
;; ------------------------------------------------------------
;; Ergaenzt fuer den Kettenfoerderer (KettenFoerderer.lsp): dort ist die
;; Neigung KEIN freier Parameter, sondern steckt fest in der Geometrie der
;; Blockvarianten (KF_UM_26 gegen KF_UM_30). Der Einbauwinkel eines
;; Folgebausteins ergibt sich darum aus der RICHTUNG des KS_AUS seines
;; Vorgaengers. Dafuer reicht der bisher allein ausgewertete KS-URSPRUNG
;; nicht - die X-Achse des KS muss mit gelesen werden. extract-ks-from-block
;; liefert sie als (origin x-end y-end z-end) bereits mit, sie wurde bislang
;; nur von keinem Aufrufer genutzt.

;; Winkel der X-Achse eines KS-Eintrags in der XY-Ebene, in Grad (-180..180).
;; ks-eintrag = (origin x-end y-end z-end), also genau der cadr-Teil eines
;; extract-ks-from-block-Ergebnisses. Rueckgabe nil, wenn die X-Achse keine
;; XY-Laenge hat (senkrecht stehendes KS) oder der Eintrag unbrauchbar ist.
(defun ks-xy-winkel (ks-eintrag / org xend dx dy)
  (if (and ks-eintrag (listp ks-eintrag) (>= (length ks-eintrag) 2)
           (listp (car ks-eintrag)) (listp (cadr ks-eintrag)))
    (progn
      (setq org (car ks-eintrag)  xend (cadr ks-eintrag))
      (setq dx (- (car  xend) (car  org))
            dy (- (cadr xend) (cadr org)))
      (if (< (+ (* dx dx) (* dy dy)) 1e-12)
        nil
        (/ (* 180.0 (atan dy dx)) pi)))
    nil))

;; Winkel auf -180..180 Grad normalisieren. Reiner Rechenkern.
(defun ks-winkel-normalisieren (w)
  (if (null w)
    nil
    (progn
      (setq w (float w))
      (while (>   w  180.0) (setq w (- w 360.0)))
      (while (<= w -180.0) (setq w (+ w 360.0)))
      w)))

;; Lokalen KS_AUS-KS_EIN-Versatz eines Blocks als (dx dy dz) liefern.
;; ks-data = Ergebnis von extract-ks-from-block/ks-block-messen.
;; Rueckgabe nil, wenn eines der beiden KS fehlt.
(defun ks-versatz (ks-data / ein aus)
  (setq ein (cadr (assoc "KS_EIN" ks-data))
        aus (cadr (assoc "KS_AUS" ks-data)))
  (if (and ein aus)
    (list (- (car   (car aus)) (car   (car ein)))
          (- (cadr  (car aus)) (cadr  (car ein)))
          (- (caddr (car aus)) (caddr (car ein))))
    nil))

;; Misst KS_EIN/KS_AUS eines Blocks, ohne eine bleibende Einfuegung zu
;; hinterlassen: der Block wird bei Massstab 1 am Ursprung eingefuegt,
;; vermessen und wieder geloescht. extract-ks-from-block cached das Ergebnis
;; je Blockname, der zweite Aufruf kostet also nichts mehr.
;; Rueckgabe wie extract-ks-from-block (Blockkoordinaten), sonst nil.
(defun ks-block-messen (blockname / eff temp-obj daten)
  (setq eff (ensure-block-loaded blockname))
  (if (tblsearch "BLOCK" eff)
    (progn
      (setq temp-obj (vla-InsertBlock modelspace
                       (vlax-3D-point '(0 0 0)) eff 1.0 1.0 1.0 0))
      (setq daten (extract-ks-from-block temp-obj))
      (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
      daten)
    nil))

;; --- Block per KS_EIN/KS_AUS einfuegen, in X SKALIERT (nur Rz-Rotation) ---
;; Wie insert-block-by-ks, zusaetzlich mit X-Massstab skala - fuer laengen-
;; variable Zwischenstuecke (Kettenfoerderer KF_LAENGE, dieselbe Rolle wie
;; die Staustrecke beim VarioFoerderer). Die lokalen KS-Punkte werden VOR der
;; Rotation in X mitskaliert; nur so liegt KS_EIN exakt auf einfuegepunkt und
;; der zurueckgegebene KS_AUS traegt den skalierten Versatz.
;; Rueckgabe: Weltpunkt von KS_AUS (fuer die Verkettung), sonst einfuegepunkt.
(defun insert-block-ks-skaliert (blockname einfuegepunkt hz skala /
                                  block-obj ks-data ks-ein ks-aus rad-h chv shv
                                  ein-x ein-y ein-z aus-x 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))
  )
  (if (or (null skala) (<= skala 0.0)) (setq skala 1.0))
  (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 am UNSKALIERTEN Block messen (der Cache arbeitet je Blockname), die
  ;; lokalen Punkte danach selbst in X skalieren.
  (setq ks-data (ks-block-messen blockname))
  (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 skala 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 (* skala (car (car ks-ein)))
            ein-y (cadr  (car ks-ein))
            ein-z (caddr (car ks-ein)))
      (setq aus-x (* skala (car (car ks-aus))))
      (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 (- aus-x 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-ks-skaliert " blockname
                " hz=" (rtos (float hz) 2 2) " skala=" (rtos (float skala) 2 4)
                " einfuegepunkt=" (ssg-sepliste-dbg-pt einfuegepunkt)
                " 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
    )
  )
)

;; ------------------------------------------------------------
;; FREI ROTIERTE KS-EINFUEGUNG (beliebige 3x3-Matrix)
;; ------------------------------------------------------------
;; Verallgemeinerung von insert-block-by-ks/insert-block-ks-skaliert: statt
;; einer festen Rz- bzw. Rz*Ry-Drehung nimmt sie eine FERTIGE 3x3-Rotations-
;; matrix entgegen. Noetig geworden fuer AUFRECHT eingebaute Baugruppen: der
;; Kettenfoerderer ist in der XY-Ebene gezeichnet (X = Fahrtrichtung,
;; Y = Hoehe), soll aber im Modell stehen - seine Hoehe muss also nach Z. Das
;; ist eine Drehung um X, die weder insert-block-by-ks (nur Rz) noch
;; ssg-rot-matrix-zy (Rz*Ry) erzeugen kann.
;;
;; Bewusst matrixbasiert statt mit einem weiteren Winkelparameter: die
;; Aufrichtung ist nur EIN Anwendungsfall, und jeder weitere haette eine
;; weitere Spezialfunktion gebraucht. Den Aufrufern bleibt freigestellt,
;; welche Drehungen sie kombinieren (beim Kettenfoerderer
;; Rz(basis) * Rx(90) * Rz(eigen), siehe kf-matrix-aufrecht).

;; Elementare Rotationsmatrizen (3x3, Winkel in GRAD).
(defun ks-rot-x (grad / r c s)
  (setq r (* (float grad) (/ pi 180.0))  c (cos r)  s (sin r))
  (list (list 1.0 0.0 0.0)
        (list 0.0  c  (- s))
        (list 0.0  s     c )))

(defun ks-rot-y (grad / r c s)
  (setq r (* (float grad) (/ pi 180.0))  c (cos r)  s (sin r))
  (list (list    c  0.0  s )
        (list  0.0  1.0 0.0)
        (list (- s) 0.0  c )))

(defun ks-rot-z (grad / r c s)
  (setq r (* (float grad) (/ pi 180.0))  c (cos r)  s (sin r))
  (list (list  c  (- s) 0.0)
        (list  s     c  0.0)
        (list 0.0  0.0  1.0)))

;; 3x3-Rotation in die 4x4-Form bringen, die vla-TransformBy erwartet.
(defun ks-mat3->mat4 (R)
  (list (append (car   R) '(0.0))
        (append (cadr  R) '(0.0))
        (append (caddr R) '(0.0))
        '(0.0 0.0 0.0 1.0)))

;; --- Block per KS_EIN/KS_AUS einfuegen, frei rotiert und in X skaliert ---
;; blockname      Rohname (wird ueber ensure-block-loaded aufgeloest)
;; einfuegepunkt  Weltpunkt, auf den KS_EIN zu liegen kommt
;; R              3x3-Rotationsmatrix (Blockkoordinaten -> Welt)
;; skala          X-Massstab (1.0 = unskaliert)
;; Rueckgabe: Weltpunkt von KS_AUS (fuer die Verkettung), sonst einfuegepunkt.
;;
;; Reihenfolge wie bei den uebrigen Primitiven: am Ursprung einfuegen,
;; skalieren, drehen, dann so verschieben, dass das GEDREHTE KS_EIN exakt auf
;; einfuegepunkt liegt. Die lokalen KS-Punkte werden dabei zuerst in X
;; mitskaliert - sonst zeigt der zurueckgegebene KS_AUS am skalierten Block
;; vorbei.
(defun insert-block-ks-matrix (blockname einfuegepunkt R skala /
                                block-obj ks-data ks-ein ks-aus
                                ein-lok aus-lok ein-welt aus-welt offset ausgang)
  (if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
    (progn
      (princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname)))
      (exit))
  )
  (if (or (null skala) (<= skala 0.0)) (setq skala 1.0))
  (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))
  )
  (setq ks-data (ks-block-messen blockname))
  (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 skala 1.0 1.0 0))
  (ssg-ils-block-auf-ebene block-obj blockname)
  (vla-TransformBy block-obj (vlax-tmatrix (ks-mat3->mat4 R)))
  (if (and ks-ein ks-aus)
    (progn
      ;; lokale KS-Punkte, in X mitskaliert
      (setq ein-lok (list (* skala (car (car ks-ein)))
                          (cadr  (car ks-ein))
                          (caddr (car ks-ein))))
      (setq aus-lok (list (* skala (car (car ks-aus)))
                          (cadr  (car ks-aus))
                          (caddr (car ks-aus))))
      (setq ein-welt (mat3-mul-vec3 R ein-lok))
      (setq aus-welt (mat3-mul-vec3 R aus-lok))
      (setq offset (list (- (car   einfuegepunkt) (car   ein-welt))
                         (- (cadr  einfuegepunkt) (cadr  ein-welt))
                         (- (caddr einfuegepunkt) (caddr ein-welt))))
      (vla-Move block-obj
        (vlax-3D-point '(0 0 0))
        (vlax-3D-point offset))
      (setq ausgang (list (+ (car   einfuegepunkt) (- (car   aus-welt) (car   ein-welt)))
                          (+ (cadr  einfuegepunkt) (- (cadr  aus-welt) (cadr  ein-welt)))
                          (+ (caddr einfuegepunkt) (- (caddr aus-welt) (caddr ein-welt)))))
      (ssg-sepliste-dbg
        (strcat "insert-block-ks-matrix " blockname
                " skala=" (rtos (float skala) 2 4)
                " einfuegepunkt=" (ssg-sepliste-dbg-pt einfuegepunkt)
                " ks_ein_welt=" (ssg-sepliste-dbg-pt ein-welt)
                " ks_aus_welt=" (ssg-sepliste-dbg-pt aus-welt)
                " ausgang=" (ssg-sepliste-dbg-pt ausgang)))
      ausgang
    )
    (progn
      (princ (ssg-text "vfc-warnung-ks-nicht-gefunden"))
      einfuegepunkt
    )
  )
)

;; ------------------------------------------------------------
;; 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)