
;;;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: BDW - Es werden Blöcke jeweils in externe DWG-Blockdateien gespeichert.			   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:											   
;;;- JB_BDW$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_BDW_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 18.06.24	   
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:BDW ( / )
  (JB_BDW)
  )

;;;Intro
(defun JB_BDW:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------BDW(1.0), 18.06.24----------------------")
  (princ str)
  (princ "\n--------------------------------------------------------------")
  )




;;;Variablenliste
(defun JB_BDW:v_liste ( / )
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ("JB_1_l1" . nil);;;BlocknamenListe
                             ("JB_1_to1" . "0");;;alle auswählen
                             ("JB_1_to2" . "0");;;dynamische Blöcke
                             ("JB_1_t1" . "*");;;Filterwert
                             ("JB_1_to3" . "1");;;Einheiten werden aus Block übernommen
                             ("JB_1_p1" . (6 "m"));;;Einheit, die zuletzt verwendet wurde
                             ("JB_1_to4" . "1");;;Einheitliche Skalierung von Block
                             ("JB_1_p2" . (1 "Ja"));;;1 = Ja, 0 = Nein
                             ("JB_1_t2" . nil);;;Zielverzeichnis
                            
                             )
                          )
                         )
      ))
  )


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

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

  (setq pfad_ini (JB_BDW: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_BDW:v_liste))pfad_ini nil))
  
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))

  (setq Osmode_Alt (getvar "OSMODE"))
  
  
  (JB_BDW:Intro "\nBlöcke in externe DWG-Block-Dateien speichern.")

  
  (if (not
            (or (and JB_BDW_$DCL$_File(findfile JB_BDW_$DCL$_File))
                (setq JB_BDW_$DCL$_File (JB_BDW:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))
  (JB_BDW:Dbox1 v_liste pfad_ini)
      
   
  (princ "\nEnde.")
  (JBf_Reinit)
  (setvar "OSMODE" Osmode_Alt)
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) 
  (princ)
  )



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


(defun JB_BDW: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
  )
                   
;;;Ini l1
(defun JB_BDW:Dbox1:l1:Ini ( / SUB N)

  (if (not BlocknameList&DBox1)
    (progn
      (vlax-for ITEM (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
        (if (and(=(vla-get-IsXref ITEM):vlax-false)
                (=(vla-get-IsLayout ITEM):vlax-false)
                (not(vl-string-search "*"(vla-get-name ITEM))))
          (setq BlocknameList&DBox1 (cons(list (vla-get-name ITEM)(vla-get-IsDynamicBlock ITEM))BlocknameList&DBox1))
          )
        )
      (setq BlocknameList&DBox1(vl-sort BlocknameList&DBox1 '(lambda(e1 e2)(< (car e1)(car e2)))))
      )
    )

  

  (setq n -1)
  (setq l1_sel&Dbox1 nil)
  (setq l1&DBox1 (vl-remove-if 'not (mapcar '(lambda(X)
                                  (if (and(or (=(cadr X):vlax-false)
                                          (= (cdr(assoc "JB_1_to2" Settings&Dbox1))"1"))
                                          (wcmatch (strcase(car X))(strcase(cdr(assoc "JB_1_t1" Settings&Dbox1)))))
                                    (progn
                                      (setq n (+ n 1))
                                      (if (member (car X)(cdr(assoc "JB_1_l1" Settings&Dbox1)))
                                        (setq l1_sel&Dbox1 (cons n l1_sel&Dbox1)))
                                      X)))BlocknameList&DBox1)))
  (if l1&DBox1
    (if l1_sel&Dbox1
      (setq l1_sel&Dbox1 (reverse l1_sel&Dbox1))
      (setq l1_sel&Dbox1 '(0)))
    (setq l1_sel&Dbox1 nil)
    )
  )


;;;Ini p1, p2
(defun JB_BDW:Dbox1:p1-p2:Ini ( / SUB)
  (setq p1&Dbox1 '((0 "keine Einheit")
                   (1 "Zoll")
                   (4 "Millimeter")
                   (5 "Zentimeter")
                   (6 "Meter")))
  (if (setq sub(member (car(cdr(assoc "JB_1_p1" Settings&Dbox1)))(mapcar 'car p1&Dbox1)))
    (setq p1_sel&DBox1 (- (length p1&Dbox1)(length sub)))
    (setq p1_sel&DBox1 0)
    )

  (setq p2&Dbox1 '((0 "Nein")
                   (1 "Ja")
                   ))
  (if (setq sub(member (car(cdr(assoc "JB_1_p2" Settings&Dbox1)))(mapcar 'car p2&Dbox1)))
    (setq p2_sel&DBox1 (- (length p2&Dbox1)(length sub)))
    (setq p2_sel&DBox1 0)
    )
  )
  
 
;;;DBox 1
(defun JB_BDW:Dbox1 (v_liste pfad_ini / A DCLID OK SETTINGS&DBOX1 BlocknameList&DBox1 p1&Dbox1 p1_sel&DBox1 p2&Dbox1 p2_sel&DBox1 l1&DBox1 l1_sel&DBox1 Error&DBox1)


   
  (setq Settings&Dbox1 (JB_BDW:v_liste:DboxSettings:get "Dbox1" v_liste))
  (JB_BDW:Dbox1:l1:Ini)
  (JB_BDW:Dbox1:p1-p2:Ini)
  
  (while (not (member ok '(1 99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_BDW_$DCL$_File "JB_BDW_1" JB_BDW$DCL$_1_po))
    (JB_BDW:Dbox1:set)
    (JB_BDW:Dbox1:mode)
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_BDW:Dbox1:action \"" A "\")")))
            '("JB_1_b1" "JB_1_b2"
              "JB_1_to1" "JB_1_to2" "JB_1_to3" "JB_1_to4"
              "JB_1_p1" "JB_1_p2"
              "JB_1_l1"
              "accept" "cancel"
             )
    )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    (cond

      ((= ok 1) ;;;Legende einfügen
       (if (and (cdr(assoc "JB_1_t2" Settings&Dbox1))
                (JBf_String:FilePath? (cdr(assoc "JB_1_t2" Settings&Dbox1))))
         (progn
           (setq v_liste (JB_BDW:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
           (JBf_SIC:sichern v_liste pfad_ini nil)
           (JB_BDW:Dbox1:action:Block2DWG)
           )
         (progn
           (setq Error&DBox1 "JB_1_b2")
           (setq ok -1)
           (alert "Der ausgewählte Verzeichnispfad ist ungültig."))
         )
         
       )
      ((= ok 99) ;;;Ende
       (setq v_liste (JB_BDW:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
       (JBf_SIC:sichern v_liste pfad_ini nil)
       
       )
      )
    )
  
  )


;;;DWG-Dateien per Wblock erstellen
(defun JB_BDW:Dbox1:action:Block2DWG ( / BLOCKNAMELIST FILEDIAALT MSGLIST RESTORESCALELIST RESTOREUNITSLIST VLA-BLOCKDEF X)
  
  (setq BlocknameList
         (vl-remove-if 'not
           (mapcar '(lambda(X)
                      (car(nth X l1&DBox1)))l1_sel&DBox1)))


  (if (=(cdr(assoc "JB_1_to3" Settings&dbox1))"0")
    (mapcar '(lambda(X)
               (setq vla-BlockDef (vla-item(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))X))
               (setq RestoreUnitsList (cons (list vla-BlockDef (vla-get-Units vla-BlockDef))RestoreUnitsList))
               (vla-put-Units vla-BlockDef(car(cdr(assoc "JB_1_p1" Settings&dbox1))))
               )
      BlockNameList))


  (if (=(cdr(assoc "JB_1_to4" Settings&dbox1))"0")
    (mapcar '(lambda(X)
               (setq vla-BlockDef (vla-item(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))X))
               (setq RestoreScaleList (cons (list vla-BlockDef (vla-get-BlockScaling vla-BlockDef))RestoreScaleList))
               (vla-put-BlockScaling vla-BlockDef(car(cdr(assoc "JB_1_p2" Settings&dbox1))))
               )
      BlockNameList))


  (setq FilediaAlt (getvar "FILEDIA"))
  (setvar "FILEDIA" 0)
  (foreach X BlockNameList
    (if (or(not(findfile (strcat (cdr(assoc "JB_1_t2" Settings&dbox1)) X ".dwg")))
           (vl-file-delete (strcat (cdr(assoc "JB_1_t2" Settings&dbox1)) X ".dwg")))
      (command ".-WBLOCK" (strcat (cdr(assoc "JB_1_t2" Settings&dbox1)) X ".dwg")X)
      (setq MsgList (cons X MsgList))
      )
    )
  (setvar "FILEDIA" FilediaAlt)


  (mapcar '(lambda(X)(vla-put-units (car X)(cadr X)))RestoreUnitsList)
  (mapcar '(lambda(X)(vla-put-BlockScaling (car X)(cadr X)))RestoreScaleList)

  (if MsgList
    (alert (strcat "Folgende Blöcke konnten nicht als DWG-Datei geschrieben werden (Schreibschutz?)\n"
             (apply 'strcat
                    (mapcar '(lambda(X)
                               (strcat "\n- " X))(reverse MsgList)))))
    )

  (if (> (-(length BlockNameList)(length MsgList))0)
    (alert (strcat "Es wurde(n) " (itoa (-(length BlockNameList)(length MsgList))) " DWG-Block-Dateie(n) gespeichert."))
    )
  )
    
  


;;;Action l1, Blocknamen speichern
(defun JB_BDW:Dbox1:action:l1 ( / NAMELIST X)
  (mapcar '(lambda(X)
             (setq NameList (cons (car(nth X l1&DBox1))NameList))
             )
    l1_sel&DBox1)
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 NameList "JB_1_l1"))
  )


;;;Toggle alle
(defun JB_BDW:Dbox1:action:to1 ( / N)
  (setq l1_sel&DBox1 nil)
  (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
    (progn      
      (setq n (length l1&DBox1))
      (setq l1_sel&DBox1
             (mapcar '(lambda(X)
                        (setq n (- 1))
                        )
               l1&DBox1))
      (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (mapcar 'car l1&DBox1)"JB_1_l1"))
      )
    (if l1&DBox1
      (progn
        (setq l1_sel&DBox1 '(0))
        (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (list(car(car l1&DBox1)))"JB_1_l1"))
        )
      )
    )
  )

;;;Action (Variable global in Aufrufender Funktion)
(defun JB_BDW:Dbox1:action (key / WERT)
  (cond

    ((= key "JB_1_b1");;;Filter für Blocknamen
     (if(setq wert (JB_BDW:Dbox2 (cdr(assoc "JB_1_t1" Settings&dbox1))))
       (progn
         (if (= wert "")(setq wert "*"))
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 wert "JB_1_t1"))
         (JB_BDW:Dbox1:l1:Ini)
         (JB_BDW:Dbox1:set)
         (JB_BDW:Dbox1:mode)
         )
       )
     )

    ((= key "JB_1_b2");;;Verzeichnis für die DWG-Block-Dateien
     (if(setq wert (getfiled "DWG-Datei für Verzeichnisauswahl" (if (cdr(assoc "JB_1_t2" Settings&dbox1))
                                                                  (strcat (cdr(assoc "JB_1_t2" Settings&dbox1))"temp.dwg")
                                                                  "temp.dwg") "dwg" 32))
                                                                   
       (progn
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (car(fnsplitl wert)) "JB_1_t2"))
         (JB_BDW:Dbox1:set)
         (JB_BDW:Dbox1:mode)
         )
       )
     )
    
    ((= key "JB_1_to1")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to1"))
     (JB_BDW:Dbox1:action:to1)
     (JB_BDW:Dbox1:l1:Ini)
     (JB_BDW:Dbox1:set)
     (JB_BDW:Dbox1:mode)
     )
    
    ((= key "JB_1_to2")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to2"))
     (JB_BDW:Dbox1:l1:Ini)
     (JB_BDW:Dbox1:set)
     (JB_BDW:Dbox1:mode)
     )

    ((= key "JB_1_to3")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to3"))
     (JB_BDW:Dbox1:mode)
     )

    ((= key "JB_1_to4")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to4"))
     (JB_BDW:Dbox1:mode)
     )
    
    ((= key "JB_1_l1")
     (setq l1_sel&DBox1 (mapcar 'atoi(JBf_String:Delimiter->List $value " ")))
     (JB_BDW:Dbox1:action:l1)
     
     )

    ((= key "JB_1_p1")
     (setq p1_sel&DBox1 (atoi $value))
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (nth p1_sel&DBox1 p1&Dbox1)"JB_1_p1"))     
     )

    ((= key "JB_1_p2")
     (setq p2_sel&DBox1 (atoi $value))
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (nth p2_sel&DBox1 p2&Dbox1)"JB_2_p2"))     
     )
    
    ((= key "accept")
     (setq JB_BDW$DCL$_1_po (done_dialog 1))
     )
    ((= key "cancel") ;;;Ende
     (setq JB_BDW$DCL$_1_po (done_dialog 99))
     )
    )
  )


