;;;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:DBS (DwgBlockScanner)						        	           
;;;													   
;;;Es werden an zu pickenden Positionen Nummern mit Kreise erzeugt, optional mit SOLID-Schraffur als       
;;;Hintergrund und Bezugslinie.										   
;;;													   
;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_DBS$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_DBS$$TempPath => temporärer Verzeichnispfad für Eigenschaftenliste			           
;;;- JB_DBS$$BlockN => vl-bb-set => Anzahl der Blöcke für Sciptablauf					   
;;;- JB_DBS$$pfad => Supportpfad für Programmdatei							   
;;;                                                                              Jörn Bosse, 12.08.25      
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:DBS ( / )
  (JB_DBS)
  )


(defun c:DwgBlockScanner ( / )
  (JB_DBS)
  )

;;;Definition der v_liste, wenn noch nicht vorhanden
(defun JB_DBS:v_liste ( / )  
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (                             
                             ("JB_1_t1" . nil);;;DWG-Pfad
			     ("JB_1_to1" . "1");;;Blockskalierung
			     ("JB_1_to2" . "1");;;dynamischer Block
			     ("JB_1_to3" . "1");;;Beschriftungseigenschaft
			     ("JB_1_to4" . "1");;;Einheit
			     ("JB_1_to5" . "1");;;TAB-geetrennte Textdatei
			     ("JB_1_to6" . "1");;;LISP-Liste
			     )
			  )
			 )
      ))
  )

;;;Pfad für SIC-Datei in Windows-User
(defun JB_DBS: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 
                           )"DBS_sic.lsp")  ;;;getauscht, z.B. c:\\User\\[WindowsUsername]\\LispData\\acad\\
  )

 

(defun JB_DBS:Intro ( / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n---------------------DBS(1.0), 12.08.25----------------------")
  (princ "\nDwgBlockScanner: Verzeichnis mit DWG-Block-Dateien scannen.  ")
  (princ "\n-------------------------------------------------------------")
  )


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

  (setq pfad_ini (JB_DBS: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_DBS:v_liste))pfad_ini nil))
  
  
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))  
  
  (JB_DBS:Intro)

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


  (JB_DBS:DwgTempFiles:Delete pfad_ini)

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

  
  (JBf_Reinit)
  (princ)
  

)


