;;;Bosse-engineering                                                                                       
;;;Dipl.-Ing. Jörn Bosse                                                                                   
;;;Am Klei 5                                                                                               
;;;38458 Velpke                                                                                            
;;;Tel. 05364 / 989 677                                                                                    
;;;mobil. 0176 / 282 323 51                                                                                
;;;bosse@bosse-engineering.com                                                                             
;;;                                                                                                        
;;;--------------------------------------------------------------------------------------------------------
;;;Funktion c:DBA (DwgBlockAdjust)						        	           
;;;													   
;;;Von dem Programm DBS (DwgBlockScanner) - AutoCAD-Magazin 6/2025 - wird die Ergebnisdatei		   
;;;JB_DBS_PropList.lsp ausgewählt. Die Dort enthaltenen Eigenschaften werden in einem Dialogfenster	   
;;;dargestellt. Dan besteht die Möglichkeit einer automatischen Anpassung für die betreffenden DWG-Dateien.
;;;													   
;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_DBA$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_DBA$$BlockN (bb)										   
;;;                                                                              Jörn Bosse, 21.09.25      
;;;--------------------------------------------------------------------------------------------------------




;;;aufrufenden Funktionen
(defun c:DBA ( / )
  (JB_DBA)
  )


(defun c:DwgBlockAdjust ( / )
  (JB_DBA)
  )

;;;Definition der v_liste, wenn noch nicht vorhanden
(defun JB_DBA:v_liste ( / )  
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (                             
                             ("JB_1_t1" . nil);;;FilePath DBS-Datei
			     ("JB_1_to1" . "1");;;Toggle BlockSkalierung
			     ("JB_1_p1" . "alle");;;Filter BlockSkalierung

			     ("JB_1_to2" . "1");;;Toggle Einheit
			     ("JB_1_p2" . "alle");;;Filter Einheit

			     ("JB_1_to3" . "1");;;Toggle Beschriftung
			     ("JB_1_p3" . "alle");;;Filter Beschriftung

			     ("JB_1_to4" . "1");;;Toggle dynamisch
			     ("JB_1_p4" . "alle");;;Filter dynamisch

			     ("JB_1_to5" . "1");;;Toggle Blocknamefilter
			     ("JB_1_t3" . "*");;;Filter Blocknamefilter

			     ("JB_1_to6" . "0");;;Toggle Blockskalierung anpassen
			     ("JB_1_p6" . "0 (Nein)");;;Wert

			     ("JB_1_to7" . "0");;;Toggle Einheit anpassen
			     ("JB_1_p7" . "6 (Meter)");;;Wert

			     ("JB_1_to8" . "0");;;Toggle Beschriftung
			     ("JB_1_p8" . "0 (Nein)");;;Wert


			     ("JB_1_r1-2" . 0);;;0 = UND, 1 = ODER

			     )
			  )
			 )
      ))
  )

;;;Pfad für SIC-Datei in Windows-User
(defun JB_DBA:pfad_ini ( / )
  (strcat (JBf_String:Userpfad:WinUser
                           "LispData\\acad\\"     ;;;Hier ändern, wenn anderer Pfad gewünscht, z.B. MeineTools\\Sicherungen\\ => Der LAufwerksbuchstabe c:\\ wird automatisch gegen das Windows-Benutzerverzeichnis 
                           )"DBA_sic.lsp")  ;;;getauscht, z.B. c:\\User\\[WindowsUsername]\\LispData\\acad\\
  )

 