;;;DBox1: setten
(defun JB_BDW:Dbox1:set ( / X)
  
  (start_list "JB_1_l1" 3)
  (mapcar 'add_list (mapcar '(lambda(x)
                               (strcat (if (=(cadr X):vlax-true)"<DYN>" "")
                                 (car X)))l1&DBox1))
  (end_list)
  (set_tile "JB_1_l1" "")
  (if l1_sel&DBox1 (set_tile "JB_1_l1" (vl-string-right-trim " " (apply 'strcat (mapcar '(lambda(X)(strcat (itoa X)" "))l1_sel&DBox1)))))

  (start_list "JB_1_p1" 3)
  (mapcar 'add_list (mapcar 'cadr p1&DBox1))
  (end_list)
  (set_tile "JB_1_p1" "")
   (if p1_sel&DBox1 (set_tile "JB_1_p1" (itoa p1_sel&DBox1)))

  (start_list "JB_1_p2" 3)
  (mapcar 'add_list (mapcar 'cadr p2&DBox1))
  (end_list)
  (set_tile "JB_1_p2" "")
   (if p2_sel&DBox1 (set_tile "JB_1_p2" (itoa p2_sel&DBox1)))  

  (mapcar '(lambda(X)(set_tile (strcat "JB_1_"(car X))(cadr X)))
    (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 "t1" (cdr(assoc "JB_1_t1" Settings&dbox1)))
      (list "t2" (if(cdr(assoc "JB_1_t2" Settings&dbox1))(JBf_String:PathFileName:reduce (cdr(assoc "JB_1_t2" Settings&dbox1))50)""))
      
      
      )
    )
     
  )
