
;;;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: ZAZ - ZahlenZieher: es werden Zahlen aus Attributen oder Texten gezogen, ein eventueller	   
;;;Präfix und/oder Suffix wird automatisch erkannt. Mit den gezogenen Zahlen können dann Einzelwerte oder  
;;;Summen in den Attributen oder Texten geändert werden, oder auch mit mathematischen Funktionen geändert  
;;;werden.											           
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_ZAZ$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_ZAZ_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 09.09.23	   
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:ZAZ ( / )
  (JB_ZAZ)
  )

;;;Intro
(defun JB_ZAZ:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------ZAZ(1.0), 09.09.23----------------------")
  (princ str)
  (princ "\n--------------------------------------------------------------")
  )




;;;Variablenliste
(defun JB_ZAZ:v_liste ( / )
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ("JB_1_r1-2" . 0);;;0 = Texte, 1 = Attribute von Blockreferenzen
                             ("JB_1_p1Last" . "+");;;Letzte Funktion
                             ("JB_1_e1" . "10.0");;;wert für Funktion
                             ("JB_1_e2" . "<Präfix>");;;Präfix
                             ("JB_1_e3" . "<Suffix>");;;Suffix
                             ("JB_1_e4" . "2");;;Nachkommastellen
                             ("JB_1_b6" . "*");;;label = Attributnamefilter
                             ("JB_1_b7" . "*");;;label = BlocknameFilter
                             ("JB_1_to1" . "1");;;Auswahl => immer alle
                             )
                          )
                         )
      ))
  )


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

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

  (setq pfad_ini (JB_ZAZ: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_ZAZ:v_liste))pfad_ini nil))
  
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))
  
  
  (JB_ZAZ:Intro "\nZAZ: ZahlenZieher - Zahlen aus Attributen und Texten.")

  
  

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


  (JB_ZAZ:Dbox1 v_liste pfad_ini)
    
   
  (princ "\nEnde.")
  (setq Osmode_Alt (getvar "OSMODE"))
  (JBf_Reinit)
  (setvar "OSMODE" Osmode_Alt)
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) 
  (princ)
  )

 

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


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

;;;Intgruppe
(defun JB_ZAZ:Dbox1:Objekte:TextwertList:IntGroup (n i IntList / K RETLIST)
  (setq k (- n i))
  (repeat i
    (setq RetList(append RetList (list k)))
    (setq k (+ k 1)))
  (list RetList))

;;;Textwert als Präfix-Zahl-Suffix-Liste
(defun JB_ZAZ:Dbox1:Objekte:TextwertList (wert / DEZILIST I INTLIST INTRETLIST N WERTLIST X ZAHLDEZILIST ZAHLLIST RetList)
  (setq DeziList (vl-string->list ".,"))
  (setq ZahlList (vl-string->list "0123456789"))
  (setq wertList (vl-string->list wert))
  (setq n -1)
  (mapcar '(lambda(X)
             (setq n (+ n 1))
             (if (and (not ZahlDeziList)(> n 0)(< n (-(length wertList)1)))
               (if (and(member X DeziList)
                       (member(nth (- n 1)wertList)ZahlList)
                       (member(nth (+ n 1)wertList)ZahlList));;;dann Zahl mit Dezi
                 (setq ZahlDeziList (list (- n 1)n (+ n 1)))
                 )
               )
             )wertList)
  (if ZahlDeziList
    (progn
      (setq n (car ZahlDeziList))
      (while (and (>=(setq n (- n 1))0)(member(nth n wertList)ZahlList))
        (setq ZahlDeziList (cons n ZahlDeziList))
        )
      (setq n (last ZahlDeziList))
      (while (and (<(setq n (+ n 1))(length wertList))(member(nth n wertList)ZahlList))
        (setq ZahlDeziList (append ZahlDeziList (list n)))
        )
      (setq RetList
             (list
               (substr wert 1 (car ZahlDeziList))
               (substr wert (+(car ZahlDeziList)1)(length ZahlDeziList))
               (substr wert (+(last ZahlDeziList)2))
               )
            )
      )
    (progn
      (setq n -1)
      (mapcar '(lambda(X)
             (setq n (+ n 1))
             (if(member(nth n wertList)ZahlList)
               (setq IntList (cons n IntList))
               )
             )wertList)
      (if IntList
        (progn
          (setq IntList (reverse IntList))
          (while IntList
            (setq n (car IntList)
                  i 1)
            (while (member (setq n (+ n 1))IntList)
              (setq i (+ i 1)))
            (setq IntRetList (append IntRetList (JB_ZAZ:Dbox1:Objekte:TextwertList:IntGroup n i IntList)))
            (repeat (length(last IntRetList))
              (setq IntList (cdr IntList))
              )
            )
          (setq IntRetList (vl-sort IntRetList '(lambda(e1 e2)(> (length e1)(length e2)))))
          (setq RetList
             (list
               (substr wert 1 (car (car IntRetList)))
               (substr wert (+(car (car IntRetList))1)(length (car IntRetList)))
               (substr wert (+(last (car IntRetList))2))
               )
            )
          
          )
        )
      )
    )
  RetList
  )