(defun JB_DBA:Intro ( / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n---------------------DBA(1.0), 21.09.25----------------------")
  (princ "\nDwgBlockScanner: DWG-Dateien aus DBS-Datei anpassen.         ")
  (princ "\n-------------------------------------------------------------")
  )


;;;Hauptfunktion
(defun JB_DBA ( / PFAD_INI V_LISTE)
  (vl-load-com)

  (setq pfad_ini (JB_DBA:pfad_ini))

  ;;;ab AutoCAD 2014, setzen von vertrauenswürdigen Pfaden für Sicherungsdateien
  (if (JBf_AcadSystem:TrustedPaths?)
    (JBf_AcadSystem:TrustedPaths:Add (strcat(car(fnsplitl pfad_ini))"...")))

    (if (not(setq v_liste (if (findfile pfad_ini)
                          (load pfad_ini)nil)))
    (JBf_SIC:sichern
      (setq v_liste (JB_DBA:v_liste))pfad_ini nil))
  
  
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))  
  
  (JB_DBA:Intro)

  
  (if (not
            (or (and JB_DBA_$DCL$_File(findfile JB_DBA_$DCL$_File))
                (setq JB_DBA_$DCL$_File (JB_DBA:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))


  

  (if (JB_DBA:Suppportpfad-p)
    (JB_DBA:Dbox1 v_liste pfad_ini)
    )
      
   
  (princ "\nEnde.")

  
  (JBf_Reinit)
  (princ)
  

)


  


(defun JB_DBA:Suppportpfad-p ( / FILENAME RETVAL SUPPORTPATHS)
  (setq RetVal 'T)
  (if (not JB_DBA$$pfad)
    (progn
      (if (not (findfile "DwgBlockAdjust.lsp"))
        (progn
          (alert (strcat "Die Programmdatei \"DwgBlockAdjust.lsp\""
			 " muss auf einem Supportpfad liegen.\n\nWählen Sie im Folgenden die Programmdatei aus, damit der Supportpfad erstellt werden kann."))
          (if (and(setq Filename (getfiled "Wählen Sie die Programmdatei \"DwgBlockAdjust.lsp\""
					   "DwgBlockAdjust.lsp"
					   "lsp"
					   4))
                  (or(= (strcase (strcat(cadr(fnsplitl Filename))(caddr(fnsplitl Filename))))
                        (strcase "DwgBlockAdjust.lsp"))
                     (alert (strcat "Der Dateiname \""(strcat(cadr(fnsplitl Filename))(caddr(fnsplitl Filename)))"\" war nicht korrekt."))))

            (progn
              ;;;vertrauenswürdigen Pfad auch gleich setzen
              (if (JBf_AcadSystem:TrustedPaths?)
                (JBf_AcadSystem:TrustedPaths:Add (strcat(car(fnsplitl Filename))"...")))
              ;;;und jetzt noch den Supportpfad setzen
              (setq SupportPaths (getenv "ACAD"))
              (if(not(member (strcase (car(fnsplitl Filename)))(mapcar 'strcase (JBf_AcadSystem:TrustedPath:Split SupportPaths))))
                (setenv "ACAD"(strcat SupportPaths ";" (car(fnsplitl Filename)))))

              )
            (setq RetVal nil)
            )
          )
        )
      (if RetVal
        (setq JB_DBA$$pfad (car(fnsplitl(findfile "DwgBlockAdjust.lsp"))))
        (setq JB_DBA$$pfad nil)
        )
      )
    )
  RetVal)



(defun  JB_DBA:v_liste:DboxSettings:get (key v_liste / )
  (cdr(assoc key(cdr (assoc "DboxSettings" v_liste))))
)


(defun JB_DBA:v_liste:DboxSettings:put (key liste v_liste / DboxList) 
  (setq DboxList (cdr (assoc "DboxSettings" v_liste)))
  (setq DBoxList (JBf_list:subst:gc DBoxList liste key))
  (setq v_liste (JBf_list:subst:gc v_liste DBoxList "DboxSettings"))
  v_liste
  )



;;;Einstellung aus DBS-Datei anhand Togglename
(defun JB_DBA:Dbox1:l1:Ini:Filter:DBSWertByToggle (key X / )
  (cond ((= key "to1")(cdr(assoc"BlockScaling"(cdr X))))
	((= key "to2")(cdr(assoc"Units"(cdr X))))
	((= key "to3")(cdr(assoc"ANNOTATIVEDWG"(cdr X))))
	((= key "to4")(cdr(assoc"Dynamic"(cdr X)))))
  )


;;;Filterliste pro Block Eintrag
(defun JB_DBA:Dbox1:l1:Ini:Filter:DBSFilter-p-list (X / )
  (mapcar '(lambda(Y)
	     (or
	     (and(=(cdr(assoc (strcat "JB_1_" (car Y))Settings&Dbox1))"1")
		 (if (=(car Y)"to5");;;Blocknamefilter
		   (wcmatch (strcase(car X))(strcase(cdr(assoc (strcat "JB_1_" (cadr Y))Settings&Dbox1))))
		   (if (setq wert(JB_DBA:Dbox1:l1:Ini:Filter:DBSWertByToggle (car Y) X))
		     (or (= (cdr(assoc (strcat "JB_1_" (cadr Y))Settings&Dbox1))"alle")
			 (= (atoi(cdr(assoc (strcat "JB_1_" (cadr Y))Settings&Dbox1)))wert))
		     (= (cdr(assoc (strcat "JB_1_" (cadr Y))Settings&Dbox1))"keine")
		     )
		   )
		 )
	     (=(cdr(assoc (strcat "JB_1_" (car Y))Settings&Dbox1))"0")
	     )
	     )
	  '(("to1" "p1") ("to2" "p2") ("to3" "p3") ("to4" "p4") ("to5" "t3")))
  )


;;;FilterList-Auswertung
(defun JB_DBA:Dbox1:l1:Ini:Filter:ListAuswertung (Filter-p-List / )
  (if (=(cdr(assoc "JB_1_r1-2" Settings&Dbox1))0);;;UND
    (=(length(vl-remove-if 'not Filter-p-List))(length Filter-p-List))
    (=(type(vl-remove-if 'not Filter-p-List))'LIST)
    )
  )
  


;;;l1 Initialisierung - Filter
(defun JB_DBA:Dbox1:l1:Ini:Filter ( /  X)
  (setq l1Base&DBox1
  (mapcar '(lambda(X)
	     (setq Filter-p-List(JB_DBA:Dbox1:l1:Ini:Filter:DBSFilter-p-list X))
	     (if (assoc "Filter"(cdr X))
	       (cons (car X)(JBf_list:subst:gc (cdr X)(JB_DBA:Dbox1:l1:Ini:Filter:ListAuswertung Filter-p-List) "Filter"))
	       (cons (car X)
		     (append (cdr X)
			     (list (cons "Filter" (JB_DBA:Dbox1:l1:Ini:Filter:ListAuswertung Filter-p-List)
					   ))))
	       )
	     )
	  l1Base&DBox1)
  )

  (setq l1&DBox1 (vl-remove-if (function(lambda(X)(not(cdr(assoc "Filter" (cdr X))))))l1Base&DBox1))
  )
					 
					   
	

;;;l1 Initialisierung
(defun JB_DBA:Dbox1:l1:Ini-p ( / )
  (and(cdr(assoc "JB_1_t1" Settings&Dbox1))
      (or
	(findfile(cdr(assoc "JB_1_t1" Settings&Dbox1)))
	(progn
	  (setq l1&DBox1 nil)
	  (setq l1Base&DBox1 nil)
	  (alert (strcat"Folgende Datei ist nicht vorhanden:\n"
			(cdr(assoc "JB_1_t1" Settings&Dbox1))))))
      (or(and(not(vl-catch-all-error-p
		   (setq l1Base&DBox1
			  (vl-catch-all-apply 'load (list (cdr(assoc "JB_1_t1" Settings&Dbox1)))))))
	     l1Base&DBox1)
	 (progn
	   (setq l1&DBox1 nil)
	   (setq l1Base&DBox1 nil)
	   (alert (strcat"Folgende Datei konnte nicht geladen werden:\n"
			 (cdr(assoc "JB_1_t1" Settings&Dbox1)))))
	 )
      )
    
  )

;;;RootFolder
(defun JB_DBA:Dbox1:l1:Ini:RootFolder ( / FOLDERROOTLIST FOLDERROOTSTR I N X)
  (if(setq FolderRootList
	    (mapcar '(lambda(X)
		       (JBf_String:Delimiter->List (cdr(assoc "Path" (cdr X)))"\\")
		       )
		    l1Base&DBox1))
    (progn
      (setq n (apply 'min (mapcar 'length FolderRootList)))
      (setq FolderRootStr "")

      (setq i -1)
      (repeat n
	(setq i (+ i 1))
	(setq FolderRootStr (strcat FolderRootStr (nth i (car FolderRootList))"\\")))
      )
    FolderRootStr)
  )


;;;P-Lists Ini
(defun JB_DBA:Dbox1:l1:Ini:pLists ( / )
  (setq p1&Dbox1 '("alle" "keine" "0 (Nein)" "1 (Ja)"))
  (setq p1_sel&Dbox1 (-(length p1&Dbox1)(length(member(cdr(assoc "JB_1_p1" Settings&Dbox1))p1&Dbox1))))

  (setq p2&Dbox1 '("alle" "keine"
		    "0 (Keine Einheiten)"
		    "1 (Zoll)"
		    "2 (Fuß)"
		    "3 (Meilen)"
		    "4 (Millimeter)"
		    "5 (Zentimeter)"
		    "6 (Meter)"
		    "7 (Kilometer)"
		    "8 (Mikro-Zoll)"
		    "9 (Milli-Zoll)"
		    "10 (Yard)"
		    "11 (Ångström)"
		    "12 (Nanometer)"
		    "13 (Mikrometer)"
		    "14 (Dezimeter)"
		    "15 (Dekameter)"
		    "16 (Hektometer)"
		    "17 (Gigameter)"
		    "18 (Astr. Einh.)"
		    "19 (Lichtjahre)"
		    "20 (Parsec)"
		    "21 (USA Fuß-Einh.)" 
		   ))
  (setq p2_sel&Dbox1 (-(length p2&Dbox1)(length(member(cdr(assoc "JB_1_p2" Settings&Dbox1))p2&Dbox1))))

  (setq p3&Dbox1 '("alle" "keine" "0 (Nein)" "1 (Ja)"))
  (setq p3_sel&Dbox1 (-(length p3&Dbox1)(length(member(cdr(assoc "JB_1_p3" Settings&Dbox1))p3&Dbox1))))

  (setq p4&Dbox1 '("alle" "keine" "0 (Nein)" "1 (Ja)"))
  (setq p4_sel&Dbox1 (-(length p4&Dbox1)(length(member(cdr(assoc "JB_1_p4" Settings&Dbox1))p4&Dbox1))))

  (setq p6&Dbox1 '("0 (Nein)" "1 (Ja)"))
  (setq p6_sel&Dbox1 (-(length p6&Dbox1)(length(member(cdr(assoc "JB_1_p6" Settings&Dbox1))p6&Dbox1))))

  (setq p7&Dbox1 '( "0 (Keine Einheiten)"
		    "1 (Zoll)"		    
		    "4 (Millimeter)"
		    "5 (Zentimeter)"
		    "6 (Meter)"
		    "7 (Kilometer)"		   
		   ))
  (setq p7_sel&Dbox1 (-(length p7&Dbox1)(length(member(cdr(assoc "JB_1_p7" Settings&Dbox1))p7&Dbox1))))

  (setq p8&Dbox1 '("0 (Nein)" "1 (Ja)"))
  (setq p8_sel&Dbox1 (-(length p8&Dbox1)(length(member(cdr(assoc "JB_1_p8" Settings&Dbox1))p8&Dbox1))))
  )

    
    


	       



;;;DBox 1
(defun JB_DBA:Dbox1(v_liste pfad_ini / A DCLID OK SETTINGS&DBOX1 t2&Dbox1 l1&DBox1 l1Base&DBox1
		                       P1&DBOX1 P1_SEL&DBOX1 P2&DBOX1 P2_SEL&DBOX1 P3&DBOX1 P3_SEL&DBOX1 P4&DBOX1 P4_SEL&DBOX1 P6&DBOX1 P6_SEL&DBOX1 P7&DBOX1 P7_SEL&DBOX1 P8&DBOX1 P8_SEL&DBOX1)

  (setq Settings&Dbox1 (JB_DBA:v_liste:DboxSettings:get "Dbox1" v_liste))

  ;;;Loaden der DBS-Datei
  (JB_DBA:Dbox1:l1:Ini-p)
  ;;;FilterEinstellungen
  (JB_DBA:Dbox1:l1:Ini:Filter)

  ;;;RootFolder
  (setq t2&Dbox1(JB_DBA:Dbox1:l1:Ini:RootFolder))

  ;;;PList's
  (JB_DBA:Dbox1:l1:Ini:pLists)
  
  
  
    
  (while  (not(member ok '(1 99)))

    (setq DclId(JBf_Dcl:Load_dialog JB_DBA_$DCL$_File "DBA_1" JB_DBA$DCL$_1_po))
    
    (JB_DBA:Dbox1:set)
    (JB_DBA:Dbox1:mode)
           
    (mapcar '(lambda(A)(action_tile A (strcat "(JB_DBA:Dbox1:action \""A"\")")))
      '("JB_1_to1" "JB_1_to2" "JB_1_to3" "JB_1_to4" "JB_1_to5" "JB_1_to6" "JB_1_to7" "JB_1_to8"
	"JB_1_p1" "JB_1_p2" "JB_1_p3" "JB_1_p4" "JB_1_p6" "JB_1_p7" "JB_1_p8"
	"JB_1_b1" "JB_1_b2"
	"JB_1_r1" "JB_1_r2"
        "accept" "cancel"))

    (setq ok (start_dialog))
    (unload_dialog DclId)

    (if(= ok 1)
      (if (not(or(or (=(cdr(assoc "JB_1_to6" Settings&dbox1))"1")
		      (=(cdr(assoc "JB_1_to7" Settings&dbox1))"1")
		      (=(cdr(assoc "JB_1_to8" Settings&dbox1))"1")
		     )
		      
		  (alert "Es muss mindestens ein Anpassungsformat aktiviert sein.")))
	(setq ok -1)
	)
      )
    )
    

  (setq v_liste (JB_DBA:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
  (JBf_SIC:sichern v_liste pfad_ini nil)

  (if (= ok 1)
    (if (= 1(JB_DBA:DBoxJn "Vor den Anpassungen sollten alle geöffneten Zeichnungen vorher gespeichert sein, fortfahren?"))
      (JB_DBA:DBox1:Adjust)
      )
    )
  
  
    
	 
  )

;;;Action (Variable global in Aufrufender Funktion)
(defun JB_DBA:Dbox1:action (key /  nStr FILEPATH FILTER)

  (cond 
	((member key '("JB_1_to1" "JB_1_to2" "JB_1_to3" "JB_1_to4" "JB_1_to5" "JB_1_to6" "JB_1_to7" "JB_1_to8"))
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value key))
	 ;;;FilterEinstellungen
	 (JB_DBA:Dbox1:l1:Ini:Filter)
	 (JB_DBA:Dbox1:set)
	 (JB_DBA:Dbox1:mode)
	 )
	((member key '("JB_1_p1" "JB_1_p2" "JB_1_p3" "JB_1_p4" "JB_1_p6" "JB_1_p7" "JB_1_p8"))
	 (setq nStr(substr key 7))
	 (set(read (strcat "p" nStr "_sel&DBox1"))(atoi $value))
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (nth (eval(read (strcat "p" nStr"_sel&DBox1")))(eval(read (strcat "p" nStr "&DBox1"))))(strcat "JB_1_p" nStr)))
	 (if(<(atoi nStr)5)
	   (progn
	     (JB_DBA:Dbox1:l1:Ini:Filter)
	     (JB_DBA:Dbox1:set)
	     (JB_DBA:Dbox1:mode)	     
	     )
	   )
	 )

	((= key "JB_1_b1")
	 (if (and(setq FilePath (getfiled "Wählen Sie eine DBS-Datei \"JB_DBS_PropList.lsp\" aus:"
				      (if (cdr(assoc "JB_1_t1" Settings&dbox1))
					(cdr(assoc "JB_1_t1" Settings&dbox1))
					"JB_DBS_PropList.lsp")
				      "lsp" 4))
		 (or (=(strcase(strcat (cadr(fnsplitl FilePath))(caddr(fnsplitl FilePath))))(strcase "JB_DBS_PropList.lsp"))
		     (alert "Die ausgewählte DBS-Datei muss \"JB_DBS_PropList.lsp\" heißen."))
		 )
	
	   (progn
	     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 FilePath "JB_1_t1"))
	     ;;;Loaden der DBS-Datei
	     (JB_DBA:Dbox1:l1:Ini-p)
	     ;;;FilterEinstellungen
	     (JB_DBA:Dbox1:l1:Ini:Filter)
	     ;;;RootFolder
	     (setq t2&Dbox1(JB_DBA:Dbox1:l1:Ini:RootFolder))
	     (JB_DBA:Dbox1:set)
	     (JB_DBA:Dbox1:mode)
	     )
	   )
	 )

	((= key "JB_1_b2")
	 (if (setq Filter (JB_DBA:DBox2 (cdr(assoc "JB_1_t3" Settings&dbox1))))
	   (progn
	     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 Filter "JB_1_t3"))
	     (JB_DBA:Dbox1:l1:Ini:Filter)
	     (JB_DBA:Dbox1:set)
	     (JB_DBA:Dbox1:mode)
	     )
	   )
	 )

	((= key "JB_1_r1")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 0 "JB_1_r1-2"))
	 (JB_DBA:Dbox1:l1:Ini:Filter)
	 (JB_DBA:Dbox1:set)
	 (JB_DBA:Dbox1:mode)
	 )

	((= key "JB_1_r2")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 1 "JB_1_r1-2"))
	 (JB_DBA:Dbox1:l1:Ini:Filter)
	 (JB_DBA:Dbox1:set)
	 (JB_DBA:Dbox1:mode)
	 )
	
        ((= key "cancel");;;Ende
         (setq JB_DBA$DCL$_1_po (done_dialog 99))
         )
	((= key "accept");;;OK	
         (setq JB_DBA$DCL$_1_po (done_dialog 1))
         )
        )
  )



;;;PopupLists
(defun JB_DBA:Dbox1:set:p (key pList n_Sel / )
  (start_list key 3)
  (mapcar 'add_list pList)
  (end_list)
  (set_tile key (itoa n_sel))
  )
	  
  
;;;Dbox1; Werte setzen 
(defun JB_DBA:Dbox1:set ( / A X)
  (mapcar '(lambda(A)
             (set_tile (strcat "JB_1_"(car A))(cadr A)))
	  (list
	    (list "t1" (JBf_String:PathFileName:reduce(if(cdr(assoc "JB_1_t1" Settings&dbox1))(cdr(assoc "JB_1_t1" Settings&dbox1))"")110))
	    (list "t2" (JBf_String:PathFileName:reduce(if t2&Dbox1 t2&Dbox1 "")110))
	    (list "t3" (cdr(assoc "JB_1_t3" Settings&dbox1)))
	    (list "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
	    (list "to2" (cdr(assoc "JB_1_to2" Settings&dbox1)))
	    (list "to3" (cdr(assoc "JB_1_to3" Settings&dbox1)))
	    (list "to4" (cdr(assoc "JB_1_to4" Settings&dbox1)))
	    (list "to5" (cdr(assoc "JB_1_to5" Settings&dbox1)))
	    (list "to6" (cdr(assoc "JB_1_to6" Settings&dbox1)))
	    (list "to7" (cdr(assoc "JB_1_to7" Settings&dbox1)))
	    (list "to8" (cdr(assoc "JB_1_to8" Settings&dbox1)))
	    (list "r1" (itoa(- 1(cdr(assoc "JB_1_r1-2" Settings&dbox1)))))
	    (list "r2" (itoa(cdr(assoc "JB_1_r1-2" Settings&dbox1))))
	    
	    )
	  )

  (mapcar '(lambda(X)
	     (JB_DBA:Dbox1:set:p (car X)(eval (cadr X))(eval (caddr X))))
	  '(("JB_1_p1" p1&Dbox1 p1_sel&DBox1)
	    ("JB_1_p2" p2&Dbox1 p2_sel&DBox1)
	    ("JB_1_p3" p3&Dbox1 p3_sel&DBox1)
	    ("JB_1_p4" p4&Dbox1 p4_sel&DBox1)
	    ("JB_1_p6" p6&Dbox1 p6_sel&DBox1)
	    ("JB_1_p7" p7&Dbox1 p7_sel&DBox1)
	    ("JB_1_p8" p8&Dbox1 p8_sel&DBox1)))

  (start_list "JB_1_l1" 3)
  (mapcar 'add_list
	  (vl-remove-if 'not
	  (mapcar '(lambda(X)
		     (if (cdr(assoc "Filter" (cdr X)))
		     (strcat "Blockskalierung"
			     (if (cdr(assoc "BlockScaling"(cdr X)))
			       (strcat "=" (itoa (cdr(assoc "BlockScaling"(cdr X)))))
			       " -")
			     "\t"
			      "Einheit"
			     (if (cdr(assoc "Units"(cdr X)))
			       (strcat "=" (itoa (cdr(assoc "Units"(cdr X)))))
			       " -")
			     "\t"
			      "Beschriftung"
			     (if (cdr(assoc "ANNOTATIVEDWG"(cdr X)))
			       (strcat "=" (itoa (cdr(assoc "ANNOTATIVEDWG"(cdr X)))))
			       " -")
			     "\t"
			     "dynamisch"
			     (if (cdr(assoc "Dynamic"(cdr X)))
			       (strcat "=" (itoa (cdr(assoc "Dynamic"(cdr X)))))
			       " -")
			     "\t"
			     (substr (cdr(assoc "Path" (cdr X)))(+ 1(strlen t2&Dbox1)))			     
			     (car X)))
		     )
		  l1&DBox1)))
  (end_list)
  (set_tile "JB_1_l1" "")
  )





;;;DBOX 1, moden
(defun JB_DBA:Dbox1:mode ( / n)

  (setq n 0)
  (repeat 8
    (setq n (+ n 1))
    (if (= n 5)
      (if (=(cdr(assoc (strcat "JB_1_to" (itoa n))Settings&dbox1))"1")
	(progn
	  (mode_tile "JB_1_b2" 0)
	  (mode_tile "JB_1_t3" 0)
	  )
	(progn
	  (mode_tile "JB_1_b2" 1)
	  (mode_tile "JB_1_t3" 1)
	  )
	)
      
    (if (=(cdr(assoc (strcat "JB_1_to" (itoa n))Settings&dbox1))"1")
      (mode_tile (strcat "JB_1_p" (itoa n))0)
      (mode_tile (strcat "JB_1_p" (itoa n))1))
    )
    )
  
  (if (or (not(cdr(assoc "JB_1_t1" Settings&dbox1)))
	  (not(findfile(cdr(assoc "JB_1_t1" Settings&dbox1))))
	  (not l1&DBox1))
    (progn
      (mode_tile "accept" 1)
      (mode_tile "JB_1_b1" 2)
      (if (not l1Base&DBox1)
	(alert "Bitte wählen Sie eine DBS-Datei \"JB_DBS_PropList.lsp\" aus.")))
    (progn
      (mode_tile "accept" 0)
      (mode_tile "accept" 2)
      )
    )

  
  )


;;;DBox1, Anpassen
(defun JB_DBA:DBox1:Adjust ( / DBX DBXSPACE ERRORNOTVORHANDENLIST ERRORNOTWRITELIST FILEPATH PROGRESSLIST X)

  (if (=(cdr(assoc "JB_1_to6" Settings&dbox1))"1");;;dann BlockScale über DBX

    (progn
      (setq ProgressList
	     (list(list(list 1 "Blockskalierung" (if (=(cdr(assoc "JB_1_to6" Settings&dbox1))"1")(length l1&DBox1)))		       
		       ))
	    )
      (JBf_ProgressBar_01:X:DBox:Start "DWG-Verzeichnis scannen" ProgressList 'T)
      (mapcar '(lambda(X)
	       (setq FilePath (strcat (cdr(assoc "Path" (cdr X)))(car X)".dwg"))
	       (if (findfile FilePath)
		 (if (setq DBX(JBf_DBX))
		   (progn
		     (if (JBf_DBX:Open DBX FilePath)
		       (progn
			 (setq DbxSpace(vla-get-ModelSpace DBX))
			 
			 (if(=(cdr(assoc "JB_1_to6" Settings&dbox1))"1");;;Block Scaling
			   (progn
			     (JBf_progress_01:X:DBox:Fortschritt 1)
			     (vla-put-BlockScaling DbxSpace(atoi(cdr(assoc "JB_1_p6" Settings&dbox1)))))
			   )
			 
			 (JBf_DBX:SaveAs DBX FilePath)
			 
			 )
		       (setq ErrorNotWriteList (cons FilePath ErrorNotWriteList)))
		     (JBf_DBX:Release DBX))
		   (setq ErrorNotWriteList (cons FilePath ErrorNotWriteList))
		   )
		 (setq ErrorNotVorhandenList (cons FilePath ErrorNotVorhandenList))))
	    l1&DBox1)

      (JBf_progress_01:X:DBox:End)

      (if ErrorNotWriteList
	(alert (strcat "\nFolgende DWG-Dateien konnten nicht aktualisiert werden:\n"
		       (apply 'strcat
			      (mapcar '(lambda(X)
					 (strcat "\n- " X))ErrorNotWriteList)))))
      (if ErrorNotVorhandenList
	(alert (strcat "\nFolgende DWG-Dateien waren nicht vorhanden:\n"
		       (apply 'strcat
			      (mapcar '(lambda(X)
					 (strcat "\n- " X))ErrorNotVorhandenList)))))
      )
    )

  (if (and(or(=(cdr(assoc "JB_1_to7" Settings&dbox1))"1")
	      (=(cdr(assoc "JB_1_to8" Settings&dbox1))"1"))
	  (= 1(JB_DBA:DBoxJn (strcat "Für die Einheit / Beschriftungseigenschaft müssen die " (itoa(length l1&DBox1)) " DWG-Dateien im Skriptablauf geöffnet werden, fortfahren?"))))
    (JB_DBA:DBox1:Adjust:GetFromScript)
    )
  )


  ;;;Per Scriptablauf direkt aus den Zeichnungen
(defun JB_DBA:DBox1:Adjust:GetFromScript ( / DEFTEXT DWGFILE ERRORNOTVORHANDENLIST FILEPATH FILESTREAM LISPPATHFILE N NMAX SCRPATHFILE WRITELIST X)


  (vl-bb-set 'JB_DBA$$BlockN (length l1&DBox1))

  (setq n 0)
  (setq nMax (length l1&DBox1))

  

  (setq LispPathFile(vl-string-translate"\\" "/"(findfile "DwgBlockAdjust.lsp")))  

  
  (foreach X l1&DBox1
    
      
    (setq DefText (strcat (itoa(setq n (+ n 1)))"/"(itoa nMax)))

    (setq FilePath (strcat (cdr(assoc "Path" (cdr X)))(car X)".dwg"))
    (if (findfile FilePath)
      (progn
	(setq DwgFile (vl-string-translate"\\" "/" FilePath))
	(setq writeList (cons(strcat "_.OPEN \"" DwgFile "\"")writeList))
	(setq writeList (cons(strcat "(load \"" LispPathFile "\")")writeList))
	(setq writeList (cons(strcat "(JB_DBA:DBox1:Adjust:GetFromScript:TextDef \"" DefText "\")")writeList))
	(if (=(cdr(assoc "JB_1_to7" Settings&dbox1))"1")
	  (setq writeList (cons(strcat "(setvar \"INSUNITS\" " (itoa(atoi(cdr(assoc "JB_1_p7" Settings&dbox1))))")")writeList)))
	(if (=(cdr(assoc "JB_1_to8" Settings&dbox1))"1")
	  (setq writeList (cons(strcat "(setvar \"ANNOTATIVEDWG\" " (itoa(atoi(cdr(assoc "JB_1_p8" Settings&dbox1))))")")writeList)))
	(setq writeList (cons"(vl-bb-set 'JB_DBA$$BlockN (-(vl-bb-ref 'JB_DBA$$BlockN)1))"writeList))
	(setq writeList (cons (strcat "(JB_DBA:DBox1:Adjust:GetFromScript:Ausgabe)")writeList))

	(setq writeList (cons "(JB_DBA:DBox1:Adjust:GetFromScript:TextDel)" writeList))
	(setq writeList (cons "_.QSAVE" writeList))
	(setq writeList (cons "_.CLOSE" writeList))

	)
      (setq ErrorNotVorhandenList (cons FilePath ErrorNotVorhandenList))
      )
    )

  


  (if ErrorNotVorhandenList
      (alert (strcat "\nFolgende DWG-Dateien waren nicht vorhanden:\n"
		     (apply 'strcat
			    (mapcar '(lambda(X)
				       (strcat "\n- " X))ErrorNotVorhandenList)))))


  (setq ScrPathFile (strcat t2&Dbox1 "DwgBlockAdjust.scr"))  
  
  (setq FileStream (open ScrPathFile "w"))
  (mapcar '(lambda(X)
	     (write-line X FileStream)
	     )
	  (reverse WriteList))
  (close FileStream)

  ;;Ausführen des Scriptes
  (command "_.SCRIPT" (vl-string-translate"\\" "/" ScrPathFile))
  )



;;;Prüfen, ob Scriptablauf zu Ende, wenn ja, dann wird der Abschluss duchgeführt und die finalen Dateien erstellt
(defun JB_DBA:DBox1:Adjust:GetFromScript:Ausgabe ( / )
  (if (=(vl-bb-ref 'JB_DBA$$BlockN)0)
    (alert "Der Skriptablauf ist beendet, die DWG-Dateien wurden angepasst.")
    )
  )





;;;Progress für Command-Varianten (einfach einen Text mitlaufen lassen)
(defun JB_DBA:DBox1:Adjust:GetFromScript:TextDef (DefText / HOEHE PKT TEXTSTYLELIST vla-objText)
;;;Text erstellen für Bildschirmanzeige

  (setq TextStyleList '(
                       (0 . "STYLE")(100 . "AcDbSymbolTableRecord")(100 . "AcDbTextStyleTableRecord")(2 . "DBA_ARIAL")
                        (70 . 0)(40 . 0.0)(41 . 1.0)(50 . 0.0)(71 . 0)(42 . 2.5)(3 . "arial.ttf")(4 . "")))
  (if (not (tblsearch "STYLE" "DBA_ARIAL"))
    (entmake TextStyleList))

  (setq Hoehe (/(getvar "VIEWSIZE")10.0))


  
  (entmake (list
            '(0 . "TEXT") (cons 10 (mapcar '+ (trans(JBf_Zoom:BildschirmMittelpunkt)1 0) (list Hoehe 0.0))) 
             (cons 40 Hoehe) (cons 1 DefText) '(50 . 0.0) '(62 . 6)'(7 . "DBA_ARIAL")
            '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(73 . 0)))
  (setq vla-objText(vlax-ename->vla-object(entlast)))

  (vla-put-alignment vla-objText acalignmentcenter)
  ;(if (= 0 (vla-get-alignment vla-objText));;; => 0 = Left, 1 = Center, 2 = Right
(vla-put-textalignmentpoint vla-objText (vlax-3D-point (trans(JBf_Zoom:BildschirmMittelpunkt)1 0)))
  (vla-update vla-objText)

  (setq JB_DBA$$vla-objText vla-objText)
  )


(defun JB_DBA:DBox1:Adjust:GetFromScript:TextDel ( / )
  (vla-delete JB_DBA$$vla-objText)
  )




;;;aktueller Bildschirmmittelpunkt
(defun JBf_Zoom:BildschirmMittelpunkt ( / )
  (mapcar '(lambda(A)(/ A 2.0))
  (mapcar '+
  (list (- (car (getvar "viewctr")) (/ (* (getvar "viewsize") (/ (car (getvar "screensize")) (cadr (getvar "screensize")))) 2))
        (- (cadr (getvar "viewctr")) (/ (getvar "viewsize") 2))0.0)
  (list (+ (car (getvar "viewctr")) (/ (* (getvar "viewsize") (/ (car (getvar "screensize")) (cadr (getvar "screensize")))) 2))
        (+ (cadr (getvar "viewctr")) (/ (getvar "viewsize") 2))
        0))))



 

;;;Filterwert
(defun JB_DBA:Dbox2 (wert&Dbox2 / A DCLID OK)


    (setq DclId(JBf_Dcl:Load_dialog JB_DBA_$DCL$_File "DBA_2" JB_DBA$DCL$_2_po))
    
    (set_tile "JB_2_e1" wert&Dbox2)
    (mode_tile "JB_2_e1" 2)
           
    (mapcar '(lambda(A)(action_tile A (strcat "(JB_DBA:Dbox2:action \""A"\")")))
      '(
        "accept" "cancel"))

    (setq ok (start_dialog))
    (unload_dialog DclId)

    (if(= ok 1)
      (if (= wert&Dbox2 "")
	(setq wert&Dbox2 "*"))
      (setq wert&Dbox2 nil)
      )
	 
 wert&Dbox2 )



(defun JB_DBA:Dbox2:action (key /)

  (cond 
        ((= key "cancel");;;Abbrechen
         (setq JB_DBA$DCL$_2_po (done_dialog 99))
         )
	((= key "accept");;;OK
	 (setq wert&Dbox2 (get_tile "JB_2_e1"))
         (setq JB_DBA$DCL$_2_po (done_dialog 1))
         )
        )
  )


;;;JA-Nein-Frage 1-zeilig
(defun JB_DBA:DBoxJn (frage / DCLID OK)
  (setq DclId(JBf_Dcl:Load_dialog JB_DBA_$DCL$_File "JBosse_jn" JB_DBA$DCL$_jn_po))
  (set_tile "JB_jn" frage)
  ;;;Button-Action
  (action_tile "JB_nein" "(done_dialog 99)") ;Nein
  (action_tile "JB_ja" "(done_dialog 1)") ;Ja
  (setq ok (start_dialog))
  (unload_dialog DclId)
  ok)  
  
			     


;;;DCL-Datei schreiben
(defun JB_DBA:Dcl:Write ( / A  FILE)
  (if(and(setq JB_DBA_$DCL$_File(vl-filename-mktemp (strcat "DBA.dcl")))
         (setq file (open JB_DBA_$DCL$_File "w")))
    (progn
    (mapcar '(lambda(A)
               (write-line A file))
      (mapcar '(lambda(A)
                 (strcat "\n" A))
        '(
                "//Hauptdialog"
                "DBA_1: dialog {label = \"DWG-Dateien aus DBS-Datei anpassen\";"
                ":boxed_row {label = \"Dateiauswahl\";"
                ":button {key = \"JB_1_b1\"; label = \"&Datei...\"; fixed_width = true;}"
                ":text {key = \"JB_1_t1\"; label = \"c:\\\\temp\\\\JB_DBS_PropList.lsp\";width = 120;}"
                "}"
                ":boxed_column {label = \"Eigenschschaften pro Block\";"
                ":text {key = \"JB_1_t2\"; label = \"C:\\\\temp\\\\Blockverzeichnis\\\\\"; width = 110;}"
                ":list_box {key = \"JB_1_l1\"; label = \"Blockeigenschaften aus DBS-Datei:\";tabs= \"20 40 60 80\"; height = 20;}"
                ":boxed_column {label = \"Filter\";" 
                ":row {"
                ":column {"
                ":toggle {key = \"JB_1_to1\";label = \"Blockskalierung\";}"
                ":popup_list {key = \"JB_1_p1\";edit_width = 20;}}"
                ":column {"
                ":toggle {key = \"JB_1_to2\";label = \"Einheit\";}"
                ":popup_list {key = \"JB_1_p2\";edit_width = 20;}}"
                ":column {"
                ":toggle {key = \"JB_1_to3\";label = \"Beschriftung\";}"
                ":popup_list {key = \"JB_1_p3\";edit_width = 20;}}"
                ":column {"
                ":toggle {key = \"JB_1_to4\";label = \"dynamisch\";}"
                ":popup_list {key = \"JB_1_p4\";edit_width = 20;}}"
                ":column {"
                ":toggle {key = \"JB_1_to5\";label = \"Blockname\";}"
                ":row {"
                ":button {key = \"JB_1_b2\"; label = \"...\"; fixed_width = true;}"
                ":text {key = \"JB_1_t3\"; label = \"BA*\";width = 20;}}"
                "}"
                "}"
                ":radio_row {label = \"Filterverknüpfung\";"
                ":radio_button {key = \"JB_1_r1\"; label = \"UND\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"ODER\";}"
                ":spacer {width = 60;}"
                "}"
                "}"
                ":boxed_row {label = \"Anpassungen\";"
                ":column {"
                ":toggle {key = \"JB_1_to6\";label = \"Blockskalierung\";}"
                ":popup_list {key = \"JB_1_p6\";edit_width = 20;}}"
                ":column {"
                ":toggle {key = \"JB_1_to7\";label = \"Einheit\";}"
                ":popup_list {key = \"JB_1_p7\";edit_width = 20;}}"
                ":column {"
                ":toggle {key = \"JB_1_to8\";label = \"Beschriftung\";}"
                ":popup_list {key = \"JB_1_p8\";edit_width = 20;}}"
                ":spacer {width = 50;}"
                "}"
                "}"
                ":row {fixed_width = true;alignment = centered;"
                ":button {key = \"accept\"; label = \"&Anpassungen durchführen\";fixed_width = true;}"
                ":spacer {width = 2;}"
                ":button {label = \"&Ende\";  key= \"cancel\";is_cancel=true;}"
                "}}"
                "DBA_2: dialog {label = \"Blocknamefilter\";"
                ":boxed_column {label = \"Filter eingeben\";"
                ":edit_box {key = \"JB_2_e1\"; edit_width = 25;allow_accept=true;}}"
                "ok_cancel;}"
                "JBosse_jn : dialog {label = \"Frage: Ja oder Nein\";"
                ":text {value = \"Hier kommt die zu bejahende oder beneinende Frage hin.\"; key =\"JB_jn\"; width = 100;}"
                ":row {fixed_width = true;alignment = centered;"
                ":retirement_button {label= \" Ja \"; key = \"JB_ja\"; is_default  = true;}"
                ":spacer {width = 2;}"
                ":retirement_button {label = \"Nein\"; key = \"JB_nein\"; is_cancel= true;}}}"

          )))
    (close file)
    JB_DBA_$DCL$_File)
    )
  )


;;;Aktueller Space für VLA-Kram
(defun JB_DBA:CurrentSpace ( / )
  (if (or(= (strcase (getvar "CTAB")) "MODEL")
	   (/=(getvar "CVPORT")1))
      (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
      (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
  )



  
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine verwaltungstechnische Funktionen							   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Fehlermeldung
;;;Fehlermeldung;;;
(defun JBf_Error  (s)
  (print (strcat "***Fehler*** " s))
  (JBf_Reinit))

;;;Initialisierungsfunktion
(defun JBf_init (InitVaris / )
  (setq	JB_Error *error*
        *error* JBf_Error)
  (vl-load-com)
  ;;;Systemvariablen aktuelle Einstellungen für ReInit speichern
  (setq JBf$ReInit$Varis
         (mapcar '(lambda(A)
                    (list (car A)(getvar (car A))))InitVaris))
  ;;;Vorgabeeistellungen für Systemvariablen
  (mapcar '(lambda(A)
             (if (cadr A)
               (setvar (car A)(cadr A))))InitVaris)
                   
                   
  )
;;;Reinitialisierung
(defun JBf_Reinit ( / n)
  ;;;Systemvariablen ReInitialisieren
  (mapcar '(lambda(A)
             (setvar (car A)(cadr A)))JBf$ReInit$Varis)
  (setq JBf$ReInit$Varis nil)
  (princ)
)
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Strings								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


;;;benutzerspezifischer Pfad zum Speichern von Programmeinstellungen
(defun JBf_String:Userpfad:WinUser (UserPfad / )
  
  (setq UserList (JBf_String:Delimiter->List UserPfad "\\"))
  (setq Pfad (strcat "c:\\Users\\"(getvar "LOGINNAME")"\\"))
        

  ;;;wenn UserPfad noch nicht vorhanden, dann erstellen
  (mapcar '(lambda(A)
             (setq Pfad (strcat Pfad A "\\"))
             (if (not (JBf_String:FilePath? Pfad))
               (vl-mkdir Pfad)))
    UserList)
  Pfad
  )