;;;DBox1, moden
(defun JB_BDW:Dbox1:mode ( / )

  (if (=(cdr(assoc "JB_1_to3" Settings&dbox1))"1")
    (mode_tile "JB_1_p1" 1)
    (mode_tile "JB_1_p1" 0)
    )

  (if (=(cdr(assoc "JB_1_to4" Settings&dbox1))"1")
    (mode_tile "JB_1_p2" 1)
    (mode_tile "JB_1_p2" 0)
    )

  (if (not l1_sel&DBox1)
    (progn
      (mode_tile "accept" 1)
      (alert "Entweder sind in der aktuellen Datei keine Blöcke vorhanden oder die Filtereinstellungen entsprechen keinem der Blöcke.")
      )
    (mode_tile "accept" 0)
    )

  (if Error&DBox1
    (progn
      (mode_tile Error&DBox1 2)
      (setq Error&DBox1 nil)
      )
    )
    
  )


;;;DBox2, Wert getten
(defun JB_BDW:Dbox2 (wert&Dbox2 / A DCLID OK)  
  
  (while (not (member ok '(1 99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_BDW_$DCL$_File "JB_BDW_2" JB_BDW$DCL$_2_po))
    (set_tile "JB_2_e1" wert&Dbox2)
    (mode_tile "JB_2_e1" 2)
    
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_BDW:Dbox2:action \"" A "\")")))
            '(
              "accept" "cancel"
             )
    )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    )
  (if (= ok 1)
    wert&Dbox2)
  
  )


