; Programm: 		ACM-XREFREIHE.lsp
; Funktion: 		Tool zum automatisierten XREF-Zuordnen von Zeichnungen  
; Autor: 	 		Silke Molch
; Lauffähig:		AutoCAD 2024[de] auf acadiso.dwt-Basis		
; Bezug:   			nur auf Tool-CD 8/2023
; ========================================================================================================================================

(defun 		c:ACM-XREFREIHE	; Aufruf
				( / )			(vl-load-com)
								(vl-cmdf "_UNDO" "b")
								(vl-cmdf "_UCS" "w")
								(setvar "frame" 0)
	(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" "10.0")									; Fensterbreite
									'("2" "10.0")									; Fensterhöhe
									'("3" "15.0")									; Spaltenbreite
									'("4" "15.0")									; Zeilenhöhe
									'("5" "2")										; Spaltenanzahl
									'("6" "2")										; Zeilenanzahl	
									'("7" "1.0")									; ZOOM-Faktor										
																					; _____________________________________________________________
									'("-1" "de")									; Sprache
									'("-2" "eingepasst")							; Skaliermodus
									'("-3" "Spalte")								; Präferenz		
									'("-4" "mit_Rahmen")							; Rahmenmodus	
									'("-5" "zugeschnitten")							; Zuschneidemodus									
																					; _____________________________________________________________
									'("AListe" (1 2 3 4 5))							; A-Liste der DCL-Auswahlobjekte (Elementeauflistung A1 A2 ...)
									'("EListe" (1 2 3 4 5 6 7))						; E-Liste der DCL-Eingabeobjekte (Elementeauflistung E1 E2 ...)			
									'("tool" "Toolname")							; 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" 	" Skaliermodus :  ")			)	
									'("A3" 		("de" 	" Präferenz :  ")				)	
									'("A4" 		("de" 	" Rahmenmodus :  ")				)	
									'("A5" 		("de" 	" Zuschneidemodus :  ")			)
									
									
									'("E1" 		("de" 	" Fensterbreite : >0")		)
									'("E2" 		("de" 	" Fensterhöhe : >0 ")		)
									'("E3" 		("de" 	" Spaltenbreite : >0 ")		)
									'("E4" 		("de" 	" Zeilenhöhe : >0 ")		)
									'("E5" 		("de" 	" Spaltenanzahl: >0 ")		)
									'("E6" 		("de" 	" Zeilenanzahl: >0 ")		)	
									'("E7" 		("de" 	" Zoomfaktor: >0   ")		)										
									
									'("m_1" ("de"   "\nBitte die untere linke Ecke angeben: >> ")	
									)

									'("m-1" ("de"  	"Die Datei konnte nicht gefunden werden! ")	
									)
									'("m-2" ("de"  	"\nEs wurde kein zulässiges Objekt gewählt! ")	
									)									
									'("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-XREFREIHE.lsp  "
										"\n"
										"\n_________________________"
										"\tVoreinstellungen/Modi: \n"
										"\nSkaliermodus:         \tmit_ZOOM-Faktor"
										"\n                      \t\teingepasst"
										"\nPräferenz:            \t\tSpalte"
										"\n                      \t\tZeile"
										"\nRahmenmodus:          \tmit_Rahmen"
										"\n                      \t\tohne_Rahmen"										
										"\nSprache:              \t\tzugeschnitten"	
										"\n                      \t\tnicht_zugeschnitten"										
										"\n_________________________"
										"\tEinstellungen:\n"		
										"\nFensterbreite : >0   \t..."	
										"\nFensterhöhe : >0 \t\t..."
										"\nSpaltenbreite : >0 \t\t..."	
										"\nZeilenhöhe : >0 \t\t..."	
										"\nSpaltenanzahl : >0 \t..."	
										"\nZeilenanzahl : >0 \t\t..."	
										"\nZoomfaktor: >0 \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 können automatisiert viele DWG’s aus einer Dateiliste als XREF eingebunden werden. "
