;;;Baustein : LAYER
;;;
;;;
;;;
;;;AutoCAD-Release:	R2000
;;;			(vermutlich auch abwärts- und aufwärts- kompatibel)
;;;
;;;Version:		1/1-15.03.2000
;;;
;;;Hinweis:		Freeware -- Freeware -- Freeware
;;;			Verwies auf Urheber versteht sich von selbst!
;;;
;;;Startaufruf:		%
;;;
;;;benötigte Dateien:   ltb.lsp (Programm)
;;;
;;;Einschränkungen:	% (nicht bekannt)
;;;
;;;Programmiert:	Holger Brischke
;;;			CADlon - Lisp over night!
;;;			http://www.CADlon.de
;;;			Tel: +49(0)681/989 06 84
;;;			mobil: +49(0)175/205 88 77
;;;			mailto:kontakt@CADlon.de
;;;
;;;Installation:	%
;;;
;;;SUB-Beschreibung
;;;
;;;Folgende Bausteine sind hierin enthalten:
;;;			LAYER...
;;;	ltb_akt	->.. aktuell setzen / bei Bedarf erzeugen
;;;	ltb_on	->.. einschalten
;;;	ltb_off	->.. ausschalten
;;;	ltb_tau	->.. tauen
;;;	ltb_frz	->.. frieren
;;;	ltb_unl	->.. entsperren
;;;	ltb_log	->.. sperren
;;;	---------------------------
;;;	ltb_sub_make	-> erzeugt Layer in Layertabelle
;;;
;;;
;;;
;;;Über Hinweise Anregungen und auch Kritik würde ich mich freuen.
;;;
;;;Holger Brischke
;;;kontakt@CADlon.de

