;; ============================================================
;; VF_CORE - VarioFoerderer Kern-Modul
;; Version: 26.0
;; Architektur: Plugin/Dispatcher
;; Laedt automatisch: vf_standard.lsp, vf_etage.lsp
;; Befehle: VarioFoerderer (Alias: FOERDERANLAGE, ETAGEVARIOFOERDERER)
;; ============================================================

(vl-load-com)

;; ============================================================
;; TEIL 1: ABHAENGIGKEITEN
;; ============================================================
;; DXFM_DIM lesen; 2D wird auf 3D korrigiert (VF/GF benoetigen Z-Geometrie)
(setq *vf-dxfm-dim* (getenv "DXFM_DIM"))
(if (or (not (= (type *vf-dxfm-dim*) 'STR)) (= *vf-dxfm-dim* "2D"))
  (setq *vf-dxfm-dim* "3D"))
;; Block-Pfad: data/ils/3D/ wenn DXFM_DIM nicht gesetzt oder 2D
(setq modul-pfad
  (cond
    ((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
     (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
             "/data/ils/" *vf-dxfm-dim* "/"))
    ((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
          (vl-string-search "/Lisp" *ssg-lisp-pfad*))
     (strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
             "/data/ils/" *vf-dxfm-dim* "/"))
    (t
     (princ "\n[vf_core] WARNUNG: Block-Pfad nicht ermittelbar!")
     nil)
  )
)
(setq block-pfad modul-pfad)

;; ssg_core laden falls noch nicht geschehen: 1) DXFM_LISP, 2) *ssg-lisp-pfad*
(if (not *ssg-core-loaded*)
  (progn
    (setq *vf-core-lisp-pfad*
      (cond
        ((getenv "DXFM_LISP")
         (vl-string-translate "\\" "/" (getenv "DXFM_LISP")))
        ((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*)
         *ssg-lisp-pfad*)
        (t nil)
      )
    )
    (if *vf-core-lisp-pfad*
      (progn
        (load (strcat *vf-core-lisp-pfad* "/ssg_core.lsp"))
        (ssg-load-config)
        (setq *ssg-core-loaded* t)
      )
      (princ "\n[vf_core] WARNUNG: DXFM_LISP nicht gesetzt - ssg_core konnte nicht geladen werden!")
    )
  )
)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq modelspace (vla-get-ModelSpace doc))

;; ============================================================
;; TEIL 2: TYP-REGISTRY
;; ============================================================
(if (null *vf-typ-registry*) (setq *vf-typ-registry* nil))
(if (null *vf-vorauswahl-typ*) (setq *vf-vorauswahl-typ* nil))

;; Registriert einen Foerderanlagen-Typ.
;; berechne-fn:  '(lambda (deltaL deltaH richtung seite) ...)
;;               Ruft init-Bibliothek und Winkelberechnung auf.
;;               Gibt zurueck: (list best-winkel best-L_GF best-L_VF ergebnis-liste)
;; einfuege-fn: '(lambda (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite) ...)
;;               Fuegt alle Bloecke ein. Gibt endpunkt zurueck.
(defun vf-typ-registrieren (typ-name berechne-fn einfuege-fn beschreibung)
  (if (assoc typ-name *vf-typ-registry*)
    (princ (strcat "\n  Typ '" typ-name "' bereits registriert."))
    (setq *vf-typ-registry*
      (append *vf-typ-registry*
              (list (list typ-name berechne-fn einfuege-fn beschreibung))))
  )
)

;; ============================================================
;; TEIL 3: GLOBALE VARIABLEN
;; ============================================================
(if (null #VF_LetzteNr) (setq #VF_LetzteNr 0))
(setq *library-loaded* nil)
(setq *ks-cache* nil)
(setq grad-zeichen (chr 176))

;; 26 Attribut-Definitionen fuer VF_*-Block (alle Typen)
(setq *vf-attrib-defs*
  '(("NUMMER"               "0")
    ("MONTAGEHOEHE_m"       "0.000")
    ("HOEHE_VON"            "0")
    ("HOEHE_BIS"            "0")
    ("DELTA_H"              "0")
    ("DELTA_L"              "0")
    ("L_VF_m"               "0.000")
    ("L_GF_m"               "0.000")
    ("ANTRIEBFAHRTRICHTUNG" "Auf")
    ("WINKEL"               "0")
    ("ANZAHL_SEPARATOR"     "2")
    ("ANZAHL_SCANNER"       "0")
    ("TYP"                  "standard")
    ("SEITE"                "rechts")
    ("GF_Bogen_L_90"        "0")
    ("GF_Bogen_L_60"        "0")
    ("GF_Bogen_L_30"        "0")
    ("GF_Bogen_R_90"        "0")
    ("GF_Bogen_R_60"        "0")
    ("GF_Bogen_R_30"        "0")
    ("VF_Bogen_A_90"        "0")
    ("VF_Bogen_A_60"        "0")
    ("VF_Bogen_A_30"        "0")
    ("VF_Bogen_I_90"        "0")
    ("VF_Bogen_I_60"        "0")
    ("VF_Bogen_I_30"        "0")))

;; ============================================================
;; TEIL 4: HILFSFUNKTIONEN
;; ============================================================
(defun vec-length (v)
  (sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v)))))