"Die Liste muss eine Textdatei sein, die die zuzuordnenden Dateien in ihrer Zuordnungsreihenfolge enthält. "
"Jede Dateizeile soll den Pfad mit Dateiname aufweisen. Wenn die einzufügenden Dateien alle in einem Ordner inkl. "
"Unterordnern liegen, lässt sich die Liste mit einem einfachen Windowsbefehl wie 'dir .\*.dwg /b /s >__Zeichnungsliste.txt' "
"automatisch erstellen. Diese Liste ist Grundlage für die nacheinander stattfindenden XREF-Zuordnung. "
"Die Anordnung der Dateien erfolgt adäquat dem Reihe-Befehl in Spalten und Zeilenanordnung. "
"Alle Dateien der Liste werden eingefügt, es sei denn, man begrenzt die Zeilen- und Spaltenanzahl in der Voreinstellung "
"durch zu kleine Werte. Bis zu den vorgegebenen maximalen Anzahlwerten werden die Dateien zugeordnet. "
"Ob dabei zuerst die Zeilen oder die Spalten aufgefüllt werden, wird durch die Präferenzeinstellung festgelegt. "
"Des Weiteren kann voreingestellt werden, wie groß der Darstellungsausschnitt aussehen soll. "
"Das kann über Fensterbreite bzw. Fensterhöhe festgelegt werden. Diese Werte werden verwendet, wenn die Zeichnungsausschnitte "
"im Rahmen der Zuschneidemodus-Auswahl auf diese Fenstergröße zugeschnitten werden sollen. "
"Ebenso kann über den Rahmenmodus festgelegt werden, ob die Fenster- bzw. Zuschneiderahmen auch als graphischer Rahmen "
"angezeigt werden sollen. Diese Rahmen werden auch zur Bezugsgröße, wenn beim Skaliermodus kein fester ZOOM-Faktor "
"sondern 'eingepasst' gewählt wird. Dann werden die jeweiligen Zeichnungen so skaliert, dass sie größtmöglich in die Rahmen passen. "
"Das Tool ist nur im WKS des Modellbereiches einsetzbar."

										"\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)) 24.3)
											(<= (atof(substr (getvar "acadver") 1 4)) 24.3)
										)
									)
									(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 				; Spalte
				x2 				; Zeile
				x3 x4			; Datei
				x5 				; Dateizeile
				x6				; untere Ecke
				x7				; lu Ecke
				x8				; ro Ecke
				x9				; rahmen
				x10				; insertobj
				x11 x12 x13 x14 x15 x16 x17 x18 x19
				x20 x21 x22
			)					
								(setq x1 1 x2 1)
								(vl-cmdf "-layer" "en" (getvar "clayer") "")
								(setq x3 (getfiled "Listenauswahl" (getvar "dwgprefix") "txt" 4))
								(setq x4 (open x3 "r"))
								(setq x5 (read-line x4))
								(terpri)(princ (cadadr (assoc "m_1" xm)))
								(setq x6 (getpoint))
								(while x5
									(terpri)(princ x5)
									(if (not (findfile x5))
										(progn 	(princ " ")(princ (cadadr (assoc "m-1" xm)))	)
										(progn
											;(terpri)(princ x1) (princ " ")(princ x2)
											(if (and 	
													(<= x1 (atoi (cadr (assoc '"5" xz))))
													(<= x2 (atoi (cadr (assoc '"6" xz))))
												)
												(progn
													(setq x7 (list
														(+ (nth 0 x6) 	(* (- x1 1) (atof (cadr (assoc '"3" xz))))	)
														(+ (nth 1 x6)	(* (- x2 1) (atof (cadr (assoc '"4" xz))))	)
														(nth 2 x6)
													))
													(setq x8 (list
														(+ (nth 0 x7) 	(atof (cadr (assoc '"1" xz))))	
														(+ (nth 1 x7)	(atof (cadr (assoc '"2" xz))))	
														(nth 2 x7)
													))													
													(vl-cmdf "rechteck" x7 x8)
													(setq x9 (ssget "_L"))
													;
													(if (equal (cadr (assoc '"-2" xz)) "mit_ZOOM-Faktor")
														(progn
															; Rahmenanzeige
															(if (not (equal (cadr (assoc '"-4" xz)) "mit_Rahmen"))
																(progn
																	(vl-cmdf "löschen" x9 "")
																)
															)
															
															(vl-cmdf "xref" "z" x5 x7 
																(cadr (assoc '"7" xz))
																(cadr (assoc '"7" xz))
																"0"
															)
															(setq x10 (ssname (ssget "_L") 0))
															(setq x20 (vlax-ename->vla-object x10))
															(vla-GetBoundingBox x20 'x12 'x13)
															(setq x21 (vlax-safearray->list x12)) ; minpkt
															(vl-cmdf "schieben" x10 "" x21 x7)
															
															(if (equal (cadr (assoc '"-5" xz)) "zugeschnitten")
																(progn
																	(vl-cmdf "xzuschneiden" "l" "" "n" "r" x7 x8)
																)
															)
														)
														(progn
															(vl-cmdf "xref" "z" x5 x7 
																"1.0"
																"1.0"
																"0"
															)
															(setq x10 (ssname (ssget "_L") 0))
															(setq x11 (vlax-ename->vla-object x10))
															(vla-GetBoundingBox x11 'x12 'x13)
															(setq x14 (vlax-safearray->list x12)) ; minpkt
															(setq x15 (vlax-safearray->list x13)) ; maxpkt
															;
															(setq x16 (- (nth 0 x15) (nth 0 x14)))
															(setq x17 (- (nth 1 x15) (nth 1 x14)))
															(setq x18 (/ (atof (cadr (assoc '"1" xz))) x16))
															(setq x19 (/ (atof (cadr (assoc '"2" xz))) x17))
															(if (< x18 x19)
																(progn
																	(vl-cmdf "varia" x10 "" x7 x18)
																)
																(progn
																	(vl-cmdf "varia" x10 "" x7 x19)
																)																
															)
															(setq x20 (vlax-ename->vla-object x10))
															(vla-GetBoundingBox x20 'x12 'x13)
															(setq x21 (vlax-safearray->list x12)) ; minpkt
															(vl-cmdf "schieben" x10 "" x21 x7)
															
															; Rahmenanzeige
															(if (not (equal (cadr (assoc '"-4" xz)) "mit_Rahmen"))
																(progn
																	(vl-cmdf "löschen" x9 "")
																)
															)
														)														
													)
													(terpri)

												)
											)

											
											(if (equal (cadr (assoc '"-3" xz)) "Spalte")
												(progn
													(if (> x1 (- (atoi (cadr (assoc '"5" xz))) 1))
														(progn
															(setq x1 1)
															(setq x2 (+ x2 1))
														)
														(progn
															(setq x1 (+ x1 1))
														)
													)
												)
												(progn
													(if (> x2 (- (atoi (cadr (assoc '"6" xz))) 1))
														(progn
															(setq x2 1)
															(setq x1 (+ x1 1))
														)
														(progn
															(setq x2 (+ x2 1))
														)
													)
												)											
											)

										)
									)									
										
									(setq x5 (read-line x4))
								)		
								(close x4)
								(terpri)(terpri)(terpri)(terpri)(terpri)
								(princ ".............................................................................")
)
(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 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 (atoi (rtos (+ (/ (* x5 x8) 100.0) x1) 2 8)))
								;
								(setq return (abs 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_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_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}"													

												"\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 "eingepasst" "mit_ZOOM-Faktor" ) 
									(list "Spalte" "Zeile" )
									(list "mit_Rahmen" "ohne_Rahmen" )
									(list "zugeschnitten" "nicht_zugeschnitten" )
								)
	)
	(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 4 5 6 7))(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 4 5 6 7))	(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 '(1 2 3 4 5 6 7))	(= (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 '(1 2 3 4 5 6 7))	(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									; -90 <= ... <= 90
																		(<= (atof x1) 90.0)
																		(>= (atof x1) -90.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 0 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 '(5 6))	(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" 1)
									'("FRAME" 0)
								)
	)
	(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)
							)
						)
					)
)
