; Programm: 		ACM_LW.lsp
; Funktion: 		Tool ACM_LW zur längenbezogenen Selektion von Objekten
; Autor: 	 		Silke Molch
; Lauffähig:		AutoCAD 2025[de] auf acadiso.dwt-Basis		
; Bezug:   			nur auf Tool-CD: 2025/07
; ========================================================================================================================================
(defun 		c:ACM_LW			; 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" "0.0")									; Wert von
									'("2" "1.0")									; Wert bis	
									'("3" "1")										; Markierungsfarbe									
																					; _____________________________________________________________
									'("-1" "de")									; Sprache	
									'("-2" "Einfärben")								; Modus Einfärben
									'("-3" "Hinweislinien")							; Hinweislinie
									; _____________________________________________________________
									'("AListe" (1 2 3 ))							; A-Liste der DCL-Auswahlobjekte (Elementeauflistung A1 A2 ...)
									'("EListe" (1 2 3))								; E-Liste der DCL-Eingabeobjekte (Elementeauflistung E1 E2 ...)			
									'("tool" "ACM_LW ")								; 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" 	" Modus Einfärben ")			)										
									'("A3" 		("de" 	" Modus Hinweislinien")			)
									
									'("E1" 		("de" 	" Selektionswert von : "		)	)
									'("E2" 		("de" 	" Selektionswert bis : "		)	)
									'("E3" 		("de" 	" Markierungsfarbe 1-255 : "	)	)
	
									'("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 selektierenden Objekte auswählen: >> ")	
									)	
									'("m_8" ("de"   "\n\nBitte die zu beschriftenden Kreisobjekte 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! ")	
									)
									'("m-8" ("de"  	"Die Anzahl der verschiedenen Sequenzenkomponenten stimmt nicht überein! ")	
									)
									'("m-9" ("de"  	"Bei den Zeilen- und Spaltenanzahlen dürfen keine Nullwerte verwendet werden! ")	
									)									
									'("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_LW.lsp  "
										"\n"							
										"\n_________________________"
										"\tVoreinstellungen/Modi: \n"										
										"\nSprache: \t\t\tdeutsch"	
										"\nModus Einfärben: \t\tEinfärben"
										"\n\t\t\tOhne_Einfärben"
										"\nModus Hinweiselinien: \tHinweislinien"
										"\n\t\t\tOhne_Hinweislinien"
										"\n_________________________"
										"\tEinstellungen:\n"
										"\nSelektionswert von: >= 0 \t..."
										"\nSelektionswert bis: >= 0 \t..."
										"\nMarkierungsfarbe 1-255:\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 dem Tool können Linien-Objekte (Linien, Polylinien, LWPolylinien) je nach Voreinstellung entsprechend ihrer Längen-Eigenschaft aufgefunden, "