;;;temporäre Dateien vom letzten Durchgang entfernen
(defun JB_DBS:DwgTempFiles:Delete (pfad_ini / TempDwgPath)
  (setq TempDwgPath(strcat (car(fnsplitl pfad_ini))"DBS_Temp\\"))
  (mapcar '(lambda(X)
	     (vl-file-delete (strcat TempDwgPath X)))
	  (vl-remove-if '(lambda(X)
			   (not(member(strcase(caddr(fnsplitl X)))'(".DWG" ".BAK"))))
	    (vl-directory-files TempDwgPath nil 1)))
  )
  


(defun JB_DBS:Suppportpfad-p ( / FILENAME RETVAL SUPPORTPATHS)
  (setq RetVal 'T)
  (if (not JB_DBS$$pfad)
    (progn
      (if (not (findfile "DwgBlockScanner.lsp"))
        (progn
          (alert (strcat "Die Programmdatei \"DwgBlockScanner.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 \"DwgBlockScanner.lsp\""
					   "DwgBlockScanner.lsp"
					   "lsp"
					   4))
                  (or(= (strcase (strcat(cadr(fnsplitl Filename))(caddr(fnsplitl Filename))))
                        (strcase "DwgBlockScanner.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 (JBfd_AcadSystem:TrustedPath:Split SupportPaths))))
                (setenv "ACAD"(strcat SupportPaths ";" (car(fnsplitl Filename)))))

              )
            (setq RetVal nil)
            )
          )
        )
      (if RetVal
        (setq JB_DBS$$pfad (car(fnsplitl(findfile "DwgBlockScanner.lsp"))))
        (setq JB_DBS$$pfad nil)
        )
      )
    )
  RetVal)



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


(defun JB_DBS: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
  )



;;;DBox 1
(defun JB_DBS:Dbox1(v_liste pfad_ini / A DCLID OK SETTINGS&DBOX1)

  (setq Settings&Dbox1 (JB_DBS:v_liste:DboxSettings:get "Dbox1" v_liste))
    
  (while  (not(member ok '(1 99)))

    (setq DclId(JBf_Dcl:Load_dialog JB_DBS_$DCL$_File "DBS_1" JB_DBS$DCL$_1_po))
    
    (JB_DBS:Dbox1:set)
    (JB_DBS:Dbox1:mode)
           
    (mapcar '(lambda(A)(action_tile A (strcat "(JB_DBS:Dbox1:action \""A"\")")))
      '("JB_1_to1" "JB_1_to2" "JB_1_to3" "JB_1_to4" "JB_1_to5" "JB_1_to6"
	"JB_1_b1"	
        "accept" "cancel"))

    (setq ok (start_dialog))
    (unload_dialog DclId)

    (if(= ok 1)
      (if (not(and(or (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
		      (=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")
		      (=(cdr(assoc "JB_1_to3" Settings&dbox1))"1")
		      (=(cdr(assoc "JB_1_to4" Settings&dbox1))"1")
		      (alert "Es muss mindestens eine Eigenschaft aktiviert sein."))
		  (or (=(cdr(assoc "JB_1_to5" Settings&dbox1))"1")
		      (=(cdr(assoc "JB_1_to6" Settings&dbox1))"1")		      
		  (alert "Es muss mindestens ein Ausgabeformat aktiviert sein."))))
	(setq ok -1)
	)
      )
    )

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

  (if (= ok 1)
    (if (= 1(JB_DBS:DBoxJn "Vor dem Scannen sollten alle geöffneten Zeichnungen vorher gespeichert sein, fortfahren?"))
      (JB_DBS:DBox1:scannen pfad_ini)
      )
    )
  
  
    
	 
  )
			

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

  (cond 
	((member key '("JB_1_to1" "JB_1_to2" "JB_1_to3" "JB_1_to4" "JB_1_to5" "JB_1_to6"))
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value key))	 
	 )
	((= key "JB_1_b1")
	 (if (setq FilePath (getfiled "Wählen Sie eine DWG-Datei zur Bestimmung des Verzeichnisses:"
				      (if (cdr(assoc "JB_1_t1" Settings&dbox1))
					(cdr(assoc "JB_1_t1" Settings&dbox1))
					"")
				      "dwg" 4))
	   (progn
	     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 FilePath "JB_1_t1"))
	     (JB_DBS:Dbox1:set)
	     (JB_DBS:Dbox1:mode)
	     )
	   )
	 )
		
        ((= key "cancel");;;Ende
         (setq JB_DBS$DCL$_1_po (done_dialog 99))
         )
	((= key "accept");;;OK	
         (setq JB_DBS$DCL$_1_po (done_dialog 1))
         )
        )
  )

  
;;;Dbox1; Werte setzen 
(defun JB_DBS:Dbox1:set ( / A)
  (mapcar '(lambda(A)
             (set_tile (strcat "JB_1_"(car A))(cadr A)))
	  (list
	    (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 "t1" (if (cdr(assoc "JB_1_t1" Settings&dbox1))
			 (JBf_String:PathFileName:reduce (car(fnsplitl(cdr(assoc "JB_1_t1" Settings&dbox1))))80)
			 "")
		  )
	    )
	  )
  )


;;;DBOX 1, moden
(defun JB_DBS:Dbox1:mode ( / )
  (if (or (not(cdr(assoc "JB_1_t1" Settings&dbox1)))
	  (not(JBf_String:FilePath?(cdr(assoc "JB_1_t1" Settings&dbox1)))))
    (progn
      (mode_tile "accept" 1)
      (mode_tile "JB_1_b1" 2)
      (alert "Bitte wählen Sie ein gültiges DWG-Verzeichnis aus."))
    (progn
      (mode_tile "accept" 0)
      (mode_tile "accept" 2)
      )
    )  
    
  )