(defun ks-line-axis (len)
  (cond
    ((and (> len 0.5) (< len 1.5)) "X")
    ((and (> len 99) (< len 101)) "X")
    ((and (> len 1.5) (< len 2.5)) "Y")
    ((and (> len 2.5) (< len 3.5)) "Z")
    (t nil)))

(defun fmt (x)
  (if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---"))

(defun punkt-differenz (p1 p2)
  (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1))))

(defun ks-relativize (ks-data base-pt)
  (mapcar '(lambda (item)
    (list (car item)
          (mapcar '(lambda (pt)
            (list (- (car pt) (car base-pt))
                  (- (cadr pt) (cadr base-pt))
                  (- (caddr pt) (caddr base-pt))))
            (cadr item))))
    ks-data))

(defun ks-absolutize (ks-rel base-pt)
  (mapcar '(lambda (item)
    (list (car item)
          (mapcar '(lambda (pt)
            (list (+ (car pt) (car base-pt))
                  (+ (cadr pt) (cadr base-pt))
                  (+ (caddr pt) (caddr base-pt))))
            (cadr item))))
    ks-rel))

;; ============================================================
;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION
;; ============================================================
(defun ensure-block-loaded (blockname / block-datei temp-obj)
  (if (not (tblsearch "BLOCK" blockname))
    (progn
      (setq block-datei (strcat block-pfad blockname ".dwg"))
      (if (findfile block-datei)
        (progn
          (princ (strcat "\n  Lade Block: " blockname " ..."))
          (setq temp-obj (vla-InsertBlock modelspace
                           (vlax-3D-point '(0 0 0))
                           block-datei 1.0 1.0 1.0 0))
          (vla-Delete temp-obj)
          (princ " OK")
        )
        (princ (strcat "\n  FEHLER: Block-Datei nicht gefunden: " block-datei))
      )
    )
  )
)

(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
    (if (and (not (vlax-erased-p sub-obj))
             (= (vla-get-ObjectName sub-obj) "AcDbBlockReference")
             (or (= (vla-get-Name sub-obj) "KS_EIN")
                 (= (vla-get-Name sub-obj) "KS_AUS")))
      (progn
        (setq ks-ref (vla-get-Name sub-obj))
        (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
;; ============================================================
(defun get-3d-point-from-object (msg / ent obj pt variant)
  (princ msg)
  (princ "\n  >> Objekt (Block) waehlen: ")
  (setq ent (entsel))
  (if ent
    (progn
      (setq obj (vlax-ename->vla-object (car ent)))
      (if (vlax-property-available-p obj 'InsertionPoint)
        (progn
          (setq variant (vla-get-InsertionPoint obj))
          (setq pt (vlax-safearray->list (vlax-variant-value variant)))
          (princ (strcat "\n  Block-Einfuegepunkt: X=" (rtos (car pt) 2 3)
                         " Y=" (rtos (cadr pt) 2 3) " Z=" (rtos (caddr pt) 2 3)))
        )
        (progn
          (setq pt (cadr ent))
          (princ (strcat "\n  Punkt auf Objekt: Z=" (rtos (caddr pt) 2 2) " mm"))
        )
      )
    )
    (progn
      (princ "\n  Kein Objekt gewaehlt.")
      (setq pt nil)
    )
  )
  pt
)

(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt)
  (princ msg)
  (princ "\n  >> 3D-Linie oder Polylinie waehlen: ")
  (setq ent (entsel))
  (if ent
    (progn
      (setq obj (vlax-ename->vla-object (car ent)))
      (setq obj-name (vla-get-ObjectName obj))
      (cond
        ((= obj-name "AcDbLine")
         (setq start-pt (vlax-safearray->list
                         (vlax-variant-value (vla-get-StartPoint obj))))
         (setq end-pt (vlax-safearray->list
                       (vlax-variant-value (vla-get-EndPoint obj))))
         (princ (strcat "\n  3D-Linie:"
                        "\n     Start: X=" (rtos (car start-pt) 2 2)
                        " Y=" (rtos (cadr start-pt) 2 2)
                        " Z=" (rtos (caddr start-pt) 2 2)
                        "\n     Ende:  X=" (rtos (car end-pt) 2 2)
                        " Y=" (rtos (cadr end-pt) 2 2)
                        " Z=" (rtos (caddr end-pt) 2 2)))
        )
        ((= obj-name "AcDbPolyline")
         (setq start-pt (vlax-curve-getStartPoint obj))
         (setq end-pt (vlax-curve-getEndPoint obj))
         (princ (strcat "\n  3D-Polylinie:"
                        "\n     Start Z=" (rtos (caddr start-pt) 2 2)
                        " Ende Z=" (rtos (caddr end-pt) 2 2)))
        )
        (t
         (princ "\n  FEHLER: Keine Linie oder Polylinie ausgewaehlt!")
         (setq start-pt nil end-pt nil)
        )
      )
    )
    (progn
      (princ "\n  Kein Objekt gewaehlt.")
      (setq start-pt nil end-pt nil)
    )
  )
  (if (and start-pt end-pt) (list start-pt end-pt) nil)
)

;; ============================================================
;; TEIL 7: VF-NUMMERIERUNG
;; ============================================================
(defun vf-next-number ( / ss i nr maxnr attribs)
  (setq maxnr 0)
  (setq ss (ssget "X" '((0 . "INSERT") (2 . "VF_*"))))
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq attribs (ssg-attrib-read (ssname ss i)))
        (foreach pair attribs
          (if (= (car pair) "NUMMER")
            (progn
              (setq nr (atoi (cdr pair)))
              (if (> nr maxnr) (setq maxnr nr))
            )
          )
        )
        (setq i (1+ i))
      )
    )
  )
  (setq #VF_LetzteNr (max #VF_LetzteNr maxnr))
  (setq #VF_LetzteNr (1+ #VF_LetzteNr))
  #VF_LetzteNr
)

;; ============================================================
;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen)
;; ============================================================
(defun insert-block-by-ks (blockname einfuegepunkt / block-obj ks-data ks-ein ks-aus offset ausgang)
  (if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
    (progn
      (princ (strcat "\n  FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
      (exit)
    )
  )
  (ensure-block-loaded blockname)
  (if (not (tblsearch "BLOCK" blockname))
    (progn
      (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
      (exit)
    )
  )
  (princ (strcat "\n  Fuege Block '" blockname "' ein..."))
  (setq block-obj (vla-InsertBlock modelspace
                    (vlax-3D-point einfuegepunkt)
                    blockname 1.0 1.0 1.0 0))
  (setq ks-data (extract-ks-from-block block-obj))
  (setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
  (setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
  (if (and ks-ein ks-aus)
    (progn
      (setq offset (list (- (car einfuegepunkt) (car (car ks-ein)))
                         (- (cadr einfuegepunkt) (cadr (car ks-ein)))
                         (- (caddr einfuegepunkt) (caddr (car ks-ein)))))
      (vla-Move block-obj
        (vlax-3D-point (car ks-ein))
        (vlax-3D-point einfuegepunkt))
      (setq ausgang (list (+ (car (car ks-aus)) (car offset))
                          (+ (cadr (car ks-aus)) (cadr offset))
                          (+ (caddr (car ks-aus)) (caddr offset))))
      (princ (strcat "\n    KS_AUS: X=" (rtos (car ausgang) 2 2)
                     " Z=" (rtos (caddr ausgang) 2 2)))
      ausgang
    )
    (progn
      (princ "\n  WARNUNG: KS_EIN/KS_AUS nicht gefunden!")
      einfuegepunkt
    )
  )
)

(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel /
                                      rad matrix block-obj endpunkt scale)
  (if (<= laenge 0.1)
    (progn
      (princ (strcat "\n  Laenge=" (rtos laenge 2 2) " mm -> uebersprungen"))
      startpunkt
    )
    (progn
      (ensure-block-loaded blockname)
      (if (not (tblsearch "BLOCK" blockname))
        (progn
          (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
          (exit)
        )
      )
      (princ (strcat "\n  Fuege '" blockname "' ein"
                     " (L=" (rtos laenge 2 2) " mm, W=" (itoa winkel) (chr 176) ")"))
      (setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0)))
      (setq rad (* winkel (/ pi 180.0)))
      (setq block-obj (vla-InsertBlock modelspace
                        (vlax-3D-point '(0 0 0))
                        blockname scale 1.0 1.0 0))
      (setq matrix (list
        (list (cos rad) 0 (sin rad) 0)
        (list 0 1 0 0)
        (list (- (sin rad)) 0 (cos rad) 0)
        (list 0 0 0 1)
      ))
      (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 (cos rad)))
                           (cadr startpunkt)
                           (+ (caddr startpunkt) (* (- (sin rad)) laenge))))
      (princ (strcat "\n    Endpunkt: Z=" (rtos (caddr endpunkt) 2 2)))
      endpunkt
    )
  )
)

(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz /
                                      rad matrix block-obj endpunkt)
  (if (or (null startpunkt) (not (listp startpunkt)))
    (progn
      (princ (strcat "\n  FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
      startpunkt
    )
    (progn
      (ensure-block-loaded blockname)
      (if (not (tblsearch "BLOCK" blockname))
        (progn
          (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
          (exit)
        )
      )
      (princ (strcat "\n  Fuege Block '" blockname "' ein"
                     " (Rotation " (itoa winkel) (chr 176) ")"))
      (setq rad (* winkel (/ pi 180.0)))
      (setq block-obj (vla-InsertBlock modelspace
                        (vlax-3D-point '(0 0 0))
                        blockname 1.0 1.0 1.0 0))
      (setq matrix (list
        (list (cos rad) 0 (sin rad) 0)
        (list 0 1 0 0)
        (list (- (sin rad)) 0 (cos rad) 0)
        (list 0 0 0 1)
      ))
      (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)   (+ (* block-dx (cos rad)) (* block-dz (sin rad))))
        (cadr startpunkt)
        (+ (caddr startpunkt) (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz)))))
      (princ (strcat "\n    Endpunkt: X=" (rtos (car endpunkt) 2 2)
                     " Z=" (rtos (caddr endpunkt) 2 2)))
      endpunkt
    )
  )
)

;; ============================================================
;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE
;; ============================================================
(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
                                deltaL deltaH deltaX deltaY richtung antwort)
  (princ "\n\nEingabemodus waehlen:")
  (princ "\n  1 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)")
  (princ "\n  2 - Werte manuell eingeben")
  (setq antwort (getstring "\nIhre Wahl (1/2): "))
  (cond
    ((= antwort "1") (setq eingabe-modus "Linie"))
    ((= antwort "2") (setq eingabe-modus "Wert"))
    (t (setq eingabe-modus "Linie") (princ "\nModus: 3D-Linie"))
  )
  (if (= eingabe-modus "Linie")
    (progn
      (princ "\n\n>>> MODUS: 3D-Linie auswaehlen <<<")
      (command "BKS" "W")
      (princ "\n  BKS auf Weltkoordinaten gesetzt.")
      (setq line-points
        (get-line-start-end-points "\nBitte 3D-Linie fuer die Foerderstrecke auswaehlen:"))
      (if (null line-points)
        (progn (alert "Keine gueltige Linie ausgewaehlt!") (exit))
      )
      (setq startpunkt (car line-points)
            endpunkt   (cadr line-points))
      (setq differenz (punkt-differenz startpunkt endpunkt))
      (setq deltaX (abs (car differenz))
            deltaY (abs (cadr differenz))
            deltaH (caddr differenz))
      (setq deltaL (max deltaX deltaY))
      (princ (strcat "\n  △L=" (rtos deltaL 2 2) " mm"
                     "  △H=" (rtos deltaH 2 2) " mm"))
      (if (>= deltaH 0)
        (progn (setq richtung "Auf") (princ "\n  Foerderrichtung: AUF"))
        (progn (setq richtung "Ab") (setq deltaH (abs deltaH))
               (princ "\n  Foerderrichtung: AB"))
      )
    )
    (progn
      (princ "\n\n>>> MODUS: Manuelle Werteingabe <<<")
      (setq deltaL (getreal "\n△L - Horizontale Distanz (mm): "))
      (if (null deltaL) (setq deltaL 15000))
      (setq deltaH (getreal "\n△H - Hoehenunterschied (mm): "))
      (if (null deltaH) (setq deltaH 3000))
      (princ "\nFoerderrichtung:\n  1 - AUF\n  2 - AB")
      (setq antwort (getstring "\nIhre Wahl (1/2): "))
      (if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf"))
      (setq startpunkt (getpoint "\nStartpunkt fuer AUS_Element waehlen: "))
      (if (null startpunkt) (setq startpunkt '(0 0 0)))
    )
  )
  (list deltaL deltaH richtung startpunkt)
)

;; ============================================================
;; TEIL 10: VF_*-BLOCK-SYSTEM (gemeinsam fuer alle Typen)
;; ============================================================
(defun vf-make-label (vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
                      richtung best-winkel n-separator n-scanner startpunkt /
                      label-txt label-pt L_VF_str L_GF_str delta-sym)
  (setq delta-sym (chr 916))
  (setq L_VF_str (vl-string-subst "," "." (rtos (/ L_VF 1000.0) 2 3)))
  (setq L_GF_str (vl-string-subst "," "." (rtos (/ L_GF 1000.0) 2 3)))
  (setq label-txt
    (strcat "VF" (itoa vf-nummer)
            ": von " (itoa (fix hoehe-von)) "mm bis " (itoa (fix hoehe-bis)) "mm, "
            delta-sym "H=" (itoa (fix deltaH)) "mm; "
            delta-sym "L=" (itoa (fix deltaL)) "mm; "
            "VF:" L_VF_str "m; GF:" L_GF_str "m; "
            richtung ": " (itoa best-winkel) grad-zeichen "; "
            "Sep: " (itoa n-separator) "; Scan: " (itoa n-scanner)))
  (setq label-pt (list
    (+ (car startpunkt) (/ deltaL 2.0))
    (- (cadr startpunkt) 200.0)
    (caddr startpunkt)))
  (entmake (list
    '(0 . "TEXT")
    (cons 8 "VF_Beschriftung")
    '(67 . 0)
    (cons 10 label-pt)
    (cons 40 100.0)
    (cons 1 label-txt)
    (cons 50 0.0)
    '(72 . 1)
    '(73 . 2)
    (cons 11 label-pt)
  ))
)

;; Erstellt VF_N-Block aus allen seit lastEnt erzeugten Entities.
;; Setzt Attributwerte entsprechend Typ, Seite und Geometrieparametern.
(defun vf-block-erstellen (anlage-typ seite vf-nummer n-scanner
                            hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
                            richtung best-winkel startpunkt lastEnt
                            / vf-bname vf-ss vf-e vf-insert montagehoehe-m attdef-ypos)
  ;; Beschriftungstext erzeugen
  (vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
                 richtung best-winkel 2 n-scanner startpunkt)

  ;; Unsichtbare ATTDEFs am Startpunkt erzeugen
  (setq attdef-ypos (cadr startpunkt))
  (foreach def *vf-attrib-defs*
    (entmake (list
      '(0 . "ATTDEF")
      '(8 . "0")
      '(67 . 0)
      (cons 10 (list (car startpunkt) attdef-ypos (caddr startpunkt)))
      '(40 . 50.0)
      (cons 1 (cadr def))
      (cons 3 (car def))
      (cons 2 (car def))
      '(70 . 1)
    ))
    (setq attdef-ypos (- attdef-ypos 100.0))
  )

  ;; Alle neuen Entities seit lastEnt sammeln
  (setq vf-ss (ssadd))
  (if lastEnt
    (setq vf-e (entnext lastEnt))
    (setq vf-e (entnext))
  )
  (while vf-e
    (ssadd vf-e vf-ss)
    (setq vf-e (entnext vf-e))
  )

  ;; Block erstellen, einfuegen, Attribute setzen
  (setq vf-bname (strcat "VF_" (itoa vf-nummer)))
  (if (> (sslength vf-ss) 0)
    (progn
      (setvar "ATTREQ" 0)
      (setvar "ATTDIA" 0)
      (command "_.-BLOCK" vf-bname startpunkt vf-ss "")
      (command "_.INSERT" vf-bname startpunkt 1.0 1.0 0.0)
      (setvar "ATTREQ" 1)
      (setq vf-insert (entlast))
      (setq montagehoehe-m (/ (+ hoehe-von hoehe-bis) 2000.0))
      (ssg-attrib-set-on vf-insert
        (list
          (cons "NUMMER"               (itoa vf-nummer))
          (cons "MONTAGEHOEHE_m"       (rtos montagehoehe-m 2 3))
          (cons "HOEHE_VON"            (itoa (fix hoehe-von)))
          (cons "HOEHE_BIS"            (itoa (fix hoehe-bis)))
          (cons "DELTA_H"              (itoa (fix deltaH)))
          (cons "DELTA_L"              (itoa (fix deltaL)))
          (cons "L_VF_m"               (rtos (/ L_VF 1000.0) 2 3))
          (cons "L_GF_m"               (rtos (/ L_GF 1000.0) 2 3))
          (cons "ANTRIEBFAHRTRICHTUNG" richtung)
          (cons "WINKEL"               (itoa best-winkel))
          (cons "ANZAHL_SEPARATOR"     "2")
          (cons "ANZAHL_SCANNER"       (itoa n-scanner))
          (cons "TYP"                  anlage-typ)
          (cons "SEITE"                seite)
        )
      )
      ;; Typ-spezifische Bogen-Zaehler (Etage: 2x Gefaellebogen je Seite)
      (if (= anlage-typ "etage")
        (if (= seite "rechts")
          (ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_R_60" "2")))
          (ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_L_60" "2")))
        )
      )
      (princ (strcat "\n>>> Block '" vf-bname "' erstellt und eingefuegt."))
    )
    (princ "\n>>> FEHLER: Keine Entities fuer Block gefunden!")
  )
)

;; ============================================================
;; TEIL 11: UNTERMODULE LADEN
;; ============================================================
;; Guard: Untermodule nur beim ersten Laden von vf_core.lsp ausfuehren.
(if (not *ssg-vf-submodule-loaded*)
  (progn
    (princ "\n>>> VARIOFOERDERER v26.0 geladen <<<")
    ;; Lisp-Pfad ermitteln: 1) DXFM_LISP, 2) *ssg-lisp-pfad* (vom MNL gesetzt)
    (setq *vf-lisp-pfad*
      (cond
        ((getenv "DXFM_LISP")
         (vl-string-translate "\\" "/" (getenv "DXFM_LISP")))
        ((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*)
         *ssg-lisp-pfad*)
        (t nil)
      )
    )
    (if *vf-lisp-pfad*
      (progn
        (load (strcat *vf-lisp-pfad* "/vf_standard.lsp"))
        (load (strcat *vf-lisp-pfad* "/vf_etage.lsp"))
        (setq *ssg-vf-submodule-loaded* t)
      )
      (princ "\n[vf_core] WARNUNG: DXFM_LISP nicht gesetzt - Untermodule konnten nicht geladen werden!")
    )
  )
)

;; ============================================================
;; TEIL 12: DISPATCHER c:VarioFoerderer
;; ============================================================
(defun c:VarioFoerderer ( / typ-eintr anlage-typ berechne-fn einfuege-fn
                            eingabe deltaL deltaH richtung startpunkt seite
                            ergebnis ergebnis-liste gueltige-winkel
                            best-winkel L_GF L_GF1 L_GF2 L_VF
                            idx eintrag wahl antwort verteilung-modus
                            n-scanner vf-nummer hoehe-von hoehe-bis lastEnt
                            staustrecke-basis)

  (princ "\n=========================================")
  (princ "\n     VARIOFOERDERER GENERATOR v26.0")
  (princ "\n=========================================")

  ;; 1. Typ aus Registry waehlen
  (if (null *vf-typ-registry*)
    (progn
      (alert "Keine Typen registriert!\nvf_standard.lsp und vf_etage.lsp pruefen.")
      (exit)
    )
  )

  (if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
    (progn
      (setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
      (princ (strcat "\n>>> Typ vorgewaehlt: " *vf-vorauswahl-typ*))
      (setq *vf-vorauswahl-typ* nil)
    )
    (progn
      (setq *vf-vorauswahl-typ* nil)
      (princ "\n\nAnlagen-Typ waehlen:")
      (setq idx 1)
      (foreach eintr *vf-typ-registry*
        (princ (strcat "\n  " (itoa idx) " - " (nth 3 eintr)))
        (setq idx (1+ idx))
      )
      (setq wahl (getint (strcat "\nIhre Wahl (1-"
                                 (itoa (length *vf-typ-registry*)) ") [1]: ")))
      (if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*)))
        (setq wahl 1))
      (setq typ-eintr (nth (1- wahl) *vf-typ-registry*))
    )
  )
  (setq anlage-typ  (nth 0 typ-eintr))
  (setq berechne-fn (nth 1 typ-eintr))
  (setq einfuege-fn (nth 2 typ-eintr))
  (princ (strcat "\n>>> Typ: " anlage-typ))

  ;; 2. VF-Nummer automatisch ermitteln
  (setq vf-nummer (vf-next-number))
  (princ (strcat "\n>>> Naechste VF-Nummer: VF" (itoa vf-nummer)))

  ;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt)
  (setq eingabe (vf-eingabe-abfragen))
  (setq deltaL    (nth 0 eingabe)
        deltaH    (nth 1 eingabe)
        richtung  (nth 2 eingabe)
        startpunkt (nth 3 eingabe))

  ;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht)
  (princ "\n\nSeite waehlen:")
  (princ "\n  1 - Rechts")
  (princ "\n  2 - Links")
  (setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
  (if (= antwort "2") (setq seite "links") (setq seite "rechts"))
  (princ (strcat "\n>>> Seite: " seite))

  ;; 5. Typ-spezifische Berechnung (init + berechne)
  (setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
  (setq ergebnis-liste (cadddr ergebnis))

  ;; 6. Konfiguration (nach ssg_core-Init verfuegbar)
  (setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))

  ;; 7. Gueltige Winkel ermitteln
  (setq gueltige-winkel
    (mapcar 'car
      (vl-remove-if-not
        (function (lambda (e) (and (nth 3 e)
                                   (numberp (nth 1 e)) (numberp (nth 2 e))
                                   (>= (nth 1 e) 0) (>= (nth 2 e) 0))))
        ergebnis-liste)))
  (if (null gueltige-winkel)
    (progn
      (alert (strcat "Kein passender Winkel gefunden!\n"
                     "△L=" (rtos deltaL 2 0) " mm, △H="
                     (rtos deltaH 2 0) " mm, Richtung=" richtung))
      (exit)
    )
  )

  ;; 8. Winkelauswahl (automatisch oder interaktiv)
  (if (= (length gueltige-winkel) 1)
    (progn
      (setq best-winkel (car gueltige-winkel))
      (setq eintrag (assoc best-winkel ergebnis-liste))
      (setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
      (princ (strcat "\n\n>>> Einziger gueltiger Winkel: "
                     (itoa best-winkel) (chr 176)))
    )
    (progn
      (princ "\n\nMehrere gueltige Winkel verfuegbar. Bitte waehlen:")
      (setq idx 1)
      (foreach w gueltige-winkel
        (setq eintrag (assoc w ergebnis-liste))
        (princ (strcat "\n  " (itoa idx) " - " (itoa w) (chr 176)
                       "   (L_GF=" (rtos (nth 1 eintrag) 2 1)
                       " mm,  L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
        (setq idx (1+ idx))
      )
      (setq wahl (getint (strcat "Winkel waehlen (1-"
                                 (itoa (length gueltige-winkel)) ") [1]: ")))
      (if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
        (setq wahl 1))
      (setq best-winkel (nth (1- wahl) gueltige-winkel))
      (setq eintrag (assoc best-winkel ergebnis-liste))
      (setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
    )
  )
  (princ "\n\n=========================================")
  (princ (strcat "\n>>> Winkel: " (itoa best-winkel) (chr 176)
                 "   L_GF: " (rtos L_GF 2 2) " mm"
                 "   L_VF: " (rtos L_VF 2 2) " mm"))
  (princ "\n=========================================")

  ;; 9. L_GF Verteilung
  (princ "\n\nVerteilung der Gefaellestrecken (vorne/hinten):")
  (princ "\n  1 - Gleichmaessig (L_GF1 = L_GF2 = L_GF/2)")
  (princ "\n  2 - Vorne Minimum, hinten Rest")
  (princ "\n  3 - Hinten Minimum, vorne Rest")
  (princ "\n  4 - Eigene Werte eingeben")
  (setq verteilung-modus (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
  (if (= verteilung-modus "") (setq verteilung-modus "1"))
  (cond
    ((= verteilung-modus "1")
      (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
    ((= verteilung-modus "2")
      (setq L_GF1 (float staustrecke-basis))
      (setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
    ((= verteilung-modus "3")
      (setq L_GF2 (float staustrecke-basis))
      (setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
    ((= verteilung-modus "4")
      (setq L_GF1 (getreal (strcat "\nL_GF1 vorne (mm) ["
                                   (rtos (/ L_GF 2.0) 2 2) "]: ")))
      (if (null L_GF1) (setq L_GF1 (/ L_GF 2.0)))
      (setq L_GF2 (max 0.0 (- L_GF L_GF1)))
      (princ (strcat "\n  L_GF2 hinten: " (rtos L_GF2 2 2) " mm")))
    (t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
  )
  (princ (strcat "\n>>> L_GF1=" (rtos L_GF1 2 2)
                 " mm   L_GF2=" (rtos L_GF2 2 2) " mm"))

  ;; 10. Anzahl Scanner
  (setq n-scanner (getint "\nAnzahl Scanner [0]: "))
  (if (null n-scanner) (setq n-scanner 0))

  ;; 11. Bestaetigung
  (princ "\n\nMoechten Sie die Foerderanlage einfuegen?")
  (princ "\n  1 - Ja, Module einfuegen\n  2 - Nein, abbrechen")
  (setq antwort (getstring "\nIhre Wahl (1/2): "))

  (if (= antwort "1")
    (progn
      ;; Hoehenangaben fuer Attribute und Beschriftung
      (setq hoehe-von (caddr startpunkt))
      (setq hoehe-bis (cond
        ((= richtung "Auf") (+ hoehe-von deltaH))
        ((= richtung "Ab")  (- hoehe-von deltaH))
        (t hoehe-von)))

      ;; lastEnt VOR der Einfuegung merken
      (setq lastEnt (entlast))
      (if (and lastEnt
               (= (cdr (assoc 0 (entget lastEnt))) "INSERT")
               (= (cdr (assoc 66 (entget lastEnt))) 1))
        (progn
          (setq lastEnt (entnext lastEnt))
          (while (and lastEnt
                      (/= (cdr (assoc 0 (entget lastEnt))) "SEQEND"))
            (setq lastEnt (entnext lastEnt))
          )
        )
      )

      ;; Typ-spezifische Einfuegung
      (apply einfuege-fn
        (list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite))

      ;; Gemeinsame VF_*-Block-Erstellung
      (vf-block-erstellen anlage-typ seite vf-nummer n-scanner
                          hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
                          richtung best-winkel startpunkt lastEnt)

      (princ "\n=========================================")
    )
    (princ "\nVorgang abgebrochen.")
  )
  nil
)

;; ============================================================
;; START & ALIASES
;; ============================================================
(defun c:Foerderanlage () (c:VarioFoerderer))

(defun c:EtageVarioFoerderer ()
  (setq *vf-vorauswahl-typ* "etage")
  (c:VarioFoerderer)
)

;; ssg-ensure-Flags fuer beide Wrapper-Dateien setzen,
;; damit ein zweiter Ladeaufruf uebersprungen wird.
(setq *ssg-VarioFoerderer-loaded*      t)
(setq *ssg-EtageVarioFoerderer-loaded* t)

(princ "\n>>> Befehle: VarioFoerderer, Foerderanlage, EtageVarioFoerderer")
(princ "\n    Typen:")
(setq *vf-typ-idx* 1)
(foreach eintr *vf-typ-registry*
  (princ (strcat "\n    " (itoa *vf-typ-idx*) ".  " (car eintr) " - " (nth 3 eintr)))
  (setq *vf-typ-idx* (1+ *vf-typ-idx*))
)
(if block-pfad (princ (strcat "\n    Block-Pfad: " block-pfad)))
(princ "\n=========================================")
(princ)