"markiert und selektiert werden. Mittels Voreinstellung kann man festlegen, in welchem Längentoleranzbereich die Objekte selektiert werden sollen. "
"Dazu gibt man als „Selektionswert von“ den kleinsten und über den „Selektionswert bis“ den größten Wert an, um den Toleranzbereich festzulegen. "
"Dann werden alle Linien-Objekte mit Längen größer oder gleich des kleineren Selektionswertes und kleiner oder gleich dem größeren Selektionswert ausgewählt. "
"Auf diese Auswahl kann man mit einem nachfolgenden Befehl mit der Auswahloption „v“ für vorherige Auswahl zugreifen. "
"Neben der Auswahlsatzbildung kann man über die Einfärben-Modus-Option die ausgewählten Objekte auch einfärben lassen. "
"Je nach voreingestellter AutoCAD-Markierungsfarbe werden dann den selektierten Objekten die Markierungsfarbe zugeordnet. "
"Je nach Flächenausdehnung des Projektes lassen sich auch farblich markierte Objekte nicht immer gut auffinden. "
"Für solche Fälle kann auf dem aktuellen Layer über die Modus-Option Hinweislinien die Konstruktion von Linien vom selektierten Objekt "
"zum Ursprung des Benutzerkoordinatenursprungs generiert werden, sodass diese besser aufgefunden werden können."
										"\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)) 25.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 				; Prüfobjekteauswahl
				x2				; Zähler
				x3				; Auswahlsatz
				x4				; Objekt
				x5				; Länge
				x6				; Punkt
			)
								(terpri)(princ (cadr (assoc "de" (cdr (assoc '"m_7" xm)))))
								(setq x1 (ssget))
								(if (or (equal x1 nil) (< (sslength x1) 1))
									(progn (princ (cadr (assoc "de" (cdr (assoc '"m-2" xm)))))	)
									(progn
										(setq x2 0)
										(setq x5 nil)
										(setq x3 (ssadd))
										(while (< x2 (sslength x1))
											(setq x4 (vlax-ename->vla-object (ssname x1 x2)))
											(if (vlax-property-available-p x4 'Length)
												(progn
													(setq x5 (vlax-get-property (vlax-ename->vla-object (ssname x1 x2)) "Length") )
												)
												(progn
													(setq x5 nil)
												)
											)											
											;
											(if (not 
													(and
														(>= x5 (atof (cadr (assoc "1" xz))))
														(<= x5 (atof (cadr (assoc "2" xz))))
													)
												)
												(progn	(setq x5 nil)	)
											)
											;
											(if (not (equal x5 nil))
												(progn
													(if (equal (cadr (assoc "-2" xz)) "Einfärben")
														(progn
															(vl-catch-all-apply (function (lambda nil 
																(vl-cmdf "_CHPROP" 
																	(ssname x1 x2)
																	""
																	 "f"
																	(atoi (cadr (assoc "3" xz)))														
																	""
																)
															)))														
														)
													)
													(if (equal (cadr (assoc "-3" xz)) "Hinweislinien")
														(progn
															(setq x6 (cdr (assoc '10 (entget (ssname x1 x2)))))
															(if (equal (cdr (assoc '0 (entget (ssname x1 x2)))) '"POLYLINE")
																(progn
																	(setq x6 (cdr (assoc '10 (entget (entnext (ssname x1 x2))))))
																)
															)
															(if (equal (cdr (assoc '0 (entget (ssname x1 x2)))) '"LWPOLYLINE")
																(progn
																	(setq x6 (list 
																		(nth 0 x6) 
																		(nth 1 x6)
																		(vlax-get-property (vlax-ename->vla-object (ssname x1 x2)) "ELEVATION")
																	))
																)
															)
															
															(setq x6 (trans x6 (ssname x1 x2) 1))	
																													
															(vl-catch-all-apply (function (lambda nil 
																(vl-cmdf "_3DPOLY" 
																	"0,0,0"
																	x6
																	""
																)
															)))
														)
													)
													(setq x3 (ssadd (ssname x1 x2) x3))	
												)
											)
											;
											(setq x2 (+ x2 1))
											
										)
										(vl-catch-all-apply (function (lambda nil 
											(vl-cmdf "_SELECT" x3 ""																					
											)
										)))
									)
								)													
)
(defun		f_rnd				; Runden 
			(x1 				; Zahl
			x2					; Anzahl der Nachkommastellen
			/ x1 x2 x3 x4 x5 x6 x7)
								(setq x3 (* x1 (expt 10.0 x2 )))
								(setq x4 (rtos (rem x3 1.0) 2))				; Nachkomma
								(setq x5 (atoi (substr x4 3 1)))
								(if (>= x5 5)
									(setq x3 (+ 1 x3))
								)
								(setq x6 (fix x3))
								(setq x7 (/ x6 (expt 10.0 x2)))
)
(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 "Einfärben" "Ohne_Einfärben")
									(list "Hinweislinien" "Ohne_Hinweislinien")
								)													
	)	
	(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 '(1 2 3))(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 '(1 2 3))	(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 '(  3))	(= (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 '( 3))	(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 '(1 2 3))	(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 '(3))	(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 '(3 ))	(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)
									'("ARRAYASSOCIATIVITY" 1)
								)
	)
	(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)
							)
						)
					)
)
