Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
78f19c750c7daaa4efe07d8b60e5f7bcacf93308
dxfmakros/Lisp/ssg_layer.lsp
T
m.stangl 2eca169326 Uebersetzung aller Benutzermeldungen auf ssg-text/ssg-textf umgestellt 
Vollstaendiger i18n-Rollout ueber alle Feature- und Kernmodule: alle benutzersichtbaren princ/prompt/getXXX/alert-Texte laufen jetzt ueber die zentrale Sprachtabelle in ssg_lang.lsp (Deutsch/Englisch, umschaltbar via SSG_SPRACHE). 403 Tabelleneintraege, 497 Aufrufstellen in 17 Dateien.

Ausgeschlossen wie geplant: Debug-Ausgaben (dbg*), Lademeldungen, [DUMMY]-Platzhalter, [CFG]/[OMNI]-Diagnosemarker.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-15 21:24:18 +02:00

316 lines
9.8 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; 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 (ssg-text "layer-prompt-ziel-layer")))
(progn
(command "_LAYER" "_SET" lay "")
(prompt (ssg-textf "layer-aktiver-layer" (list lay)))
)
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(ssg-end)
lay
)
;; Layer eines Objektes anzeigen
(defun c:SSG-LayerInfo (/ sel lay)
(ssg-start "Layer-Info" nil)
(if (setq lay (ssg-get-layer (ssg-text "layer-prompt-objekt")))
(prompt (ssg-textf "layer-objekt-auf-layer" (list lay)))
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(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 (ssg-text "layer-prompt-ziel-layer")))
(command "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "")
(ssg-emsg (ssg-text "layer-err-kein-ziel-layer"))
)
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(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 (ssg-text "layer-prompt-ziel-layer")))
(command "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "")
(ssg-emsg (ssg-text "layer-err-kein-ziel-layer"))
)
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(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 (ssg-text "layer-prompt-referenz-objekt")))
(progn
(setq ref-sel (entsel (ssg-text "layer-prompt-typ-ermittlung")))
(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 (ssg-text "layer-prompt-ziel-layer")))
(progn
(ssg-zoom-save)
(ssg-ss-redraw ss 3)
(if (not (ssg-ques (ssg-textf "layer-ques-typ-wechseln" (list ref-typ)) nil))
(command "_CHANGE" ss "" "_PROP" "_LA" ziel-lay "")
(ssg-ss-redraw ss 4)
)
(ssg-zoom-restore)
)
(ssg-emsg (ssg-text "layer-err-kein-ziel-layer-kurz"))
)
(ssg-emsg (ssg-text "layer-err-keine-passenden-objekte"))
)
)
(ssg-emsg (ssg-text "layer-abgebrochen"))
)
)
(ssg-emsg (ssg-text "layer-err-kein-referenz-objekt"))
)
(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 (ssg-text "layer-prompt-ausblenden")))
(if (ssg-layer-safe-p lay nil)
(command "_LAYER" "_OFF" lay "")
(ssg-emsg (ssg-text "layer-err-aktiv-nicht-ausschalten"))
)
)
(ssg-end)
)
;; Layer durch Anklicken einfrieren
(defun c:SSG-LayerFreeze (/ lay)
(ssg-start "Layer einfrieren" nil)
(while (setq lay (ssg-get-layer (ssg-text "layer-prompt-einfrieren")))
(if (ssg-layer-safe-p lay nil)
(command "_LAYER" "_FR" lay "")
(ssg-emsg (ssg-text "layer-err-aktiv-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 (ssg-text "layer-prompt-aktiv-bleibt")))
(if aktiv
(progn
(command "_LAYER" "_SET" aktiv "_FR" "*" "")
(prompt (ssg-textf "layer-nur-layer-sichtbar" (list aktiv)))
)
(ssg-emsg (ssg-text "layer-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 (ssg-text "layer-prompt-name-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 (ssg-textf "layer-ques-alle-loeschen" (list lay)) nil))
(progn
(command "_ERASE" ss "")
(command "_LAYER" "_OFF" lay "")
(command "_PURGE" "_LA" lay "N")
(prompt (ssg-textf "layer-geloescht" (list lay)))
)
(progn
(ssg-ss-redraw ss 0)
(prompt (strcat "\n" (ssg-text "layer-abgebrochen")))
)
)
)
(progn
(command "_LAYER" "_OFF" lay "")
(command "_PURGE" "_LA" lay "N")
(prompt (ssg-textf "layer-leerer-geloescht" (list lay)))
)
)
)
(ssg-emsg (ssg-textf "layer-existiert-nicht" (list lay)))
)
(ssg-end)
)
(prompt "\nssg_layer.lsp geladen.")
(princ)
Reference in New Issue View Git Blame Copy Permalink