
;;;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: NLG - Es wird ein Block- und ein Attributname bestimmt. Dann werden entsprechende Block-    
;;;referenzen in der Zeichnung ausgewählt und in den festgelegten Attributen wird anstelle des Attribut-   
;;;anschriebes eine Referenznummer (oder Buchstabe) eingetragen. Dann wird eine Legende, bestehend aus 2   
;;;Spalten erzeugt: 1. Spalte = Nummer, 2. Spalte = ursprünglicher Attributwert.			   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:											   
;;;- JB_NLG$$vla-objList (Liste mit x,y-Angaben und den VLA-Objekten, die berücksichtigt werden sollen)    
;;;- JB_NLG$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_NLG_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 24.05.24	   
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:NLG ( / )
  (JB_NLG)
  )

;;;Intro
(defun JB_NLG:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------NLG(1.0), 24.05.24----------------------")
  (princ str)
  (princ "\n--------------------------------------------------------------")
  )




;;;Variablenliste
(defun JB_NLG:v_liste ( / )
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ("JB_1_t1" . nil);;;Blockname
                             ("JB_1_p1" . nil);;;Name Attribut
                             ("JB_1_e1" . "1");;;Nummer ab
                             ("JB_1_e2" . "3");;;Vorangestellte Nullen, Gesamtlänge
                             ("JB_1_e3" . "0.5");;;Texthöhe
                             ("JB_1_e4" . "1.0");;;Zeilenabstand
                             ("JB_1_e5" . "5.0");;;Spaltenabstand
                             ("JB_1_to1" . "0");;;Sortierung numerisch
                             ("JB_1_to2" . "1");;;Sortierung aufsteigend

                             )
                          )
                         )
      ))
  )


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

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

  (setq pfad_ini (JB_NLG: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_NLG: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_NLG:Intro "\nErzeugen einer Nummern-Legende aus Blockattributen.")

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


;;;Prüfen, ob WKS oder BKS in xy-Ausrichtung zum WKS
(defun JB_NLG:Bks-WKS:parallel-p ( / )
  (or(and(if (/=(getvar "WORLDUCS")1);;;wenn BKS
    (and(equal(caddr(trans '(1 0 0)1 0))0.0 0.0001)
        (equal(caddr(trans '(0 1 0)1 0))0.0 0.0001))
    'T)
      (equal(car (getvar "VIEWDIR"))0.0 0.0001)
      (equal(cadr (getvar "VIEWDIR"))0.0 0.0001))
  (alert (strcat "Für die Verwendung des Programms \"NLG\" müssen Sie sich im WKS oder einem BKS, dessen xy-Ebenen-Ausrichtung der xy-Ebenen-Ausrichtung des Weltkoordinatensystems entspricht.\n"
                 "Zudem muss die DRAUFSICHT auf das aktuelle Koordinatensystem aktiviert sein."))
     )
  )

 

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


(defun JB_NLG: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
  )
                   
;;;AttributListe p1
(defun JB_NLG:Dbox1:p1:Ini ( / )
  (if (and(cdr(assoc "JB_1_t1" Settings&Dbox1))
          (tblsearch "BLOCK" (cdr(assoc "JB_1_t1" Settings&Dbox1))))
    (if(setq p1&Dbox1 (mapcar 'vla-get-TagString(JBf_list_att_aus_vla-blockdef(cdr(assoc "JB_1_t1" Settings&Dbox1)))))
      (if (member (cdr(assoc "JB_1_p1" Settings&Dbox1))p1&Dbox1)
        (setq p1_sel&DBox1 (- (length p1&Dbox1)(length (member (cdr(assoc "JB_1_p1" Settings&Dbox1))p1&Dbox1))))
        (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (car p1&Dbox1)"JB_1_p1")
              p1_sel&DBox1 0)
        )
      )

    )
  )
 
;;;DBox 1
(defun JB_NLG:Dbox1 (v_liste pfad_ini / A DCLID OK SETTINGS&DBOX1 p1&Dbox1 p1_sel&DBox1 l1&DBox1 l1Text&DBox1 Error&Dbox1)
   
  (setq Settings&Dbox1 (JB_NLG:v_liste:DboxSettings:get "Dbox1" v_liste))
  (JB_NLG:Dbox1:p1:Ini)
  
  (while (not (member ok '(1 99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_NLG_$DCL$_File "JB_NLG_1" JB_NLG$DCL$_1_po))
    (JB_NLG:Dbox1:set)
    (JB_NLG:Dbox1:mode)
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_NLG:Dbox1:action \"" A "\")")))
            '("JB_1_b1" "JB_1_b2" "JB_1_b3"
              "JB_1_to1" "JB_1_to2"
              "JB_1_p1"
              "accept" "cancel"
             )
    )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    (cond
      ((= ok 11) ;;;Block picken
       (JB_NLG:DBox1:BlockPick)
       )

      ((= ok 12) ;;;Blockreferenzen auswählen
       (JB_NLG:Dbox1:BlockRefsSel nil)
       )

      ((= ok 13) ;;;Textwerte wieder an Blockattribute zurückstellen
       (JB_NLG:Dbox1:BlockRefsSel 'T)
       )

      ((= ok 1) ;;;Legende einfügen
       (setq v_liste (JB_NLG:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
       (JBf_SIC:sichern v_liste pfad_ini nil)
       (JB_NLG:Dbox1:Legende)
       )
      ((= ok 99) ;;;Ende
       (setq v_liste (JB_NLG:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
       (JBf_SIC:sichern v_liste pfad_ini nil)
       
       )
      )
    )
  
  )


;;;wenn Dynamische Block im Auswahlsatz sind, dann muss noch geprüft werden, ob der EffectiveName passt
(defun JB_NLG:Dbox1:BlockRefsSel:Dyn (aws / aws1 n)
  (setq aws1 (ssadd))
  (setq n 0)
  (repeat (sslength aws)
    (if(=(vla-get-IsDynamicBlock (vlax-ename->vla-object(ssname aws n))) :vlax-true)
      (if(=(strcase(cdr(assoc "JB_1_t1" Settings&dbox1)))
           (strcase(vla-get-EffectiveName (vlax-ename->vla-object (ssname aws n)))))
        (ssadd(ssname aws n)aws1))
      (ssadd(ssname aws n)aws1))
    (setq n (+ n 1)))
  (if (>(sslength aws1)0)
    aws1)
  )
;;;Block mit Attributen picken
(defun JB_NLG:DBox1:BlockPick( / AWS VLA-ATTLIST VLA-OBJ)
  (if(and(princ "\nPicken Sie einen Block mit Attributen:")
         (setq aws (ssget "_:S"(list (cons 0 "INSERT"))))
         (setq vla-obj (vlax-ename->vla-object(ssname aws 0)))
         (or(setq vla-AttList (JBf_list_att_aus_vla-blockdef (vla-get-Effectivename vla-obj)))
            (alert "In dem gepickten Block waren keine Attribute vorhanden."))
         )
    (progn
      (setq p1&Dbox1 nil)
      (setq p1_sel&DBox1 nil)
      (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vla-get-Effectivename vla-obj)"JB_1_t1"))
      (JB_NLG:Dbox1:p1:Ini)
      )
    )
  )
      
    

    

;;;Blockreferenzen auswählen
(defun JB_NLG:Dbox1:BlockRefsSel (RestoreFlag / AWS N VLA-ATTLIST VLA-ATTSUB VLA-OBJ XDATEN)
  
  (if (and (princ (strcat "\nWählen Sie Blöcke \"" (cdr(assoc "JB_1_t1" Settings&dbox1)) "\" aus der Zeichnung aus:"))
           (setq aws (ssget(list (cons 0 "INSERT")(cons 2 (strcat (cdr(assoc "JB_1_t1" Settings&dbox1))",`*U*")))))
           (setq aws (JB_NLG:Dbox1:BlockRefsSel:Dyn aws))
           )
    (progn
      (setq l1&DBox1 nil)
      (setq n 0)
      (repeat (sslength aws)
        (setq vla-obj (vlax-ename->vla-object (ssname aws n)))
        (setq vla-attList (JBf_list_att_aus_block_vla-obj vla-obj))
        (if (setq vla-attSub(assoc (strcase (cdr(assoc "JB_1_p1" Settings&dbox1)))vla-attList))
          (if RestoreFlag
            (if (setq Xdaten (JBf_list_xdaten_read:Vla "JB_NLG_AttText" (cadr vla-attSub)nil))
                (cond((= (cdr(assoc 1070 Xdaten))1);;;wenn nummer Aktuell
                      (vla-put-Textstring (cadr vla-attSub)(cdr(car Xdaten)))
                      (vla-update (cadr vla-attSub))
                      (JBf_list_xdaten_append:Vla "JB_NLG_AttText" (cadr vla-attSub)
                        (append(reverse(cdr(reverse Xdaten)))(list(cons 1070 0)))))
                     ((= (cdr(assoc 1070 Xdaten))0);;;wenn Text Aktuell
                      (vla-put-Textstring (cadr vla-attSub)(cdr(cadr Xdaten)))
                      (vla-update (cadr vla-attSub))
                      (JBf_list_xdaten_append:Vla "JB_NLG_AttText" (cadr vla-attSub)
                        (append(reverse(cdr(reverse Xdaten)))(list(cons 1070 1)))))
                     )
                )
            (setq l1&DBox1 (cons vla-attSub l1&DBox1)))
          )
        (setq n (+ n 1)))
      )
    )
  )

;;;DBox1, getten        
(defun JB_NLG:Dbox1:get ( / WERT)

  (setq Error&Dbox1 nil)
  
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (itoa(atoi(get_tile "JB_1_e1")))"JB_1_e1"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (itoa(atoi(get_tile "JB_1_e2")))"JB_1_e2"))
  (setq wert(vl-string-subst "." ","(get_tile "JB_1_e3")))
  (if(<=(atof wert) 0.0)
    (progn
      (setq Error&Dbox1 "e3")
      (alert "Die Texthöhe muss größer Null sein.")
      )
    (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 wert "JB_1_e3")))

  (if (not Error&Dbox1)
    (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vl-string-subst "." ","(get_tile "JB_1_e4"))"JB_1_e4")
          Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vl-string-subst "." ","(get_tile "JB_1_e5"))"JB_1_e5"))
    )
  Error&Dbox1)
   

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

    ((= 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_b1")
     (if(not(JB_NLG:Dbox1:get))
       (setq JB_NLG$DCL$_1_po (done_dialog 11))
       )
     )
    ((= key "JB_1_b2")
     (if(not(JB_NLG:Dbox1:get))
       (setq JB_NLG$DCL$_1_po (done_dialog 12))
       )
     )

    ((= key "JB_1_b3")
     (if(not(JB_NLG:Dbox1:get))
       (setq JB_NLG$DCL$_1_po (done_dialog 13))
       )
     )
    
    ((= key "JB_1_to1")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value"JB_1_to1"))
     (JB_NLG:Dbox1:set)
     )
    ((= key "JB_1_to2")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value"JB_1_to2"))
     (JB_NLG:Dbox1:set)
     )
    ((= key "accept")
     (if(not(JB_NLG:Dbox1:get))
       (setq JB_NLG$DCL$_1_po (done_dialog 1))
       )
     )
    ((= key "cancel") ;;;Ende
     (if(not(JB_NLG:Dbox1:get))
       (setq JB_NLG$DCL$_1_po (done_dialog 99)))
     )
    )
  )