;;;Action DBox2
(defun JB_BDW:Dbox2:action (key /)
  (cond
    ((= key "accept")
     (setq wert&Dbox2 (get_tile "JB_2_e1"))
     (setq JB_BDW$DCL$_2_po (done_dialog 1))
     )
    ((= key "cancel") ;;;Ende
     (setq JB_BDW$DCL$_2_po (done_dialog 99))
     )
    )
  )
  
   
;;;DCL-schreiben
(defun JB_BDW:dcl:Write ( / file)  
  (if (and (setq JB_BDW_$DCL$_File (vl-filename-mktemp (strcat "BDW.dcl")))
           (setq file (open JB_BDW_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "//Hauptdialog"
                "JB_BDW_1: dialog {label= \"Blöcke als DWG-Datei\";"
                ":boxed_row {label = \"vorhandene Blöcke, Optionen\";"
                ":column {"
                ":list_box {key = \"JB_1_l1\"; label = \"(Mehrfachauswahl mit STRG+UMSCHALT)\";width=40;height=16;multiple_select=true;}"
                ":row {"
                ":button {key = \"JB_1_b1\"; label = \"&Filter...\"; fixed_width = true;}"
                ":text {key = \"JB_1_t1\"; label = \"MeinBlock\";width= 30;}}"
                ":toggle {key = \"JB_1_to1\"; label = \"alle auswählen\";}"
                ":toggle {key = \"JB_1_to2\"; label = \"Dynamische Blöcke berücksichtigen\";}"
                "}"
                ":column {"
                ":spacer {height=7;}"
                ":toggle {key = \"JB_1_to3\"; label = \"Einheit von Block\";}"
                ":popup_list {key = \"JB_1_p1\";}"
                ":toggle {key = \"JB_1_to4\"; label = \"Einheitl. Skalierung von Block\";}"
                ":popup_list {key = \"JB_1_p2\";}"
                ":spacer {height=7;}"
                "}"
                "}"
                ":boxed_row {label = \"Zielverzeichnis\";"
                ":button {key = \"JB_1_b2\"; label = \"&Verzeichnis...\";fixed_width = true;}"
                ":text {key = \"JB_1_t2\"; label = \"MeinVerzeichnis\";width= 60;}}"
                ":row{fixed_width = true;alignment = centered;"
                ":retirement_button {label = \"&OK\"; key= \"accept\";  is_default = true;}"
                ":spacer {width=2;}"
                ":button { label =\"&Ende\"; key = \"cancel\";fixed_width=true;is_cancel=true;}"
                "}"
                "}"
                "JB_BDW_2: dialog {label= \"Filterwert\";"
                ":boxed_column {label = \"Bitte eingeben\";"
                ":edit_box {key = \"JB_2_e1\"; allow_accept = true;}"
                "}"
                "ok_cancel;}"


               )
              )
      )
      (close file)
      JB_BDW_$DCL$_File
    )
  )
)

;;;--------------------------------------------------------------------------------------------------------
;;;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 auf dem Benutzer von Windows
;;;Übergeben wird der relative Pfad, der hinter den Windows-Pfad angehängt wird. Wenn die Verzeichnisse nicht vorhanden sind werden sie erstellt.
(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))





;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine 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" sab 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 (JBfd_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))
										   (JBfd_AcadSystem:TrustedPath:Split TrustedPaths)))))))
  )

;;;String splitten an Semikolons, als Liste zurückgeben
(defun JBfd_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))
;;;--------------------------------------------------------------------------------------------------------
;;;alBDWmeine 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
  )




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

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|Blöcke in externe DWG-Block-Dateien speichern.              |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: BDW                                    |"          
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)





                  