;;;
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------EINSCHALTEN-----
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht angeschaltet (war an oder Layer gibt es nicht)
;;;		T   ->	angeschaltet
(defun ltb_on (ltb_name / ltb_layer ltb_do ltb_laycol)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (> 0 (cdr(assoc 62 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))))
	(progn
	  (setq ltb_laycol (cons 62 (* -1 (cdr(assoc 62 ltb_layer))))
		ltb_layer (subst ltb_laycol (assoc 62 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------AUSSCHALTEN-----
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht ausgeschaltet (war aus oder Layer gibt es nicht)
;;;		T   ->	ausgeschaltet
(defun ltb_off (ltb_name / ltb_layer ltb_do ltb_laycol)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (< 0 (cdr(assoc 62 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))))
	(progn
	  (setq ltb_laycol (cons 62 (* -1 (cdr(assoc 62 ltb_layer))))
		ltb_layer (subst ltb_laycol (assoc 62 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------TAUEN-----------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht getaut (war getaut oder Layer gibt es nicht)
;;;		T   ->	getaut
(defun ltb_tau (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (= 1 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 1))
	(progn
	  (setq ltb_bit70 (cons 70 (1- (cdr(assoc 70 ltb_layer))))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------FRIEREN---------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht gefroren (war getaut oder Layer gibt es nicht oder Layer ist aktuell)
;;;		T   ->	gefroren
(defun ltb_frz (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (and
	(tblsearch "LAYER" ltb_name)
	(not (= ltb_name (getvar "CLAYER")))
	);and
    (progn
      (if (= 0 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 1))
	(progn
	  (setq ltb_bit70 (cons 70 (1+ (cdr(assoc 70 ltb_layer))))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------ENTSPERREN------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht entsperrt (war nicht gesperrt oder Layer gibt es nicht)
;;;		T   ->	entsperrt
(defun ltb_unl (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (= 4 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 4))
	(progn
	  (setq ltb_bit70 (cons 70 (- (cdr(assoc 70 ltb_layer)) 4))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------SPERREN---------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht entsperrt (war nicht gesperrt oder Layer gibt es nicht)
;;;		T   ->	entsperrt
(defun ltb_log (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (= 0 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 4))
	(progn
	  (setq ltb_bit70 (cons 70 (+ (cdr(assoc 70 ltb_layer)) 4))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------AKTUELL---------
;;;########################################################################################################
;;;Neue Layer aktuell setzen oder erzeugen
;;;Übergabewerte müssen sein Lay-Name,-Linientyp,-Farbe, Drucken JA/NEIN Linientypdatei
;;;			   Stirng  String  Int	Int(1/0) String
;;;verwendete SUB's	(ltb_sub_make)	Erzeugt Layer in Zeichnungsdatenbank
;;;
;;;Der aktuelle zu setzende Layer wird entweder erzeugt oder eingeschaltet/getaut/entsperrt und aktuell gesetzt
;;;Linientypen werden, wenn sie nicht geladen werden entweder aus der acadiso oder aus einer anzugebenden Linientypdatei geladen
;;;
;;;Beispielaufruf:	(ltb_akt "MEINLAYER" "CONTINUOUS" 3 0 nil) ;;;Linientyp wird aus der acadiso genommen, wenn dieser nicht schon vorhanden ist
;;;			(ltb_akt "MEINLAYER" "CONTINUOUS" 3 0 "MEINELTYPEN");;;Linientyp wird aus der meineltypen genommen, wenn dieser nicht schon vorhanden ist
;;;
;;;
;;;
(defun ltb_akt (ltb_name ltb_ltyp ltb_laycol ltb_prn ltb_file_ltyp / 
		 ltb_olay ltb_vor ltb_ltvor
		 ltb_laycol ltb_name)
  (if (not ltb_file_ltyp)
    (setq ltb_file_ltyp "acadiso")
    )
  (setq ltb_olay (getvar "clayer")
	ltb_vor (tblsearch "LAYER" ltb_name);Ist Layer vorhanden?
	ltb_ltvor (tblsearch "LTYPE" ltb_ltyp)
	)
  (if (= ltb_ltvor nil);Wenn Linientyp nicht gefunden wird, dann wird Linientyp geladen aus ACADISO.LIN
    (progn
      (setvar "filedia" 0)
      (command "_.linetype" "_l" ltb_ltyp ltb_file_ltyp "")
      (setvar "filedia" 1)
      )
    )
  (if (tblsearch "LTYPE" ltb_ltyp)
    (progn
      (if (= ltb_vor nil);wenn der Layer nicht vorhanden ist,...
	(ltb_sub_make ltb_name ltb_ltyp ltb_laycol ltb_prn);Aufruf SUB (laymak) ;(Name LTyp Farbe dru_jn)
	(setq;wenn LAyer bereits vorhanden
	  ltb_von (ltb_on ltb_name);EINSCHALTEN
	  ltb_vtau (ltb_tau ltb_name);TAUAN
	  ltb_vunl (ltb_unl ltb_name);ENTSPERREN
	  )
	);if
      (if ltb_vtau (command "_.regen"));nach dem Tauen ist ein regenerieren notwendig
      (princ)
      (setvar "clayer" ltb_name)
      (princ "\naktueller Layer: ")
      (princ ltb_name)
      )
      (princ "\nLinientyp/Linientypdatei nicht gefunden! Keinen Layer erzeugt!")    
    )  
  (princ)
)
;;;
;;;////////////////////////////////////////////////////////////////////////////////////////////////////////
;;;Layer--------------------------------------------------------------------------SUB------ERZEUGEN--------
;;;////////////////////////////////////////////////////////////////////////////////////////////////////////
;;;Neue Layer aktuell erzeugen
;;;AutoCAD-Version unabhängig
(defun ltb_sub_make (ltbs_name ltbs_ltyp ltbs_color ltbs_prn / )
  (entmake
    (if (< 14 (atoi(substr (getvar "acadver") 1 2)));AutoCAD-Version abfragen
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	(cons 2  ltbs_name)
	'(70 . 0)
	(cons 62  ltbs_color)
	(cons 6  ltbs_ltyp)
	(cons 290 ltbs_prn);ab R15 (2000) erst möglich
	'(370 . -3)
	)
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	(cons 2  ltbs_name)
	'(70 . 0)
	(cons 62  ltbs_color)
	(cons 6  ltbs_ltyp)
	'(370 . -3)
	)
      )
    )
  (princ)
  )
;;;
;;;
;;;
(princ "\nLTB geladen!\nCADlon - Lisp over night\nHolger Brischke (kontakt@cadlon.de)")
(princ "\nVerwendung:")
(princ "\n(ltb_akt Layername Linientyp Farbnr DruckenJ/N alternative Linientypdatei)")
(princ "\n(ltb_akt \"MEINLAYER\" \"CONTINUOUS\" 3 0 \"MEINELTYPEN\")")
(princ "\n(ltb_akt \"MEINLAYER\" \"CONTINUOUS\" 3 0 nil)")
(princ)