Aus den Lisp Daten unter M:\ACADSST\MENU eine neue Standardlibrary mit Codedoku extrahiert
This commit is contained in:
@@ -0,0 +1,315 @@
|
||||
;; ============================================================
|
||||
;; 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)
|
||||
Reference in New Issue
Block a user