;;;Textwert aus Attribut: entweder OriginalText oder, wenn bereits Nummer enthalten, Text aus Xdaten
(defun JB_NLG:Dbox1:TextListSort:TextWert (vla-Att / XDaten)
  (if (setq Xdaten(JBf_list_xdaten_read:Vla "JB_NLG_AttText" vla-Att nil))
    (cdr(car Xdaten))
    (vla-get-Textstring vla-Att))
  )


;;;Sortierte Textlist
(defun JB_NLG:Dbox1:TextListSort ( / liste)
  (if l1&DBox1
    (progn
      (setq l1Text&DBox1 nil)
      (setq liste(mapcar '(lambda(X)
                            (list (JB_NLG:Dbox1:TextListSort:TextWert X)X))(mapcar 'cadr l1&DBox1)))
      (mapcar '(lambda(X)
                 (if (assoc (car X) l1Text&DBox1)
                   (setq l1Text&DBox1 (subst (list (car X) (+(cadr (assoc (car X) l1Text&DBox1))1)(cons (cadr X)(caddr (assoc (car X) l1Text&DBox1))))(assoc (car X) l1Text&DBox1)l1Text&DBox1))
                   (setq l1Text&DBox1 (append l1Text&DBox1 (list (list (car X) 1 (list (cadr X))))))
                   )
                 )
        liste)
      (setq l1Text&DBox1
           (vl-sort l1Text&DBox1
             '(lambda(e1 e2)
                ((if (=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")
                   < >)
                  (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
                    (atof (car e1))
                    (car e1))
                  (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
                    (atof (car e2))
                    (car e2))))))
      )
    (setq l1Text&DBox1 nil)
   )
  )
                  
  

;;;DBox1: setten
(defun JB_NLG:Dbox1:set ( / X)
  (JB_NLG:Dbox1:TextListSort)
  (start_list "JB_1_p1" 3)
  (mapcar 'add_list p1&Dbox1)
  (end_list)
  (if p1_sel&DBox1
    (set_tile "JB_1_p1" (itoa p1_sel&DBox1)))
  
  (mapcar '(lambda(X)(set_tile (strcat "JB_1_"(car X))(cadr X)))
    (list
      (list "t1" (if(cdr(assoc "JB_1_t1" Settings&dbox1))(cdr(assoc "JB_1_t1" Settings&dbox1))""))
      (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 "e5" (cdr(assoc "JB_1_e5" Settings&dbox1)))
      (list "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
      (list "to2" (cdr(assoc "JB_1_to2" Settings&dbox1)))
      
      )
    )

  (start_list "JB_1_l1" 3)
  (mapcar 'add_list (mapcar '(lambda(X)(strcat (car X) (if (>(cadr X)1)(strcat " (" (itoa(cadr X))")")"")))l1Text&DBox1))
  (end_list)
  (set_tile "JB_1_l1" "")
           
  )
;;;DBox1, moden
(defun JB_NLG:Dbox1:mode ( / )
  (if (or (not (cdr(assoc "JB_1_t1" Settings&dbox1)))
          (not(tblsearch "BLOCK" (cdr(assoc "JB_1_t1" Settings&dbox1)))))
    (progn
      (mode_tile "JB_1_b2" 1)
      (mode_tile "accept" 1)
      (mode_tile "JB_1_b1" 2)
      (alert "Es muss ein Block mit Attributen aus der Zeichnung gepickt werden.")
      )
    (progn
      (mode_tile "JB_1_b2" 0)
      (if (not l1&DBox1)
        (progn
          (mode_tile "JB_1_b2" 2)
          (mode_tile "accept" 1)
          )
        (progn
          (mode_tile "accept" 0)
          (mode_tile "accept" 2))
        )
      )
    )

  (if Error&Dbox1
    (mode_tile (strcat "JB_1_" Error&Dbox1)2)
    )
  )


;;;Text entmake
(defun JB_NLG:Dbox1:Legende:Text:Entmake (TextString w p / TEXTSTYLELIST)
  (setq TextStyleList (entget(tblobjname "STYLE" (getvar "TEXTSTYLE"))))
   (entmake(list '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 410 (getvar "CTAB")) (cons 8  (getvar "CLAYER"))
                 '(100 . "AcDbText") (cons 10 p) (cons 40 (atof(cdr(assoc "JB_1_e3" Settings&dbox1))))
                 (cons 1 TextString) (cons 50 w) (assoc 41 TextStyleList) (if (assoc 51 TextStyleList)(assoc 51 TextStyleList)'(51 . 0.0))
                 (cons 7 (getvar "TEXTSTYLE")) '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0)))
  )


;;;Nummer, vorangestellt Nullen
(defun JB_NLG:Dbox1:Legende:Text:PraeNullen (TextString / )
  (while (<(strlen TextString)(atoi(cdr(assoc "JB_1_e2" Settings&dbox1))))
    (setq TextString (strcat "0" TextString))
    )
  )

;;;Legende einfügen
(defun JB_NLG:Dbox1:Legende ( / N NSTRING P W X Y)
  (if (setq p (getpoint "\nPicken Sie den Einfügepunkt:"))
    (progn
      (setq w (angle (trans'(0 0 0)1 0)(trans'(1 0 0)1 0)))
      (setq p (trans p 1 0))
      (setq n (atoi(cdr(assoc "JB_1_e1" Settings&dbox1))))
      
      (mapcar '(lambda(X)
                 (JB_NLG:Dbox1:Legende:Text:Entmake
                   (setq nString(JB_NLG:Dbox1:Legende:Text:PraeNullen (itoa n)))
                   w
                   p)
                 
                 (JB_NLG:Dbox1:Legende:Text:Entmake
                   (strcat (car X)(if (> (cadr X)1) (strcat " (" (itoa (cadr X))")")""))
                   w
                   (polar p w (atof(cdr(assoc "JB_1_e5" Settings&dbox1)))))

                 (mapcar '(lambda(Y)
                            (JBf_list_xdaten_append:Vla "JB_NLG_AttText" Y (list (cons 1000 (vla-get-Textstring Y))
                                                                                 (cons 1000 nString)
                                                                                 (cons 1070 1);;;1 => Nummer in Att, 0 = Originaltext
                                                                                 ))
                            (vla-put-TextString Y nString)
                            )
                   (caddr X))

                 (setq p (polar p (- w (* 0.5 pi))(atof(cdr(assoc "JB_1_e4" Settings&dbox1)))))
                 (setq n (+ n 1))
                 
                 
                 )
        l1Text&DBox1)
      )
    )
  )
        
      
      
 

   
;;;DCL-schreiben
(defun JB_NLG:dcl:Write ( / file)  
  (if (and (setq JB_NLG_$DCL$_File (vl-filename-mktemp (strcat "NLG.dcl")))
           (setq file (open JB_NLG_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "//Hauptdialog"
                "JB_NLG_1: dialog {label= \"Nummern-Legende\";"
                ":boxed_column {label = \"Blockdefinition, Attribut\";"
                ":row {"
                ":button {key = \"JB_1_b1\"; label = \"&Block<\";}"
                ":text {key = \"JB_1_t1\"; label = \"BBMST\";width = 30;}}"
                ":popup_list{key = \"JB_1_p1\"; label = \"Attribut\";}}"
                ":boxed_column {label = \"Nummer\";"
                ":edit_box {key = \"JB_1_e1\"; label = \"Nummer ab:\"; edit_width = 6;}"
                ":edit_box {key = \"JB_1_e2\"; label = \"Vorangestellte Nullen, Gesamtlänge:\"; edit_width = 6;}"
                "}"
                ":boxed_column {label = \"Legende\";"
                ":edit_box {key = \"JB_1_e3\"; label = \"Texthöhe:\"; edit_width = 6;}"
                ":edit_box {key = \"JB_1_e4\"; label = \"Zeilenabstand:\"; edit_width = 6;}"
                ":edit_box {key = \"JB_1_e5\"; label = \"Spaltenabstand:\"; edit_width = 6;}"
                ":list_box {key = \"JB_1_l1\"; label = \"Vorschau Legendentexte\";height=16;}"
                ":row{"
                ":toggle {key = \"JB_1_to1\"; label = \"Sortierung numerisch\";}"
                ":toggle {key = \"JB_1_to2\"; label = \"Sortierung aufsteigend\";}}"
                ":button {key = \"JB_1_b2\"; label = \"Block&referenzen<\";fixed_width=true; alignment = right;}"
                "}"
                ":row{fixed_width = true;alignment = centered;"
                ":retirement_button {label = \"&Einfügen\"; key= \"accept\";  is_default = true;}"
                ":spacer {width=2;}"
                ":button { label =\"&Ende\"; key = \"cancel\";fixed_width=true;is_cancel=true;}"
                ":spacer {width=2;}"
                ":button {key = \"JB_1_b3\"; label = \"Attributwerte wieder herstellen<\";fixed_width=true;}"
                "}"
                "}"



               )
              )
      )
      (close file)
      JB_NLG_$DCL$_File
    )
  )
)
;;;--------------------------------------------------------------------------------------------------------
;;;alNLGmeine 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)
)
;;;--------------------------------------------------------------------------------------------------------
;;;alNLGmeine 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)
	  