;;;Trennzeichen aus Zahl
(defun JB_ZAZ:Dbox1:Trennzeichen (WertAsString / )
  (cond
    ((vl-string-search "." WertAsString)".")
    ((vl-string-search "," WertAsString)",")
    ('T ""))
  )
  


;;;;ObjList
(defun JB_ZAZ:Dbox1:Objekte:ObjList (aws / N RETLIST TEXTWERT TEXTWERTLIST VLA-ATT VLA-OBJ)
  (setq n 0)
  (repeat (sslength aws)
    (setq vla-obj (vlax-ename->vla-object (ssname aws n)))
    (if (=(vla-get-Objectname vla-obj)"AcDbText")
      (progn
        (setq Textwert (vla-get-TextString vla-obj))
        (setq TextwertList (JB_ZAZ:Dbox1:Objekte:TextwertList TextWert))
        (setq RetList (append RetList
                        (list
                          (list
                          (cons "Handle" (vla-get-handle vla-obj))
                          (cons "vla-obj" vla-obj)
                          (cons "Praefix" (car TextwertList))
                          (cons "ZahlAsString" (cadr TextwertList))
                          (cons "Suffix" (caddr TextwertList))
                          (cons "Attname" nil)
                          (cons "Blockname" nil)
                          (cons "Trennzeichen"
                                (cond
                                  ((vl-string-search "." (cadr TextwertList))".")
                                  ((vl-string-search "," (cadr TextwertList))",")
                                  ('T ""))))))))
      
        (mapcar '(lambda(vla-att)
                   (setq Textwert (vla-get-TextString vla-att))
                   (if(setq TextwertList (JB_ZAZ:Dbox1:Objekte:TextwertList TextWert))
                   (setq RetList (append RetList
                                   (list
                                     (list
                                       (cons "Handle" (vla-get-handle vla-att))
                                       (cons "vla-obj" vla-att)
                                       (cons "Praefix" (car TextwertList))
                                       (cons "ZahlAsString" (cadr TextwertList))
                                       (cons "Suffix" (caddr TextwertList))
                                       (cons "Attname" (vla-get-TagString vla-att))
                                       (cons "Blockname" (vla-get-Effectivename vla-obj))
                                       (cons "Trennzeichen" (JB_ZAZ:Dbox1:Trennzeichen (cadr TextwertList))
                                             )))))))
          (mapcar 'cadr(JBf_list_att_aus_block_vla-obj vla-obj)))
      )
    (setq n (+ n 1)))
  RetList)
          
                      
;;;Filtern der Liste
(defun JB_ZAZ:Dbox1:Objekte:l1Filtern ( / X)
  (if (=(cdr(assoc "JB_1_r1-2" Settings&Dbox1))1);;;wenn Attribute
    (setq l1&Dbox1 (vl-remove-if 'not
                     (mapcar '(lambda(X)
                                (if (and (wcmatch(strcase(cdr(assoc "Attname" X)))(strcase (cdr(assoc "JB_1_b6" Settings&Dbox1))))
                                         (wcmatch(strcase(cdr(assoc "Blockname" X)))(strcase (cdr(assoc "JB_1_b7" Settings&Dbox1)))))
                                  X))l1All&Dbox1)))
    (setq l1&Dbox1 l1All&Dbox1)
    )
  )


;;;Objekte auswählen
(defun JB_ZAZ:Dbox1:Objekte ( / AWS OBJLIST)
  (if (and
        (princ (strcat "\nWählen Sie "
                 (if (=(cdr(assoc "JB_1_r1-2" Settings&Dbox1))0)
                   "Texte"
                   "Blöcke mit Attributen")
                 " aus:"))
        (setq aws (ssget
                    (if (=(cdr(assoc "JB_1_r1-2" Settings&Dbox1))0)
                      (list (cons 0 "TEXT"))
                      (list (cons 0 "INSERT"))
                      )))
        (setq objList(JB_ZAZ:Dbox1:Objekte:ObjList aws)))
    (progn
      (if(setq l1All&Dbox1 objList)
        (if(setq l1&Dbox1 (JB_ZAZ:Dbox1:Objekte:l1Filtern))
          (if (= (cdR(assoc "JB_1_to1" Settings&dbox1)) "1")
            (setq l1_sel&Dbox1 (progn(setq n -1)(mapcar '(lambda(X)(setq n(+ n 1)))l1&Dbox1)))
            (setq l1_sel&Dbox1 '(0))
            )
          (progn
            (alert "Es entsprach kein Attribut in der Auswahl dem Attribut- und Blocknamefilter.")
            (setq l1&Dbox1 nil)
            (setq l1_sel&Dbox1 nil)
            )
          )
        (setq l1&Dbox1 nil
              l1_sel&Dbox1 nil)
        )
      )
    (if (and aws (not objList))
      (alert "Die ausgewählten Blöcke enthielten keine Attribute oder Attribute ohne Zahlenwert."))
    )
  )
    
    
                    




;;;DBox 1
(defun JB_ZAZ:Dbox1 (v_liste pfad_ini / DclId ok l1&Dbox1 l1All&Dbox1 l1_sel&Dbox1 p1&Dbox1 p1_sel&Dbox1)

  (setq Settings&Dbox1 (JB_ZAZ:v_liste:DboxSettings:get "Dbox1" v_liste))
  (setq p1&Dbox1 '("+" "-" "*" "/"))
  (setq p1_sel&Dbox1 (- (length p1&Dbox1)(length (member (cdr(assoc "JB_1_p1Last" Settings&Dbox1))p1&Dbox1))))
  
      
  (while (not (member ok '(99)))

    (setq DclId (JBf_Dcl:Load_dialog JB_ZAZ_$DCL$_File "JB_ZAZ_1" JB_ZAZ$DCL$_1_po))

    (JB_ZAZ:Dbox1:set)
    (JB_ZAZ:Dbox1:mode)
    
    
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_ZAZ:Dbox1:action \"" A "\")")))
            '("JB_1_b1" "JB_1_b2" "JB_1_b3" "JB_1_b4" "JB_1_b5" "JB_1_b6" "JB_1_b7"   
              "JB_1_l1"  "JB_1_p1"            
              "JB_1_r1" "JB_1_r2"
              "JB_1_to1"
              "JB_1_b0" "cancel"
             )
    )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    
      
    
    (cond ((= ok 99) ;;;Ende
           (setq v_liste (JB_ZAZ:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
           (JBf_SIC:sichern v_liste pfad_ini nil)
           )
          ((= ok 10);;;Objekte wählen
           (JB_ZAZ:Dbox1:Objekte)
           )
             
          ((= ok 12)
           (vl-catch-all-apply 'getpoint (list (trans(cdr(assoc "xy0" (nth l1_sel&Dbox1 l1&Dbox1)))0 1) "\nmit ENTER zurück ins Dialogfenster."))
           )
          ((= ok 13)
           (sssetfirst (ssadd(vlax-vla-object->ename(cdr(assoc "vla-obj1" (nth l1_sel&Dbox1 l1&Dbox1)))))(ssadd(vlax-vla-object->ename(cdr(assoc "vla-obj1" (nth l1_sel&Dbox1 l1&Dbox1))))))
           (vl-catch-all-apply 'getpoint (list (trans(cdr(assoc "xy0" (nth l1_sel&Dbox1 l1&Dbox1)))0 1) "\nmit ENTER zurück ins Dialogfenster."))
           (sssetfirst nil nil)
           )
          ((= ok 14)
           (sssetfirst (ssadd(vlax-vla-object->ename(cdr(assoc "vla-obj2" (nth l1_sel&Dbox1 l1&Dbox1)))))(ssadd(vlax-vla-object->ename(cdr(assoc "vla-obj2" (nth l1_sel&Dbox1 l1&Dbox1))))))
           (vl-catch-all-apply 'getpoint (list (trans(cdr(assoc "xy0" (nth l1_sel&Dbox1 l1&Dbox1)))0 1) "\nmit ENTER zurück ins Dialogfenster."))
           (sssetfirst nil nil)
           )
          )
    ) 
  )


;;;Mathematische Funktion, Genauigkeit
(defun JB_ZAZ:Dbox1:action:b1:Rechnen (ZahlAsString wert / DEZI NACHKOMMA NACHKOMMAWERT)
  (setq Dezi
         (cond
           ((vl-string-search "." ZahlAsString)".")
           ((vl-string-search "," ZahlAsString)",")
           ('T ".")))

  (setq Nachkomma (if (vl-string-search Dezi ZahlAsString)
                    (strlen (substr ZahlAsString (+ 2 (vl-string-search Dezi ZahlAsString))))
                    0))

  (setq NachkommaWert (if (vl-string-search "." wert)
                    (strlen (substr wert (+ 2 (vl-string-search "." wert))))
                    0))

  (setq Nachkomma (apply 'max (list Nachkomma Nachkommawert)))

  (vl-string-subst Dezi "."
    (rtos
      (cond ((= (cdr(assoc "JB_1_p1Last" Settings&dbox1))"+")
             (+(atof(vl-string-subst "." Dezi ZahlAsString))(atof wert)))
            ((= (cdr(assoc "JB_1_p1Last" Settings&dbox1))"-")
             (-(atof(vl-string-subst "." Dezi ZahlAsString))(atof wert)))
            ((= (cdr(assoc "JB_1_p1Last" Settings&dbox1))"/")
             (/(atof(vl-string-subst "." Dezi ZahlAsString))(atof wert)))
            ((= (cdr(assoc "JB_1_p1Last" Settings&dbox1))"*")
             (*(atof(vl-string-subst "." Dezi ZahlAsString))(atof wert))))2 Nachkomma))
  )
  



;;;Rechnen, Action b1
(defun JB_ZAZ:Dbox1:action:b1 ( / N X Y ZAHLASSTRING)
  (setq n -1)
  (setq l1&Dbox1
         (mapcar '(lambda(X)
                    (setq n (+ n 1))
                    (if (member n l1_sel&Dbox1)
                      (progn
                        (vla-put-Textstring (cdr(assoc "vla-obj" X))(strcat
                                                                      (cdr(assoc "Praefix" X))
                                                                      (setq ZahlAsString(JB_ZAZ:Dbox1:action:b1:Rechnen (cdr(assoc "ZahlAsString" X))(cdr(assoc "JB_1_e1" Settings&dbox1))))
                                                                      (cdr(assoc "Suffix" X))))
                        (vla-update (cdr(assoc "vla-obj" X)))
                        (setq X(JBf_list:subst:gc X ZahlAsString "ZahlAsString"))
                        (setq X(JBf_list:subst:gc X (JB_ZAZ:Dbox1:Trennzeichen ZahlAsString)"Trennzeichen"))
                        (setq l1All&Dbox1 (mapcar '(lambda(Y)(if (= (cdr(assoc "Handle" Y))(cdr(assoc "Handle" X)))X Y))l1All&Dbox1))
                        X)
                      X))l1&Dbox1))
  )

;;;Präfix, action b2
(defun JB_ZAZ:Dbox1:action:b2( / N PRAEFIX X Y)
  (setq n -1)
  (setq l1&Dbox1
         (mapcar '(lambda(X)
                    (setq n (+ n 1))
                    (if (member n l1_sel&Dbox1)
                      (progn
                        (vla-put-Textstring (cdr(assoc "vla-obj" X))(strcat
                                                                      (setq Praefix (cdr(assoc "JB_1_e2" Settings&dbox1)))
                                                                      (cdr(assoc "ZahlAsString" X))
                                                                      (cdr(assoc "Suffix" X))))
                        (vla-update (cdr(assoc "vla-obj" X)))
                        (setq X(JBf_list:subst:gc X Praefix "Praefix"))
                        (setq l1All&Dbox1 (mapcar '(lambda(Y)(if (= (cdr(assoc "Handle" Y))(cdr(assoc "Handle" X)))X Y))l1All&Dbox1))
                        X)
                      X))l1&Dbox1))
  )




;;;Suffix, action b3
(defun JB_ZAZ:Dbox1:action:b3( / N SUFFIX X Y)
  (setq n -1)
  (setq l1&Dbox1
         (mapcar '(lambda(X)
                    (setq n (+ n 1))
                    (if (member n l1_sel&Dbox1)
                      (progn
                        (vla-put-Textstring (cdr(assoc "vla-obj" X))(strcat
                                                                      (cdr(assoc "Praefix" X))
                                                                      (cdr(assoc "ZahlAsString" X))                                                                      
                                                                      (setq Suffix (cdr(assoc "JB_1_e3" Settings&dbox1)))))
                        (vla-update (cdr(assoc "vla-obj" X)))
                        (setq X(JBf_list:subst:gc X Suffix "Suffix"))
                        (setq l1All&Dbox1 (mapcar '(lambda(Y)(if (= (cdr(assoc "Handle" Y))(cdr(assoc "Handle" X)))X Y))l1All&Dbox1))
                        X)
                      X))l1&Dbox1))
  )


;;;Wert mit getauschtem Trennzeichen
(defun JB_ZAZ:Dbox1:action:b4:Trennzeichen (ZahlAsString Trennzeichen / )
  (if (vl-string-search Trennzeichen ZahlAsString)
    (vl-string-subst (if (= Trennzeichen ".")"," ".")Trennzeichen ZahlAsString)
    ZahlAsString)
  )
  
  


;;;Trennzeichen action b4
(defun JB_ZAZ:Dbox1:action:b4( / N X Y ZAHLASSTRING)
  (setq n -1)
  (setq l1&Dbox1
         (mapcar '(lambda(X)
                    (setq n (+ n 1))
                    (if (member n l1_sel&Dbox1)
                      (progn
                        
                        (vla-put-Textstring (cdr(assoc "vla-obj" X))(strcat
                                                                      (cdr(assoc "Praefix" X))
                                                                      (setq ZahlAsString(JB_ZAZ:Dbox1:action:b4:Trennzeichen (cdr(assoc "ZahlAsString" X))(cdr(assoc "Trennzeichen" X))))                                                                      
                                                                      (cdr(assoc "Suffix" X))))
                        (vla-update (cdr(assoc "vla-obj" X)))
                        (setq X(JBf_list:subst:gc X ZahlAsString "ZahlAsString"))
                        (setq X(JBf_list:subst:gc X (JB_ZAZ:Dbox1:Trennzeichen ZahlAsString)"Trennzeichen"))
                        (setq l1All&Dbox1 (mapcar '(lambda(Y)(if (= (cdr(assoc "Handle" Y))(cdr(assoc "Handle" X)))X Y))l1All&Dbox1))
                        X)
                      X))l1&Dbox1))
  )


;;;Wert mit getauschtem Trennzeichen
(defun JB_ZAZ:Dbox1:action:b5:Runden (ZahlAsString Nachkomma / TRENNZEICHEN)
  (setq Trennzeichen(JB_ZAZ:Dbox1:Trennzeichen ZahlAsString))
  (if (= Trennzeichen "")(setq Trennzeichen "."))
  (setq ZahlAsString (vl-string-subst "." Trennzeichen ZahlAsString))
  (setq ZahlAsString (rtos(atof ZahlAsString)2 (atoi Nachkomma)))
  (setq ZahlAsString (vl-string-subst Trennzeichen "." ZahlAsString))
  
  ZahlAsString)


;;;Runden action b5
(defun JB_ZAZ:Dbox1:action:b5( /  N X Y ZAHLASSTRING)
  (setq n -1)
  (setq l1&Dbox1
         (mapcar '(lambda(X)
                    (setq n (+ n 1))
                    (if (member n l1_sel&Dbox1)
                      (progn
                        
                        (vla-put-Textstring (cdr(assoc "vla-obj" X))(strcat
                                                                      (cdr(assoc "Praefix" X))
                                                                      (setq ZahlAsString(JB_ZAZ:Dbox1:action:b5:Runden (cdr(assoc "ZahlAsString" X)) (cdr(assoc "JB_1_e4" Settings&dbox1))))                                                                                                                                           
                                                                      (cdr(assoc "Suffix" X))))
                        (vla-update (cdr(assoc "vla-obj" X)))
                        (setq X(JBf_list:subst:gc X ZahlAsString "ZahlAsString"))
                        (setq X(JBf_list:subst:gc X (JB_ZAZ:Dbox1:Trennzeichen ZahlAsString)"Trennzeichen"))
                        (setq l1All&Dbox1 (mapcar '(lambda(Y)(if (= (cdr(assoc "Handle" Y))(cdr(assoc "Handle" X)))X Y))l1All&Dbox1))
                        X)
                      X))l1&Dbox1))
  )
                        
                                                                    
                      
               
   
;;;Action (Variable global in Aufrufender Funktion)
(defun JB_ZAZ:Dbox1:action (key / NAME X)

  (cond

    ((= key "JB_1_to1")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to1"))
     (if (= (cdR(assoc "JB_1_to1" Settings&dbox1)) "1")
       (setq l1_sel&Dbox1 (progn(setq n -1)(mapcar '(lambda(X)(setq n(+ n 1)))l1&Dbox1)))
       (setq l1_sel&Dbox1 '(0))
       )
     (JB_ZAZ:Dbox1:set)
     (JB_ZAZ:Dbox1:mode)
     
     )
    ((= key "JB_1_r1")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (- 1 (atoi $value)) "JB_1_r1-2"))
     (JB_ZAZ:Dbox1:get)
     (setq l1&Dbox1 nil
           l1_sel&Dbox1 nil)
     (JB_ZAZ:Dbox1:set)
     (JB_ZAZ:Dbox1:mode)
     
     )
    ((= key "JB_1_r2")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi $value) "JB_1_r1-2"))
     (JB_ZAZ:Dbox1:get)
     (setq l1&Dbox1 nil
           l1_sel&Dbox1 nil)
     (JB_ZAZ:Dbox1:set)
     (JB_ZAZ:Dbox1:mode)
     )
    ((= key "JB_1_b0");;;Objekte auswählen
     (JB_ZAZ:Dbox1:get)
     (setq JB_ZAZ$DCL$_1_po (done_dialog 10))
     )
    ((= key "JB_1_l1")
     (setq l1_sel&Dbox1 (mapcar 'atoi(JBf_String:Delimiter->List $value " ")))
     (JB_ZAZ:Dbox1:get)
     (JB_ZAZ:Dbox1:set)
     )

    ((= 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_p1Last"))
     
     )

    ((= key "JB_1_b6");;;Attributnamefilter
     (JB_ZAZ:Dbox1:get)
     (if (setq wert (JB_ZAZ:Dbox2 (cdr(assoc "JB_1_b6" Settings&dbox1))))
       (progn
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 wert "JB_1_b6"))
         (if(setq l1&Dbox1 (JB_ZAZ:Dbox1:Objekte:l1Filtern))
           (progn
             (if (= (cdR(assoc "JB_1_to1" Settings&dbox1)) "1")
               (setq l1_sel&Dbox1 (progn(setq n -1)(mapcar '(lambda(X)(setq n(+ n 1)))l1&Dbox1)))
               (setq l1_sel&Dbox1 '(0))
               )
             (JB_ZAZ:Dbox1:set)
             (JB_ZAZ:Dbox1:mode)
             )
           (progn
             (setq l1_sel&Dbox1 nil)
             (JB_ZAZ:Dbox1:set)
             (JB_ZAZ:Dbox1:mode)
             (if l1All&Dbox1
               (alert "Es entsprach kein Attribut in der Auswahl dem Attribut- und Blocknamefilter.")))
           )
         )
       )
     )


    ((= key "JB_1_b7");;;Blocknamefilter
     (JB_ZAZ:Dbox1:get)
     (if (setq wert (JB_ZAZ:Dbox2 (cdr(assoc "JB_1_b7" Settings&dbox1))))
       (progn
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 wert "JB_1_b7"))
         (if(setq l1&Dbox1 (JB_ZAZ:Dbox1:Objekte:l1Filtern))
           (progn
             (if (= (cdR(assoc "JB_1_to1" Settings&dbox1)) "1")
               (setq l1_sel&Dbox1 (progn(setq n -1)(mapcar '(lambda(X)(setq n(+ n 1)))l1&Dbox1)))
               (setq l1_sel&Dbox1 '(0))
               )
             (JB_ZAZ:Dbox1:set)
             (JB_ZAZ:Dbox1:mode)
             )
           (progn
             (setq l1_sel&Dbox1 nil)
             (JB_ZAZ:Dbox1:set)
             (JB_ZAZ:Dbox1:mode)
             (if l1All&Dbox1
               (alert "Es entsprach kein Attribut in der Auswahl dem Attribut- und Blocknamefilter.")))
           )
         )
       )
     )

    
    
    ((= key "JB_1_b1");;;Rechnen
     (JB_ZAZ:Dbox1:get)
     (JB_ZAZ:Dbox1:action:b1)
     (JB_ZAZ:Dbox1:set)
         
     )

    ((= key "JB_1_b2");;;Präfix
     (JB_ZAZ:Dbox1:get)
     (JB_ZAZ:Dbox1:action:b2)
     (JB_ZAZ:Dbox1:set)
         
     )

    ((= key "JB_1_b3");;;Suffix
     (JB_ZAZ:Dbox1:get)
     (JB_ZAZ:Dbox1:action:b3)
     (JB_ZAZ:Dbox1:set)
         
     )
    ((= key "JB_1_b4");;;Trennzeichen
     (JB_ZAZ:Dbox1:get)
     (JB_ZAZ:Dbox1:action:b4)
     (JB_ZAZ:Dbox1:set)
         
     )
    ((= key "JB_1_b5");;;Nachkommastellen
     (JB_ZAZ:Dbox1:get)
     (JB_ZAZ:Dbox1:action:b5)
     (JB_ZAZ:Dbox1:set)
         
     )
    
    
    ((= key "cancel") ;;;Ende
     (JB_ZAZ:Dbox1:get)
     (setq JB_ZAZ$DCL$_1_po (done_dialog 99))
     )
    )
    
)


;;;DBox1: getten
(defun JB_ZAZ:Dbox1:get ( / )
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vl-string-subst "." ","(get_tile "JB_1_e1")) "JB_1_e1"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (get_tile "JB_1_e2") "JB_1_e2"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (get_tile "JB_1_e3") "JB_1_e3"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (get_tile "JB_1_e4") "JB_1_e4"))
  
  )


;;;Aus Objekte Textwerte rausziehen für DBOX-Darstellung
(defun JB_ZAZ:Dbox1:set:Text (art / L1 WERT N X)
  (if l1&Dbox1
    (progn
      (setq n -1)
      (setq l1 (vl-remove-if 'not
                 (mapcar '(lambda(X)
                            (setq n (+ n 1))
                            (if (member n l1_sel&Dbox1)X))l1&Dbox1)))
      (setq wert(cdr(assoc art(car l1))))
      (if (not(vl-remove-if '(lambda(X)(= wert (cdr(assoc art X))))l1))
        wert
        "*"
        )
      )
    "")
  )
    
    
;;;DBox1: setten
(defun JB_ZAZ:Dbox1:set ( / X)
  

  (JBf_Dcl:AddList:New "JB_1_l1"
    (mapcar '(lambda(X)
               (strcat
                 (cdr(assoc "ZahlAsString" X)) "\t"
                 (if (cdr(assoc "Attname" X))
                   (strcat "ATTRIBUT<"(cdr(assoc "Attname" X))">(Blockname="(cdr(assoc "Blockname" X))")")
                   "TEXT")))
                 
      l1&Dbox1)
    )
  (if l1_sel&Dbox1
    (set_tile "JB_1_l1" (vl-string-right-trim " "(apply 'strcat(mapcar '(lambda(X)(strcat X " "))(mapcar 'itoa l1_sel&Dbox1)))))
    (set_tile "JB_1_l1" "")
    )

  (JBf_Dcl:AddList:New "JB_1_p1" p1&Dbox1)
  (set_tile "JB_1_p1" (itoa p1_sel&Dbox1))

  (mapcar '(lambda(X)(set_tile (strcat "JB_1_"(car X))(cadr X)))
    (list
      (list "r1" (if(=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0)"1" "0"))
      (list "r2" (if(=(cdr(assoc "JB_1_r1-2" Settings&dbox1))1)"1" "0"))      
      (list "e1" (cdr(assoc "JB_1_e1" Settings&dbox1)))
      (list "e2" (cdr(assoc "JB_1_e2" Settings&dbox1)))
      (list "e3" (cdr(assoc "JB_1_e3" Settings&dbox1)))
      (list "e4" (cdr(assoc "JB_1_e4" Settings&dbox1)))
      (list "t1" (JB_ZAZ:Dbox1:set:Text "Praefix"))
      (list "t2" (JB_ZAZ:Dbox1:set:Text "Suffix"))
      (list "t3" (progn
                   (setq trennzeichen(JB_ZAZ:Dbox1:set:Text "Trennzeichen"))
                   (strcat Trennzeichen (cond ((= Trennzeichen ",")" (Komma)")((= Trennzeichen ".")" (Punkt)")((= Trennzeichen "")" (ohne)")('T "")))
                   )
                   )
      (list "t6" (cdr(assoc "JB_1_b6" Settings&dbox1)))
      (list "t7" (cdr(assoc "JB_1_b7" Settings&dbox1)))
      (list "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
      )))

;;;DBox1, moden
(defun JB_ZAZ:Dbox1:mode ( / )
  (if l1&Dbox1
    (mapcar '(lambda(X)(mode_tile (strcat "JB_1_" X)0))
      '("p1" "t1" "t2" "t3" "t4" "e1" "e2" "e3" "e4" "t5" "b1" "b2" "b3" "b4" "b5" "b6" "b7" "to1"))
    (progn
      (mapcar '(lambda(X)(mode_tile (strcat "JB_1_" X)1))
      '("p1" "t1" "t2" "t3" "t4" "e1" "e2" "e3" "e4" "t5" "b1" "b2" "b3" "b4" "b5" "to1"))
      (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))1)
        (progn
          (mode_tile "JB_1_b6" 0)
          (mode_tile "JB_1_b7" 0))
        (progn
          (mode_tile "JB_1_b6" 1)
          (mode_tile "JB_1_b7" 1))
        )
      (mode_tile "JB_1_b0" 2))
    )
      
  )



(defun JB_ZAZ:Dbox2 (wert&Dbox2 / DclId ok)
 
  (while (not (member ok '(1 99)))

    (setq DclId (JBf_Dcl:Load_dialog JB_ZAZ_$DCL$_File "JB_ZAZ_2" JB_ZAZ$DCL$_2_po))

    (set_tile "JB_2_e1" wert&Dbox2)
    (mode_tile "JB_2_e1" 2)

    (action_tile "accept" "(setq wert&Dbox2 (get_tile \"JB_2_e1\"))(setq JB_ZAZ$DCL$_2_po (done_dialog 1))")
    (action_tile "cancel" "(setq JB_ZAZ$DCL$_2_po (done_dialog 1))")
    (setq ok (start_dialog))
    (unload_dialog DclId)
    ) 
  (if (= ok 1)wert&Dbox2))


         
;;;DCL-schreiben
(defun JB_ZAZ:dcl:Write ( / file)  
  (if (and (setq JB_ZAZ_$DCL$_File (vl-filename-mktemp (strcat "ZAZ.dcl")))
           (setq file (open JB_ZAZ_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "//Hauptdialog"
                "JB_ZAZ_1: dialog {label= \"Zahlenzieher\";	 "
                ":boxed_column {label = \"Textwert-Objekte\";"
                ":radio_row {"
                ":radio_button {key = \"JB_1_r1\"; label = \"Texte\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"Attribute (von Blockreferenzen)\";}"
                "}"
                "}"
                ":boxed_column {label = \"Zahlenwertliste (Mehrfachauswahl mit STRG+UMSCHALT)\";"
                ":row {"
                ":button{key = \"JB_1_b6\"; label = \"&Attributnamefilter...\";}"
                ":text {key = \"JB_1_t6\"; label = \"pnr*\"; width=12;}"
                ":button{key = \"JB_1_b7\"; label = \"&Blocknamefilter...\";}"
                ":text {key = \"JB_1_t7\"; label = \"bat*\"; width=12;}"
                
                "}"
                ":list_box {key = \"JB_1_l1\"; width = 60; height =25; tabs = \"15\"; multiple_select=true;}"
                ":toggle {key = \"JB_1_to1\"; label = \"alle\";}"
                "}"
                ":boxed_column {label = \"Aktionen\";"
                ":row {"
                ":column {"
                ":text {label = \"Funktion\";}"
                ":text {label = \"Präfix\";}"
                ":text {label = \"Suffix\";}"
                ":text {label = \"Trennzeichen\";}"
                ":text {label = \"Runden\";}"
                "}"
                ":column {"
                ":popup_list {key = \"JB_1_p1\";}"
                ":text {key = \"JB_1_t1\";label = \"Pnr:\";}"
                ":text {key = \"JB_1_t2\"; label = \"cm\";}"
                ":text {key = \"JB_1_t3\"; label = \".\";}"
                ":text {key = \"JB_1_t4\"; label = \"Nachkommastellen\";}}"
                ":column {"
                ":edit_box {key = \"JB_1_e1\";}"
                ":edit_box {key = \"JB_1_e2\";}"
                ":edit_box {key = \"JB_1_e3\";}"
                ":text {key = \"JB_1_t5\"; label = \"Punkt <-> Komma\";}"
                ":edit_box {key = \"JB_1_e4\";}"
                "}"
                ":column {"
                ":button {key = \"JB_1_b1\"; label = \"Rechnen\";}"
                ":button {key = \"JB_1_b2\"; label = \"Ändern\";}"
                ":button {key = \"JB_1_b3\"; label = \"Ändern\";}"
                ":button {key = \"JB_1_b4\"; label = \"Ändern\";}"
                ":button {key = \"JB_1_b5\"; label = \"Ändern\";}"
                "}"
                "}"
                "}"
                ":row{fixed_width = true;alignment = centered;"
                ":button {key = \"JB_1_b0\"; label = \"Objekte aus&wählen<\";width=20;}"
                ":spacer {width = 2;}"
                ":retirement_button {label = \"&Ende\"; key= \"cancel\"; fixed_width = true;is_cancel=true;}"
                "}"
                "}"
                "JB_ZAZ_2: dialog {label= \"Filter\";"
                ":edit_box {key = \"JB_2_e1\"; allow_accept=true;}"
                "ok_cancel;}"

               )
              )
      )
      (close file)
      JB_ZAZ_$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)
	  
;;;--------------------------------------------------------------------------------------------------------
;;;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))


;;;Att_liste aus vla-object
(defun JBf_list_att_aus_block_vla-obj(vla-obj / A)
  (if (=(vla-get-hasattributes vla-obj):vlax-true)
    (mapcar '(lambda(A)(list(strcase(vlax-get A 'TagString))A))
      (vlax-safearray->list (vlax-variant-value(vla-getattributes vla-obj))))
  ))          

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

;;;DCL-Liste komplett neu füllen
(defun JBf_Dcl:AddList:New (key liste / )
  (start_list key 3)
  (mapcar 'add_list liste)
  (end_list)
  )

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

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|ZahlenZieher - Zahlen aus Attributen und Texten.            |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: ZAZ                                    |"
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)



      