;;;String anhand Trennzeichen in Liste zurückgeben
(defun JBf_String:Delimiter->List (Str Delim / StrList)
  (setq Str (vl-string-left-trim Delim Str)
	Str (vl-string-right-trim Delim Str))
  (if (vl-string-search Delim Str)
    (progn
      (while (vl-string-search Delim Str)
        (setq StrList (cons (substr Str 1 (vl-string-search Delim Str))StrList)
	      Str (vl-string-left-trim Delim(substr Str(+(vl-string-search Delim Str)(+ (strlen Delim)1))))))
      (if (/= Str "")
        (setq StrList (cons Str StrList))))
    (setq StrList (cons Str StrList)))
  (reverse StrList))

;;;Dateipfad prüfen
(defun JBf_String:FilePath? (Pfad / FSO TRUE-FALSE)
  (setq Pfad (if(vl-string-search "." Pfad)(car(fnsplitl  Pfad))Pfad))
  (if (setq FSO (vlax-create-object "Scripting.FilesystemObject"))
    (progn
      (if (vlax-method-applicable-p FSO 'FOLDEREXISTS)
        (setq TRUE-FALSE
               (=(vl-catch-all-apply
                   'vlax-invoke-method
                   (list FSO 'FOLDEREXISTS Pfad)):vlax-true))
        (vlax-release-object FSO))))
  TRUE-FALSE)


;;;Dateipfad kürzen (Filename bleibt komplett erhalten), wenn nur Pfad, dann wird in der Mitte getrennt
(defun JBf_String:PathFileName:reduce (PathFileName Lmax / )
  
(if(>(strlen PathFileName)Lmax)
  (if (fnsplitl PathFileName)
    (progn
      (setq FileName (strcat (cadr(fnsplitl PathFileName))(caddr(fnsplitl PathFileName)))
            LPrae (- Lmax (strlen FileName)))
      (if (<= LPrae 0);;;wenn Dateiname größer als Lmax
        (strcat (substr PathFileName 1 (- (/ Lmax 2) (/ Lmax 50)))"..."(substr PathFileName(-(strlen PathFileName)(- (/ Lmax 2) (/ Lmax 50)))))
        (strcat (substr PathFileName 1 (-(- Lmax (strlen FileName))(/ Lmax 50)))"..."
          (substr PathFileName(-(-(strlen PathFileName)(strlen FileName))(/ Lmax 50))))
        )
      )
    (strcat (substr PathFileName 1 (fix (/ Lmax 2.0)))"..."(substr PathFileName (-(strlen PathFileName)(+(fix(/ Lmax 2.0))4)))))
  
  PathFileName)
)



;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Listen								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Es wird der GcN-Eintrag gesubst
(defun JBf_list:subst:gc (liste Wert GcN / )
  (subst (cons GcN Wert)(assoc GcN liste)liste))



;;;--------------------------------------------------------------------------------------------------------
;;;alLGZmeine Funktionen => Listen in SIC-Datei sichern  					   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Liste in LSP-Datei sichern
;;;Sichern von Einstellungen, Ausführung
;;;liste => DottetPairList, die es zu sichern gilt
;;;path => vollständiger Dateipfad mit Dateiname
;;;AcadTrustCheck => 'T or NIL, es wird bei 'T ein temnporärer TrustedPath erstellt und danach auch gleich wieder gelöscht
(defun JBf_SIC:sichern (liste FilePath AcadTrustCheck / FILESTREAM X)

  (setq FileStream (open FilePath "w"))
  (write-line "'(" FileStream)
  (mapcar '(lambda (X)
                   (JBf_SIC:sichern:prin1 X FileStream)
           )
          liste
  )
  (write-line ")" FileStream)
  (close FileStream)

  (if
    (if AcadTrustCheck
      (car (JBf_SIC:load:Catch FilePath nil))
      (vl-catch-all-error-p
        (vl-catch-all-apply 'JBf_SIC:load (list FilePath))
      )
    )


    (if (findfile (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
      (progn
        (alert (strcat "Die Sicherungsdatei \n\n"
                       FilePath
                       "\n\n ist fehlerhaft und wird automatisch durch die BAK-Datei\n\n"
                       (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                       "\n\nersetzt."
               )
        )
        (if (vl-file-delete FilePath)
          (vl-file-copy (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak") FilePath)
          (alert (strcat "Die Sicherungsdatei \n\n"
                         FilePath
                         "\n\n ist fehlerhaft und konnte nicht automatisch durch die BAK-Datei\n\n"
                         (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                         "\n\nersetzt werden. Bitte führen Sie diesen Arbeitsgang manuell durch."
                 )
          )
        )
      )

      (alert (strcat "Die Sicherungsdatei \n\n"
                     FilePath
                     "\n\n ist fehlerhaft, bitte löschen Sie diese, anderfalls kann das Programm nicht mehr\n"
                     "ordnungsgemäß starten."
             )
      )
    )
    (if (findfile (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
      (if (vl-file-delete (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
        (vl-file-copy FilePath (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
        (alert (strcat "Für die Sicherungsdatei \n\n"
                       FilePath
                       "\n\n konnte keine BAK-Datei erstellt werden. Bitte löschen Sie die vorh. BAK-Datei\n\n"
                       (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                       "\n\nmanuell."
               )
        )
      )
      (vl-file-copy FilePath (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
    )
  )
)
;;;Laden der Datei um zu prüfen, ob diese korrekt ist!
  (defun JBf_SIC:load (FilePath /)
    (load FilePath)
  )
;;;Pfad muss existieren, Prüfung in aufrufender Funktion und temporärem TrustPath
  (defun JBf_SIC:load:Catch (PathFile ErrMsg / ERROR RETVAL TRUTHPATHSET)
    (if (JBf_AcadSystem:TrustedPaths?)
      (progn
        (setq TruthPathSet 'T)
        (JBf_AcadSystem:TrustedPaths:Add (strcat (car (fnsplitl PathFile)) "..."))
      )
    )

    (setq error (vl-catch-all-error-p
                  (setq RetVal (vl-catch-all-apply 'JBf_SIC:load (list PathFile)))
                )
    )
    (if (and error ErrMsg)
      (alert ErrMsg)
    )

    (if TruthPathSet
      (JBf_AcadSystem:TrustedPaths:Delete (strcat (car (fnsplitl PathFile)) "..."))
    )
    (list error RetVal)
  )
;;;Iteratives lustiges Listenschreiben
  (defun JBf_SIC:sichern:prin1 (A FileStream / B)

    (cond  ;;;wenn einzelner Eintrag
                 ((atom A)
                        (write-line (vl-prin1-to-string A) FileStream)
                 )
      ((and (atom (car A)) (not (cdr A)))  ;;;GC ohne Wert
            (write-line (vl-prin1-to-string A) FileStream)
      )
      ((and (atom (car A)) (cdr A) (not (listp (cdr A))))  ;;;DottedPair
            (write-line (vl-prin1-to-string A) FileStream)
      )
      ((and (atom (car A)) (cdr A) (listp (cdr A)) (= (length (cdr A)) 1) (atom (car (cdr A))))  ;;;GC + Wert
            (write-line (strcat "(" (vl-prin1-to-string (car A))) FileStream)
            (mapcar '(lambda (B)
                             (JBf_SIC:sichern:prin1 B FileStream)
                     )
                    (cdr A)
            )
         (write-line ")" FileStream)
      )
      ((and (atom (car A)) (cdr A) (listp (cdr A)))  ;;;GC + Liste
            (write-line (strcat "(" (vl-prin1-to-string (car A))) FileStream)
            (mapcar '(lambda (B)
                             (JBf_SIC:sichern:prin1 B FileStream)
                     )
                    (cdr A)
            )
         (write-line ")" FileStream)
      )
      ( 'T
        (write-line "(" FileStream)
        (mapcar '(lambda (B)
                         (JBf_SIC:sichern:prin1 B FileStream)
                 )
                A
        )
         (write-line ")" FileStream)
      )
    )
  )  



;;;--------------------------------------------------------------------------------------------------------
;;;Setzen von "TrustedPaths's" ab ACAD  2014								   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Prüfen, ob bereits TrustedPaths in der aktuelle Version verwendet werden können
(defun JBf_AcadSystem:TrustedPaths? ( / )
  (and (= "ACAD" (strcase (getvar "PROGRAM"))) (getvar "SECURELOAD"))
  )

;;;Pfadangaben immer mit BackSlashes, "\\..." hinten angestellt, damit alle untergeordneten Verzeichnisse berücksichtigt werden
(defun JBf_AcadSystem:TrustedPaths:Add (pfad / TRUSTEDPATHS)
  (setq TrustedPaths(if (getvar "TRUSTEDPATHS")(getvar "TRUSTEDPATHS")""))
  (if(not(member (strcase pfad)(mapcar 'strcase (JBf_AcadSystem:TrustedPath:Split TrustedPaths))))
    (setvar "TRUSTEDPATHS"(strcat TrustedPaths ";" pfad)))
  )

;;;Pfad entfernen
(defun JBf_AcadSystem:TrustedPaths:Delete (pfad / A TRUSTEDPATHS)
  (setq TrustedPaths(if (getvar "TRUSTEDPATHS")(getvar "TRUSTEDPATHS")""))
  (setvar "TRUSTEDPATHS"
	  (vl-string-right-trim ";"(apply 'strcat(mapcar '(lambda(A)
							   (strcat A ";"))
							(vl-remove-if 'not (mapcar '(lambda(A)
										      (if(/= (strcase pfad)(strcase A))A))
										   (JBf_AcadSystem:TrustedPath:Split TrustedPaths)))))))
  )
			     

;;;String splitten an Semikolons, als Liste zurückgeben
(defun JBf_AcadSystem:TrustedPath:Split (TrustedPaths / A RETLIST TEMP)
  (mapcar '(lambda(A)
	     (if (/= A 59)
	       (setq temp (cons A temp))
	       (setq RetList (cons (vl-list->string(reverse temp))RetList)
		     temp nil))
	     )
	     (vl-string->list TrustedPaths))
  (if temp
    (setq RetList (cons (vl-list->string (reverse temp))RetList)))
  (reverse RetList))

;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Dcl									   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



;;;DCL-Dialogfenster laden
(defun JBf_Dcl:Load_dialog (FileName DialogName JB_$DCL$_x_po / DclId)
  (setq DclId (load_dialog FileName))
  (if	JB_$DCL$_x_po
    (if (not (new_dialog DialogName DclId "" JB_$DCL$_x_po))
      (exit))
    (if (not (new_dialog DialogName DclId))
      (exit)))
  DclId
  )


;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => ProgressBarsX							   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


;;;Starten der Progressbar einschließlich Setzen von Variablen
(defun JBf_ProgressBar_01:X:DBox:Start (Titel XList DclNewFlag /  SPALTE SPALTEN X ZEILE ZEILEN iX1 iY1)

  (if DclNewFlag (setq JBf_progress_01X$DCL$_File nil))

  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (JBf_ProgressBar_01:X:Ini XList)
      (setq JBf_progress_01X$$dat (load_dialog JBf_progress_01X$DCL$_File))
      (if (not (new_dialog "JBf_ProgressX_01_1" JBf_progress_01X$$dat "" '(-1 -1))) (exit))

      ;;;weil alle ProgBars gleiche Größe haben wird X_tile und Y_tile anhand der ersten rausgezogen und für alle verwendet
      (setq iX1 (dimx_tile (strcat "JB_1_i1_s1z1")))
      (setq iY1 (dimy_tile (strcat "JB_1_i1_s1z1")))

      (if Titel (set_tile "JB_1_d" Titel))
      
      (setq SpalteN 0)
      (setq JBf_progress_01X$$List
	     (apply 'append
		    (mapcar '(lambda(spalte)
			(setq SpalteN (+ SpalteN 1))
			(setq ZeileN 0)
			       (vl-remove-if 'not
				 (mapcar '(lambda(zeile)
					    (setq ZeileN (+ ZeileN 1))
					    (if (cadr zeile)
					      (list(strcat "s" (itoa SpalteN) "z" (itoa ZeileN))						   
						   zeile)
					      )
				     )
				   
				spalte))
			       )
			    XList)))
      (JBf_ProgressBar_01:X:DBox:Start:i1:Frame iX1 iY1)
      (JBf_ProgressBar_01:X:DBox:Start:Label)
      (if redraw_dialog (redraw_dialog)) ;; bricsys - if new "redraw_dialog" is available
      ;;;Parameter in Liste
      

      (setq JBf_progress_01X$$ListPara
	     (mapcar '(lambda(X)
			
			  
			(cons (car (cadr X))
			      (list (cons "n" 0)
				    (cons "l" (caddr (cadr X)))
				    (cons "prz" 0)				    
				    (cons "i1X" iX1)
				    (cons "i1Y" iY1)
				    (cons "DclKey" (car X))
				    )
			      )
			)
		     
	    JBf_progress_01X$$List)
	    )

      ;;;wenn Balken nicht in Verwendung, dann grau machen
      (mapcar '(lambda(X)
		 (if (not (cdr(assoc "l" (cdr X))))
			  (JBf_progress_01:X:DBox:VollerBalken (car X))
			  )
		 )
	      JBf_progress_01X$$ListPara)
	      
      
    )
  )
  )

;(JBf_progress_01_X:DBox:Para:Refresh 1 "n" '(+ (cdr(assoc key sub))1))

;;;Progress-Para aktualisieren
(defun JBf_progress_01:X:DBox:Para:Refresh (ProgressN key func / PARASUB)
  (setq ParaSub (cdr(assoc ProgressN JBf_progress_01X$$ListPara)))
  (setq ParaSub (subst (cons key (eval func))(assoc key ParaSub)ParaSub))
  (setq JBf_progress_01X$$ListPara (subst (cons ProgressN ParaSub)(assoc ProgressN JBf_progress_01X$$ListPara)JBf_progress_01X$$ListPara))
  ParaSub)


;;;ProgressBalken im Aufbau
(defun JBf_progress_01:X:DBox:Start:i1:BalkenRun (ProgressN prz ParaSub / i1X i1Y)
  (if (= 100 prz)
    (setq i1X (- (cdr(assoc "i1X" ParaSub))7))
    (setq i1X (atoi(rtos(+(*(/(- (cdr(assoc "i1X" ParaSub)) 7)100.0)prz)2)2 0)))
    )
  (setq i1Y (cdr(assoc "i1Y" ParaSub)))
  
  (start_image (start_image (strcat "JB_1_i1_"(cdr(assoc "DclKey" ParaSub)))))
  (fill_image 4 4 i1X (- i1Y 7) 74)

  (end_image)
  )


;;;ProgressBalken im Aufbau
(defun JBf_progress_01:X:DBox:Start:i1:Balken(ProgressN ParaSub Aci / i1X i1Y)
  (setq i1X (cdr(assoc "i1X" ParaSub)))
  (setq i1Y (cdr(assoc "i1Y" ParaSub)))
  
  (start_image (strcat "JB_1_i1_"(cdr(assoc "DclKey" ParaSub))))
  (fill_image 4 4 (- i1X 7) (- i1Y 7) Aci)

  (end_image)
  )



;;;ProgressBalken durchlaufend (immer nur 10% fortlaufenden Anzeige)
(defun JBf_progress_01:X:DBox:Start:i1:Balken:10erSteps(ProgressN ParaSub StepN N Text / I1X I1XEND I1XSTART I1XSUB I1Y)
  (setq i1X (dimx_tile (strcat "JB_1_i1_"(cdr(assoc "DclKey" ParaSub)))))
  (setq i1Y (cdr(assoc "i1Y" ParaSub)))
  (setq i1XSub (/ (- i1X 8) 10.0))

  (start_image (strcat "JB_1_i1_"(cdr(assoc "DclKey" ParaSub))))
  (fill_image 4 4 (- i1X 8)(- i1Y 7) -15)
  (setq i1XStart (+(fix(*(- StepN 10)i1XSub))4)
	i1XEnd (+(+(fix(*(- StepN 10)i1XSub))4)(fix i1XSub)))
  (fill_image i1XStart 4 (+(- i1XEnd i1XStart)1) (- i1Y 7) 74)
  
  (end_image)
  
  (if (and N Text)(set_tile (strcat "JB_1_t2_" (cdr(assoc "DclKey" ParaSub))) (strcat "("(itoa N) ") - " Text )))
  )
 

;;;ProgressBar X Fortschritt eines Balkens
(defun JBf_progress_01:X:DBox:Fortschritt (ProgressN / PARASUB PRZ )
  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (setq ParaSub(JBf_progress_01:X:DBox:Para:Refresh ProgressN "n" '(+ (cdr(assoc key ParaSub))1)))
      (if (= (cdr(assoc "n" ParaSub))(cdr(assoc "l" ParaSub)))
        (setq prz 100)
        (setq prz (JBf_progress_01:prz (cdr(assoc "l" ParaSub)) (cdr(assoc "n" ParaSub))))
	)
	
      (if (> prz (cdr(assoc "prz" ParaSub)))
        (progn
          (set_tile (strcat  "JB_1_t2_" (cdr(assoc "DclKey" ParaSub)))
		    (strcat "(" (itoa (cdr(assoc "n" ParaSub))) " von " (itoa (cdr(assoc "l" ParaSub))) ")  -  " (strcat (itoa prz) "% erledigt.") ))
	  (JBf_progress_01:X:DBox:Start:i1:BalkenRun ProgressN prz ParaSub) 
          
          (if redraw_dialog (redraw_dialog)) ;; bricsys - if new "redraw_dialog" is available          
	  (JBf_progress_01:X:DBox:Para:Refresh ProgressN "prz" 'prz)
        )
      )
                                     
    )
  )
)
 
    
  

;;;Fortschritt in 10er Schritten => keine Absolutzahl durch Länge AWS/Liste bekannt
;;;StepN muss zwischen 10 und 19 liegen
;;;wenn N, dann die Anzahl, die einfach angeschrieben wird als Zahl, wenn nil, dann kein Anschrieb

;;;Prozenzwert aus l (Gesamtlänge) und n (aktueller Stand)
(defun JBf_progress_01:prz (l n / )
  (/(* n 100)l)
)

;;;Forschritt 10er-Steps
(defun JBf_progress_01:X:10erSteps (ProgressN StepN N Text / X XEND1 XENDMARK XTILE)

  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (setq ParaSub(cdr(assoc ProgressN JBf_progress_01X$$ListPara)))
      (JBf_progress_01:X:DBox:Start:i1:Balken:10erSteps ProgressN ParaSub StepN N Text)
      
      (if redraw_dialog (redraw_dialog)) ;; bricsys - if new "redraw_dialog" is available          
	  
        )
      )
  )

;;;ProgressBar X BalkenOhneVerarbeitung
(defun JBf_progress_01:X:DBox:VollerBalken (ProgressN / PARASUB )
  (setq ParaSub(cdr(assoc ProgressN JBf_progress_01X$$ListPara)))
  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (set_tile (strcat  "JB_1_t2_" (cdr(assoc "DclKey" ParaSub))) "keine Verarbeitung")
	  (JBf_progress_01:X:DBox:Start:i1:Balken ProgressN ParaSub 253)  
          (if redraw_dialog (redraw_dialog)) ;; bricsys - if new "redraw_dialog" is available          
	  
        )
      )
                                     
    )


;;;ProgressBar X: aktuelle Gesamtanzahl, wenn 0, dann VollerBalken, ansonsten auch den Laufwert auf Null setzen, beginnt also wieder bei 0%
(defun JBf_progress_01:X:DBox:NGesamt:Refresh (ProgressN NewN / )
  (if (and NewN (> NewN 0))
    (progn
      (setq JBf_progress_01X$$List
	     (mapcar '(lambda(X)
			(if (/= (car(cadr X))ProgressN)
			  X
			  (list (car X)
				(list (car(cadr X))(cadr(cadr X))NewN))))JBf_progress_01X$$List))
      (setq JBf_progress_01X$$ListPara
	     (mapcar '(lambda(X)
			(if (/=(car X)ProgressN)
			  X
			  (progn
			    (setq ParaSub(subst (cons "l" NewN)(assoc "l" (cdr X))(cdr X)))
			    (setq ParaSub(subst (cons "prz" 0)(assoc "prz" ParaSub)ParaSub))
			    (setq ParaSub(subst (cons "n" 0)(assoc "n" ParaSub)ParaSub))
			    (JBf_progress_01:X:DBox:Reset ProgressN)
			    (set_tile (strcat  "JB_1_t2_" (cdr(assoc "DclKey" ParaSub)))
				      (strcat "(" (itoa (cdr(assoc "n" ParaSub))) " von " (itoa (cdr(assoc "l" ParaSub))) ")  -  " (strcat (itoa (cdr(assoc "prz" ParaSub))) "% erledigt.") ))
			    
			  (cons (car X)
				ParaSub))))JBf_progress_01X$$ListPara))
     
      
      )
    (JBf_progress_01:X:DBox:VollerBalken ProgressN)
    )
  )
  


;;;ProgressBar X Balkenflaeche reinitiaisieren
(defun JBf_progress_01:X:DBox:Reset (ProgressN / PARASUB )
  (setq ParaSub(cdr(assoc ProgressN JBf_progress_01X$$ListPara)))
  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (set_tile (strcat  "JB_1_t2_" (cdr(assoc "DclKey" ParaSub))) "keine Verarbeitung")
	  (JBf_progress_01:X:DBox:Start:i1:Balken ProgressN ParaSub -15)  
          (if redraw_dialog (redraw_dialog)) ;; bricsys - if new "redraw_dialog" is available          
	  
        )
      )
                                     
    )


;;;Rahmen zeichnen X
(defun JBf_ProgressBar_01:X:DBox:Start:i1:Frame (i1X i1Y / )
  (mapcar '(lambda(X)
	     
	     (start_image (strcat "JB_1_i1_"(car X)))
	     (vector_image 1 4 4 1 8)
	     
	     (vector_image 4 1 (- i1X 4) 1 8)
	     
	     (vector_image (- i1X 4) 1 (- i1X 1) 4 8)
	     
	     (vector_image (- i1X 1) 4 (- i1X 1) (- i1Y 4) 8)
	     
	     (vector_image (- i1X 1) (- i1Y 4) (- i1X 4) (- i1Y 1) 8)
	     
	     (vector_image (- i1X 4) (- i1Y 1) 4 (- i1Y 1) 8)
	     
	     (vector_image  4 (- i1Y 1) 1 (- i1Y 4) 8)
	     (vector_image  1 (- i1Y 4) 1 4 8)
	     (end_image)	     
	     )
	  JBf_progress_01X$$List)  
  
)

		   
;;;Rahmen X Label beschriften
(defun JBf_ProgressBar_01:X:DBox:Start:Label ( / )
  (mapcar '(lambda(X)
	     (set_tile (strcat "JB_1_t1_"(car X))(cadr(cadr X)))	     
	     )
	  JBf_progress_01X$$List)  
  
)



;;;Progress_01-INI => es wird die DCL-Datei geschrieben!
(defun  JBf_ProgressBar_01:X:Ini (XList / )
  (if (not
        (or (and JBf_progress_01X$DCL$_File(findfile JBf_progress_01X$DCL$_File))
            (setq JBf_progress_01X$DCL$_File (JBf_progress_01:X:DclWrite XList))))
            (progn
              (alert "Die DCL-Datei konnte nicht geschrieben werden.")
              (exit)))
)

;;;Beenden der ProgressBar
(defun JBf_progress_01:X:DBox:End (/)
  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (done_dialog)
      ;(start_dialog)
      (if JBf_progress_01X$$dat
        (progn
          (unload_dialog JBf_progress_01X$$dat)
          (setq JBf_progress_01X$$List nil
                JBf_progress_01X$$ListPara nil
                
          )
        )
      )
    )
  )
)

  
;;;DCL-Datei für Progress-X
;;;DCL-Datei schreiben
(defun JBf_progress_01:X:DclWrite (XList / A FILE n)
  (if (and (setq JBf_progress_01X$DCL$_File (vl-filename-mktemp (strcat "JBf_progress_01X.dcl")))
           (setq file (open JBf_progress_01X$DCL$_File "w"))
      )
    (progn
      (setq SpalteN 0)
      
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
		      (apply 'append
			     (list
			       (list "JBf_ProgressX_01_1 : dialog {key = \"JB_1_d\";label = \"ProgressBar-X\"; "
				     (if (>(length XList)1);;;wenn mehr als 1 Spalte
				       ":row{"
				       "")
				     )
			       (apply 'append
				      
					(mapcar '(lambda(spalte)
						   (setq SpalteN (+ SpalteN 1))
						   (setq ZeileN 0)
						   (apply 'append
						   (list
						     (list
						       ":column{"
						       )
						     (apply 'append
							    (mapcar '(lambda(zeile)
								       (setq ZeileN (+ ZeileN 1))
								       (if (and(= SpalteN 1)(= ZeileN 1));;;1. Zeile
									 (list
									   ":spacer{ height = 0.12;}"
									   ":row{"
									   (strcat ":text{key = \"JB_1_t1_s"(itoa SpalteN)"z1\"; label = \"\";}")
									   ":image {key = \"cancel\";is_cancel=true;width = 0.5; height = 0.5;fixed_width = true;fixed_height = true;aspect_ratio = 1; color = -15;vertical_margin = none;}"
									   "}"
									   (strcat":image{key = \"JB_1_i1_s"(itoa SpalteN)"z1\";width = 58.92; fixed_width = true;height = 1.51; fixed_height = true;aspect_ratio = 1;color = -15; vertical_margin = none;}")
									   (strcat":text {key = \"JB_1_t2_s"(itoa SpalteN)"z1\";label = \"\";}")
									   )
									 (list
									   ":spacer{ height = 0.12;} "
									   (strcat ":text{key = \"JB_1_t1_s"(itoa SpalteN)"z"(itoa ZeileN)"\"; label = \"\";}")
									   (strcat ":image{key = \"JB_1_i1_s"(itoa SpalteN)"z"(itoa ZeileN)"\";width = 58.92; fixed_width = true;height = 1.51; fixed_height = true;aspect_ratio = 1;color = -15; vertical_margin = none;}")
									   (strcat":text {key = \"JB_1_t2_s"(itoa SpalteN)"z"(itoa ZeileN)"\";label = \"\";}")
									   )
									 )
								       )
								    spalte)
								    )
						     (list
						       "}")))
						   )XList)	
						   
						 )
			       (list
				 (if (>(length XList)1);;;wenn mehr als 1 Spalte
				       "}"
				       "")
				 
				 "//ok_only;"
				 "} "
				 )
			       )
			     )
		      )
		)
      (close file)
      ;(startapp  "notepad.exe" (strcat "\""JBf_progress_01X$DCL$_File"\""))
      JBf_progress_01X$DCL$_File
    )
  )
)


;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => DBX									   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



;;;Rückgabe: gültiges DBX-Objekt für aktuelle Version
(defun JBf_DBX:Open:GetVS (vs / DBX)
  (if(not(vl-catch-all-error-p
           (setq DBX (vl-catch-all-apply
                       'vla-GetInterfaceObject
                       (list
                         (vlax-get-acad-object)
                         vs)))
           ))DBX))
;;;DBX-Objekt
(defun JBf_DBX ( / DBX)
  (if (>=(setq vs (atoi (getvar "ACADVER")))15)
    (JBf_DBX:Open:GetVS (strcat "ObjectDBX.AxDbDocument."(itoa vs)))
    (JBf_DBX:Open:GetVS "ObjectDBX.AxDbDocument")
  )
)
 

;;;DWG-Datei als DBX-Object öffnen (nur, wenn gültig und nicht schreibgeschützt
(defun JBf_DBX:Open(DBX dwgname / )
  (not(vl-catch-all-error-p   
        (vl-catch-all-apply 'vla-open(list DBX dwgname)))))
;;;DBX-Object wieder freigeben
(defun JBf_DBX:Release(DBX / )
  (not(vl-catch-all-error-p
        (vl-catch-all-apply
          'vlax-release-object(list DBX)
          ))))
;;;DBX-Objekt speichern
(defun JBf_DBX:SaveAs (DBX DWGname / )
  (not(vl-catch-all-error-p
        (vl-catch-all-apply
          'vla-saveas(list DBX DWGNAME)  
        )))
  )


;;;--------------------------------------------------------------------------------------------------------
;;;Info für Textfenster nach dem laden des Programms							   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|DwgBlockScanner: DWG-Dateien aus DBS-Datei anpassen.        |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: DBA oder DWGBLOCKADJUST                |"
	  "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )

(princ)





    

