; Copyright (c) 27.12.2002 Christian Bermpohl
; 
; Das Programm COE_special_kitchen ermöglicht
;	-->	Das Anlegen von vordifinierten Layern
;	-->	Das Verwalten dieser ( ein/ausschalten/setzen)
;	-->	Der Objektfang wird aktiviert
;



(defun C:cadtop(/ farbeNew linieNew dcl_id zahl aktbox
		  aktboxUmgebung aktboxGruppe linieDazu layer_num find NummerNEW NummerLNEW) 
		  		  
      


;*************************************************************************
;
; Die Autocad-Umgebung entsprechend anpassen
;
;*************************************************************************

(defun AcadUmgeON ()
	(progn
	(graphscr)  
  	(princ "\n Konstruktionsumgebung ein...")
	;(command "modell") besser nicht...
	(lanl)							; Layer anlegen...
        (laydiff)
        (dimdiff)						; Bemaßungsstile anlegen...
        (reaload)
	(command "eags_rulefromtb" "Special_DelEntselmarker")	; "Autocad"-Modus setzen (siehe Regel im COE)
	(display "Alles incl special Artikel")
	(command "-ofang" "end,mit,zen,sch")			; Den Objektfang aktivieren
	(command "_layer" "tauen" "SPECIAL_*" "")		; Konstruktionsrelevante Layer Tauen
	(command "_layer" "ein" "SPECIAL_*" "")			; Konstruktionsrelevante Layer ein
	(command "_bemstil" "" "special_Nobilia" )		; BemStil special_Nobilia aktuell setzen
	(command "_.PSPACE")
        (command "_.zoom" "g")
        (command "_.MSPACE")
	(setvar "PELLIPSE" 1)
	(setq AcadON "1")					; Ausführung von "AcadUmgeOn" merken
	(setq AcadOFF nil)					; "AcadUmgeOFF" nil setzen	
	)
)
  
(defun AcadUmgeOFF ()
	(progn
  	(princ "\n Konstruktionsumgebung aus...")
	;(command "tilemode" 0 "") besser nicht...
        (vlr-remove-all :VLR-ACDB-REACTOR)
	(vlr-remove-all :VLR-Command-Reactor)
	(c:DisplayCOELayerON)					; COE-LAyer einschalten
	(command "_layer" "Setzen" "0" "")			; Layer >0< wieder aktuell setzen...
	(command "-ofang" "aus")				; Den Objektfang aktivieren
	(command "bks" "")					; BKS auf WELT setzen
  	(command "_layer" "aus" "SPECIAL_*" "")			; Konstruktionsrelevante Layer aus
	(command "_layer" "FRieren" "SPECIAL_*" "")		; Konstruktionsrelevante Layer FRIEREN
	(command "_bemstil" "" "standard" )			; Bemstil Standard als aktuell setzen
	(display "Ohne_Bemaßung_mit_Langteile")			; und in die Standard-Ansicht schalten...
	(command "eags_rulefromtb" "Special_SetEntselmarker")	; "normale Erfassung" Modus setzen (siehe Regel im COE)
	(command "_.PSPACE")
        (command "_.zoom" "g")
        (command "_.MSPACE")	       
	(setq AcadON  nil)					; "AcadUmgeOn" nil setzen
	(setq AcadOFF "1")					; Ausführung von "AcadUmgeOFF" merken
	(setq GesAnsich "0")
	)
)

;*************************************************************************
;
; Fest Definierte Layer anlegen
;
;*************************************************************************

;Es werden folgende Layer angelegt 
;	--> Hilfsgeo 	  Farbe: rot  	Linie: Acad_iso07w100
;	--> Freiformgeo   Farbe: weiss 	Linie: CONTINUOUS
;	--> Sondergeo 	  Farbe: weiss 	Linie: CONTINUOUS
;	--> BemSondergeo  Farbe: gelb  	Linie: CONTINUOUS


; LAYER lesen
;*************************************************************************

;Prüfen ob der Layer schon exestiert ( >find< dann auf 1 setzen )  
(defun Pruef (suchen typ / ) ;such infolyr layer ret2 merk
	(setq such suchen)
	(setq info nil 
	name  (cdr (assoc 2 (tblnext typ T))))
	(while name					; Layer auslesen
		(if (/= "*" (substr name 1 1))
			(setq info (cons name info))
		)
		(setq name (cdr (assoc 2 (tblnext typ))))
	)
	(setq ret2 (length info))
	(while (not (zerop ret2))			; Layer prüfen ob schon da...
		(setq ret2 (1- ret2))
		(setq merk (nth ret2 info))
		(if (= merk such)(setq find "1"))
	)
)


; Beschreibung:
;
; Es werden in die Variable >infolyr< alle vorhandenen Layer der aktuellen Zeichnung
; geschrieben.
; Nachfolgend wird die erstellte Liste >infolyr< nach dem  
; 1.Parameter >watt< Zeilenlänge 7 und dem
; 2.Parameter >grup< Zeilenlänge 3 gefiltert.
; Die gefundenen Layernamen werden als Liste  in die Variablen
; layerSpecial und layerSpecialGrup geschrieben.
;
;
(defun layerSuch (watt grup / ) ; such layerNr infolyr layer ret2 merk 
	(setq such watt)
  	(setq suchg grup)
	(setq layerSpecial nil)
  	(setq layerSpecialGrup nil)
  	(setq layerNr nil)
	(setq infolyr nil
	layer    (cdr (assoc 2 (tblnext "layer" T))))
	(while layer					; alle Layer auslesen
		(if (/= "*" (substr layer 1 1))
			(setq infolyr (cons layer infolyr))
		)
		(setq layer (cdr (assoc 2 (tblnext "layer"))))
	)
	(setq ret2 (length infolyr))
	(while (not (zerop ret2))			; Layer nach dem übergebenen Parameter WATT filter
		(setq ret2 (1- ret2))			; und bei Übereinstimmung in die Variable >layerSpecial< 
		(setq merk  (nth ret2 infolyr))		; schreiben...
		(setq merk1 (substr merk 1 7 ))
		(if (= merk1 such)(setq layerSpecial (cons merk layerSpecial)))
	)
  	(setq ret2 (length layerSpecial))
	(while (not (zerop ret2))			; Layer nach dem übergebenen Parameter grup filter
		(setq ret2 (1- ret2))			; und bei Übereinstimmung in die Variable >layerSpecialGrup< 
		(setq merk  (nth ret2 layerSpecial))	; schreiben...
		(setq merk1 (substr merk 12 3 ))
		(if (= merk1 suchg)(setq layerSpecialGrup (cons merk layerSpecialGrup)))
	)
	(setq ret2 (length infolyr))
	(while (not (zerop ret2))			; Layer mit laufender Nr. 01... auslesen
		(setq ret2 (1- ret2))
		(setq merk (nth ret2 infolyr))
		(setq merk1 (substr merk 8 2))
		(if (= merk1 "_0")(setq layerNr (cons merk layerNr)))
	  	(if (= merk1 "_1")(setq layerNr (cons merk layerNr)))
	)
)



(defun GruppeLangtei ()

  	(progn
	(princ "\n Layer Langteile blättern ein")
	(setq merk1 (atoi NummerL))
	(if (/= Nummer nil)
	      (progn	
	      (ListeLayerDazu merk1 2_layerXXXX)
	      (setq layerBlae layerDazu)
	      (setq layerBlae (cons "SPECIAL_HILFS" layerBlae ))
	      )
	)
	(if (= layerBlae nil)
		(setq layerBlae '("SPECIAL_HILFS"  "SPECIAL_01_FREIFORM"  "SPECIAL_01_FREIFORMBEM"))
	)  
	(setq GruppeLON "1"
	      GruppeAON nil
	      GruppeAll nil
	)
	)
)


(defun GruppeArtikel ()

  	(progn
	(princ "\n Layer Artikel blättern ein")
	(setq merk1 (atoi Nummer))
	(if (/= Nummer nil)
	      (progn	
	      (ListeLayerDazu merk1 layerXXXX)
	      (setq layerBlae layerDazu)
	      (setq layerBlae (cons "SPECIAL_HILFS" layerBlae ))
	      )
	)
	(if (= layerBlae nil)
	      (setq layerBlae '("SPECIAL_HILFS"  "SPECIAL_01_SONDER" "SPECIAL_01_SONDERLINE" "SPECIAL_01_SONDERBEM" ))
	)  
	(setq GruppeAON "1"
	      GruppeLON nil
	      GruppeAll nil
	)
	)
)


(defun GruppeAlle ()

  	(progn
	(princ "\n Layer >SPECIAL..< blättern ein")
	(laydiff)
	(setq layerBlae layerNew )
	(setq GruppeAll "1"
	      GruppeLON nil
	      GruppeAON nil
	)
	)  	
)

  

  
; Layer anlegen
  
;*******************************************************************************

; zu setzende Layer
;------------------------------------------------
(defun laydiff ()

	(setq find "0")
	(setq zahl 8)			; Anzahl der zu erzeugenden Layer
	(setq zahldazu 4)		; Anzahl der zu erzeugenden Artikel-Layer
	(setq dazuLan  2)		; Anzahl der zu erzeugenden Langteil-Layer  
  	
	; Nachfolgend die zu erzeugenden Layer mit den entsprechenden Eigenschaften...
	(setq layerNew (list "SPECIAL_HILFS"  "SPECIAL_01_FREIFORM" "SPECIAL_01_FREIFORMBEM"   "SPECIAL_01_SONDER"  "SPECIAL_01_SONDERLINE"  "SPECIAL_01_SONDERKON"  "SPECIAL_01_SONDERBEM" "SPECIAL_GESBEM" ))
	(setq farbeNew (list "rot"               "blau" 	        "grün"              	  "weiss"		"weiss"			"magenta"		    "grün"             "grün"       ))
	(setq linieNew (list "ACAD_ISO02W100"    "CONTINUOUS"           "CONTINUOUS"              "CONTINUOUS"		"ACAD_ISO02W100"	"CONTINUOUS"		    "CONTINUOUS"       "CONTINUOUS" ))
	(setq lstarNew (list ""    		 ""	           	"0.1"	      	       	  ""			"0.1"			""			    "0.1"	       "0.1"	    ))
  	; Nachfolgend zu erzeugende Layer über dem Button Layer >Artikel< neu
	(setq layerXXXX (list "SPECIAL_XX_SONDER" "SPECIAL_XX_SONDERLINE" "SPECIAL_XX_SONDERKON" "SPECIAL_XX_SONDERBEM"))
	(setq farbeDazu (list "weiss"		        "weiss"			"magenta"	       "grün"          ))
	(setq linieDazu (list "CONTINUOUS"	        "ACAD_ISO02W100"        "CONTINUOUS"           "CONTINUOUS"    ))
  	(setq lstarDazu (list ""		        "0.1"			""   		       "0.1"	       ))
  	; Nachfolgend zu erzeugende Layer über dem Button Layer >Langteile< neu
	(setq 2_layerXXXX (list "SPECIAL_XX_FREIFORM" "SPECIAL_XX_FREIFORMBEM" ))
	(setq 2_farbeDazu (list "blau"                 "grün"		       ))
	(setq 2_linieDazu (list "CONTINUOUS"            "CONTINUOUS" 	       ))
  	(setq 2_lstarDazu (list ""	            	"0.1"	 	       ))
  
);end laydiff	  




; zu setzende Bemaßungsstile
;------------------------------------------------
(defun dimdiff ()  

  	; prüfen ob DimTyp schon vorhanden ist
	(setq such "special_Nobilia")
  	(setq typ "DIMSTYLE")
  	(setq find "0")
	(Pruef such typ)

  	; schon mal die Texthoehe setzen
  	(setvar "TEXTSIZE" 40.000)

  	(if (= find "0")
 	    (progn
	        ; Werte Bemaßung
		(setvar "DIMADEC" 1)
              	(setvar "DIMASZ" 50.0)
                (setvar "DIMAZIN" 2)
       		(setvar "DIMDEC" 1)
       		(setvar "DIMEXO" 0)
              	(setvar "DIMDLI" 100.000)
	      	(setvar "DIMTIH" 0)	; 0 = aus, 1 = ein
	      	(setvar "DIMTOH" 0)	; 0 = aus, 1 = ein
                (setvar "DIMSE1" 0)	; 0 = aus, 1 = ein
                (setvar "DIMSE2" 0)	; 0 = aus, 1 = ein 
                (setvar "DIMTDEC" 1)
                (setvar "DIMTXT" 50.000)
                (setvar "DIMZIN" 8)
              	(command "_Dimstyle" "si" "special_Nobilia" )
	        ; Werte Schraffur
	        (setvar "HPSCALE" 45.00)
            )  
        );endIF



  	; prüfen ob DimTyp schon vorhanden ist
	(setq such "special_Nobilia_klein")
  	(setq typ "DIMSTYLE")
  	(setq find "0")
	(Pruef such typ) 		

        (if (= find "0")
 	    (progn
	        ; Werte Bemaßung
		(setvar "DIMADEC" 1)
                (setvar "DIMASZ" 20.0)
                (setvar "DIMAZIN" 2)
       		(setvar "DIMDEC" 1)
              	(setvar "DIMDLI" 40.000)
       		(setvar "DIMEXO" 0)
	        (setvar "DIMTIH" 0)	; 0 = aus, 1 = ein
	      	(setvar "DIMTOH" 0)	; 0 = aus, 1 = ein
                (setvar "DIMSE1" 0)	; 0 = aus, 1 = ein
                (setvar "DIMSE2" 0)	; 0 = aus, 1 = ein
                (setvar "DIMTDEC" 1)
                (setvar "DIMTXT" 25.000)
                (setvar "DIMZIN" 8)
       		(command "_Dimstyle" "si" "special_Nobilia_klein" )
	        ; Werte Schraffur
	        (setvar "HPSCALE" 45.00)
            )  
        );endIF

  	; prüfen ob DimTyp schon vorhanden ist
	(setq such "special_Nobilia_nano")
  	(setq typ "DIMSTYLE")
  	(setq find "0")
	(Pruef such typ) 		

        (if (= find "0")
 	    (progn
	        ; Werte Bemaßung
		(setvar "DIMADEC" 1)
                (setvar "DIMASZ" 5.0)
                (setvar "DIMAZIN" 2)
       		(setvar "DIMDEC" 1)
              	(setvar "DIMDLI" 15.000)
       		(setvar "DIMEXO" 0)
	        (setvar "DIMTIH" 0)	; 0 = aus, 1 = ein
	      	(setvar "DIMTOH" 0)	; 0 = aus, 1 = ein
                (setvar "DIMSE1" 0)	; 0 = aus, 1 = ein
                (setvar "DIMSE2" 0)	; 0 = aus, 1 = ein
                (setvar "DIMTDEC" 2)
                (setvar "DIMTXT" 8.000)
                (setvar "DIMZIN" 9)
       		(command "_Dimstyle" "si" "special_Nobilia_nano" )
	        ; Werte Schraffur
	        (setvar "HPSCALE" 45.00)
            )  
        );endIF
  
);end dimdiff


  
; Layer anlegen
;--------------------------------------------------
(defun lanl ( / ret name zahl )

(laydiff)
(princ "\n Layer anlegen...")
(while (not (zerop zahl))

	(setq ret(1- zahl))
	(setq name (nth ret layerNew))
  	(setq typ "layer")
  	(setq find "0")
	(Pruef name typ) 		
	(if (= find "0")	
	    (progn
		(command "_layer" "Neu"   (nth ret layerNew) "")
		(command "_layer" "Farbe" (nth ret farbeNew)  (nth ret layerNew) "")
		(command "_layer" "Ltyp"  (nth ret linieNew)  (nth ret layerNew) "")
		; wenn eine Linienstärke vorgegeben wurde...	
	        (setq merk (nth ret lstarNew))
		(if (/= merk "")
		    (progn
		        ; string-Typ in real Nummer umwandeln 
			(setq merk (atof merk))	
		      	(command "_layer" "Lstä"  merk  (nth ret layerNew) "")
		    )
		)  
	    )  
	)  
  
        (setq zahl(1- zahl))
);end while
):end lanl



  
  
(defun NewSonderlayer ( /) ;NR_liste ret2 merk merk1 ret name
  
	(laydiff)
	(layerSuch "SPECIAL" "SON")
  	(setq NR_liste nil)
  	(setq ret2 (length layerSpecialGrup))
	(while (not (zerop ret2))			; Die höchste laufende Nr. auslesen
			(setq ret2 (1- ret2))
			(setq merk (nth ret2 layerSpecialGrup))
			(setq merk1 (substr merk 9 2 ))
			(setq NR_liste (cons merk1 NR_liste))
	)
    	(setq merk nil merk1 1)
    	(setq ret2 (length NR_liste))

  	(while (not (zerop ret2))			; Die höchste laufende Nr. auslesen
			(setq ret2 (1- ret2))
			(setq merk (nth ret2 NR_liste))
	  		(if (< merk1 (atoi merk))(setq merk1 (atoi merk)))
	)

  	(setq merk1 (+ 1 merk1))

  	(ListeLayerDazu merk1 layerXXXX)		; In der Liste layerDazu die laufende Nr. ersetzen 
	
	; und jetzt die Layer anlegen
  	
	(while (not (zerop zahldazu))
		(setq ret(1- zahldazu))
		(setq name (nth ret layerDazu))
	  	(setq typ "layer")
          	(setq find "0")
		(Pruef name typ) 		
		(if (= find "0")	
		    (progn	
		  	(command "_layer" "Neu" (nth ret layerDazu) "")
			(command "_layer" "Farbe" (nth ret farbeDazu) (nth ret layerDazu) "")
			(command "_layer" "Ltyp" (nth ret linieDazu) (nth ret layerDazu) "")

  			; wenn eine Linienstärke vorgegeben wurde...	
			(setq merk (nth ret lstarDazu))
			(if (/= merk "")
			    (progn
				(setq merk (atof merk))	
			      	(command "_layer" "Lstä"  merk  (nth ret layerDazu) "")

			      
			    )
			)
  		    )	
  		)	

  		(setq zahldazu(1- zahldazu))
	);end while

  
)  


(defun NewFreiformlayer ( / NR_liste ret2 merk merk1 ret name) 
  
	(laydiff)
	(layerSuch "SPECIAL" "FRE")
  	(setq NR_liste nil)
  	(setq ret2 (length layerSpecialGrup))
	(while (not (zerop ret2))			; Die höchste laufende Nr. auslesen
			(setq ret2 (1- ret2))
			(setq merk (nth ret2 layerSpecialGrup))
			(setq merk1 (substr merk 9 2 ))
			(setq NR_liste (cons merk1 NR_liste))
	)
    	(setq merk nil merk1 1)
    	(setq ret2 (length NR_liste))

  	(while (not (zerop ret2))			; Die höchste laufende Nr. auslesen
			(setq ret2 (1- ret2))
			(setq merk (nth ret2 NR_liste))
	  		(if (< merk1 (atoi merk))(setq merk1 (atoi merk)))
	)

  	(setq merk1 (+ 1 merk1))

  	(ListeLayerDazu merk1 2_layerXXXX)		; In der Liste layerDazu die laufende Nr. ersetzen 
	
	; und jetzt die Layer anlegen
  	
	(while (not (zerop dazuLan))
	(setq ret(1- dazuLan))
	(setq name (nth ret layerDazu))
  	(setq typ "layer")
        (setq find "0")  
	(Pruef name typ) 		
	(if (= find "0")	
	    (progn	
	  	(command "_layer" "Neu" (nth ret layerDazu) "")
		(command "_layer" "Farbe" (nth ret 2_farbeDazu) (nth ret layerDazu) "")
		(command "_layer" "Ltyp" (nth ret 2_linieDazu) (nth ret layerDazu) "")

	      	; wenn eine Linienstärke vorgegeben wurde...	
		(setq merk (nth ret 2_lstarDazu))
		(if (/= merk "")
		    (progn
			(setq merk (atof merk))	
		      	(command "_layer" "Lstä"  merk  (nth ret layerDazu) "")

		      
		    )
		)
	    )  
	)
	      
        (setq dazuLan(1- dazuLan))
	);end while

  
)


  
;*******************************************************************************************************
  


  
;*************************************************************************
;
;			Layer-Verwaltung COE_special_kitchen			
;
;*************************************************************************




; weitere Funktionen... 
;*************************************************************************



  
(defun ListeLayerDazu (LayerNummer LayerGrupp / ) 	;newNR ret1 ret2 Ehint Evorn Emitt

	(setq Gruppe LayerGrupp)	
	(setq newNR (itoa LayerNummer))			; in eine Zeichenkette umwandeln
	(setq ret1 (strlen newNR))
	(if (< ret1 2)(setq newNR (strcat "0" newNR)))

  
  	(setq ret2 (length Gruppe))
  	(setq layerDazu nil)						
  	(while (not (zerop ret2))			; In der Liste layerDazu die laufende Nr. ersetzen
			(setq ret2 (1- ret2))
			(setq merk (nth ret2 Gruppe))
	  		(setq ret1 (strlen merk))
	  		(setq Ehint(substr merk  11))	; Hier das Element merk zerlegen...
	  		(setq Evorn(substr merk 1 8))
	  		(setq Emitt newNR)
	  		(setq layerDazu (cons (strcat Evorn Emitt Ehint) layerDazu))
	  		
	)

)



; -- holt sich aus einem vom Anwender selectiertem Element den Layer
; -- setzt den gefundenen Layer als aktuellen
; -- setzt die entsprechende Layergruppe
; -- setzt die Konstruktionshöhe vom delektierten Element 
(defun todoSelect (  / ret)

        (setq what_next (start_dialog))
	(alert (strcat "Bitte ein Elemet wählen dessen Layer gesetzt werden soll."))
	(setq objekte (ssget))
	(setq anzObjekte (sslength objekte))
        (if (> anzObjekte 1)
	    (progn
    		(alert (strcat "Es darf nur ein Element selectiert werden"))
	      
	    )
	)		  

  	; Layer vom selectierten Element holen...
  	(setq Seg_detail (ssname objekte 0))
	(setq Seg_detail (entget Seg_detail))
  	(setq Seg_layer (cdr (assoc 8  Seg_detail)))

  	; Die Nummer aus dem Layernamen auslesen
	(setq ret (substr Seg_layer 9 2 ))
	
  	; Wir prüfen in welcher Liste und damit Gruppe der Layer vorhanden ist
	(setq subLayer (substr Seg_layer 12 5 ))


	; erste element aus Liste Langteile holen  
	(setq subList (car 2_layerXXXX ))
	(setq subList (substr subList 12 5 ))
  
	; erste element aus Liste Artikel holen  
	(setq subList2 (car layerXXXX ))
	(setq subList2 (substr subList2 12 5 ))

	; Z-Höhe auslesen und der Variablen z_koor zuweisen
  	(setq bks_ZPos (caddr(trans '(0.0 0.0 0.0) 1 0 )))
	(setq z_koor (cdr (assoc 10 Seg_detail)))
	(setq z_koor (caddr z_koor))  
  	(setq z_koor (+ bks_ZPos z_koor))
    	(command "setvar" "USERS1" z_koor)

  	  	
  
  
  	(cond
	    ((= subList subLayer)
	     	(progn
		  (GruppeLangtei)		 		; handelt es sich um die Gruppe Langteile
		  (setq NummerL ret)				;
		  (setq NummerLNEW "true")
		  (command "_layer" "Setzen" Seg_layer "")	; ermittelten Layer setzen
		))  

  	    ((= subList2 subLayer)
	      	(progn
		  (GruppeArtikel)			 	; handelt es sich um die Gruppe Langteile
		  (setq Nummer ret)				;
		  (setq NummerNEW "true")			;
		  (command "_layer" "Setzen" Seg_layer "")	; ermittelten Layer setzen
		))  

	    ('T (  (strcat "Das selectierte Element liegt auf dem Layer >"Seg_layer"< "
		       	"\n Der Layer gehört nicht zu den >special-Layern< und kann"
			"\n nicht als aktueller Layer gesetzt werden...")))
  	);endCond
	     
  
  	; Dialog-Werte neu setzen
  	(mode_anz)
 	
);endtodoSelect  


; Die Funktion bearbeitet die Layer der Liste >laylist< mit dem
; Wert >todo<
(defun todo_layer (laylist todo )

 
  	(setq doing todo)	
   	(setq sliste laylist)
  	(setq akt_lay (getvar "CLAYER"))	; nochmals den aktuellen Layer auslesen
  	(setq ret3 (length sliste))
  	(while (not (zerop ret3))
		(setq ret3 (1- ret3))                
          	(setq layerN (nth ret3 sliste))
	  	; Betrifft nicht den aktuellen Layer 
	  	(if (/= layerN akt_lay)
		    (progn
		      	(command "_layer" doing  layerN "")		; im Modellbereich...
		      	(if (= doing "tauen")
		  		(command "aflayer" doing layerN "" "" )	; im Ansichtsfenster
			)  
		    )  
                )
	);endwhile

)

  
  
(defun rs_err()
(    set_tile "error" "")			; fehler ??
)
  
(defun akt ()
(mode_tile "list_box" 0)			; Box aktivieren
)

(defun deakt ()
(mode_tile "list_box" 1)			; Box deaktivieren
)

(defun chkit (aktButten name)			
    (setq aktbox name)
    (if (= aktButten "1")(akt))
    (if (= aktButten "0")(deakt))
)

(defun WATTNummer (NR name)
   (setq aktbox name)  
   (if (= aktbox "Nummer" )
       (progn
           (setq Nummer  NR)
           (setq NummerNEW "true")
       )
   )  
   (if (= aktbox "NummerL")
       (progn
           (setq NummerL NR)
           (setq NummerLNEW "true")
       )
   )
   (if (= aktbox "z_hoehe")
       (progn
	   (setq z_koor (atof NR))
       )
   )  
  
  )

  
(defun chkitUmgebung (aktButten name)
(setq aktboxUmgebung name)
)  

(defun chkitGruppe (aktButten name)
(setq aktboxGruppe name)
)  


; Funktionen zu "list_box"
;*************************************************************************


(defun aktLayer (position / ret2)
	(setq ret2 (+ 0 (atoi position )))
	(setq layer_num (nth ret2 layerSpecial))
)


; Öffnen Dialog-BOX
;*************************************************************************



;OPENS DIALOG BOX
(defun lbox ()

  	(if( < (setq dcl_id (load_dialog "coe_special_kitchen.dcl"))0) (exit))
	(setq result 2)
  
	(while (>= result 2)
	  	(new_dialog "coe_special_kitchen" dcl_id)
	   	(setq aktboxUmgebung  nil
		      aktbox	      nil
		)
	  	(mode_anz)
		(action_tile "accept" "(done_dialog 1)")
		(action_tile "cancel" "(done_dialog 0)")
	  	(action_tile "add_special_on"  "(chkitUmgebung $value $key)")
	    	(action_tile "add_special_off" "(chkitUmgebung $value $key)")
	  	(action_tile "new_Sonderlayer" "(chkitUmgebung $value $key)")
	  	(action_tile "new_Freiformlayer" "(chkitUmgebung $value $key)")
	  	(action_tile "LayerAktEIN"     "(setq onlyAktLayer $value)")
	  	(action_tile "selectLayer"     "(done_dialog 4)")
	  	(action_tile "GesamtAnsicht"   "(setq GesAnsich $value)")
	  	(action_tile "GruppeLangteile" "(chkitGruppe   $value $key)(setq GruppeLON $value)(mode_anz)")
	  	(action_tile "GruppeAlle"      "(chkitGruppe   $value $key)(setq GruppeAll $value)(mode_anz)")
		(action_tile "GruppeArtikel"   "(chkitGruppe   $value $key)(setq GruppeAON $value)(mode_anz)")
	  	(action_tile "NummerL" "(WATTNummer $value $key)")
	  	(action_tile "Nummer"  "(WATTNummer $value $key)")
	  	(action_tile "z_hoehe" "(WATTNummer $value $key)")
	  	(strtlist)
	  	(action_tile "list_box" "(aktLayer $value)")
	  	(if (=  onlyAktLayer "1")(set_tile "LayerAktEIN"   "1"))
	  	(if (=  GesAnsich "1")   (set_tile "GesamtAnsicht" "1"))
	  	(setq result (start_dialog))
	  	(cond
		   ((= result 1)(runit)
		   )
		   ((= result 4)(todoSelect)
		   )
		)   
	)	

  	(unload_dialog dcl_id)
  

)

  
(defun mode_anz( / bks_ZPos)
  	
	(princ "\n Werte in Dialogbox setzen...")
  
  	(if (= GruppeLON "1")
	  (progn
	    	(mode_tile "GruppeArtikel" 1)
	    	(set_tile "GruppeArtikel" "0")
	    	(mode_tile "GruppeAlle" 1)
	    	(set_tile  "GruppeAlle" "0")	    
	  )
	  (progn
	  	(mode_tile "GruppeArtikel" 0)
	    	(mode_tile "GruppeLangteile" 0)
	    	(mode_tile "GruppeAlle" 0)
	  )
	)
  	(if (= GruppeAON "1")
	  (progn
	    	(mode_tile "GruppeLangteile" 1)
	    	(set_tile  "GruppeLangteile" "0")
	    	(mode_tile "GruppeAlle" 1)
	    	(set_tile  "GruppeAlle" "0")
	  )
	)
  	(if (= GruppeAll "1")
	  (progn
	    	(mode_tile "GruppeArtikel" 1)
	    	(set_tile "GruppeArtikel" "0")
	     	(mode_tile "GruppeLangteile" 1)
	    	(set_tile "GruppeLangteile" "0")
	  )
  
	)

  	
  	(if (= GruppeAON "1") (set_tile "GruppeLangteile" "0"))
  	(if (/= AcadON  nil ) (set_tile "add_special_on"  AcadON))
	(if (/= AcadOFF nil ) (set_tile "add_special_off" AcadOFF))  
	(if (/= GruppeLON nil)(set_tile "GruppeLangteile" GruppeLON))
	(if (/= GruppeAON nil)(set_tile "GruppeArtikel"   GruppeAON))
  	(if (/= GruppeAll nil)(set_tile "GruppeAlle"      GruppeAll))
  	(if (= Nummer nil  )(setq Nummer  "1"))
  	(if (= NummerL nil )(setq NummerL "1"))

  	; prüfen ob wir einen Typ string haben	
  	(if (= (numberp NummerL) T )(setq NummerL (itoa NummerL )))
   	(if (= (numberp Nummer) T ) (setq Nummer  (itoa Nummer )))
  
  	(set_tile "NummerL" NummerL )
    	(set_tile "Nummer"  Nummer )

	(if (= z_koor nil) (setq z_koor 0.0))
	(set_tile "z_hoehe" (rtos z_koor 2 2))	 	; Fließkommerzahl in eine Zeichenkette umwandeln
            						; und Wert in Dialogbox setzen
  
)  	


(defun runit ()

  	(setq what_next 0)
 
  	(if (= aktbox "Layerakt")			; Layer setzen
		(command "_layer" "Setzen" layer_num "")
	)
	(if (= aktbox "Layerfri")			; Layer ausschalten
		(command "_layer" "Aus" layer_num "")
	)
	(if (= aktbox "Layertau")			; Layer setzen
		(command "_layer" "Ein" layer_num "")
	)
  	(if (= aktboxUmgebung "add_special_on")
	  	(AcadUmgeON)
	)
  	(if (= aktboxUmgebung "add_special_off")
	  	(AcadUmgeOFF)
	)
  	(if (= aktboxUmgebung "new_Sonderlayer")
	  	(NewSonderlayer)
	)
  	(if (= aktboxUmgebung "new_Freiformlayer")
	  	(NewFreiformlayer)
	)
  	(if (= aktboxGruppe "GruppeLangteile")
	  	(GruppeLangtei)
	)  
	(if (= aktboxGruppe "GruppeArtikel")
	  	(GruppeArtikel)
	)
    	(if (= aktboxGruppe "GruppeAlle")
	  	(GruppeAlle)
	)
  	(if (= NummerNEW "true")	; Auch bei geänderter Fortlaufender Nummer ausführen
	    (progn
		(GruppeArtikel)
	      	; und zur neuen Layergruppe blättern
	        (setq layer (nth 1 layerBlae))	
		(command "_layer" "Setzen" layer "" )
		;(c:Layer_next)
	    )  
	)
  	(if (= NummerLNEW "true")	; Auch bei geänderter Fortlaufender Nummer ausführen
	    (progn
  		(GruppeLangtei)
       	      	; und zur neuen Layergruppe blättern
      	        (setq layer (nth 1 layerBlae))	
		(command "_layer" "Setzen" layer "" )
		;(c:Layer_next)
	    )  
	)       
	(if (= onlyAktLayer "1")
	    (progn
       		; den aktuellen Layer holen 
		(setq such (getvar "CLAYER"))
	        (display "Layer aus")

	      	; tauen
		(command "_layer" "Ein" such "" )
		(command "_layer" "Tauen" such "" )
	        (command "aflayer" "Tauen" such "" "" )

	        ; Layer setzen
    	        (setvar "CLAYER" such)
	    )
	)  

  	(if (=  GesAnsich "1")
	    (progn
	      	(display "Alles incl special Artikel")
	      	(command "_layer" "Aus"    "SPECIAL_*" "")
	      	(command "_layer" "tauen"    "SPECIAL_*" "")
	        (command "_layer" "Setzen" "SPECIAL_GESBEM" "")
	    )  
  	)

  	(command "setvar" "USERS1" z_koor)		   
)

(defun strtlist ()
	(princ "\n Layer in List-Box anzeigen...")
	(layerSuch "SPECIAL" "FALSE")					;Layer >SPECIAL_..< auslesen
	(mode_tile "list_box" 1)
  	(if (/= layerSpecial nil)
	       (progn
		(setq layerSpecial (acad_strlsort layerSpecial))	;Liste alphabetisch sortieren 
		(start_list "list_box")
		(mapcar 'add_list layerSpecial)
		(end_list)
		(action_tile "Layerakt" "(chkit $value $key)")
		(action_tile "Layerfri" "(chkit $value $key)")
		(action_tile "Layertau" "(chkit $value $key)")
	       )	 	
	)

)



; Callback-Funktionen (vlr-...) --> Reaktor-Funktionen)
;***********************************************************************



; kurze info was wir denn alle so machen..
;
; vor dem Befehl:
;	-->  Beim erstellen einer >xline< setzen wir immer den Layer >special_hilfs<
;	-->  Beim erstellen einer >Dimension< setzen wir immer den Layer >special_****bem<  
;
;
; nach dem Befehl:
;	-->  Den aktuellen Layer wieder setzen
;	-->  Nach dem erstellen einer Linie / Kreis / Bogen / Dimension die Elemente auf die
;	     Konstruktionshöhe setzen.
;	-->  Nach dem setzen vom Element Text / MTEXT  4 Punkte an der Umhüllung setzen
;	     PROBLEM der Positionierung auf dem COE-Plot damit behoben. 
;
;
; bei Abbruch
;	-->  Den aktuellen Layer wieder setzen



; Parameter ELEMENT	--> alte ENITY Liste
;	    NEU		--> geänderte ENITY Liste
;	    CODE	--> geänderter DXF-Typ 
(defun ENITY-CHANGE (ELEMENT NEU CODE / )
  	(setq merkElem ELEMENT)
	(setq ENITY-ALT (cdr (assoc CODE merkElem)))
	(setq ALT (assoc CODE merkElem))
	(setq LISTE (cons CODE NEU))
	(setq ELEMENT (subst LISTE ALT merkElem))
	(setq NEW ELEMENT)
) ;_ end defun


  
; Von Element >ENT< DXF-Code >NR< bearbeiten
(defun EH_WORK (ENT NR EH_Z_NEU)
	(setq EH_XYZ (cdr (assoc NR ENT)))		; assoc --> Liste >ENT< durchsuchen nach NR 
	(if (/= EH_Z_NEU (caddr EH_XYZ))
		(progn (setq EH_NEU (list (car EH_XYZ) (cadr EH_XYZ) EH_Z_NEU))
		   (ENITY-CHANGE ENT EH_NEU NR)
		   (setq lastAcadObjekt NEW)
		);progn
	);endif  
) ;_ end defun




; Schaltet einen Layers innerhalb einer
; Callback-Funktionen ein. 
(defun todo_Reaktor (todoName / i)

  	(setq i 0)
  	(setq s todoName)
  
  	; Zeiger auf aktuelle Dokument
  	(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
  	; Alle Layer holen
	(setq Layers (vla-get-layers acadDocument))
  	; Schleife über alle Layer
	(repeat (vla-get-count Layers)
  		(setq aLayer (vla-item Layers i))
	  	; Name auslesen
		(setq aName  (vla-get-Name aLayer))
	  	; finden wir den Layer >*name*< in der Liste...
	  	(if (= aName s) 
		  	; und wir tauen den Layer
		  	(vla-put-freeze aLayer :vlax-false)
	
		);endif
		(setq i (1+ i))
  
   	);repeat	

);endLayerMap



; erstellt von Christian Bermpohl am 17.12.2004
;
; Funktionen: >boundingBox<
;	--> liefert die Umhüllung von Element MText und text
;
;*************************************************************************
(defun boundingBox (ent_data rand / tb p1 p2 p3 p4 w breite hoehe ausrichtrichtung)
	(cond
	  	; wir haben einen Text
		((or (= (cdr (assoc 0 ent_data)) "TEXT")
			(= (cdr (assoc 0 ent_data)) "ATTRIB")
		 )
			(setq tb (textbox ent_data))
			(setq tb (list (mapcar '- (nth 0 tb) (list rand rand))
				       (mapcar '+ (nth 1 tb) (list rand rand))
				 )
			)
	 
			(command "bks" "o" (cdr (assoc -1 ent_data)))
 
			(setq w (cdr (assoc 50 ent_data)))
			(setq p1 (nth 0 tb))
			(setq p3 (nth 1 tb))
			(setq p1 (trans p1 1 0))
			(setq p3 (trans p3 1 0))
			(setq p2 (inters p1 (polar p1 w 1) p3 (polar p3 (+ w (/ pi 2.0)) 1) nil))
 			(setq p4 (inters p1 (polar p1 (+ w (/ pi 2.0)) 1) p3 (polar p3 w 1) nil))

		 	(command "bks" "_p")
		);endText

		; wir haben einen MText
		((= (cdr (assoc 0 ent_data)) "MTEXT")
			(setq breite (cdr (assoc 42 ent_data)))
			(setq hoehe (cdr (assoc 43 ent_data)))

			(setq ausricht (cdr (assoc 210 ent_data)))
			(setq richtung (cdr (assoc 11 ent_data)))
			;(print richtung)
			(setq w (angle (list 0.0 0.0 0.0) richtung))
			;(print w)

			(if (and (minusp (nth 2 ausricht)) (minusp (nth 0 richtung)))
				(setq breite (- 0.0 breite))
			)

		 	(if (and (minusp (nth 2 ausricht)) (not (minusp (nth 0 richtung))))
				(setq hoehe (- 0.0 hoehe))
			)
		 
			(setq basis (cdr (assoc 10 ent_data)))

		 	; je nachdem wo der Anschußpunkt vom Text zu finden ist die Umhüllung ermitteln
		 	(cond
				((= (cdr (assoc 71 ent_data)) 1)
				 (setq p4 basis)
				 (setq p1 (mapcar '- p4 (list 0.0 hoehe 0.0)))
				 (setq p2 (mapcar '+ p1 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 2)
				 (setq p4 (mapcar '- basis (list (/ breite 2.0) 0.0 0.0)))
				 (setq p1 (mapcar '- p4 (list 0.0 hoehe 0.0)))
				 (setq p2 (mapcar '+ p1 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 3)
				 (setq p3 basis)
				 (setq p1 (mapcar '- p3 (list breite hoehe 0.0)))
				 (setq p2 (mapcar '+ p1 (list breite 0.0 0.0)))
				 (setq p4 (mapcar '+ p1 (list 0.0 hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 4)
				 (setq p1 (mapcar '- basis (list 0.0 (/ hoehe 2.0) 0.0)))
				 (setq p2 (mapcar '+ p1 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				 (setq p4 (mapcar '+ p1 (list 0.0 hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 5)
				 (setq p1 (mapcar '- basis (list (/ breite 2.0) (/ hoehe 2.0) 0.0)))
				 (setq p2 (mapcar '+ p1 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				 (setq p4 (mapcar '+ p1 (list 0.0 hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 6)
				 (setq p2 (mapcar '- basis (list 0.0 (/ hoehe 2.0) 0.0)))
				 (setq p1 (mapcar '- p2 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				 (setq p4 (mapcar '+ p1 (list 0.0 hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 7)
				 (setq p1 basis)
				 (setq p2 (mapcar '+ p1 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				 (setq p4 (mapcar '+ p1 (list 0.0 hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 8)
				 (setq p1 (mapcar '- basis (list (/ breite 2.0) 0.0 0.0)))
				 (setq p2 (mapcar '+ p1 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				 (setq p4 (mapcar '+ p1 (list 0.0 hoehe 0.0)))
				)
				((= (cdr (assoc 71 ent_data)) 9)
				 (setq p2 basis)
				 (setq p1 (mapcar '- p2 (list breite 0.0 0.0)))
				 (setq p3 (mapcar '+ p1 (list breite hoehe 0.0)))
				 (setq p4 (mapcar '+ p1 (list 0.0 hoehe 0.0)))
				)
			);endCond

		 	; um Wert >rand< Umhüllung versetzen
		 	; aus >z_koor< nehmen wir die höhe
			(setq -rand (- 0.0 rand))
			(setq p1 (mapcar '+ p1 (list -rand -rand 0.0)))
			(setq p2 (mapcar '+ p2 (list rand -rand 0.0)))
		 	(setq p3 (mapcar '+ p3 (list rand rand 0.0)))
			(setq p4 (mapcar '+ p4 (list -rand rand 0.0)))

			(setq p1 (polar basis (+ (angle basis p1) w) (distance basis p1)))
			(setq p2 (polar basis (+ (angle basis p2) w) (distance basis p2)))
			(setq p3 (polar basis (+ (angle basis p3) w) (distance basis p3)))
			(setq p4 (polar basis (+ (angle basis p4) w) (distance basis p4)))
		);endMtext
	);endCond

  	(setq tb (list p1 p2 p3 p4))

);end boundingBox
  


  
; vor dem Befehl....
(defun before (reatyp befname / )
  (cond
     ((wcmatch (car befname) "XLINE")
		; den aktuellen Layer holen 
		(setq *oldlay* (getvar "CLAYER"))
      
             	(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
		    	     '((:VLR-OBJECTAPPENDED . workElement)))
		
		);endsetq
      
		; den zu setzenden Layer holen
		(setq *name* (nth 0 layerNew))
      		; Layer vorab einschalten
      		(todo_Reaktor *name*)  
		; Layer setzen
     		(setvar "CLAYER" *name*)

    )
    ((wcmatch (car befname) "DIM*")
		; den aktuellen Layer holen 
		(setq *oldlay* (getvar "CLAYER"))
		; merker für workDimension
     		(setq imerk nil)
	        (setq DEFUN_DIMENSION (VLR-ACDB-REACTOR "DEFUN_DIMENSION"
	    	 	    	'((:VLR-OBJECTAPPENDED . workDimension)))
		);endsetq
     
		(if (/= *oldlay* "0")
                    (progn
		        ; den zu setzenden Layer holen
			(setq ret2 (length layerBlae))
			(while (not (zerop ret2))		
				(setq ret2 (1- ret2))
				(setq merk (nth ret2 layerBlae))
				(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
			)
		        ; Layer vorab einschalten
      			(todo_Reaktor *name*)  
			; Layer setzen
			(setvar "CLAYER" *name*)
                    )
		);endIF
     );endDIM
    ((wcmatch (car befname) "MTEXT")
     
	     		; den aktuellen Layer holen 
			(setq *oldlay* (getvar "CLAYER"))
	      		(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
			    	     '((:VLR-OBJECTAPPENDED . workElement)))
			
			);endsetq

     			(if (/= *oldlay* "0" and /= *oldlay* "SPECIAL_GESBEM")
	                    (progn
			        ; den zu setzenden Layer holen
				(setq ret2 (length layerBlae))
				(while (not (zerop ret2))		
					(setq ret2 (1- ret2))
					(setq merk (nth ret2 layerBlae))
					(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
				)
			        ; Layer vorab einschalten
	      			(todo_Reaktor *name*)  
				; Layer setzen
				(setvar "CLAYER" *name*)
	                    )
			);endIF
     
     );endLINE
    ((wcmatch (car befname) "LEADER")
	     		; den aktuellen Layer holen 
			(setq *oldlay* (getvar "CLAYER"))
	      		(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
			    	     '((:VLR-OBJECTAPPENDED . workElement)))
			
			);endsetq

     			(if (/= *oldlay* "0")
	                    (progn
			        ; den zu setzenden Layer holen
				(setq ret2 (length layerBlae))
				(while (not (zerop ret2))		
					(setq ret2 (1- ret2))
					(setq merk (nth ret2 layerBlae))
					(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
				)
			        ; Layer vorab einschalten
	      			(todo_Reaktor *name*)  
				; Layer setzen
				(setvar "CLAYER" *name*)
	                    )
			);endIF

     );endLEADER
    ((wcmatch (car befname) "QLEADER")
	     		; den aktuellen Layer holen 
			(setq *oldlay* (getvar "CLAYER"))
	      		(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
			    	     '((:VLR-OBJECTAPPENDED . workElement)))
			
			);endsetq

     			(if (/= *oldlay* "0")
	                    (progn
			        ; den zu setzenden Layer holen
				(setq ret2 (length layerBlae))
				(while (not (zerop ret2))		
					(setq ret2 (1- ret2))
					(setq merk (nth ret2 layerBlae))
					(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
				)
			        ; Layer vorab einschalten
	      			(todo_Reaktor *name*)  
				; Layer setzen
				(setvar "CLAYER" *name*)
	                    )
			);endIF

     );endQLEADER
     ((wcmatch (car befname) "BHATCH")
		; den aktuellen Layer holen 
		(setq *oldlay* (getvar "CLAYER"))
     		(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
		    	     '((:VLR-OBJECTAPPENDED . workElement)))
		);endsetq
     
		(if (/= *oldlay* "0")
                    (progn
		        ; den zu setzenden Layer holen
			(setq ret2 (length layerBlae))
			(while (not (zerop ret2))		
				(setq ret2 (1- ret2))
				(setq merk (nth ret2 layerBlae))
				(if (= (wcmatch merk "*BEM") T) (setq *name* merk))
			)
		        ; Layer vorab einschalten
      			(todo_Reaktor *name*)  
			; Layer setzen
			(setvar "CLAYER" *name*)
                    )
		);endIF
     );endDIM
    ((wcmatch (car befname) "LINE")
	     		; den aktuellen Layer holen 
			(setq *oldlay* (getvar "CLAYER"))
	      		(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
			    	     '((:VLR-OBJECTAPPENDED . workElement)))
			
			);endsetq
     );endLINE
    ((wcmatch (car befname) "ARC")
	     		; den aktuellen Layer holen 
			(setq *oldlay* (getvar "CLAYER"))
	      		(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
			    	     '((:VLR-OBJECTAPPENDED . workElement)))
			
			);endsetq
     );endLINE
    ((wcmatch (car befname) "CIRCLE")
	     		; den aktuellen Layer holen 
			(setq *oldlay* (getvar "CLAYER"))
	      		(setq DEFUN_SETZ (VLR-ACDB-REACTOR "DEFUN_SETZ"
			    	     '((:VLR-OBJECTAPPENDED . workElement)))
			
			);endsetq
     );endLINE     
  )
)



; nach dem Befehl....
(defun after(reatyp befname /)
  (cond
     ((and	
      (wcmatch (car befname) "XLINE" ) *oldlay* )
	       ; Layer setzen
      	       (setvar "CLAYER" *oldlay*)
      	       (setq *oldlay* nil)
     )
     ((and
      (wcmatch (car befname) "DIM*" ) *oldlay* )
	       ; Layer setzen
      	       (setvar "CLAYER" *oldlay*)
      	       (setq *oldlay* nil)
     )
     ((and     
      (wcmatch (car befname) "MTEXT" ) *oldlay* )
	       ; Layer setzen
      	       (setvar "CLAYER" *oldlay*)
      	       (setq *oldlay* nil)
     )     
     ((and     
      (wcmatch (car befname) "QLEADER" ) *oldlay* )
	       ; Layer setzen
      	       (setvar "CLAYER" *oldlay*)
      	       (setq *oldlay* nil)
     )     
     );endcond

  ; und die geänderten Elemente neu setzen
  (setq ret2 (length list_elem))
  (while (not (zerop ret2))		
	 (setq ret2 (1- ret2))
	 (setq merk (nth ret2 list_elem))
	 (entmod merk)
  )
  
  (setq list_elem nil)
  (vlr-remove-all :VLR-ACDB-REACTOR)
)


  
(defun cancel (reatyp befname )

  (princ "\n Start Funktion cansel...")	

  (setq thecommandcancel (nth 0 befname))
  (if (/= *oldlay* nil) (setvar "CLAYER" *oldlay*))

  ; auch hier die eventuell noch geänderten Elemente neu setzen
  (setq ret2 (length list_elem))
  (while (not (zerop ret2))		
	 (setq ret2 (1- ret2))
	 (setq merk (nth ret2 list_elem))
	 (entmod merk)
  )  

  (setq list_elem nil)
  (vlr-remove-all :VLR-ACDB-REACTOR)
    
)  

  
(defun workElement (reatyp Data /)


         (princ "\n Bearbeite Element...")
	 (setq  z_Set z_koor) ;wert aus Variable holen
	 (setq lastAcadObjekt (last Data))
	 (setq lastAcadObjekt (entget lastAcadObjekt))
	 
	 (cond
	     ((= (cdr (assoc 0 lastAcadObjekt)) "LINE")
	      (if (/= z_koor 0.0)
		(progn
		    	(princ "\n Ändere Z-Höhe Linie...")
		      	(EH_WORK lastAcadObjekt 10 z_Set)
		      	(EH_WORK lastAcadObjekt 11 z_Set)
		      	(setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )  
	     )						;end Linie
	     ((= (cdr (assoc 0 lastAcadObjekt)) "XLINE")
	      (if (/= z_koor 0.0)
		(progn
			(princ "\n Ändere Z-Höhe Hilfslinie...")
			(EH_WORK lastAcadObjekt 10 z_Set)
	      		(EH_WORK lastAcadObjekt 11 0.0)   
	      		(setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )  		  
	     )						;end Hilfslinie
	     ((= (cdr (assoc 0 lastAcadObjekt)) "ARC")
	      (if (/= z_koor 0.0)
		(progn
		  	(princ "\n Ändere Z-Höhe Bogen...")
	      		(EH_WORK lastAcadObjekt 10 z_Set)
	      		(setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )  		  		  
	     )						;end Bogen
	     ((= (cdr (assoc 0 lastAcadObjekt)) "CIRCLE")
	      (if (/= z_koor 0.0)
		(progn
		  	(princ "\n Ändere Z-Höhe Kreis...")	
	      		(EH_WORK lastAcadObjekt 10 z_Set)
	      		(setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )		  
	     )						;end Kreis
	     ((= (cdr (assoc 0 lastAcadObjekt)) "MTEXT")
	      (if (/= z_koor 0.0)
		(progn
		      (princ "\n Ändere Z-Höhe Text...")	
		      (EH_WORK lastAcadObjekt 10 z_Set)
		      (setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )		  		  
	      (setq tb (boundingBox lastAcadObjekt 10.0))
	      (princ "\n Setze 4 Punkte um Text...")
	      (setq p1 (nth 0 tb))
	      (setq p2 (nth 1 tb))
	      (setq p3 (nth 2 tb))
	      (setq p4 (nth 3 tb))

	      ; Koordinatens. auf welt setzen...
	      (command "bks" "")
	      
	      (command "punkt" p1)
	      (command "punkt" p2)
	      (command "punkt" p3)
	      (command "punkt" p4)
	     )						;end Text
	     ((= (cdr (assoc 0 lastAcadObjekt)) "QLEADER")
	      (if (/= z_koor 0.0)
		(progn
	      		(princ "\n Ändere Z-Höhe Schnellführung-Text...")	
	      		(EH_WORK lastAcadObjekt 10 z_Set)
	      		(setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )		  
	     )						;end Schnellführung-Text	     
	     ((= (cdr (assoc 0 lastAcadObjekt)) "LEADER")
	      (if (/= z_koor 0.0)
		(progn
	      		(princ "\n Ändere Z-Höhe Bezugslinie...")	
	      		(EH_WORK lastAcadObjekt 10 z_Set)
	      		(setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )		  
	     )						;end Schraffur
	     ((= (cdr (assoc 0 lastAcadObjekt)) "HATCH")
	      (if (/= z_koor 0.0)
		(progn
	      		(princ "\n Ändere Z-Höhe Text...")	
			(EH_WORK lastAcadObjekt 10 z_Set)
	      		(EH_WORK lastAcadObjekt 11 z_Set)
	      		(setq list_elem (cons lastAcadObjekt list_elem ))
		)	
	      )		  
	     )						;end Schraffur
	     (t nil)
	);endcond
);endworkElement  



(defun workDimension (reatyp Data /)

  	 ;wert aus Variable holen
  	 (setq  z_Set z_koor)
  
  	 (setq merk (last Data))
	 (setq merk (entget merk))
	 ; Type...	
  	 (setq dimtyp (cdr (assoc 0 merk)))
  
	 (if (= dimtyp "DIMENSION")
	     (progn
	        (setq lastAcadObjekt merk)
	        (princ "\n Bearbeite Dimension...")
       		(EH_WORK lastAcadObjekt 10 z_Set)
	        (EH_WORK lastAcadObjekt 11 z_Set)
		(if (/= (cdr (assoc 16 lastAcadObjekt)) nil )
		    (progn	
		        (EH_WORK lastAcadObjekt 16 z_Set)
		    )
		);endIF
	        (setq list_elem (cons lastAcadObjekt list_elem ))
	      );endprogn  
	 );endIF
);endworkDimension



  
;Initialisierung des Reactors
(defun reaload ()

  (princ "\n Aktiviere Callback-Funktion...")
  (vl-load-com)
  (if (not *DEFUN_TODO*)
    (progn
            (vlr-command-reactor nil
		'((:vlr-CommandWillStart . before))
	    )  
	    (vlr-command-reactor nil  
                '((:vlr-commandEnded . after))
	    )
            (vlr-command-reactor nil  
		'((:vlr-commandCancelled . cancel))
	    )  
	    (setq *DEFUN_TODO* 'T)	
   );endprogn
  );endif
 );endreaload



;COUNTING ROUTINE
;*************************************************************************
(setvar "cmdecho" 0)			; Deaktiviere die Protokollierung von command...
(setvar "texteval" 1)
(lbox)					; Dialogbox öffnen	
(gc)					; Speicherstruktur säubern			
(princ "\n Lade Funktion C:cadtop... ")	; wir schreiben in die Befehlszeile
(setvar "cmdecho" 1)			; Aktiviere die Protokollierung von command...
);endCADTOP




;*************************************************************************
;
; zwischen den Layern der gewählten Layerguppe blättern
;
;*************************************************************************
;
(defun C:Layer_next (/ ) ;TODO ret3 such info  md_subst_layerNew ret

(setvar "cmdecho" 0) ; Deaktiviere die Protokollierung von command...
  

	; Prüfen ob die Funktion ausgeführ werden kann
	; Bei Fehler Message mit Hinweis...
	(setq Prüfung "ok")

	; Special Kitchen muß "ein" sein...
	(cond
	    ((= AcadON nil)	    (setq Prüfung nil))	
	    ((= GruppeAON "1")      (setq Prüfung "ok"))
	    ((= GruppeLON "1") 	    (setq Prüfung "ok"))
	    ((= GruppeALL "1")      (setq Prüfung "ok"))
	    ('T (setq Prüfung nil))
	)    
	(if (= Prüfung nil)
	    (progn
            (alert (strcat "Die Funktion >Layer_next< kann nur bei"
		          "\neingeschalteter CAD-Umgebung und Layergruppe"
		          "\nausgeführt werden."))
		   (setq Prüfung nil)
	    )	
	)


	(if (/= Prüfung nil)
	    (progn
  
		(laydiff)

		(terpri) ; Zeilenumbruch
		(princ "\n Blättern innerhalb der aktivierten Layergruppe...")
		(terpri)

             
		; und hier die toggle-Box >GesamtAnsicht< deaktivieren
		(setq GesAnsich "0")


                ; zwischen den in der Liste >layerBlae< definierten Layern "blättern"
                ; wir.
		; 

             
              	(setq ID nil)
		(setq akt_lay (getvar "CLAYER"))		; den aktuellen Layer holen
		(setq ret (length layerBlae))		        ; die ID des folgenden Layers in der Liste holen
                (setq ret1 (- ret 1))
		(while (not (zerop ret))	
			(setq ret (1- ret))
                  	(setq such (nth ret layerBlae))
			(if (= such akt_lay)
                            (progn
				(if (=  ret ret1) (setq ID 0))
                              	(if (/= ret ret1) (setq ID (+ ret 1)))
                            )
                        )
	        );endwhile

		(if (= ID nil) (setq ID 0))		; immer noch keine ID...  dann nehmen wir den ersten Eintrag
		(setq layer (nth ID layerBlae))		; und jetzt holen wir uns den Layer mit der ermittelten ID
              
	      	; wir haben endlich den Layer welchen wir setzen
	        ; wollen.
	        ; Erstmal noch prüfen ob es diesen denn überhaupt schon gibt...
	        ; 		-->	Bei Fehler: Message anzeigen
	        (setq such layer)
	  	(setq typ "layer")
	      
                (setq find "0")
		(Pruef layer typ) 		
		(if (= find "1")
		    (progn  

	        	(todo_layer layerBlae "tauen" )                          
		    	(todo_layer layerBlae "Ein" )
                        ; den gefundenen Layer setzen...
		        (command "_layer" "Setzen" such "" )	
		    ); endprogn
		);endIF Layer existiert

		(if (= onlyAktLayer "1")
		    (progn
	       		; den aktuellen Layer holen 
			(setq such (getvar "CLAYER"))
		        (display "Layer aus")

		      	; tauen
			(command "_layer" "Ein" such "" )
			(command "_layer" "Tauen" such "" )
		        (command "aflayer" "Tauen" such "" "" )

		        ; Layer setzen
            	        (setvar "CLAYER" such)

		    )
		)  

	      
                (if (= find "0")
		    (progn
      			(alert (strcat "Den Layer >"such"< gibt es"
  	             		       "\nnoch nicht. 		--> Bitte erst neu anglegen."))
		    )
		);endIF Layer fehlt
	      
	    ) ;end progn
	) ;end IFPrüfung


  
;COUNTING ROUTINE
;*************************************************************************
(princ "\n Lade Funktion C:layer_next... ")	; wir schreiben in die Befehlszeile
(setvar "cmdecho" 1)				; Aktiviere die Protokollierung von command...
);ende layer_next






;*************************************************************************
;
; Die Funktion schaltet alle Layer welche nicht zur aktuellen Layergruppe
; gehören aus.
;
;*************************************************************************
;
(defun C:Layer_group_on (/ such ret) 


  (princ "\n Alle Layer der aktuellen Layergruppe einblenden...")
  (setvar "cmdecho" 0)	; Deaktiviere die Protokollierung von command...
  (terpri) 		; Zeilenumbruch

  (if (= LayerNext nil) (setq LayerNext "on"))
  
  ; Prüfen ob die Funktion ausgeführ werden kann
  ; Bei Fehler Message mit Hinweis...
  (setq Prüfung "ok")

  ; Special Kitchen muß "ein" sein...
  (cond
      ((= AcadON nil)	    (setq Prüfung nil))	
      ((= GruppeAON "1")    (setq Prüfung "ok"))
      ((= GruppeLON "1")    (setq Prüfung "ok"))
      ((= GruppeALL "1")    (setq Prüfung "ok"))
      ('T (setq Prüfung nil))
  )    
  (if (= Prüfung nil)
      (progn
      (alert (strcat "Die Funktion >Layer_group_on< kann nur bei"
  	             "\neingeschalteter CAD-Umgebung und Layergruppe"
	             "\nausgeführt werden."))
	      (setq Prüfung nil)
      )	
  )
  

  ; und hier die toggle-Box >GesamtAnsicht< deaktivieren

  (if (/= Prüfung nil)
      (progn
	  (setq GesAnsich "0")

	  ; den aktuellen Layer merken
	  (setq md_ist_lay (getvar "CLAYER"))
	  ; Layer 0 aktuelle setzen	
	  (command "_layer" "Setzen" "0" "")
	
	  (if (= LayerNext "on")
	 	(progn   
			(command "_layer" "frieren" "SPECIAL_*" "" )     ; erstmal alle SPECIAL... Layer ausblenden
								     ; incl. dem aktuellen

		  	(todo_layer layerBlae "tauen" )		     ; Layer aus >layerBlae< vorsoglich tauen
		  
			(setq ret (length layerBlae))		     ; Layer der aktuellen Layergruppe einschalten	
			(while (not (zerop ret))	
				(setq ret (1- ret))
				(setq such (nth ret layerBlae))
				(command "_layer" "ein" such "" )
		        )
		  	(command "_layer" "Setzen" md_ist_lay "")    ; und wieder den >md_ist_lay< setzen
			(setq LayerNext "off")
			(quit)
		)
	  )

	  (if (= LayerNext "off")
	        (progn
		(command "_layer" "Ein" "SPECIAL_*_*" "" )   ; alle SPECIAL... Layer wieder einblenden
		(command "_layer" "Tauen" "SPECIAL_*_*" "" ) ; alle SPECIAL... Layer wieder tauen
		(setq LayerNext "on")
		(command "_layer" "Setzen" md_ist_lay "")    ; und wieder den >md_ist_lay< setzen
		(command "_zoom" "g")
		(quit)
		)
	  )
	) ;end progn
) ;end IFPrüfung

;COUNTING ROUTINE
;******************************************************************************************************
(princ "\n Lade Funktion C:Layer_group_on... ")	; wir schreiben in die Befehlszeile
;(setvar "cmdecho" 1)				; Aktiviere die Protokollierung von command...  
) ;end Layer_group_on




;*************************************************************************
;
; Die Funktion blendet den Layer >special_hilfs< aus/ein
;
;*************************************************************************
;
(defun c:DisplayHilfsgeo( / sliste_new)

   (princ "\n Hilfsgeometrie ein/aus...")
   (setvar "cmdecho" 0)	; Deaktiviere die Protokollierung von command...
  
   ; Die Funktion bearbeitet die übergebene Liste
   ; todo --> insert
   ; todo --> del
   (defun todo_liste (sliste todo element )

     	; >element< in der Liste >sliste< vorhanden ?
	(setq exist "false")	 
  	(setq ret (length sliste))
  	(while (not (zerop ret))
		(setq ret (1- ret))                
          	(setq elem (nth ret sliste))
	  	(if (= elem element)
		    (progn
			(setq exist "true")	 
		    )  
                )
	);endwhile	

     	; einfügen eines Elements
	(if (= todo "insert")
            (if (= exist "false")
                (progn
                    (setq sliste_new sliste)
	            (setq sliste_new (cons element sliste ))
		    (setq layerBlae sliste_new)
                )
            )
        )  

        ; löschen eines Elements
	(if (= todo "del")
            (if (= exist "true") 
		(progn
	            (setq ret (length sliste))
		    (while (not (zerop ret))
			   (setq ret (1- ret))                
		           (setq elem (nth ret sliste))
		    	   (if (/= elem  element)
			       (setq sliste_new (cons elem sliste_new ))
	                   )
	             )
	             (setq layerBlae sliste_new)
                 );endprogn
              );endif
        );endif  
   );endtodo_liste


  
   ; Prüfen ob die Funktion ausgeführt werden kann
   ; Bei Fehler Message mit Hinweis...
   (setq Prüfung "ok")

  (if (NOT(TBLSEARCH "layer" "SPECIAL_HILFS"))
	(setq Prüfung nil)  
  )	
  
  (if (= Prüfung nil)
      (progn
      (alert (strcat "Den Layer >SPECIAL_HILFS< gibt es in der "
  	             "\naktuellen Planung noch nicht."))
	      (setq Prüfung nil)
      )	
  )

   ; der Layer SPECIAL_HILFS darf nicht der aktuelle sein...
   (setq md_ist_lay (getvar "CLAYER"))

   (if (= md_ist_lay "SPECIAL_HILFS")
         (progn
           (alert (strcat "Der Layer >Special_Hilfs< ist derzeit "
		          "\nder aktuelle Layer und kann deshalb "
		          "\nnicht ausgeblendet werden."))
	   (setq Prüfung nil)
   	 )
   )  

   
  (if (/= Prüfung nil)
      (progn


	(setq ret (tblobjname "layer" "Special_Hilfs"))
	(setq layer (entget ret))
	(setq layer (entmod layer)) 

	; aus DXF-Code 70 info holen ob layer aus / ein
	(setq layer (cdr (assoc 70 layer)))

	(if (= layer 0)
            (progn
	  	(command "_layer" "FRieren" "Special_Hilfs" "")
          	(todo_liste layerBlae "del" "SPECIAL_HILFS" )
            )  
	)
	
	(if (/= layer 0)
	    (progn
	  	(command "_layer" "Tauen" "Special_Hilfs" "")
	        (command "_layer" "ein" "Special_Hilfs" "")
                (todo_liste layerBlae "insert" "SPECIAL_HILFS" )
	    )  
	)  
      )
  )  


;COUNTING ROUTINE
;******************************************************************************************************
(princ "\n Lade Funktion C:DisplayHilfsgeo... ")	; wir schreiben in die Befehlszeile
(setvar "cmdecho" 1)				; Aktiviere die Protokollierung von command...    
);endDisplayHilfsgeo





;*************************************************************************
;
; Die Funktion blendet nur den Layer >special_hilfs< ein
; Der Layer >insert< auf welchem alle COE-Oblekte  wird gefroren
;
;*************************************************************************
         
(defun c:DisplayHilfsgeoAfen()

   (princ "\n Hilfsgeometrie INSERT - Layer ein/aus...")
   (setvar "cmdecho" 0)	; Deaktiviere die Protokollierung von command...
  
   ; der Layer SPECIAL_HILFS darf nicht der aktuelle sein...
   (setq md_ist_lay (getvar "CLAYER"))

   (if (= md_ist_lay "SPECIAL_HILFS")
         (progn
           (alert (strcat "Um den Layer >Special_Hilfs< ein/aus zu blenden "
		          "\nwird der Layer >0< als aktueller Layer gesetzt."))
	   (command "_layer"  "Setzen" "0" "")
   	 )
   )  

   (setq ret (tblobjname "layer" "Special_Hilfs"))
   (setq layer (entget ret))
   (setq layer (entmod layer)) 

   ; aus DXF-Code 70 info holen ob layer aus / ein
   (setq layer (cdr (assoc 70 layer)))
  

   (if (= layer 0)
       (progn
           (command "_layer"  "FRieren" "Special_Hilfs" "")
  	   (command "aflayer" "FRieren" "Special_Hilfs" "" "" )
           (command "_layer"  "Tauen" "INSERT" "")
       )  
   )

   (if (/= layer 0)
       (progn
           (command "_layer"  "Tauen" "Special_Hilfs" "")
	   (command "_layer"  "Ein" "Special_Hilfs" "")
  	   (command "aflayer" "Tauen" "Special_Hilfs" "" "" )
      	   (command "_layer"  "FRieren" "INSERT" "")
       )  
   )
  
;COUNTING ROUTINE
;******************************************************************************************************
(princ "\n Lade Funktion C:DisplayHilfsgeoAfen... ")	; wir schreiben in die Befehlszeile
(setvar "cmdecho" 1)					; Aktiviere die Protokollierung von command...      
);end DisplayHilfsgeoAfen






;*************************************************************************
;
; Problem:
; - Beim Zoomen in AutoCAD werden alle sichtbaren UND gefrorenen Layer berücksichtigt.
;
; - Beim Befehl >ZOOM ALLES< sollen aber nur alle sichtbaren Elemente
;   berücksichtigt werden.
;
;*************************************************************************
(defun C:DisplayCOELayerOFF()

	(princ "\n Layer COE-Objekte ausblenden")

	(setvar "cmdecho" 0) ; Deaktiviere die Protokollierung von command...

  	(setq ret (tblobjname "layer" "EAGS_ENTSELMARKER"))
   	(setq layer (entget ret))
   	(setq layer (entmod layer)) 

	; den aktuellen Layer merken
	(setq md_ist_lay (getvar "CLAYER"))
	; Layer 0 aktuelle setzen	
	(command "_layer" "Setzen" "0" "")
  
	; Layer mit COE-Objekten ausblenden 
        (rule"c_Anzeige_allesAus")	      
  
	(if (= LayerNext "off")
	    (progn
	        ; Nur SPECIAL-Layer der aktiven Gruppe einblenden
	      	(todo_layer layerBlae "tauen" )
 	    )  
	)

  	
  	(if (/= LayerNext "off")
	    (progn
		; Alle SPECIAL-Layer einblenden
		(command "_layer" "Tauen" "Special_*" "" )
	        (rule"c_Anzeige_Special")	      
	    )  
	)  

	; Layer wieder setzen	
	(command "_layer" "Setzen" md_ist_lay "")
  	(command "_zoom" "g")

   	(if (= eags_status 2) (command "_layer" "tauen" "EAGS_ENTSELMARKER" "" ))
  
	(setvar "cmdecho" 1) ; Deaktiviere die Protokollierung von command...
 
);;End DisplayCOELayerOFF



(defun c:DisplayCOELayerON()

	(princ "\n Layer COE-Objekte ausblenden")

	(setvar "cmdecho" 0) ; Deaktiviere die Protokollierung von command...

	(setq ret (tblobjname "layer" "EAGS_ENTSELMARKER"))
   	(setq layer (entget ret))
   	(setq layer (entmod layer)) 
  
     	; aus DXF-Code 70 info holen ob layer aus / ein
	(setq eags_status (cdr (assoc 70 layer)))

	; Layer mit COE-Objekten ausblenden 
	(command "_layer" "Ein" "*_*" "" )
	(command "_layer" "tauen" "*_*" "" )

  	(if (= eags_status 3) (command "_layer" "frieren" "EAGS_ENTSELMARKER" "" ))

  	(setvar "cmdecho" 1)

)

;*************************************************************************
;
; Konstruktionshöhe aus einem vom Anwender gewählten 3DPunkt auslesen und
; der Variable >z_koor< zuweisen.
; Elemente wie Linien / Bögen usw. werden jetzt in der gesetzten Einfügehöhe
; plaziert. 
;			--> siehe coe_special_kitschen.lsp  Reaktor-Funktionen
;
;*************************************************************************

(defun C:ZHoehe(/ 3D_Point test)

	(setvar "cmdecho" 0)	; Deaktiviere die Protokollierung von command...

  	(setq bks_ZPos (caddr(trans '(0.0 0.0 0.0) 1 0 )))
	; wir holen uns die Z-Höhe
	(setq 3D_Point (getpoint "\nZ-Höhe für Nachfolgende Eingaben: "))
	(setq z_koor (caddr 3D_Point))
  	(setq z_koor (+ bks_ZPos z_koor))

  	(command "setvar" "USERS1" z_koor)
  
;COUNTING ROUTINE
;******************************************************************************************************
(princ "\n Lade Funktion C:ZHoehe... ")	; wir schreiben in die Befehlszeile
(setvar "cmdecho" 1)			; Aktiviere die Protokollierung von command...      
);endZHoehe