;; ============================================================
;; SSG_LAYER.LSP - Layer-Verwaltungsroutinen
;; Interaktive Layer-Operationen: verschieben, ein/ausschalten,
;; einfrieren, Gruppen-Management.
;; Ursprung: ACADSST/MENU/laymr14.lsp (Schoenenberger)
;; Bereinigt und verallgemeinert: 2025
;; Setzt ssg_core.lsp voraus.
;; ============================================================


;; ------------------------------------------------------------
;; LAYER-INFORMATION
;; ------------------------------------------------------------

;; Alle Layer als Liste von Layernamen liefern
;; Rueckgabe: Liste von Strings
(defun ssg-layer-list-all (/ result entry first)
  (setq result nil
        first  T
  )
  (while (setq entry (tblnext "LAYER" first))
    (setq result (cons (cdr (assoc 2 entry)) result)
          first  nil
    )
  )
  (reverse result)
)

;; Layer-Infos als Assoziationsliste liefern
;; Rueckgabe: Liste von (name . layer-alist) Paaren
(defun ssg-layer-info-all (/ result entry first)
  (setq result nil
        first  T
  )
  (while (setq entry (tblnext "LAYER" first))
    (setq result (cons (cons (cdr (assoc 2 entry)) (cdr entry)) result)
          first  nil
    )
  )
  (reverse result)
)

;; Layer-Sichtbarkeitsstatus pruefen
;; lay-name = Layername; Rueckgabe: T wenn sichtbar, nil wenn aus/gefroren
(defun ssg-layer-visible-p (lay-name / entry flags color)
  (setq entry (tblsearch "LAYER" lay-name))
  (if entry
    (progn
      (setq flags (cdr (assoc 70 entry))
            color (cdr (assoc 62 entry))
      )
      (and (not (minusp color))      ; nicht ausgeschaltet (negativ = aus)
           (= (logand flags 1) 0)    ; nicht gefroren (bit 0)
      )
    )
  )
)

;; Pruefen ob Objekt-Layer der aktive Layer ist (Schutz vor Ausschalten)
;; lay-name = zu pruefender Layer; ist-gruppe = T wenn Gruppen-Layer
;; Rueckgabe: T wenn sicher (nicht aktiver Layer), nil wenn Problem
(defun ssg-layer-safe-p (lay-name ist-gruppe)
  (if ist-gruppe
    (/= (substr (getvar "CLAYER") 2 2) lay-name)
    (/= (getvar "CLAYER") lay-name)
  )
)


;; ------------------------------------------------------------
;; EINFACHE LAYER-OPERATIONEN
;; ------------------------------------------------------------