;;;--------------------------------------------------------------------------------------------------------
;;;alNLGmeine 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_vla-blockdef (name / LISTE)
  (if name
  (if (tblsearch "BLOCK" name)
    (progn
  (vlax-for ITEM
    (vla-item
      (vla-get-blocks
        (vla-get-activedocument
          (vlax-get-acad-object)))name)
    (if (= (vla-get-Objectname ITEM) "AcDbAttributeDefinition")
      (setq liste (cons ITEM liste))))
  (reverse 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))))
  ))



;;;In DBX-Objekten kann die ursprüngliche Funktion für Xdaten auslesen nicht verwendet werden, daher ein globales Umschalten auf vla

;;;XDaten mit VLA-Funktionen lesen, weil z.B. in DBX-Objekten dann auch verläßlich Daten zurück gegeben werden

(defun JBf_list_xdaten_read:Vla (art vla-obj gc_nr / DATACODE N RETLIST VALUE VARDATATYPES VARDATAVALUES VARVALUE)

  (vla-GetXData vla-obj art 'VarDataTypes 'VarDataValues)
  (if VarDataTypes
      (progn
        ;; Get the dimension of the safearray
        (setq n (vlax-safearray-get-l-bound VarDataTypes 1))
        
         (while (<= n (vlax-safearray-get-u-bound VarDataTypes 1))
           (setq dataCode (vlax-safearray-get-element VarDataTypes n))
           (setq VarValue (vlax-safearray-get-element VarDataValues n))
           
            ;; VarValue contains the variant, but we need the Lisp value of it

           (if (and (> dataCode 1009) (< dataCode 1040))
             ;; Test to see if it's a point Variant
             (setq Value (vlax-safearray->list (vlax-variant-value VarValue)))
             (setq Value (vlax-variant-value VarValue))
            )
            ;; Create the list
            (setq RetList (append RetList (list (cons dataCode Value))))
            (setq n (+ n 1))
         ) ;_ end of while
      ) ;_ end of progn
    )
  (setq RetList(vl-remove-if '(lambda(X)(=(car X)1001))RetList))
  (if gc_nr
    (cdr(assoc gc_nr RetList))
    RetList))

;;;XDaten mit VLA-Funktionen anhängen, weil z.B. in DBX-Objekten dann auch verläßlich Daten zurück gegeben werden
(defun JBf_list_xdaten_append:Vla (art vla-obj liste / ARRAYTYPES ARRAYVALUES CODES N VALUES)
  ;; Register an application name
  (regapp art)

  ;; Attach some xdatas:
  ;; 1001: application name  ;; 1000: string ;; 1010: 3D point ;; 1040: real ; 1070: 16bit integer
  (setq codes (cons 1001 (mapcar 'car liste))
        values (cons art (mapcar 'cdr liste)))

  ;; Create the Safe and Variant Arrays needed for vla-SetXData
  (setq ArrayTypes
         (vlax-make-safearray
           vlax-vbInteger
           (cons 0 (-(length codes)1))
           )
        ArrayValues
         (vlax-make-safearray
           vlax-vbVariant
           (cons 0 (-(length codes)1))
           ))
  ;;; Fill the Arrays; simple list works
  (vlax-safearray-fill ArrayTypes codes)

  ; A more complex list needs to be constructed one element at a time:
  (setq n 0)
  (while (< n (length codes))
    (if (=(type (nth n values)) 'LIST)
      (vlax-safearray-put-element
        ArrayValues
        n
        (vlax-3d-point (nth n values)))
      (vlax-safearray-put-element ArrayValues n (nth n values)))
    (setq n (+ n 1)))

  (vla-SetXData vla-obj ArrayTypes ArrayValues)
  )                      








;;;--------------------------------------------------------------------------------------------------------
;;;alNLGmeine 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))
;;;--------------------------------------------------------------------------------------------------------
;;;alNLGmeine 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|Erzeugen einer Nummern-Legende aus Blockattributen.         |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: NLG                                    |"          
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)







                  












