; Programm: 		ACM_Kennung.lsp
; Funktion: 		Tool 
; Autor: 	 		Silke Molch
; Lauffähig:		AutoCAD 2025[de] auf acadiso.dwt-Basis		
; Bezug:   			nur auf Tool-CD: 2025/04
; ========================================================================================================================================
(defun 		c:ACM_Kennung	; Aufruf
				( / )			(vl-load-com)
								(vl-cmdf "_UNDO" "b")	
								(setvar "frame" 0)
								;(vl-cmdf "_ucs" "w")	
	(setq 		xe  			; Aufruf Hauptroutine
								
								(vl-catch-all-apply 'f_algo '() )  )    	
								(if (vl-catch-all-error-p xe) 
									(progn (vl-cmdf "_UNDO" "r")
										(prompt (strcat "\n" (f_t) "-" (f_z)"\t : not ok >> " (vl-catch-all-error-message xe)))
									)
									(progn (vl-cmdf "_UNDO" "e")
										(setq tool_ xz)
										(f_xv_zuruecksetzen)
										(setvar "frame" 0)
										(prompt (strcat "\n" (f_t) "-" (f_z)"\t : ok "))
									)
								)
								(f_var_undef)
								(princ)	
)

; ============================    Tool-Voreinstellung
(defun		f_var_xz_init		; Toolzustand voreinstellen
				( / )			; (cadr (assoc '"lang" xz))
	(setq		xz				(list												; _____________________________________________________________
	
									'("1" "Vorsilbe_")								; Vorsilbe
									'("2" "_Nachsilbe")								; Nachsilbe
									'("3" "Ä;Ö;Ü;ä;ö;ü;ß; ;.;!;")					; zu ersetzen
									'("4" "Ae;Oe;Ue;ae;oe;ue;sz;;_;_;")				; ersetzen durch									
																					; _____________________________________________________________
									'("-1" "de")									; Sprache	
									'("-2" "nur_Zeichen")							; Auswahlmodi  	"mit_Vorsilbe" "mit_Nachsilbe" "mit_Vor-_und_Nachsilbe"
									'("-3" "Layer")									; Layermodi: 	"Block"
									'("-4" "0")		
									; _____________________________________________________________
									'("AListe" (1 2 3))								; A-Liste der DCL-Auswahlobjekte (Elementeauflistung A1 A2 ...)
									'("EListe" (1 2 3 4))							; E-Liste der DCL-Eingabeobjekte (Elementeauflistung E1 E2 ...)			
									'("tool" "ACM_Kennung ")						; Toolname
									'("logtofile" "off")							; Protokollierung 
									'("logtoscreen" "off")	
								)
	)
	(setq 		xp				(list "f_var_xm_init" '())			
				r				xz )		
)
(defun		f_var_xm_init		; Message-Begriffe definieren
				( / )			; (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '1 xm))))
			
	(setq		xm				(list
									'(1 ("de" "Tool-Einstellung")						("en" "Tool Setting"))
									'(2 ("de" "DCL-Datei konnte nicht erstellt werden!")("en" "Could not create .dcl file!"))
									'(3 ("de" "Verwerfen")								("en" "Discard"))
									'(4 ("de" "Originalwerte")							("en" "Original values"))
									'(5 ("de" "Hilfe")									("en" "Help"))
									'(6 ("de" "Ausführen")								("en" "Execute"))
									'(7 ("de" "Exit")									("en" "Exit"))
									'(8 ("de" "Speichern")								("en" "Save"))																		
									'("A1" 		("de" 	" Sprache :  ")					)
									'("A2" 		("de" 	" Ersetzungsmodus:  ")			)										
									'("A3" 		("de" 	" Objektmodus:  ")				)
									'("A4" 		("de" 	" neuer_Layer:  ")				)
									'("A5" 		("de" 	" Farbmodus:  ")				)	
									
									
									'("E1" 		("de" 	" Vorsilbe "				)	)
									'("E2" 		("de" 	" Nachsilbe "				)	)
									'("E3" 		("de" 	" zu ersetzende Zeichen getrennt durch ; "		)	)
									'("E4" 		("de" 	" Ersatzzeichen getrennt durch ; "				)	)
	
									'("m_1" ("de"   "\n\nBitte den Bezugspunkt eingeben: >> ")	
									)	
									'("m_2" ("de"   "\n\nBitte den Zeilenabstand bestimmen oder eingeben: >> ")	
									)	
									'("m_3" ("de"   "\n\nBitte den Objektabstand bestimmen oder eingeben: >> ")	
									)	
									'("m_4" ("de"   "\n\nBitte den Spaltenabstand bestimmen oder eingeben: >> ")	
									)	
									'("m_5" ("de"   "\n\nBitte den Bezugspunkt eingeben: >> ")	
									)
									'("m_6" ("de"   "\n\nBitte das Farbreferenzobjekt auswählen: >> ")	
									)	
									'("m_7" ("de"   "\n\nBitte die zu bearbeitenden Objekte auswählen: >> ")	
									)									
									'("m-1" ("de"  	"Es wurden keine Auflistungsdatei bzw. keine Dateiangaben gefunden! ")	
									)
									'("m-2" ("de"  	"\nEs wurde kein zulässiges Objekt gewählt! ")	
									)
									'("m-3" ("de"  	"\nEs wurde kein Punkt gewählt! ")	
									)	
									'("m-4" ("de"  	"\nEs wurden keine Objekte gewählt! ")	
									)
									'("m-5" ("de"  	"Das ausgewählte Objekt war kein Block! ")	
									)
									'("m-6" ("de"  	"Das Objekt hat keine Attribute! ")	
									)
									'("m-7" ("de"  	"Es wurde kein positiver Abstand angegeben! ")	
									)										
									'("e_lz" ("de"  "\nEs konnte keine DCL-Datei erstellt werden! ")	
									)											
								)
	)
	(setq 		xp				(list "f_var_xm_init" '())		
				r				xm )	
)
(defun		f_var_xh_init		; Help-Text definieren
				( / )
	(setq		xh				(list
									(list "de" (strcat

										"\nTool ACM_Kennung.lsp  "
										"\n"							
										"\n_________________________"
										"\tVoreinstellungen/Modi: \n"										
										"\nSprache:              \t\tdeutsch"	
										"\nErsetzungsmodus:          \t\t"	
										"\n  \t\t\tnur Zeichen"	
										"\n  \t\t\tmit_Vorsilbe"											
										"\n  \t\t\tmit_Nachsilbe"
										"\n  \t\t\tmit_Vor-_und_Nachsilbe"
										"\nLayermodus:          \t\t"	
										"\n  \t\t\tLayer"											
										"\n  \t\t\tBlock"											
										"\n_________________________"
										"\tEinstellungen:\n"
										"\nVorsilbe: \t\t\t..."
										"\nNachsilbe: \t\t..."										
										"\nzu ersetzende Zeichen getrennt durch ; \t..."	
										"\nErsatzzeichen getrennt durch ; \t\t..."	
										"\n"
										"\n_________________________"
										"\tButton:\n"
										"\nAusführen \t\tAktion ausführen"
										"\nSpeichern           \t\tSpeichern der voreingestellten Werte"
										"\nOriginalwerte \t\tZurücksetzen auf die Originalwerte"
										"\nVerwerfen \t\tZurücksetzen auf vorherige Einstellung"
										"\nHilfe \t\t\tAnzeige der Hilfe"
										"\nExit \t\t\tVerlassen des Tools"									
										
										"\n"
										"\n_________________________"										
										"\tInformation:\n"
										"\n"
"Mit diesem Tool kann man automatisch bestimmte Buchstaben durch andere Buchstaben oder Buchstabenkombinationen in einem Durchlauf ersetzen lassen. " 
"Dazu sind die zu ersetzenden Buchstaben einfach durch Semikolon getrennt aufzulisten. "
"Die Ersatzbuchstaben bzw. Buchstabenkombinationen sind in derselben Reihenfolge wie die zu ersetzenden Buchstaben ebenfalls durch Semikolon getrennt anzugeben. "
"Werden ausversehen zu wenige Ersatzzeichen eingegeben, werden die entsprechenden fehlenden Zeichen nicht ersetzt. "
"Zusätzlich können je nach Auswahl des Ersetzungsmodus den Layer- bzw. Blocknamen auch voreingestellte Vor- und/oder Nachsilben voran- bzw. nachgestellt werden. "
"Über den Objektmodus kann festgelegt werden, ob Layer oder Blocknamen ersetzt werden sollen. Die Layer werden auch umbenannt, wenn diese gefroren sind. "
"Mit dem Zurück-Befehl kann man die Toolaktionen rückgängig machen"
										"\n\nKontakt: \t\t\tIKT-Service@gmx.de"

									))
									(list "en" (strcat
										"\nTool "
										"\n"	
										
										"\n"
										"\nButton:"
										"\n"
										"\nExecute \t\tExecute"
										"\nSave    \tSave the value"
										"\nOriginal value \tZurücksetzen auf die Originalwerte / Goldener Schnitt"
										"\nVerwerfen \tReturn to the original values"
										"\nHelp\t\tShow the help"
										"\n...  \t\tShowing the help"
										"\nExit \t\tClose the tool"
										"\n"
										"\nContakt: \t\tIKT-Service@gmx.de"
									))
								)
	)
	(setq 		xp				(list "f_var_xh_init" '())		
				r				xh )		
)
; ============================    Tool-Algorithmus
(defun		f_algo				; Allgemeiner Ablauf
				( / )			
								(setq return nil)
								(if (equal '(t t) 																						; Laufbedingung
										(list 
											(>= (atof(substr (getvar "acadver") 1 4)) 23.0)
											(<= (atof(substr (getvar "acadver") 1 4)) 25.0)
										)
									)
									(progn
										(f_var_def)(f_var_xs_init)
										
										(if (not (equal tool_ nil))																				; letzte Einstellung			
											(setq xz tool_)
											(f_var_xz_init)
										)
										
										(f (f_var_xm_init))(f (f_var_xh_init))
												
										(f (f_xv_def))(f (f_xv_sichern))(f (f_xv_setzen))

												
										(f (f_DCL_erstellen))(f (f_DCL_laden))
											
										(if (equal r t)
											(f (f_action))
										)
																						

									)
									(alert "Diese AutoCAD-Version wird nicht unterstützt!\nThis version of AutoCAD is not supported!\n\nService: IKT-Service@gmx.de")
								)
	(setq 		xp				(list "f_algo" '())								
				r				"OK" )							
)
(defun		f_action			; Toolablauf
			( / 
				x1 
				x2 				; Symbolliste
				x3
				x4
				x5
				x6
				x7				; Ersetzungsliste
				x8				; Ersatzliste
				x9
				x10
				x11
			)
								(setq x2 '())
								(setq x1 (tblnext (cadr (assoc "-3" xz)) T))							
								(if (not (equal x1 nil))
									(progn
										(while (not (equal x1 nil))
											(setq x2 (cons (cdr (assoc '2 x1)) x2))
											(setq x1 (tblnext (cadr (assoc "-3" xz))))
										)
										(setq x2 (reverse x2))
									)
								)
								(if (not (equal x2 nil))
									(progn
										(setq x3 0 )
										(setq x7 (f_str_to_list (cadr (assoc '"3" xz)) ";"))  	; Ersetzungsliste
										(setq x8 (f_str_to_list (cadr (assoc '"4" xz)) ";"))  	; Ersatzliste
										(while (< x3 (length x2))
											(setq x4 (nth x3 x2))								; nte Name
											;
											(setq x5 0 x9 "")
											(while (< x5 (strlen x4))
												(setq x6 (substr x4 (+ x5 1) 1)) 				; Buchstabe
												(if (member x6 x7)
													(progn
														(setq x10 (vl-position x6 x7))
														(if (< x10 (length x8))
															(progn
																(setq x11 (nth x10 x8))
															)
															(progn
																(setq x11 x6)
															)															
														)
														(setq x9 (strcat x9 x11))
													)
													(progn
														(setq x9 (strcat x9 x6))
													)
												)
												(setq x5 (+ 1 x5))
											)
											;
											(cond
												((equal (cadr (assoc "-2" xz)) "mit_Vorsilbe")
													(setq x9 (strcat (cadr (assoc "1" xz)) x9))
												)
												((equal (cadr (assoc "-2" xz)) "mit_Nachsilbe")
													(setq x9 (strcat x9 (cadr (assoc "2" xz)) ))
												)
												((equal (cadr (assoc "-2" xz)) "mit_Vor-_und_Nachsilbe")
													(setq x9 (strcat (cadr (assoc "1" xz)) x9 (cadr (assoc "2" xz))))
												)												
											)	
											(terpri)(princ "umbenannt von  ")(princ x4)(princ "  in  ")(princ x9)
											(cond
												((equal (cadr (assoc "-3" xz)) "Layer")
													(if (not (equal x4 "0"))
														(progn
															(vl-catch-all-apply (function (lambda nil 
																(vl-cmdf "-umbenenn" "LA" x4 x9)
															)))
														)
													)
												)
												((equal (cadr (assoc "-3" xz)) "Block")
													(vl-catch-all-apply (function (lambda nil 
														(vl-cmdf "-umbenenn" "BL" x4 x9)
													)))
												)												
											)
											;
											
											(setq x3 (+ x3 1))
										)
									)
								)	
								(terpri)(princ "")
)
(defun		f_str_to_list		; String split in Liste mittels Trennzeichnen
			(x1 				; String
			x2					; Trennzeichnen
			/ x1 x2 x3 x4 x5 x6)
								(setq x3 0 x5 '() x6 "")
								(while (< x3 (strlen x1))
									(setq x4 (substr x1 (+ 1 x3) 1))
									(if (not (equal x4 ";"))
										(progn
											(setq x6 (strcat x6 x4))
										)
										(progn
											(setq x5 (cons x6 x5))
											(setq x6 "")
										)
									)
									(setq x3 (+ x3 1))
								)
								(setq return (reverse x5))
)
(defun 		f_hsl_to_rgb  		; HSL to RGB 
			(x1 x2 x3 / x1 x2 x3 x4 x5)
								(setq x1 (/ x1 360.0)
									  x2 (/ x2 100.0)
									  x3 (/ x3 100.0)
								)
								(mapcar '(lambda ( x ) (fix (+ 0.5 (* 255 x))))
									(cond
										(   (zerop x2) (list x3 x3 x3))
										(   (zerop x3)'(0 0 0))
										(   (setq x5 (if (< x3 0.5) (* x3 (1+ x2)) (- (+ x3 x2) (* x3 x2)))
												  x4 (-  (* 2.0 x3) x5)
											)
											(mapcar
											   '(lambda ( x1 )
													(setq x1 (rem (1+ x1) 1))
													(cond
														(   (< (* 6.0 x1) 1.0) (+ x4 (* 6.0 x1 (- x5 x4))))
														(   (< (* 2.0 x1) 1.0) x5)
														(   (< (* 3.0 x1) 2.0) (+ x4 (* 6.0 (- (/ 2.0 3.0) x1) (- x5 x4))))
														(   x4   )
													)
												)
												(list (+ x1 (/ 1.0 3.0)) x1 (- x1 (/ 1.0 3.0)))
											)
										)
									)
								)
)
(defun 		f_rgbz_to_rgb		; RGBZ to RGB
			( x1 / x1 )
			(mapcar '(lambda ( x ) (lsh (lsh (fix x1) x) -24)) '(8 16 24))
)
(defun		f_rgb_to_hsl		; RGB to HSL
			(x1 x2 x3 / 	; r g b
			x1 x2 x3 	x4 x5 x6 x7 x8 x9 ) 
									(setq x1 (/ x1 255.0)
										  x2 (/ x2 255.0)
										  x3  (/ x3  255.0)
										  x8 (min x1 x2 x3 )
										  x7 (max x1 x2 x3 )
									)
									(if (zerop (setq x4 (- x7 x8)))
										(list 0 0 (fix (+ 0.5 (* x7 100))))
										(progn
											(if (< (setq x6 (/ (+ x7 x8) 2.0)) 0.5)
												(setq x9 (/ x4 (+ x7 x8)))
												(setq x9 (/ x4 (- 2.0 x7 x8)))
											)
											(cond
												(   (= x2 x7) (setq x5 (+ (/ (- x3  x1) x4) 2)))
												(   (= x3 x7) (setq x5 (+ (/ (- x1 x2) x4) 4)))
												(   (setq x5 (/ (- x2 x3 ) x4)))
											)
											(list
												(fix (+ 0.5 (rem (+ 360 (* x5 60)) 360)))
												(fix (+ 0.5 (* x9 100)))
												(fix (+ 0.5 (* x6 100)))
											)
										)
									)
)
(defun 		f_rgb_z 			; RGB to RGBZ
			( x1 / x1 )
									(logior (lsh (fix (nth 0 x1)) 16) (lsh (fix (nth 1 x1)) 8) (fix (nth 2 x1)))
)
(defun 		f_aci_to_rgb		; RGB TO ACI 	
			(x1 / x1 x2 x3)
								  (cond
									( (or(> x1 255)(< x1 1))nil)
									( (> 7 x1 0)(f_aci_to_rgb(+ 10(* 40(1- x1)))))
									( (> 250 x1 9)
									  (setq x2
									   '(0 1 2 3 4 4 4 4 4 4 4 4 4 3 2 1 0 0 0 0 0 0 0 0)
									  )
									  (setq x3 '(1 0.65 0.5 0.3 0.15))
									  (mapcar
									   '(lambda(v w / )
										  (fix
											(* 255
											  (+
												(*
												  0.25
												  (nth(rem(+(1-(/ x1 10))v)24)x2)
												  (nth(/(rem x1 10)2)x3)
												)
												(*
												  (rem x1 2)
												  0.125
												  (nth(rem(+(1-(/ x1 10))w)24)x2)
												  (nth(/(rem x1 10)2) x3)
												)
											  )
											)
										  )
										)
									   '(8 0 16)
									   '(20 12 4)
									  )
									)
									(1
									  (apply
									   '(lambda(v w / )(list w w w))
										(assoc x1
										  '((7 255)(8 128)(9 192)(250 84)(251 118)(252 152)
															  (253 186)(254 220)(255 255)))
									  )
									)
								  )
)
(defun		f_file_read			; Datei lesen
			(  / x1	x2 x3 )
								(setq x1 (getfiled "XREF-Dateiliste auswählen" "x:\\\Test\\" "txt" 4 ))
								(setq x4 '())
								(if (equal x1 nil)
									(progn
										(setq x4 nil)
									)
									(progn
										(setq x1 (findfile x1))
										(if (not (equal x1 nil))
											(progn
												(setq x2 (open x1 "r"))
												(setq x3 (read-line x2))
												(while x3
													(if (findfile x3)
														(progn
															(setq x4 (cons x3 x4))
														)
													)
													(setq x3 (read-line x2))
												)
												(close x2)
											)
										)
									)
								)
								(setq return (reverse x4))
								(terpri)
)
(defun		f_tol				; Zufallszahl
			(x1 x2 x3 x4 x10	; von bis Koordinatenzahl Objektnr Faktor
			/ x1 x2	x3 	x4 
			x5 x6 x7 x8 x9 x10
			)
								(setq x5 (- x2 x1))		; Spanne
								(setq x6 (list
											(atoi (substr (f_tolstring (rtos (nth 0 x3) 2 8)) 1 2))
											(atoi (substr (f_tolstring (rtos (nth 1 x3) 2 8)) 1 2))
											(atoi (substr (f_tolstring (rtos (getvar "MILLISECS") 2 8)) 1 2))
											(atoi (substr (f_tolstring (vl-prin1-to-string x4)) 1 2))
											(* (atoi (substr (f_tolstring (rtos (getvar "MILLISECS") 2 8)) 1 2)) x10)
										)
								)
								(setq x7 (apply '+ x6))
								(setq x8 (atoi (substr (f_tolstring (rtos x7 2 0)) 1 2)))
								(setq x9 (atof (rtos (+ (/ (* x5 x8) 100.0) x1) 2 8)))
								;
								(setq return x9)
)

(defun		f_tolstring			; String in String mit Elimenieren von Punkten, Kommas etc.
			(x1 / x1 x2 x3 x4)
								(setq x2 0 x3 "1234")
								(while (< x2 (strlen x1))
									(setq x4 (substr x1 (+ 1 x2) 1))
									(if (member x4 '( "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
										(progn
											(setq x3 (strcat x4 x3))
										)
									)
									(setq x2 (+ x2 1))
								)
								(setq return x3)
)	
(defun		f_ssfiltern			; Filtern der Objektauswahl nach assoc-Filterwerten
			( x1 / x1 x2 x3)	; Auswahlsatz assco Filterwert
								(setq x2 (nth 0 x1))
								(setq x0 0 )
								(setq x3 (ssadd))
								(while (< x0 (sslength x2))
									(if (equal 
											(cdr (assoc (nth 1 x1)(entget (ssname  (nth 0 x1) x0))))
											(nth 2 x1)
										)
										(progn
											(setq x3 (ssadd (ssname  (nth 0 x1) x0) x3))
										)
									)
									(setq x0 (+ x0 1))
								)
								(setq x3 x3)
)
(defun		f_xz_setzen			; xz setzen
			( x1 x2 / x1 x2 x3 x4)	; assco neuerWert
								(setq x3 0 x4 '())
								;(princ "\nListe vorher")(princ xz)
								(while (< x3 (length xz))
									(if (equal (nth 0 (nth x3 xz)) x1)
										(progn
											(setq x4 (cons (list x1 x2)	x4))
										)
										(progn
											(setq x4 (cons (nth x3 xz) x4))
										)
									)
									(setq x3 (+ x3 1))
								)
								(setq xz (reverse x4))
								;(princ "\nListe nachher")(princ xz)
								(terpri)
)
(defun 		f_split				; String zu Liste durch Trennzeichen
			( x1 x2 
			/ x3 x4 x5 )
								(setq x3 (1+ (strlen x2)))
								(while (setq x5 (vl-string-search x2 x1))
									(setq x4 (cons (substr x1 1 x5) x4)
										  x1 (substr x1 (+ x5 x3))
									)
								)
								(reverse (cons x1 x4))
)
(defun		f_zahl_zahlohnekomma	; Zahl in Zahl ohne Komma 
			(x1
			/ x1 x2)
								(setq x2
									(atoi
										(strcat
											(substr (rtos x1 2) 1 	(+ (strlen (rtos (fix x1) 2)) 0))
											(substr (rtos x1 2)		(+ (strlen (rtos (fix x1) 2)) 2))	
										)
									)
								)
			(setq r	x2	)			
)	
(defun		f_delta				; Differenzliste L1 > L2 => Rest L3
			( x1 				; Liste 1 neu nacher
			x2 					; Liste 2 alt vorher
			/ x1 x2 x3 x4)
								(if (and (not (equal x1 nil))(not (equal x2 nil)))
									(progn
										(setq x3 x1)
										(setq x4 0)
										
										(while (< x4 (sslength x2))
											(if (ssmemb (ssname x2 x4) x1)
												(progn
													(ssdel (ssname x2 x4) x3)
												)
											)
											(setq x4 (+ x4 1))
										)
									)
								)
								(setq r	x3)			
)
(defun		f_slistdelta		; Differenzliste L2 - L1 => Rest L2
			( x1 				; Liste 1 alt
			x2 					; Liste 2 neu
			/ x1 x2 x3 x4)
								(if (and (not (equal x1 nil))(not (equal x2 nil)))
									(progn
										(setq x3 x2 x4 0)
										(while (< x4 (sslength x1))
											(if (ssmemb (ssname x1 x4) x2)
												(progn
													(ssdel (ssname x1 x4) x3)
												)
											)
											(setq x4 (+ x4 1))
										)
									)
								)
	(setq 		xp				(list "f_slistdelta" (list x1 x2))
				r				x3)			
)																											
; ============================    DCL-Routinen
(defun		f_DCL_erstellen		; DCL_erstellen
				( / x1 x2)		
	(setq 		x2 			(open (cadr (assoc '"dcl" xs)) "w"))
							(if (/= x2 nil)
								(progn
									(setq x1
										(strcat 
											"//tool.dcl"
											"\ntool : dialog{"
												"\n						label = "	(chr 34) (f (f_xm 1)) (chr 34)	";"														
												"\n:boxed_row{"

													"\n:column{"			
														"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A1" xm))))	(chr 34) ";}"
														"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A2" xm))))	(chr 34) ";}"
														"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A3" xm))))	(chr 34) ";}"																
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A4" xm))))	(chr 34) ";}"	
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A5" xm))))	(chr 34) ";}"														
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A6" xm))))	(chr 34) ";}"															
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A7" xm))))	(chr 34) ";}"	
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"A8" xm))))	(chr 34) ";}"														
													"\n}"	
													"\n:column{"
														"\n:popup_list 	{ key=" 	(chr 34) "A1" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"		
														"\n:popup_list 	{ key=" 	(chr 34) "A2" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"		
														"\n:popup_list 	{ key=" 	(chr 34) "A3" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"		
														;"\n:popup_list 	{ key=" 	(chr 34) "A4" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"															
														;"\n:popup_list 	{ key=" 	(chr 34) "A5" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"
														;"\n:popup_list 	{ key=" 	(chr 34) "A6" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"														
														;"\n:popup_list 	{ key=" 	(chr 34) "A7" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"														
														;"\n:popup_list 	{ key=" 	(chr 34) "A8" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=29; }"																
													"\n}"													
												"\n}"	
										)
									)
									(princ x1 x2)
									(setq x1
										(strcat
												"\n:boxed_row{"											
													"\n:column{"	
														"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E1" xm))))	(chr 34) ";}"													
														"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E2" xm))))	(chr 34) ";}"																
														"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E3" xm))))	(chr 34) ";}"																											
														"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E4" xm))))	(chr 34) ";}"		
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E5" xm))))	(chr 34) ";}"		
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E6" xm))))	(chr 34) ";}"		
														; "\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E7" xm))))	(chr 34) ";}"		
														; "\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E8" xm))))	(chr 34) ";}"		
														; "\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E9" xm))))	(chr 34) ";}"		
														; ;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E10" xm))))	(chr 34) ";}"		
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E11" xm))))	(chr 34) ";}"		
														;"\n:text		{ label="  	(chr 34) (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc '"E12" xm))))	(chr 34) ";}"																
													"\n}"
													"\n:column{"	
														"\n:edit_box	{ key=" 	(chr 34) "E1" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"	
														"\n:edit_box	{ key=" 	(chr 34) "E2" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"														
														"\n:edit_box	{ key=" 	(chr 34) "E3" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"
														"\n:edit_box	{ key=" 	(chr 34) "E4" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"	
														;"\n:edit_box	{ key=" 	(chr 34) "E5" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"	
														;"\n:edit_box	{ key=" 	(chr 34) "E6" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"																
														; "\n:edit_box	{ key=" 	(chr 34) "E7" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"	
														; "\n:edit_box	{ key=" 	(chr 34) "E8" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"			
														; "\n:edit_box	{ key=" 	(chr 34) "E9" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"																
														; ;"\n:edit_box	{ key=" 	(chr 34) "E10" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"	
														;"\n:edit_box	{ key=" 	(chr 34) "E11" (chr 34) "; label = " (chr 34) " " (chr 34) "; edit_width=30; }"	
													"\n}"													

												"\n}"	
												"\n:boxed_row{"
														"\n:button			{ key=" (chr 34) "A" (chr 34) "; label = " (chr 34) (f (f_xm 6)) (chr 34) "; is_default = true; }"
														"\n:button			{ key=" (chr 34) "S" (chr 34) "; label = " (chr 34) (f (f_xm 8)) (chr 34) "; is_default = true; }"	
														"\n:button			{ key=" (chr 34) "O" (chr 34) "; label = " (chr 34) (f (f_xm 4)) (chr 34) "; is_default = true; }"												
														"\n:button			{ key=" (chr 34) "C" (chr 34) "; label = " (chr 34) (f (f_xm 3)) (chr 34) "; is_default = true; }"
														"\n:button			{ key=" (chr 34) "H" (chr 34) "; label = " (chr 34) (f (f_xm 5)) (chr 34) "; is_default = true; }"
														"\n:button			{ key=" (chr 34) "E" (chr 34) "; label = " (chr 34) (f (f_xm 7)) (chr 34) "; is_default = true; }"	
												"\n}"																
											"\n}"
										)						
									)
									(princ x1 x2)
									(close x2)
								)
								(alert (cadr (assoc '"de" (cdr (assoc '"e_lz" xm))))) 
							)
	(setq 		xp			(list "f_DCL_erstellen" '())
				r			"ok")
)
(defun		f_DCL_laden			; DCL_laden
				( / x1 x2)		
	(setq 		x1 				(load_dialog (cadr (assoc '"dcl" xs)))
				r				nil
	)
								(if (not (new_dialog "tool" x1))
									(alert (f (f_xm 2)))
									(progn
										(action_tile "A" "(f (f_DCL_Uebernehmen))(setq r t)(done_dialog 6)")
										(action_tile "O" "(f (f_var_xz_init))(f (f_DCL_A_Wert_init))")
										(action_tile "H" "(f (f_help))")
										(action_tile "C" "(f (f_DCL_A_Wert_init))")
										(action_tile "E" "(setq r nil)(done_dialog 6)")
										(action_tile "S" "(f (f_DCL_Uebernehmen))")
										
										(action_tile "B1" "(f_ordner)")										
											
										(foreach x1 (cadr (assoc '"EListe" xz))	
											(action_tile (strcat "S" (rtos x1 2)) "(f (f_help))")
										)
										(foreach x1 (cadr (assoc '"AListe" xz))	
											(action_tile (strcat "S-" (rtos x1 2)) "(f (f_help))")
										)										
											
										(f (f_DCL_Liste_def))
										(f (f_DCL_Auflisten))	
										(f (f_DCL_A_Wert_init))
										(f (f_DCL_Pruefen))
										
										(start_dialog)
										(unload_dialog x1)
									)
								)
	(setq 		xp				(list "f_DCL_laden" '())
				r				r
	)							
)
(defun 		f_DCL_Liste_def		; DCL-Listen definieren
				( / x1 x2 x3 x4 x5 x6)

								(setq x1 (tblnext "layer" "T"))
								(setq x2 '())
								(while (not (equal x1 nil))	(setq x2 (cons (cdr (assoc '2 x1)) x2))	(setq x1 (tblnext "layer")) )
								
								(setq x1 (tblnext "style" "T"))
								(setq x3 '("Standard"))
								(while (not (equal x1 nil))	(setq x3 (cons (cdr (assoc '2 x1)) x3))	(setq x1 (tblnext "style")) )	
								
								(setq x1 (tblnext "block" "T"))
								(if (equal x1 nil)
									(progn (setq x4 '("")))
									(progn
										(while (not (equal x1 nil))	(setq x4 (cons (cdr (assoc '2 x1)) x4))	(setq x1 (tblnext "block")) )	
									)
								)
								
								(setq x1 (tblnext "ucs" "T"))
								(if (equal x1 nil)
									(progn
										(setq x5 (list " "))
									)
									(progn 
										(while (not (equal x1 nil))	(setq x5 (cons (cdr (assoc '2 x1)) x5))	(setq x1 (tblnext "ucs")) )	
									)
								)
								(setq x1 (tblnext "view" "T"))
								(if (equal x1 nil)
									(progn (setq x6 '("")))
									(progn
										(while (not (equal x1 nil))	(setq x6 (cons (strcase (cdr (assoc '2 x1))) x6))	(setq x1 (tblnext "view")) )
										(setq x6 (vl-sort x6 '<))										
									)
								)								
	(setq 		xl 				(list 
									(list " ")
									(list "de")
									(list "nur_Zeichen" "mit_Vorsilbe" "mit_Nachsilbe" "mit_Vor-_und_Nachsilbe")
									(list "Layer" "Block")
									x2
									(list "Farbe_original" "Farbe_neu")
								)													
	)
	(setq 		xp				(list "f_DCL_Liste_def" '())	
				r				"ok")	
)
(defun 		f_DCL_A_Wert_init	; DCL-Auswahlfeldlistenvorgabewert voreinstellen
				( / )							
								(foreach x1 (cadr (assoc '"EListe" xz))				 	
									(set_tile (strcat "E" (rtos x1 2)) 	(cadr (assoc (rtos x1 2) xz)))
								)
								(foreach x1 (cadr (assoc '"AListe" xz))				 	
									(set_tile (strcat "A" (rtos x1 2))
										(rtos (- (length (nth x1 xl))(length (member (cadr (assoc (strcat "-" (rtos x1 2)) xz))(nth x1 xl)))) 2))
								)
	(setq 		xp				(list "f_DCL_A_Wert_init" '())								
				r				"ok")							
)

(defun 		f_DCL_Auflisten		; DCL-Auflisten AlISTE
				( / )
									(foreach x1 (cadr (assoc '"AListe" xz)) 
										(start_list (strcat "A" (rtos x1 2)))
										(mapcar 'add_list (nth x1 xl))
										(end_list)
									)						
	(setq 		xp				(list "f_DCL_Auflisten" '())									
				r				"ok")	
)
(defun		f_DCL_Pruefen		; DCL-Pruefaufruf für Eingabefelder E1 ... Ex
				( / x1)			(if (> (length (cadr (assoc '"EListe" xz))) 0)
									(progn
										(foreach x1 (cadr (assoc '"EListe" xz))				 	
											(action_tile (strcat "E" (rtos x1 2)) 	
												(strcat "(f (f_DCL_Regeltest $value $reason " (rtos x1 2)  "))") 
											)
										)
									)
								)
	(setq 		xp				(list "f_DCL_Pruefen" '()))									
	(setq 		r				"ok")								
)
(defun 		f_DCL_Regeltest		; Regeltest
				( x1 			; E-Wert string value
				x2 x3 /
				x1 x2 x3 )		
								(cond	
									((and (member x3 '(3 4))(equal x1 ""))							; nicht leer
										(alert "Wert darf nicht leer sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)									
									((and (member x3 '(0))	(not (wcmatch x1 "~*[~-.0-9]*")))	; nur Dezimalzahlen
										(alert "Wert muss eine Dezimalzahl sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)
									((and (member x3 '(0))	(not (wcmatch x1 "~*[~;.0-9]*")))	; nur Zahlen Punkte Semikolon
										(alert "Es dürfen nur Zahl 0 bis 9 Dezimalpunkt und Semikolon verwendet werden!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)
									((and (member x3 '(0))	(= (atof x1) 0.0))								; <> 0
										(alert "Wert muss ungleich Null sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)										
									((and (member x3 '(0))	(not (> (atof x1) 0.0)))						; > 0
										(alert "Wert muss größer Null sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)	
									((and (member x3 '(0))	(not (>= (atof x1) 0.0)))						; >= 0
										(alert "Wert muss größer gleich Null sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)	
									((and (member x3 '(0))	(not (< (atof x1) 0.0)))						; < 0
										(alert "Wert muss kleiner Null sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)		
									((and (member x3 '(0))	(not (> (atof x1) 1.0)))						; > 1
										(alert "Wert muss größer Eins sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)	
									((and (member x3 '(0))	(not (>= (atof x1) 1.0)))						; >= 1
										(alert "Wert muss größer gleich Eins sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)
									((and (member x3 '(0))	(not (<= (atof x1) 255)))			; <= 255
										(alert "Wert muss kleiner gleich 255 sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)									
									((and (member x3 '(0))	(not (and									; 0 <= ... <= 90
																		(<= (atof x1) 90.0)
																		(>= (atof x1) 0.0)
																	)))							
										(alert "Wert muss zwischen 0  und <= 90 liegen!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)
									((and (member x3 '(0))	(not (and								;  -360 ...  360
																		(>= (atof x1) -360)
																		(<= (atof x1) 360)
																	)))							
										(alert "Wert muss zwischen >= -360 und 360 liegen!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)
									((and (member x3 '(0))	(not (and								;  -255 ...  255
																		(>= (atof x1) -255 )
																		(<= (atof x1) 255 )
																	)))							
										(alert "Wert muss zwischen >= -255 und 255 liegen!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)									
									((and (member x3 '(0))	(not (and						;  -100 ...  100
																		(>= (atof x1) -100 )
																		(<= (atof x1) 100 )
																	)))							
										(alert "Wert muss zwischen >= -100 und 100 liegen!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)										
									((and (member x3 '(0 ))	(not (<= (atof x1) 360)))			; <= 360
										(alert "Wert muss <= 360 sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)	
									((and (member x3 '(0 ))	(not (wcmatch x1 "~*[~+-][~0-9]*")))		; nur ganze Zahlen
										(alert "Wert muss eine ganze Zahl sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)	
									((and (member x3 '(0))	(not (wcmatch x1 "~*[~>=]*")))		; nur bestimmte Zeichen
										(alert "Wert muss > oder >= sein!")
										(set_tile (strcat "E" (rtos x3 2)) (cadr (assoc (rtos x3 2) xz)))	
									)
								)
	(setq 		xp				(list "f_DCL_Regeltest" (list x1 x2 x3))								
				r				"ok")		
)
(defun		f_DCL_Uebernehmen	; DCL-Werte übernehmen/speichern
				( / )
								(foreach x1 (cadr (assoc '"EListe" xz))				 	
									(setq xz	
										(subst (list (rtos x1 2) (get_tile (strcat "E" (rtos x1 2))))(assoc (rtos x1 2) xz) xz)
									)
								)
								(foreach x1 (cadr (assoc '"AListe" xz))				 	
									(setq xz
										(subst 	
										(list (strcat "-" (rtos x1 2)) (nth (atoi (get_tile (strcat "A" (rtos x1 2)))) (nth x1 xl)))
										(assoc (strcat "-" (rtos x1 2)) xz) 
										xz )
									)
								)								
	(setq 		xp				(list "f_DCL_Uebernehmen" '())								
				r				xz)								
)

; ============================ 	  Sytem-Konfiguration
(defun		f_var_xs_init		; Systemeinstellung festlegen
				( / )
	(setq 		xp				(list "f_xvar_xs_init" '()))					
	(setq		xs				(list
									(list "dcl" (strcat (getvar "TEMPPREFIX") "tool.dcl"))
									(list "log" (strcat (getvar "TEMPPREFIX") "tool.log"))
									(list "help" (strcat (getvar "TEMPPREFIX") "help.html"))										
								)
	)
	(setq		r				xs )			
)
(defun 		f_xv_def			; AutoCAD-Umgebungsvariablen-Werte
				(  / )
	(setq 		xp				(list "f_xv_def" '()))				
	(setq 		xv 				(list
									'("CMDECHO" 0)	
									'("CMDDIA" 0)
									'("FILEDIA" 0)	
									'("3DOSMODE" 0)									
									'("OSMODE" 0)	
									'("OSNAPCOORD" 2)
									'("OSNAPOVERRIDE" 0)
									'("OSNAPZ" 0)										
									;'("CLAYER" nil)	
									'("DYNMODE" 0)	
									'("COPYMODE" 1)		
									'("DELOBJ" 0)	
									'("INSUNITS" 6)	
									'("INSUNITSDEFSOURCE" 6)								
									'("INSUNITSDEFTARGET" 6)
									'("BLOCKEDITLOCK" 0)
									'("PEDITACCEPT" 1)
									'("AFLAGS" 4)	
									'("LAYERDLGMODE" 0)
									'("DIMTZIN" 8)
									'("DIMZIN" 8)
									'("CECOLOR" "vonlayer")	
									'("PLINETYPE" 2)
									'("HPASSOC" 1)	
									'("ANGBASE" 0.0)
									'("ANGDIR" 0)
									'("TILEMODE" 1)
									'("SMOOTHMESHCONVERT" 3)
									'("SURFACEMODELINGMODE" 0)
									'("PLINETYPE" 2)
									'("PDMODE" 32)
									'("FRAME" 0)
									'("EXPERT" 3)
								)
	)
	(setq 		r				xv)	
)
; ============================ 	  Funktionen
(defun		f_help				; Helpfile erstellen
				( / x1)

								(alert (cadr (assoc (cadr (assoc "-1" xz)) xh)))
	(setq 		xp				(list "f_help" '())
				r				"ok")									
							
)
(defun		f_fw				; File schreiben
				( 	x1 			; Dateipfad+Dateiname
					x2 			; zu schreibender Inhalt
				/ 	x3 x4)
	(setq 		x3 				(open x1 "w"))	
								(if (not (equal x3 nil))
									(progn	(princ x2 x3)(close x3) (setq x4 "ok"))
									(progn (setq x4 (cadr (assoc (cadr (assoc "-1" xz)) (cdr (assoc "e_fw" xm))))))
								)
	(setq 		xp				(list "f_fw" (list x1 x2))								
				r				x4)							
)
(defun 		f_xv_sichern		; AutoCAD-Umgebungsvariablen sichern
				( / x1 x2)
	(setq 		xp				(list "f_xv_sichern" '()))				
								(setq x1 0 xv_alt '())
								(while (< x1 (length xv))
									(setq x2 (getvar (car (nth x1 xv))))
									(setq xv_alt (cons (list (car (nth x1 xv)) x2) xv_alt))
									(setq x1 (+ x1 1))
								)
	(setq 		xv_alt 			(reverse xv_alt))
	(setq		r				xv_alt )		
)
(defun 		f_xv_setzen			; AutoCAD-Umgebungsvariablen setzen
			( / x1 x2)
	(setq 		xp				(list "f_xv_setzen" '()))				
								(setq x1 0)
								(while (< x1 (length xv))
									(if (not (equal (cadr (nth x1 xv)) nil))
										(setq x2 (setvar (car (nth x1 xv))(cadr (nth x1 xv))))
									)
									(setq x1 (+ x1 1))
								)
	(setq		r				"ok")								
)
(defun 		f_xv_zuruecksetzen	; AutoCAD-Umgebungsvariablen zurücksetzen
			( / x1 x2)
	(setq 		xp				(list "f_xv_zuruecksetzen" '()))			
								(setq x1 0)
								(while (< x1 (length xv_alt))
									(if (not (equal (cadr (nth x1 xv_alt)) nil))
										(setq x2 (setvar (car (nth x1 xv_alt))(cadr (nth x1 xv_alt))))
									)
									(setq x1 (+ x1 1))
								)
	(setq		r				"ok")								
)
(defun		f_xm				; Mitteilungswert lesen
				(x1	/ x1)		; Kategorie	
			(setq 		xp				(list "f_xm" (list x1)))
			(setq		r				(cadr (assoc (cadr (assoc '"-1" xz)) (cdr (assoc x1 xm)))))						
)
(defun		f_test				; Testfunktion
				( / )
	(setq 		xp			(list "f_test" '()))	
	(setq		r			"Testresults")
)
(defun		f_var_def			; Variablen global 	definieren
				( / )
	(setq		r				nil			; Return
				xe				nil			; Error	
				xp				'()			; Funktionsparameter
				xs				'()			; Systemeinstellung
				xz				'()			; Systemzustand
				xm				'()			; Mitteilung
				xh				'()			; Help-HTML
				xf				'()			; Fehlerinhalt
				xv				'()			; AutoCAD-Variablenliste	
				xv_alt			'()			; AutoCAD-Variablenliste_vorherige Werte
				xl				'()			; DCL-Listenvariable				
	)
	(setq 		xp				(list "f_var_def" '()))
	(setq		r				"ok")	
)
(defun		f_var_undef			; Variablen global 	freigeben
				( / )
	(setq		r				nil			; Return
				xe				nil			; Error
				xp				nil			; Funktionsparameter
				xs				nil			; Systemeinstellung
				xz				nil			; Systemzustand
				xm				nil			; Mitteilung
				xh				'()			; Help-HTML
				xf				nil			; Fehlerinhalt	
				xv				nil			; AutoCAD-Variablenliste
				xv_alt			'()			; AutoCAD-Variablenliste_vorherige Werte		
				xl				'()			; DCL-Listenvariable				
	)
)
(defun		f					; Log-Aufruf
				( x1 / x1 )			
					
								(mapcar 'f_p 
									(list 	"\n" 
											(f_t) "-" (f_z) 
											"\t : Aktion : " (car xp)
											"\t : Result : " x1
											"\t : Parameter : " (cdr xp)
											"\n" 
									)
								)
	(setq 		r 				x1)
)
(defun		f_p					; Protokollieren
				(x1 / 
					x1 x2)
	(setq 		xp				(list "f_p" (list x1)))					
	(setq 		x2 				(open (cadr (assoc '"log" xs)) "a"))		
								(if (/= x2 nil)
									(progn
										(if (equal (cadr (assoc '"logtofile" xz)) "on")
											(princ x1 x2)
										)									
										(close x2)
									)
								)
								(if (equal (cadr (assoc '"logtoscreen" xz)) "on")
									(princ x1 )
								)
	(setq		r				"ok")
)
(defun 		f_t					; Datum ermitteln
				( / )	
			
	(setq 		r				(strcat		
									(substr (rtos (getvar "cdate")2 6) 1 4)			; Jahr
									(substr (rtos (getvar "cdate")2 6) 5 2)			; Monat
									(substr (rtos (getvar "cdate")2 6) 7 2)			; Tag
								)		
	)
)
(defun 		f_z					; Zeit ermitteln
				( / )			
	(setq		r				(strcat		
									(substr (rtos (getvar "cdate")2 6) 10 2)		; Stunden
									":"	(substr (rtos (getvar "cdate")2 6) 12 2)	; Minuten
									":"	(substr (rtos (getvar "cdate")2 6) 14 2)	; Sekunden
								)		
	)
)
(defun		f_str_do			; String ersetzen
		(p1 / p1	; 	(string suchmuster ersatzmuster modus (split | replace) )
			x1 
			x2		; String
			x3		; neuer String
			x4		; neue Liste
			z1
		)			
					(if (<= (strlen (nth 0 p1))(strlen (nth 1 p1)))
						(progn	(setq r "nok")
						)
						(progn
							(setq z1 1 x2 "" x3 "" x4 '() )
							(setq x1 (substr (nth 0 p1) z1 (strlen (nth 1 p1))))							
							(while (<= z1 (+ 1 (strlen (nth 0 p1))))
					
								(if (not (equal x1 (nth 1 p1)))
									(progn
										(setq x2 (strcat x2 (substr (nth 0 p1) z1 1)))
										(setq z1 (+ z1 1))
									)
									(progn		
										(setq x3 (strcat x3 x2))
										(setq x3 (strcat x3 (nth 2 p1)))		; ersetzen
										(setq x4 (cons x2 x4))					; liste
										(setq x2 "")
										(setq z1 (+ z1 (strlen (nth 1 p1))))
									)
								)
								(setq x1 (substr (nth 0 p1) z1 (strlen (nth 1 p1))))
							)
							(setq x3 (strcat x3 x2))
							(setq x4 (reverse (cons x2 x4)))
							(if (equal (nth 3 p1) "split")
								(setq r x4)
								(setq r x3)
							)
						)
					)
)