;; Layer eines angeklickten Objektes ermitteln und setzen (aktiv machen)
;; Rueckgabe: neuer Layername oder nil bei Abbruch
(defun c:SSG-LayerSet (/ sel lay)
  (ssg-start "Layer setzen" nil)
  (if (setq lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
    (progn
      (command "_LAYER" "_SET" lay "")
      (prompt (strcat "\nAktiver Layer: " lay))
    )
    (ssg-emsg "Kein Objekt gewaehlt.")
  )
  (ssg-end)
  lay
)

;; Layer eines Objektes anzeigen
(defun c:SSG-LayerInfo (/ sel lay)
  (ssg-start "Layer-Info" nil)
  (if (setq lay (ssg-get-layer "\nObjekt waehlen: "))
    (prompt (strcat "\nObjekt liegt auf Layer: " lay))
    (ssg-emsg "Kein Objekt gewaehlt.")
  )
  (ssg-end)
  lay
)

;; Objekte auf einen anderen Layer verschieben (interaktiv)
(defun c:SSG-LayerMove (/ elem ziel-lay)
  (ssg-start "Layer wechseln" nil)
  (if (setq elem (ssget))
    (if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
      (command "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "")
      (ssg-emsg "Kein Ziel-Layer gewaehlt.")
    )
    (ssg-emsg "Kein Objekt gewaehlt.")
  )
  (ssg-end)
)

;; Objekte auf einen anderen Layer kopieren und dort ablegen
(defun c:SSG-LayerCopy (/ elem ziel-lay)
  (ssg-start "Layer-Kopie" nil)
  (if (setq elem (ssget))
    (if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
      (command "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "")
      (ssg-emsg "Kein Ziel-Layer gewaehlt.")
    )
    (ssg-emsg "Kein Objekt gewaehlt.")
  )
  (ssg-end)
)

;; Alle Objekte eines Typs auf dem gleichen Layer auf neuen Layer verschieben
;; (nach Auswahl eines Referenz-Objektes dieses Typs)
(defun c:SSG-LayerMoveType (/ ref-lay ref-typ elem ziel-lay ss ref-sel)
  (ssg-start "Layer-Typ verschieben" nil)
  (if (setq ref-lay (ssg-get-layer "\nReferenz-Objekt waehlen (bestimmt Typ und Layer): "))
    (progn
      (setq ref-sel (entsel "\nNochmals fuer Typ-Ermittlung anklicken: "))
      (if ref-sel
        (progn
          (setq ref-typ (cdr (assoc 0 (entget (car ref-sel))))
                ss      (ssg-layer-ss ref-lay ref-typ)
          )
          (if ss
            (if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
              (progn
                (ssg-zoom-save)
                (ssg-ss-redraw ss 3)
                (if (not (ssg-ques (strcat "Layer dieser " ref-typ "-Objekte wechseln?") nil))
                  (command "_CHANGE" ss "" "_PROP" "_LA" ziel-lay "")
                  (ssg-ss-redraw ss 4)
                )
                (ssg-zoom-restore)
              )
              (ssg-emsg "Kein Ziel-Layer.")
            )
            (ssg-emsg "Keine passenden Objekte gefunden.")
          )
        )
        (ssg-emsg "Abgebrochen.")
      )
    )
    (ssg-emsg "Kein Referenz-Objekt gewaehlt.")
  )
  (ssg-end)
)


;; ------------------------------------------------------------
;; LAYER EIN-/AUSSCHALTEN UND EINFRIEREN
;; ------------------------------------------------------------

;; Layer durch Anklicken ausschalten
(defun c:SSG-LayerOff (/ lay)
  (ssg-start "Layer ausschalten" nil)
  (while (setq lay (ssg-get-layer "\nLayer zum Ausblenden anklicken (Enter=Ende): "))
    (if (ssg-layer-safe-p lay nil)
      (command "_LAYER" "_OFF" lay "")
      (ssg-emsg "Aktiven Layer nicht ausschalten!")
    )
  )
  (ssg-end)
)

;; Layer durch Anklicken einfrieren
(defun c:SSG-LayerFreeze (/ lay)
  (ssg-start "Layer einfrieren" nil)
  (while (setq lay (ssg-get-layer "\nLayer zum Einfrieren anklicken (Enter=Ende): "))
    (if (ssg-layer-safe-p lay nil)
      (command "_LAYER" "_FR" lay "")
      (ssg-emsg "Aktiven Layer nicht einfrieren!")
    )
  )
  (ssg-end)
)

;; Alle Layer ausser dem aktiven einfrieren
(defun c:SSG-FreezeAll (/ aktiv)
  (ssg-start "Alle anderen Layer einfrieren" nil)
  (setq aktiv (ssg-get-layer "\nObjekt auf dem Layer waehlen, der AKTIV bleibt: "))
  (if aktiv
    (progn
      (command "_LAYER" "_SET" aktiv "_FR" "*" "")
      (prompt (strcat "\nNur Layer '" aktiv "' ist sichtbar."))
    )
    (ssg-emsg "Abgebrochen.")
  )
  (ssg-end)
)

;; Alle ausgefrorenen Layer wieder auftauen
(defun c:SSG-ThawAll ()
  (ssg-start "Alle Layer auftauen" nil)
  (command "_LAYER" "_T" "*" "")
  (ssg-end)
)

;; Alle ausgeschalteten Layer einschalten
(defun c:SSG-LayerOnAll ()
  (ssg-start "Alle Layer einschalten" nil)
  (command "_LAYER" "_ON" "*" "")
  (ssg-end)
)


;; ------------------------------------------------------------
;; LAYER UMBENENNEN / VERSCHIEBEN (Gruppenkonzept)
;; Im Schoenenberger-System haben Layer die Form "X-XX-Name"
;; wobei Position 2-3 die Gruppe identifiziert.
;; Diese Funktionen erlauben das Umbenennen der Gruppen-Kennung.
;; ------------------------------------------------------------

;; Gruppen-Buchstaben aus Layernamen extrahieren (Position 2-3)
(defun ssg-layer-group (lay-name)
  (substr lay-name 2 2)
)

;; Neuen Layernamen mit geaenderter Gruppen-Kennung erzeugen
;; lay-name = original; new-grp = neue Gruppen-Kennung (2 Zeichen)
(defun ssg-layer-rename-group (lay-name new-grp)
  (strcat (substr lay-name 1 1) new-grp (substr lay-name 4))
)

;; Alle Objekte eines Gruppen-Layers auf neuen Gruppen-Layer verschieben
;; old-grp = alte Gruppen-Kennung; new-grp = neue Gruppen-Kennung
(defun ssg-layer-group-move (old-grp new-grp / all-layers entry lay-info new-name
                                              lay-color lay-ltyp c ss i e ed)
  (setq all-layers (ssg-layer-info-all))
  (foreach entry all-layers
    (if (= (ssg-layer-group (car entry)) old-grp)
      (progn
        (setq lay-info  (cdr entry)
              new-name  (ssg-layer-rename-group (car entry) new-grp)
              c         (cdr (assoc 62 lay-info))
              lay-color (if (minusp c) (abs c) c)
              lay-ltyp  (cdr (assoc 6 lay-info))
        )
        (if (not (tblsearch "LAYER" new-name))
          (command "_LAYER" "_N" new-name "_CO" (itoa lay-color) new-name
                   "LT" lay-ltyp new-name "")
        )
        (setq ss (ssg-layer-ss (car entry) nil))
        (if ss
          (progn
            (setq i 0)
            (while (setq e (ssname ss i))
              (setq ed (entget e))
              (entmod (subst (cons 8 new-name) (assoc 8 ed) ed))
              (setq i (1+ i))
            )
          )
        )
      )
    )
  )
)


;; ------------------------------------------------------------
;; LAYER LOESCHEN (mit Sicherheitsabfrage)
;; Loescht alle Objekte auf einem Layer und danach den Layer selbst.
;; Nur interaktiv verwenden!
;; ------------------------------------------------------------
(defun c:SSG-LayerDelete (/ lay ss)
  (ssg-start "Layer loeschen" nil)
  (initget 1)
  (setq lay (getstring "\nLayername zum Loeschen: "))
  (if (tblsearch "LAYER" lay)
    (progn
      (setq ss (ssg-layer-ss lay nil))
      (if ss
        (progn
          (ssg-ss-redraw ss 4)
          (if (not (ssg-ques (strcat "Alle Objekte auf Layer '" lay "' loeschen?") nil))
            (progn
              (command "_ERASE" ss "")
              (command "_LAYER" "_OFF" lay "")
              (command "_PURGE" "_LA" lay "N")
              (prompt (strcat "\nLayer '" lay "' geloescht."))
            )
            (progn
              (ssg-ss-redraw ss 0)
              (prompt "\nAbgebrochen.")
            )
          )
        )
        (progn
          (command "_LAYER" "_OFF" lay "")
          (command "_PURGE" "_LA" lay "N")
          (prompt (strcat "\nLeerer Layer '" lay "' geloescht."))
        )
      )
    )
    (ssg-emsg (strcat "Layer '" lay "' existiert nicht."))
  )
  (ssg-end)
)


(prompt "\nssg_layer.lsp geladen.")
(princ)