;;;JBf_progress_01:DBox:Start (Titel l msg
;;;JBf_progress_01:DBox:Reset (Titel l msg
;;;JBf_progress_01:DBox:Fortschritt
;;;JBf_progress_01:DBox:Status (msg
;;;JBf_progress_01:DBox:End


;;;DBox1, scannen
(defun JB_DBS:DBox1:scannen (pfad_ini / BLOCKLIST ProgressList StepN& N& TempPath PROPLIST BasisPath)
  
  (if JB_DBS$$TempPath (setq TempPath JB_DBS$$TempPath)
    (setq TempPath (vl-filename-mktemp (strcat "DbsPropList.lsp"))
	  JB_DBS$$TempPath TempPath)
	  )


  (setq BasisPath (car(fnsplitl(cdr(assoc "JB_1_t1" Settings&dbox1)))))
  
  (setq ProgressList
	     (list(list(list 1 "Verzeichnis" nil)
		       (list 2 "DWG-Dateien" nil)
		  ))
	    )

  (setq N& 0)

  (JBf_ProgressBar_01:X:DBox:Start "DWG-Verzeichnis scannen" ProgressList 'T)  
  (setq BlockList(mapcar 'cadr(JB_DBS:DBox1:scannen:FolderCopy:Search ProgressList nil BasisPath)))  
  (JBf_progress_01:X:DBox:End)

  (if (or (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
	  (=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")
	  (=(cdr(assoc "JB_1_to3" Settings&dbox1))"1")
	  (=(cdr(assoc "JB_1_to4" Settings&dbox1))"1"))
    (setq PropList (JB_DBS:DBox1:scannen:GetFromDef BlockList))
    )

  (JBf_SIC:sichern PropList TempPath nil)

  (if (and(or(=(cdr(assoc "JB_1_to3" Settings&dbox1))"1")
	     (=(cdr(assoc "JB_1_to4" Settings&dbox1))"1"))
	  (= 1(JB_DBS:DBoxJn (strcat "Für die Beschriftungseigenschaft und Einheit müssen die " (itoa(length BlockList)) " Blöcke im Skriptablauf geöffnet werden, fortfahren?"))))
    (JB_DBS:DBox1:scannen:GetFromScript pfad_ini BlockList TempPath (cdr(assoc "JB_1_to5" Settings&dbox1))(cdr(assoc "JB_1_to6" Settings&dbox1))BasisPath (cdr(assoc "JB_1_to3" Settings&dbox1))(cdr(assoc "JB_1_to4" Settings&dbox1)))
    (if(or (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
	   (=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")
	   )
      (JB_DBS:DBox1:scannen:Ausgabe TempPath (cdr(assoc "JB_1_to5" Settings&dbox1))(cdr(assoc "JB_1_to6" Settings&dbox1))BasisPath)
      )
      
    )
  )


;;;Ausgabe
(defun JB_DBS:DBox1:scannen:Ausgabe (TempPath TabFlag LispFlag BasisPath / FILE FILEPATH FILESTREAM PROPLIST WRITELIST X)
  (setq PropList (load TempPath))
  (if (= TabFlag "1")
    (progn
      (setq WriteList (mapcar '(lambda(X)
				 (strcat "\""(car X)"\"\t"
					 (if(cdr(assoc "BlockScaling" (cdr X)))(itoa(cdr(assoc "BlockScaling" (cdr X))))"")"\t"
					 (if(cdr(assoc "Dynamic" (cdr X)))(itoa(cdr(assoc "Dynamic" (cdr X))))"")"\t"
					 (if(cdr(assoc "ANNOTATIVEDWG" (cdr X)))(itoa(cdr(assoc "ANNOTATIVEDWG" (cdr X))))"")"\t"
					 (if(cdr(assoc "Units" (cdr X)))(itoa(cdr(assoc "Units" (cdr X))))"")"\t"
					 (if(cdr(assoc "Path" (cdr X)))(strcat "\""(vl-string-translate"\\" "/"(cdr(assoc "Path" (cdr X))))"\"")"")
					 )
				 )
			      PropList))
      (if (setq FileStream (open (setq FilePath(strcat BasisPath "JB_DBS_PropList_TAB.txt"))"w"))
	(progn
	  (mapcar '(lambda(X)
		     (write-line X FileStream)
		     )
		  (cons
		    "Blockname\tBlockskalierung\tdynamischer Block\tBeschriftungseigenschaft\tEinheit\tBlockPfad"
		    WriteList))
	  (close FileStream)
	  (startapp  "notepad.exe" (strcat "\""FilePath"\""))
	  )
	(alert (strcat "Folgende Datei konnte nicht geschrieben werden:\n\n"
		       FilePath))
	)
      )
    )

  (if (= LispFlag "1")
    (progn
      (JBf_SIC:sichern PropList (setq FilePath(strcat BasisPath "JB_DBS_PropList.lsp")) 'T)
      (startapp  "notepad.exe" (strcat "\""FilePath"\""))
      )
    )
  (vl-file-delete TempPath)
  )
    
  
  

;;;Block als VLA-Objekt einfügen
(defun JB_DBS:DBox1:scannen:GetFromDef:Insert:vla (FilePath space / block)
	  (vla-InsertBlock
    space
    (vlax-3d-point '(0 0 0))
    FilePath
    1
    1
    1
    0
    )
  )
 


;;;Eigenschaften aus DWG-Liste
(defun JB_DBS:DBox1:scannen:GetFromDef (BlockList / PROGRESSLIST PROPLIST SPACE VLA-DOC VLA-OBJ VLA-OBJLIST VORHFLAG X)
  (setq ProgressList
	     (list(list(list 1 "Blöcke einfügen" (length BlockList))
		       (list 2 "Eigenschaften lesen" (length BlockList))
		       (list 3 "Blöcke löschen" (length BlockList))
		  ))
	    )

  (JBf_ProgressBar_01:X:DBox:Start "Eigenschaften aus Blöcken" ProgressList 'T)

  (setq vla-doc (vla-get-activeDocument(vlax-get-acad-object)))

  (setq space (vla-get-modelspace vla-doc))

  (mapcar '(lambda(X)
	     (JBf_progress_01:X:DBox:Fortschritt 1)
	     (setq VorhFlag (tblsearch "BLOCK" (cadr(fnsplitl X))))
	     (setq vla-obj(JB_DBS:DBox1:scannen:GetFromDef:Insert:vla X space))
	     (setq vla-objList (cons(list vla-obj (vla-item(vla-get-blocks vla-doc)(vla-get-Effectivename vla-obj))VorhFlag X)vla-objList))
	     )
	  BlockList)

  

  (Setq PropList
	 (mapcar '(lambda(X)
		    
		    (JBf_progress_01:X:DBox:Fortschritt 2)
		    (cons (vla-get-name (cadr X))
			  (list
			    (cons "BlockScaling" (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")(vla-get-Blockscaling (cadr X))))
			    (cons "Dynamic" (if(=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")(if(=(vla-get-isdynamicblock (cadr X)):vlax-false)0 1)))
			    (cons "ANNOTATIVEDWG" nil)
			    (cons "Units" nil)
			    (cons "Path" (car(fnsplitl(cadddr X))))
			    )
			  )
		    )
		 vla-objList)
  )

  ;;;Blöcke wieder löschen, wenn vorher noch nicht vorhanden, dann auch die Defintionen entfernen
  (mapcar '(lambda(X)
	     (JBf_progress_01:X:DBox:Fortschritt 3)
	     (vla-delete (car X))
	     (if (not(caddr X))(vl-catch-all-apply 'vla-delete (list(vla-item(vla-get-blocks vla-doc)(vla-get-name(cadr X))))))
	     )
	  vla-objList)

  (JBf_progress_01:X:DBox:End)

  PropList)




;;;Substen der Eigenschaft ANNOTATIVEDWG
(defun JB_DBS:DBox1:scannen:GetFromScript:PropSubst (Blockname TempPath Beschriftungsflag EinheitFlag / FILEPATH SUB)


  (setq PropList(cadr(JBf_SIC:load:Catch TempPath nil)))
  ;(setq PropList (load TempPath))
  
  (setq sub (cdr(assoc Blockname PropList)))
  (if(= Beschriftungsflag "1")
    (setq sub (subst (cons "ANNOTATIVEDWG" (getvar "ANNOTATIVEDWG"))
		     (assoc "ANNOTATIVEDWG" sub)
		     sub))
    )
  (if (= EinheitFlag "1")
    (setq sub (subst (cons "Units" (getvar "INSUNITS"))
		     (assoc "Units" sub)
		     sub))
    )
  (setq PropList (subst (cons Blockname Sub)(assoc Blockname PropList)PropList))

  (JBf_SIC:sichern PropList TempPath 'T)
  (princ)
  )


;;;Prüfen, ob Scriptablauf zu Ende, wenn ja, dann wird der Abschluss duchgeführt und die finalen Dateien erstellt
(defun JB_DBS:DBox1:scannen:GetFromScript:Ausgabe (TempPath TabFlag LispFlag BasisPath / )
  (if (=(vl-bb-ref 'JB_DBS$$BlockN)0)
    (progn
      (alert "Der Skriptablauf ist beendet, es werden die Ausgabedateien erzeugt.")
      (JB_DBS:DBox1:scannen:Ausgabe TempPath TabFlag LispFlag BasisPath)
      )
    )
  )
      

;;;Bachslash hinzufügen für Pfade in SCR-Datei
(defun Text2DCcl:Slash (string / A)
  (vl-list->string
    (cons 34(reverse(cons 34(reverse
    (apply 'append (mapcar '(lambda(A)
                              (if (member A '(92 34))
                                (list 92 A)
                                (list A)))
  (vl-string->list string)))))))
))


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

  (setq TextStyleList '(
                       (0 . "STYLE")(100 . "AcDbSymbolTableRecord")(100 . "AcDbTextStyleTableRecord")(2 . "DBS_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" "DBS_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 . "DBS_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)
  )

;;;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))))


;;;aktuelle Zeichnung als Sicherung kopieren
(defun JB_DBS:DBox1:scannen:GetFromScript:FileCopy (SourceFile TargetFile / )
  (if (findfile TargetFile)
    (vl-file-delete TargetFile))
  (vl-file-copy SourceFile TargetFile)
  TargetFile)
;;;Letzte Datei löschen, damit es nicht zu viel wird im Temp-Verzeichnis
(defun JB_DBS:DBox1:scannen:GetFromScript:TempFile:Delete (CurrentFilePath n / BAKFILEPATH FILEPATH)
  (if (and(> n 1)(setq FilePath(vl-bb-ref 'JB_DBS$$LastDwg)))
    (progn
      (if (findfile FilePath)
	(vl-file-delete FilePath))
      
      (setq bakFilePath (strcat(car(fnsplitl(vl-bb-ref 'JB_DBS$$LastDwg)))(cadr(fnsplitl(vl-bb-ref 'JB_DBS$$LastDwg)))".bak"))
      (if (findfile bakFilePath)
	(vl-file-delete bakFilePath))
      )
    )
  (vl-bb-set 'JB_DBS$$LastDwg CurrentFilePath)
  )
  


;;;Per Scriptablauf direkt aus den Zeichnungen
(defun JB_DBS:DBox1:scannen:GetFromScript (pfad_ini BlockList TempPath TabFlag LispFlag BasisPath BeschriftungsFlag EinheitFlag / DWGFILE FILESTREAM LISPPATHFILE SCRPATHFILE WRITELIST X n nMax DefText TempDwgBlock)

  (vl-bb-set 'JB_DBS$$BlockN (length BlockList))
  (vl-bb-set 'JB_DBS$$LastDwg nil)

  (setq n 0)
  (setq nMax (length BlockList))

  (setq TempDwgPath(strcat (car(fnsplitl pfad_ini))"DBS_Temp\\"))

  (if (not(member "DBS_Temp"(vl-directory-files (car(fnsplitl pfad_ini)) nil -1)))
    (vl-mkdir TempDwgPath)
    )

  

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

  
  (foreach Block BlockList
    
      
    (setq DefText (strcat (itoa(setq n (+ n 1)))"/"(itoa nMax)))

    (setq TempBlock(JB_DBS:DBox1:scannen:GetFromScript:FileCopy
      Block
      (strcat TempDwgPath (cadr(fnsplitl Block))(caddr(fnsplitl Block)))))
    
    (setq DwgFile (vl-string-translate"\\" "/" TempBlock))    
    (setq writeList (cons(strcat "_.OPEN \"" DwgFile "\"")writeList))    
    (setq writeList (cons(strcat "(load \"" LispPathFile "\")")writeList))
    (setq writeList (cons (strcat "(JB_DBS:DBox1:scannen:GetFromScript:TempFile:Delete " (Text2DCcl:Slash TempBlock) " "  (itoa n) ")") writeList))
    (setq writeList (cons(strcat "(JB_DBS:DBox1:scannen:GetFromScript:TextDef \"" DefText "\")")writeList))
    (setq writeList (cons(strcat "(JB_DBS:DBox1:scannen:GetFromScript:PropSubst \"" (cadr(fnsplitl DwgFile)) "\" " (Text2DCcl:Slash TempPath) " \"" BeschriftungsFlag "\" \"" EinheitFlag  "\")")writeList))
    (setq writeList (cons"(vl-bb-set 'JB_DBS$$BlockN (-(vl-bb-ref 'JB_DBS$$BlockN)1))"writeList))
    (setq writeList (cons (strcat "(JB_DBS:DBox1:scannen:GetFromScript:Ausgabe " (Text2DCcl:Slash TempPath) " \"" TabFlag "\" \"" LispFlag "\" " (Text2DCcl:Slash BasisPath)")")writeList))
    (setq writeList (cons "(command \"_.close\" \"_n\")" writeList))    
    )
  
  (setq ScrPathFile (strcat BasisPath "DwgBlockScanner.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))
  )
  

;;;Verzeichnis mit DWG-Dateien zu DWG-DateiListe
(defun JB_DBS:DBox1:scannen:FolderCopy:Search (ProgressList FolderFileListe SourcePath / A B Files)

  (if (or(not StepN&)(= StepN& 19))
      (setq StepN& 10)
      (setq StepN& (+ StepN& 1)))
  (setq N& (+ N& 1))

  (JBf_progress_01:X:10erSteps 1 StepN& N& (JBf_String:PathFileName:reduce SourcePath 40))  
  
;;;wenn Dateien im Quellverzeichnis
  (if (setq Files (vl-directory-files SourcePath "*.dwg" 1))
;;;dann FolderFileListe mit (Flag = 'T; [Quellpfad]+[Dateinamen])
    (progn
      (JBf_progress_01:X:DBox:NGesamt:Refresh 2 (length Files))
      (mapcar '(lambda (A)
		 (JBf_progress_01:X:DBox:Fortschritt 2)
		 (setq FolderFileListe (cons (list 'T (strcat SourcePath A)) FolderFileListe)))
	      Files
	      )
      )
;;;FolderFileListe mit (Flag = nil; [Quellpfad])
  (setq FolderFileListe (cons (list nil SourcePath) FolderFileListe)))
  ;;;rekursiver Aufruf der Funktion "JB_DBS:DBox1:scannen:FolderCopy:Search" für jedes gefundene Unterverzeichnis
  (mapcar '(lambda (A)
	     (setq FolderFileListe (JB_DBS:DBox1:scannen:FolderCopy:Search ProgressList FolderFileListe (strcat SourcePath A "\\")))
	     )
	  (vl-remove-if '(lambda (B) (member B '("." ".."))) (vl-directory-files SourcePath nil -1))
	  )
;;;Rückgabe der gefundenen Dateien und Unterverzeichnisse
  (vl-remove-if '(lambda (B) (not (car B)))FolderFileListe)
  )


;;;JA-Nein-Frage 1-zeilig
(defun JB_DBS:DBoxJn (frage / DCLID OK)
  (setq DclId(JBf_Dcl:Load_dialog JB_DBS_$DCL$_File "JBosse_jn" JB_DBS$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_DBS:Dcl:Write ( / A  FILE)
  (if(and(setq JB_DBS_$DCL$_File(vl-filename-mktemp (strcat "DBS.dcl")))
         (setq file (open JB_DBS_$DCL$_File "w")))
    (progn
    (mapcar '(lambda(A)
               (write-line A file))
      (mapcar '(lambda(A)
                 (strcat "\n" A))
        '(
                "//Hauptdialog"
                "DBS_1: dialog {label = \"Verzeichnis mit DWG-Block-Dateien scannen\";"
                ":boxed_column {label = \"Verzeichnisauswahl\";"
                ":row{"
                ":button {key = \"JB_1_b1\"; label = \"&DWG-Datei...\";fixed_width = true;}"
                ":text {key = \"JB_1_t1\"; label = \"c:\\\\temp\\\\MeinVerzeichnis\\\\\"; width = 80;}}}"
                ":row {"
                ":boxed_column {label = \"Eigenschaften\";"
                ":toggle {key = \"JB_1_to1\"; label = \"Blockskalierung\";}"
                ":toggle {key = \"JB_1_to2\"; label = \"dynamischer Block\";}"                
                ":toggle {key = \"JB_1_to4\"; label = \"Einheit\";}"
	        ":toggle {key = \"JB_1_to3\"; label = \"Beschriftungseigenschaft\";}"
                "}"
                ":boxed_column {label = \"Ausgabeformate\";"
                ":toggle {key = \"JB_1_to5\"; label = \"TAB-getrennte Textdatei (*.txt)\";}"
                ":toggle {key = \"JB_1_to6\"; label = \"LISP-Liste (*.lsp)\";}"
                ":spacer {height = 3;}"
                "}}"
                ":row {fixed_width = true;alignment = centered;"
                ":button {key = \"accept\"; label = \"&Scannen...\";fixed_width = true;}"
                ":spacer {width = 2;}"
                ":button {label = \"&Ende\";  key= \"cancel\";is_cancel=true;}"
                "}}"

	        "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_DBS_$DCL$_File)
    )
  )


;;;Aktueller Space für VLA-Kram
(defun JB_DBS: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

;;;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 / 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
    )
  )
)
  


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

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|DwgBlockScanner: Verzeichnis mit DWG-Block-Dateien scannen. |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: DBS oder DWGBLOCKSCANNER               |"
	  "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )

(princ)








    

