
;;;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: FAT - (FrageAntwortTool) - Fragen und Antworten pro Eintrag (Pin-Nadel-Block) können Objekte
;;;ausgewählt werden, zu dem Eintrag werden Eigenschaften wie Einfügepunkt, Fragen und Antworten sowei ein 
;;;Status festgelegt werden.										   
;;;													   
;;;Die Einträge können nach Excel exportiert, dort bearbeitet, dann wieder importiert werden.		   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_FAT$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_FAT_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 14.09.22	   
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:FAT ( / )
  (JB_FAT)
  )

;;;Intro
(defun JB_FAT:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------FAT(1.0), 14.09.22---------------------")
  (princ str)
  (princ "\n-------------------------------------------------------------")
  )


;;;Liste mit Kategorien, Werte können an dieser Stelle ergänzt bzw. geändert werden

;;;Variablenliste
(defun JB_FAT:v_liste ( / )
  
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ( "JB_1_t2" . nil);;;Excelvorlagedatei
			     ( "JB_1_t3" . 0.25);;;Einfügefaktor
                             ( "JB_1_e7" . "Wichtig");;;Status, Anmerkung
                             ( "JB_1_r1-2" . 0);;;0 = Punkt, 1 = Objekte
                             ))))))
;;;Pfad für SIC-Datei
(defun JB_FAT:pfad_ini ( / )
  (strcat (JBf_String:Userpfad
                           "c:\\acad\\" ;;;Hier ändern, wenn anderer Pfad gewünscht
                           )"FAT_sic.lsp")
  )

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

  (setq pfad_ini (JB_FAT:pfad_ini))

    (if (not(setq v_liste (if (findfile pfad_ini)
                          (load pfad_ini)nil)))
    (JBf_SIC:sichern
      (setq v_liste (JB_FAT:v_liste))pfad_ini nil))
  
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))
  
  
  (JB_FAT:Intro "\nFAT: Fragen und Antworten mit Hilfe einer Exceltabelle.")

  
  ;;;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
            (or (and JB_FAT_$DCL$_File(findfile JB_FAT_$DCL$_File))
                (setq JB_FAT_$DCL$_File (JB_FAT:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))

  (JB_FAT:Dbox1 v_liste pfad_ini)
   
  (princ "\nEnde.")
  (JBf_Reinit)
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) 
  (princ)
  )

 

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


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


;;;ID für PIN, 3 stellig mit mit Nullen von vorne
(defun JB_FAT:BlockDef:Pin:IDString (n / )
  (setq str (itoa n))
  (while (<(strlen str)3)
    (setq str (strcat "0" str)))
  str)

;;;Blockdefinition - PIN-Nadel
(defun JB_FAT:BlockDef:Pin (n / NAME)
  ;;;Einfügelayer ebenfalls erstellen
  (if (not (tblsearch "LAYER" "FAT_PIN"))
    (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "FAT_PIN") (70 . 0) (62 . 7) (6 . "Continuous") (290 . 1) (370 . -3))))
  (setq Name (strcat "FAT_PIN_" (JB_FAT:BlockDef:Pin:IDString n)))
  (if (not (tblsearch "BLOCK" Name))
    (progn
      (entmake '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "FAT_ARIAL") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "arial.ttf") (4 . "")))
      (entmake (list '(0 . "BLOCK") (cons 2 (strcat "FAT_PIN_" (JB_FAT:BlockDef:Pin:IDString n))) '(70 . 0) '(4 . "") '(10 0.0 0.0 0.0)))
      (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 7) (100 . "AcDbPolyline") (90 . 8) (70 . 1) (43 . 0.0)(38 . 0.0) (39 . 0.0) (10 -3.79027 3.69737) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0)
                 (10 -3.16217 4.34125) (40 . 0.0) (41 . 0.0) (42 . 0.393745) (91 . 0) (10 -3.19447 5.01924) (40 . 0.0) (41 . 0.0)(42 . 0.0) (91 . 0) (10 -3.63707 5.451) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0)
                 (10 -4.58831 4.47586) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -5.53955 3.50072) (40 . 0.0) (41 . 0.0)(42 . 0.0) (91 . 0) (10 -5.09695 3.06896) (40 . 0.0) (41 . 0.0) (42 . 0.393745) (91 . 0)
                 (10 -4.41837 3.0535) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (210 0.0 0.0 1.0)))
      (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 7) (100 . "AcDbPolyline") (90 . 16) (70 . 1)
                 (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 -3.6407 3.55147) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -4.44162 2.73042) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -3.61152 1.92067) (40 . 0.0)
                 (41 . 0.0) (42 . 0.157122) (91 . 0) (10 -3.81324 1.41907) (40 . 0.0) (41 . 0.0) (42 . 0.220599) (91 . 0) (10 -3.61979 0.910607) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -3.11085 0.414144) (40 . 0.0)
                 (41 . 0.0) (42 . 0.0) (91 . 0) (10 -1.95097 1.60317) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -0.377864 0.0686227) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.0 0.0) (40 . 0.0)
                 (41 . 0.0) (42 . 0.0) (91 . 0) (10 -0.0779762 0.376045) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -1.65108 1.91059) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -0.491195 3.09962) (40 . 0.0)
                 (41 . 0.0) (42 . 0.0) (91 . 0) (10 -1.00013 3.59608) (40 . 0.0) (41 . 0.0) (42 . 0.220599) (91 . 0) (10 -1.51324 3.77686) (40 . 0.0) (41 . 0.0) (42 . 0.157122) (91 . 0) (10 -2.00968 3.56275) (40 . 0.0)
                 (41 . 0.0) (42 . 0.0) (91 . 0) (10 -2.83978 4.37251) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (210 0.0 0.0 1.0)))
      (entmake '((0 . "HATCH") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 1) (100 . "AcDbHatch") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (2 . "SOLID") (70 . 1) (71 . 0) (91 . 2)
                 (92 . 7) (72 . 1) (73 . 1) (93 . 8) (10 -5.53955 3.50072 0.0) (42 . 0.0) (10 -5.09695 3.06896 0.0) (42 . 0.393745) (10 -4.41837 3.0535 0.0) (42 . 0.0) (10 -3.79027 3.69737 0.0) (42 . 0.0)
                 (10 -3.16217 4.34125 0.0) (42 . 0.393745) (10 -3.19447 5.01924 0.0)(42 . 0.0) (10 -3.63707 5.451 0.0) (42 . 0.0) (10 -4.58831 4.47586 0.0) (42 . 0.0) (97 . 0) (92 . 7) (72 . 1) (73 . 1) (93 . 13)
                 (10 -2.00968 3.56275 0.0) (42 . 0.0) (10 -2.83978 4.37251 0.0) (42 . 0.0)(10 -3.6407 3.55147 0.0) (42 . 0.0) (10 -4.44162 2.73042 0.0) (42 . 0.0) (10 -3.61152 1.92067 0.0) (42 . 0.157122)
                 (10 -3.81324 1.41907 0.0) (42 . 0.220599) (10 -3.61979 0.910607 0.0) (42 . 0.0) (10 -3.11085 0.414144 0.0) (42 . 0.0) (10 -1.95097 1.60317 0.0) (42 . 0.0) (10 -1.65108 1.91059 0.0)
                 (42 . 0.0) (10 -0.491195 3.09962 0.0) (42 . 0.0) (10 -1.00013 3.59608 0.0) (42 . 0.220599) (10 -1.51324 3.77686 0.0) (42 . 0.157122) (97 . 0) (75 . 1) (76 . 1) (47 . 0.00446693) (98 . 2) (10 -4.36833 3.98642 0.0)
                 (10 -2.66892 2.62847 0.0) (450 . 0) (451 . 0) (460 . 0.0) (461 . 0.0) (452 . 0) (462 . 0.0) (453 . 2) (463 . 0.0) (63 . 5) (421 . 255) (463 . 1.0) (63 . 2) (421 . 16776960) (470 . "LINEAR")))
      (entmake '((0 . "HATCH") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 8) (100 . "AcDbHatch") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (2 . "SOLID") (70 . 1) (71 . 0) (91 . 1)
                 (92 . 7) (72 . 0) (73 . 1) (93 . 5) (10 -0.377864 0.0686227 0.0) (10 1.11022e-16 0.0 0.0) (10 -0.0779762 0.376045 0.0) (10 -1.65108 1.91059 0.0) (10 -1.95097 1.60317 0.0) (97 . 0) (75 . 1) (76 . 1) (47 . 0.00446693)
                 (98 . 1) (10 -0.915851 0.859568 0.0) (450 . 0) (451 . 0) (460 . 0.0) (461 . 0.0) (452 . 0) (462 . 0.0) (453 . 2) (463 . 0.0) (63 . 5) (421 . 255) (463 . 1.0) (63 . 2) (421 . 16776960)(470 . "LINEAR")))      
      (entmake  (list '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0") '(62 . 1) '(100 . "AcDbText") '(10 -1.62231 5.366 0.0) '(40 . 1.8) (cons 1 (JB_FAT:BlockDef:Pin:IDString n)) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0)
                 '(7 . "FAT_ARIAL") '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0)))
      (entmake '((0 . "endblk")(8 . "0"))))
    )
  )


;;;Skalierung für Pn-Blöcke anpassen
(defun JB_FAT:PinList:Skal->obj (obj skal / )
  (setq entmodList (entget obj))
  (setq entmodList (JBf_list:subst:gc entmodList skal 41))
  (setq entmodList (JBf_list:subst:gc entmodList skal 42))
  (setq entmodList (JBf_list:subst:gc entmodList skal 43))
  (entmod entmodList)
  (entupd obj)
  )
;;;Xdaten prüfen
(defun JB_FAT:PinList:awsList (aws / AWS1 ENTMODLIST N RETLIST SKAL XDATEN)
  (setq n 0)
  (setq aws1 (ssadd))

  (if (/= (setq Skal(cdr(assoc 41(entget(ssname aws 0)))))(cdr(assoc "JB_1_t3" Settings&Dbox1)))
    (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 skal "JB_1_t3")))
  
  (repeat (sslength aws)
    (if (setq xdaten(JB_FAT:DBox1:action:1000erCodes:ReadAndAppend (ssname aws n)))
      (setq RetList (cons (list (cons "obj" (ssname aws n))
                                (cons "ID" (atoi(substr(cdr(assoc 2 (entget (ssname aws n))))9)))
                                (cons "Status" (cdr(car xdaten)))
                                (cons "Position" (cdr(cadr xdaten)))
                                (cons "Frage1" (cdr(caddr xdaten)))
                                (cons "Frage2" (cdr(cadddr xdaten)))
                                (cons "Frage3" (cdr(nth 4 xdaten)))
                                (cons "Antwort1" (cdr(nth 5 xdaten)))
                                (cons "Antwort2" (cdr(nth 6 xdaten)))
                                (cons "Antwort3" (cdr(nth 7 xdaten)))
                                (cons "Handles" (cdr(nth 8 xdaten)))
                                )RetList)))
    (if (/=(cdr(assoc 41 (entget (ssname aws n))))skal)
      (JB_FAT:PinList:Skal->obj (ssname aws n)skal)
      )
    (setq n (+ n 1)))
  (vl-sort RetList '(lambda(e1 e2)(<(cdr(assoc "ID" e1))(cdr(assoc "ID" e2))))))

;;;PinList
(defun JB_FAT:Dbox1:PinList ( / AWS AWSLIST)
  (if(setq aws (ssget "_X" (list (cons 0 "INSERT")(cons 2 "FAT_PIN_###"))))
    (setq awsList (JB_FAT:PinList:awsList aws)))
  awsList
  )

;;;Wenn noch kein Eintrag, dann leere Liste mit Vorgabestatus erstellen
(defun JB_FAT:Dbox1:ini:l1 ( / )
  (list (cons "obj" nil)
        (cons "ID" nil)
        (cons "Status" (cdr(assoc "JB_1_e7" Settings&Dbox1)))
        (cons "Position" nil)
        (cons "Frage1" nil)
        (cons "Frage2" nil)
        (cons "Frage3" nil)
        (cons "Antwort1" nil)
        (cons "Antwort2" nil)
        (cons "Antwort3" nil)
        (cons "Handles" nil)
        )
  )
;;;DBox 1
(defun JB_FAT:Dbox1 (v_liste pfad_ini / DCLID OK PinList&DBox1 l1&Dbox1 l1_sel&Dbox1)
  (setq Settings&Dbox1 (JB_FAT:v_liste:DboxSettings:get "Dbox1" v_liste))
  (if(setq PinList&DBox1 (JB_FAT:Dbox1:PinList))
    (progn
      (setq l1&Dbox1 (car PinList&DBox1))
      (setq l1_sel&Dbox1 0)
      )
    (setq l1&Dbox1(JB_FAT:Dbox1:ini:l1))
    )  
  (while (not (member ok '(99)))

    (setq DclId (JBf_Dcl:Load_dialog JB_FAT_$DCL$_File "JB_FAT_1" JB_FAT$DCL$_1_po))

    (JB_FAT:Dbox1:set)
    (JB_FAT:Dbox1:mode)
    
    
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_FAT: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_b8"
              "JB_1_l1"
              "JB_1_r1" "JB_1_r2"
	      "cancel"
             )
    )
    (setq ok (start_dialog))
    (unload_dialog DclId)
    
    (cond ((= ok 99)
           (JB_FAT:DBox1:action:XdataToObj)
           (setq v_liste (JB_FAT:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
           (JBf_SIC:sichern v_liste pfad_ini nil)
           )
          ((= ok 101);;;Hinzufügen
           (JB_FAT:Dbox1:action:Hinzufuegen)
           )
          ((= ok 103);;;Position
           (JB_FAT:Dbox1:action:Position)
           )

          ((= ok 108);;;Objekte anzeigen
           (JB_FAT:Dbox1:action:Anzeigen)
           )
          )
    ) 
  )


;;;Neue Position für PIN
(defun JB_FAT:Dbox1:action:Position ( / P)
  
  (if (and(not(vl-catch-all-error-p
                (setq p (vl-catch-all-apply 'getpoint (list (trans(cdr(assoc "Position" l1&Dbox1))0 1)"\nNeuer Punkt für Pinnadel-Markierung.")))))
          p
          (setq p (trans p 1 0)))
    (progn
      (vla-move (vlax-ename->vla-object(cdr(assoc "obj" l1&Dbox1)))
        (vlax-3d-Point (cdr(assoc "Position" l1&Dbox1)))
        (vlax-3d-Point p))
      (vla-update (vlax-ename->vla-object(cdr(assoc "obj" l1&Dbox1))))
      (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 p "Position"))
      
      )
    )
  )

;;;Handles und obj zu aws
(defun JB_FAT:Dbox1:action:Anzeigen:aws ( / AWS X)
  (setq aws (ssadd))
  (ssadd (cdr(assoc "obj" l1&Dbox1))aws)

  (if (and (cdr(assoc "Handles" l1&Dbox1))(/=(cdr(assoc "Handles" l1&Dbox1))""))
    (mapcar '(lambda(X)
               (if (and (handent X)
                        (entget (handent X)))
                 (ssadd(handent X)aws)))
      (JBf_String:Delimiter->List (cdr(assoc "Handles" l1&Dbox1)) ","))
   )
  aws)

;;;Objekte anzeigen (selektieren)
(defun JB_FAT:Dbox1:action:Anzeigen ( / AWS)
  (setq aws (JB_FAT:Dbox1:action:Anzeigen:aws))
  (sssetfirst aws aws)
  (vl-catch-all-apply 'getpoint (list (trans(cdr(assoc "Position" l1&Dbox1))0 1)"\nZurück mit ENTER."))
  (sssetfirst nil nil)
  )
  
;;;Nächste Freie ID, leere ID's (z.B. durch Löschen werden neu belegt)
(defun JB_FAT:DBox1:action:NextID ( / N NEXTID X)
  (setq n 0)
  (mapcar '(lambda(X)
             (setq n (+ n 1))
             (if (not NextID)
               (if(/=(cdr(assoc "ID" X))n)
                 (setq NextID n))
               )
             )PinList&DBox1)
  (if (not NextID)
    (if PinList&DBox1
      (setq NextID (+(cdr(assoc "ID" (last PinList&DBox1)))1))
      (setq NextID 1)
      )
    )
  NextID)

;;;l1_sel aus ID und PinList ermittlen
(defun JB_FAT:DBox1:action:l1_selAtID (ID / ID N X)
  (setq n -1)
  (mapcar '(lambda(X)
             (setq n (+ n 1))
             (if (=(cdr(assoc "ID" X))ID)
               (setq l1_sel&Dbox1 n)))PinList&DBox1)
  )


;;;ObjList
(defun JB_FAT:Dbox1:action:Hinzufuegen:Add:objList (aws / RetList)
  (setq n 0)
  (repeat (sslength aws)
    (setq RetList (cons (ssname aws n)RetList))
    (setq n (+ n 1)))
  RetList)

;;;Einfügen des Pin-Blocks, und Liste usw. erstellen
(defun JB_FAT:Dbox1:action:Hinzufuegen:Add (aws p / AWSLIST NEXTIDSTRING X)
  (setq p (trans p 1 0))
  (JB_FAT:BlockDef:Pin (setq NextID(JB_FAT:DBox1:action:NextID)))
  (JBf_VlaAdd:AddBlock
    (strcat "FAT_PIN_" (JB_FAT:BlockDef:Pin:IDString NextID))
    (vlax-3d-Point p)
    (cdr(assoc "JB_1_t3" Settings&dbox1))
    "FAT_PIN"
    (angle (trans '(0 0 0)1 0)(trans '(1 0 0)1 0))
    (vlax-3d-Point '(0 0 1))
    nil
    nil)
  (vla-update (vlax-ename->vla-object(entlast)))
  (setq l1&Dbox1(JB_FAT:Dbox1:ini:l1))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (entlast) "obj"))  
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 NextID "ID"))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 p "Position"))
  ;;;wenn Objekte
  (if (and aws
           (setq awsList(JB_FAT:Dbox1:action:Hinzufuegen:Add:objList aws)))
    (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda(X)(strcat(cdr(assoc 5 (entget X)))","))awsList)))"Handles"))
    )
  (setq PinList&DBox1 (vl-sort(append PinList&DBox1 (list l1&Dbox1))'(lambda(e1 e2)(< (cdr(assoc "ID" e1))(cdr(assoc "ID" e2))))))
  (JB_FAT:DBox1:action:XdataToObj)
  (JB_FAT:DBox1:action:l1_selAtID NextID)
  )
;;;action:Hinzufügen
(defun JB_FAT:Dbox1:action:Hinzufuegen ( / AWS P)
  (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0);;;wenn Punkt
    (if (setq p (getpoint "\nGeben Sie den Punkt für die Pinnadel-Markierung an:"))
      (JB_FAT:Dbox1:action:Hinzufuegen:Add nil p)
      )
    (if (and (princ "\nWählen Sie ein oder mehrere Objekte aus:")
             (setq aws (ssget(list (cons -4 "<NOT")
                                   (cons -4 "<AND")
                                   (cons 0 "INSERT")
                                   (cons 2 "FAT_PIN_###")
                                   (cons -4 "AND>")
                                   (cons -4 "NOT>"))))                                   
             (setq p (getpoint "\nGeben Sie den Punkt für die Pinnadel-Markierung an:"))
             )
      (JB_FAT:Dbox1:action:Hinzufuegen:Add aws p)
      )
    )
  )  
;;;Listeneintrag entfernen
(defun JB_FAT:Dbox1:action:b2 ( / BLOCKNAME N X)
  (JB_FAT:Dbox1:get)
  (setq Blockname (vla-get-Effectivename(vlax-ename->vla-object(cdr(assoc "obj" l1&Dbox1)))))
  (JBf_aws:Vla-DeleteRefresh (ssadd(cdr(assoc "obj" l1&Dbox1))))
  (if (not (ssget "_X" (list (cons 0 "INSERT")(cons 2 Blockname))))
    (vl-catch-all-apply 'vla-delete (list(vla-item(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))BlockName)))
    )
  (setq n -1)
  (setq PinList&DBox1 (vl-remove-if 'not
                        (mapcar '(lambda(X)
                                   (setq n (+ n 1))
                                   (if (/= l1_sel&Dbox1 n) X))PinList&DBox1)))
  (if PinList&DBox1
    (progn
      (if (/= l1_sel&Dbox1 0)
        (setq l1_sel&Dbox1 (- l1_sel&Dbox1 1)))
      (setq l1&Dbox1 (nth l1_sel&Dbox1 PinList&DBox1))
      )
    (progn
      (setq l1_sel&Dbox1 nil)
      (setq l1&Dbox1(JB_FAT:Dbox1:ini:l1))
      )
    )
  (JB_FAT:Dbox1:set)
  (JB_FAT:Dbox1:mode)
  )

;;;Action => Excel-Vorlagen-Datei auswählen
(defun JB_FAT:Dbox1:action:b4 ( / FILE)
  (if (setq File (getfiled "Excel-Vorlagen-Datei auswählen:"
			   (if(cdr(assoc "JB_1_t2" Settings&dbox1))
                             (cdr(assoc "JB_1_t2" Settings&dbox1))
                             "")
			   "xlsx" 4))
    (progn
      (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 File "JB_1_t2"))
      (JB_FAT:Dbox1:set)
      
      )
    )
  )

;;;Excel importieren
(defun JB_FAT:Dbox1:action:b5 ( / CELLS EXCEL EXCELSHEETLIST PATH SHEET SHEETS WORKBOOK X Y)

  (setq PinList&DBox1 (JBf_list:nth:change PinList&DBox1 l1&Dbox1 l1_sel&Dbox1))
  (if(setq Path(getfiled "Excel-Datei auswählen:"
                             (strcat (getvar "DWGPREFIX")(cadr(fnsplitl(getvar "DWGNAME")))".xlsx")
                             "xlsx" 4))
    (if(setq excel(JBf_Excel:Open:EineDatei Path))
      (progn
        (setq Workbook (cadr excel)
              Sheets (caddr excel)
              excel (car excel))
        (if (or(vl-catch-all-error-p
                 (setq Sheet(vl-catch-all-apply 'vlax-get-property (list Sheets 'Item "FAT"))))
               (not Sheet))
          (progn
              (JB_FAT:Excel:Close :vlax-false)
              (alert "In der ausgewählten Exceldatei ist keine Tabellenblatt \"FAT\" vorhanden.")
              )
          (progn
            (setq Cells(vlax-get-property Sheet 'Cells))
            (setq ExcelSheetList
                   (mapcar '(lambda(X)
                              (mapcar '(lambda(Y)
                                         (if Y Y ""))
                                (mapcar 'vlax-variant-value X)
                                )
                              )
                     (vlax-safearray->list
                       (vlax-variant-value
                         (vlax-get-property
                           (vlax-get-property sheet 'UsedRange)
                           'Value)
                         )
                       )
                     )
                  )
            (JB_FAT:Dbox1:action:b5:SheetList2PinList ExcelSheetList)
            (vlax-release-object cells)
            (vlax-release-object sheet)
            (JB_FAT:Excel:Close :vlax-false)
            )
          )
        )
      )
    )
  )

(defun JB_FAT:Dbox1:action:b5:SheetList2PinList (ExcelSheetList / ANTWORTENLIST EXCELSUB FRAGENLIST STATUS X)
  (setq ExcelSheetList (mapcar '(lambda(X)
                                  (cons (atoi (car X))
                                        (cdr(cdr X))))(cdr ExcelSheetList)))
  (setq PinList&DBox1 (mapcar '(lambda(X)
                                 (if (setq ExcelSub(assoc (cdr(assoc "ID" X))ExcelSheetList))
                                   (progn
                                     (setq Status (cadr ExcelSub))
                                     (setq FragenList (JBf_string:Trennzeichen->listCharsWithBlanks (caddr ExcelSub) "\n"))
                                     (setq AntwortenList(JBf_string:Trennzeichen->listCharsWithBlanks (cadddr ExcelSub) "\n"))
                                     (setq X (JBf_list:subst:gc X (if(car FragenList)(car FragenList)"")"Frage1"))
                                     (setq X (JBf_list:subst:gc X (if(cadr FragenList)(cadr FragenList)"")"Frage2"))
                                     (setq X (JBf_list:subst:gc X (if(caddr FragenList)(caddr FragenList)"")"Frage3"))
                                     (setq X (JBf_list:subst:gc X (if(car AntwortenList)(car AntwortenList)"")"Antwort1"))
                                     (setq X (JBf_list:subst:gc X (if(cadr AntwortenList)(cadr AntwortenList)"")"Antwort2"))
                                     (setq X (JBf_list:subst:gc X (if(caddr AntwortenList)(caddr AntwortenList)"")"Antwort3"))
                                     (if Status (setq X (JBf_list:subst:gc X Status "Status")))
                                     )
                                   )
                                 X)PinList&DBox1))
  (setq l1&Dbox1 (nth l1_sel&Dbox1 PinList&DBox1))
  )
     
;;;SheetList 4 Export
(defun JB_FAT:Dbox1:action:b6:ExcelSheetList ( / X)
  (setq PinList&DBox1 (JBf_list:nth:change PinList&DBox1 l1&Dbox1 l1_sel&Dbox1))
  (mapcar '(lambda(X)
             (list (JB_FAT:BlockDef:Pin:IDString(cdr(assoc "ID" X)))
                   (JB_FAT:Dbox1:set:Handles->ObjString(cdr(assoc "Handles" X))"\n")
                   (if(cdr(assoc "Status" X))(cdr(assoc "Status" X))"")
                   (strcat
                     (if(cdr(assoc "Frage1" X))(cdr(assoc "Frage1" X))"")
                     (if(cdr(assoc "Frage2" X))(strcat "\n"(cdr(assoc "Frage2" X)))"")
                     (if(cdr(assoc "Frage3" X))(strcat "\n"(cdr(assoc "Frage3" X)))""))
                   (strcat
                     (if(cdr(assoc "Antwort1" X))(cdr(assoc "Antwort1" X))"")
                     (if(cdr(assoc "Antwort2" X))(strcat "\n"(cdr(assoc "Antwort2" X)))"")
                     (if(cdr(assoc "Antwort3" X))(strcat "\n"(cdr(assoc "Antwort3" X)))""))
                   )
             )PinList&DBox1)
  )
;;;Öffnen der Exceldatei nach dem Schreiben
(defun JB_FAT:Dbox1:action:b6:excel:Open (TargetExcelFile / vla-ShellObj)
  
  (vl-load-com)
  (setq vla-ShellObj (vlax-create-object "Shell.Application"))
  (vlax-invoke-method vla-ShellObj 'Open TargetExcelFile)
  (vlax-release-object vla-ShellObj)
  (princ)
  )

;;;Excel exportieren
(defun JB_FAT:Dbox1:action:b6 ( / CELLS EXCEL EXCELSHEETLIST EXCELVORLAGE WORKBOOK WORKBOOKVORLAGE FILENAME4WRITE RANGE SHEET SHEETS SHEETSVORLAGE TARGETEXCELFILE)
  (if (not(and(cdr(assoc "JB_1_t2" Settings&dbox1))
          (findfile (cdr(assoc "JB_1_t2" Settings&dbox1)))))
    (progn
      (mode_tile "JB_1_b4" 2)
      (alert "Bitte wählen Sie erst die Excelvorlagendatei aus.")
      )
    (if(setq Filename4Write(getfiled "Excel-Datei auswählen:"
                             (strcat (getvar "DWGPREFIX")(cadr(fnsplitl(getvar "DWGNAME")))".xlsx")
                             "xlsx" 1))
      (if(setq excel (JBf_Excel:Open:VorlageUndKopie (cdr(assoc "JB_1_t2" Settings&dbox1)) Filename4Write  nil nil))
        (progn
          (setq excelVorlage (cadr excel)
                Workbook (caddr excel)
                WorkbookVorlage (cadddr excel)
                Sheets (nth 4 excel)
                SheetsVorlage (nth 5 excel)                
                TargetExcelFile (nth 6 excel)
                excel (car excel))
          (vlax-invoke-method WorkbookVorlage 'Close :vlax-false)
          (vlax-release-object SheetsVorlage)
          (vlax-release-object WorkbookVorlage)
          (vlax-release-object excelVorlage)


          (if (or(vl-catch-all-error-p
                   (setq Sheet(vl-catch-all-apply 'vlax-get-property (list Sheets 'Item "FAT"))))
                 (not Sheet))
            (progn
              (JB_FAT:Excel:Close :vlax-false)
              (alert "In der ausgewählten Exceldatei ist keine Tabellenblatt \"FAT\" vorhanden.")
              )
            (progn
              (setq Cells(vlax-get-property Sheet 'Cells))
              (setq ExcelSheetList (JB_FAT:Dbox1:action:b6:ExcelSheetList))
              (setq Range (vlax-get-property Cells 'Range (strcat "A2:E" (itoa (+ 1(length ExcelSheetList))))))
              (vlax-put-property Range 'Value2
                (vlax-make-variant
                  (vlax-safearray-fill
                    (vlax-make-safearray vlax-vbstring (cons 0 (-(length ExcelSheetList)1))(cons 0 4));;;5 Spalten!
                    ExcelSheetList)))
              (vlax-release-object Range)
              (vlax-release-object cells)
              (vlax-release-object sheet)
              (JB_FAT:Excel:Close :vlax-true)
              (JB_FAT:Dbox1:action:b6:excel:Open Filename4Write)
              )
            )
          )
        )
      )
    )
  )
          
;;;Skalierung ändern
(defun JB_FAT:DBox1:action:b7 ( / SKAL X)
  (if (setq skal(JB_FAT:Dbox2))
    (progn
      (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (atof skal)"JB_1_t3"))
      (mapcar '(lambda(X)
                 (JB_FAT:PinList:Skal->obj (cdr(assoc "obj" X))(atof skal))
                 )
        PinList&DBox1)
      (set_tile "JB_1_t3" skal)
      )
    )
  )

;;;Dateneintrag in Xdaten des Obj's sichern
(defun JB_FAT:DBox1:action:XdataToObj ( / )
  (if (cdr(assoc "obj" l1&Dbox1))
    (JBf_list_xdaten_append "FAT_PIN" (cdr(assoc "obj" l1&Dbox1))
      (list (cons 1000 (if(cdr(assoc "Status" l1&Dbox1))(cdr(assoc "Status" l1&Dbox1))""))
            (cons 1010 (if(cdr(assoc "Position" l1&Dbox1))(cdr(assoc "Position" l1&Dbox1))'(-99 -99 -99)))
            (cons 1000 (if(cdr(assoc "Frage1" l1&Dbox1))(cdr(assoc "Frage1" l1&Dbox1))""))
            (cons 1000 (if(cdr(assoc "Frage2" l1&Dbox1))(cdr(assoc "Frage2" l1&Dbox1))""))
            (cons 1000 (if(cdr(assoc "Frage3" l1&Dbox1))(cdr(assoc "Frage3" l1&Dbox1))""))
            (cons 1000 (if(cdr(assoc "Antwort1" l1&Dbox1))(cdr(assoc "Antwort1" l1&Dbox1))""))
            (cons 1000 (if(cdr(assoc "Antwort2" l1&Dbox1))(cdr(assoc "Antwort2" l1&Dbox1))""))
            (cons 1000 (if(cdr(assoc "Antwort3" l1&Dbox1))(cdr(assoc "Antwort3" l1&Dbox1))""))
            (cons 1000 (JB_FAT:DBox1:action:1000erCodes:Write (if(cdr(assoc "Handles" l1&Dbox1))(cdr(assoc "Handles" l1&Dbox1))"")(cdr(assoc "obj" l1&Dbox1))))
            )
      )
    )
  )


(defun JB_FAT:DBox1:action:1000erCodes:Write (string obj / STRINGLIST X)
  (if (>(strlen string)250)    
  (while (>(strlen string)250);;;eigentlich 255, aber lieber ma ein paar Zeichen weniger, bevor es wieder Ärger gibt
    (setq StringList (cons (substr string 1 250)StringList)
          string (substr string 251))))
  (if (/= string "")
    (setq StringList (cons string StringList))
    )

  (JBf_list_xdaten_append "FAT_PIN_HandleList" obj (mapcar '(lambda(X)(cons 1000 X))(reverse StringList)))
  "0");;;RetVal "0", damit der Originalspeicherplatz damit "markiert" werden kann

;;;Lesen der Codes, zusammenfassen aller Xdaten-1000er-Einträge => Rückgabe As String
(defun JB_FAT:DBox1:action:1000erCodes:Read (obj / )
 (apply 'strcat(mapcar 'cdr(JBf_list_xdaten_read "FAT_PIN_HandleList" obj nil))))

;;;Lesen von Xdaten und mit READ-Werten substen
;;;SubstList (("JB_FST_AttText_3" 3)("JB_FST_AttText_4" 4)...)
(defun JB_FAT:DBox1:action:1000erCodes:ReadAndAppend (obj / STRING XDATEN)
  (if(setq xdaten(JBf_list_xdaten_read "FAT_PIN" obj nil))
    (progn
      (setq string(JB_FAT:DBox1:action:1000erCodes:Read obj));;;StringDaten aus Inhalt mit READ auspacken AsList
      (setq xdaten (jbf_list:nth:change xdaten (cons 1000 string)8))
      )
    )
  xdaten)
;;;Pin-Markierung in Liste auswählen
(defun JB_FAT:DBox1:action:l1 ( / )
  (JB_FAT:Dbox1:get)
  (JB_FAT:DBox1:action:XdataToObj)
  (setq PinList&DBox1 (JBf_list:nth:change PinList&DBox1 l1&Dbox1 l1_sel&Dbox1))
  (setq l1_sel&Dbox1 (atoi $value))
  (setq l1&Dbox1 (nth l1_sel&Dbox1 PinList&DBox1))
  (JB_FAT:Dbox1:set)
  (JB_FAT:Dbox1:mode)
  )
;;;DBox 1, getten
(defun JB_FAT:Dbox1:get ( / )
  
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (get_tile "JB_1_e7")"Status"))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (get_tile "JB_1_e1")"Frage1"))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (get_tile "JB_1_e2")"Frage2"))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (get_tile "JB_1_e3")"Frage3"))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (get_tile "JB_1_e4")"Antwort1"))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (get_tile "JB_1_e5")"Antwort2"))
  (setq l1&Dbox1 (JBf_list:subst:gc l1&Dbox1 (get_tile "JB_1_e6")"Antwort3"))
  (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (get_tile "JB_1_e7")"JB_1_e7"))
  )
               
;;;Action (Variable global in Aufrufender Funktion)
(defun JB_FAT:Dbox1:action (key / NAME X)

  (cond
    ((= key "JB_1_b1")    ;;;hinzufügen
     (JB_FAT:Dbox1:get)
     (setq JB_FAT$DCL$_1_po (done_dialog 101)))
    ((= key "JB_1_b2")    ;;;DWG-Datei entfernen
     (JB_FAT:Dbox1:action:b2))
    ((= key "JB_1_b3")    ;;;Position
     (JB_FAT:Dbox1:get)
     (setq JB_FAT$DCL$_1_po (done_dialog 103)))
    ((= key "JB_1_b4")    ;;;Excel-Vorlagendatei auswählen
     (JB_FAT:Dbox1:get)
     (JB_FAT:Dbox1:action:b4))
    ((= key "JB_1_b5")    ;;;Excel importieren
     (JB_FAT:Dbox1:get)
     (JB_FAT:Dbox1:action:b5)
     (JB_FAT:Dbox1:set))
    ((= key "JB_1_b6")    ;;;Excel exportieren
     (JB_FAT:Dbox1:get)
     (JB_FAT:Dbox1:action:b6))
    ((= key "JB_1_b7")    ;;;Skalierung eingeben (global für alle Blöcke)
     (JB_FAT:Dbox1:action:b7))
    ((= key "JB_1_b8")    ;;;Objekte anzeigen
     (setq JB_FAT$DCL$_1_po (done_dialog 108)))    
    ((= key "JB_1_l1")    ;;;PinMarkierung in Liste auswählen
     (JB_FAT:Dbox1:action:l1)
     (if (= $reason 4)(setq JB_FAT$DCL$_1_po (done_dialog 108))))
    ((= key "JB_1_r1")
     (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (- 1 (atoi $value))"JB_1_r1-2")))
    ((= key "JB_1_r2")
     (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (atoi $value)"JB_1_r1-2")))
    ((= key "cancel")    ;;;Ende
     (JB_FAT:Dbox1:get)
     (setq JB_FAT$DCL$_1_po (done_dialog 99))
     )
    )
)

;;;Handles zu ObjektString
(defun JB_FAT:Dbox1:set:Handles->ObjString (HandleString Trenner / OBJNAME RETLIST X)
  (mapcar '(lambda(X)
                 (setq ObjName (cdr(assoc 0 (entget X))))
                 (if (assoc ObjName RetList)
                   (setq RetList (JBf_list:subst:gc RetList (+(cdr(assoc ObjName RetList))1)ObjName))
                   (setq RetList (append RetList (list (cons ObjName 1))))
                   )
                 )
        (vl-remove-if 'not
          (mapcar '(lambda(X)
                     (if (and (handent X)
                              (entget (handent X)))
                       (handent X)))
            (JBf_String:Delimiter->List HandleString ","))))
  
  (if RetList
    (vl-string-right-trim Trenner(apply 'strcat(mapcar '(lambda(X)
                                                      (strcat X Trenner))
                                             (mapcar '(lambda(X)
                                                        (strcat (car X) "(" (itoa (cdr X))")"))
                                               (vl-sort RetList
                                                 '(lambda(e1 e2)(< (car e1)(car e2))))))))
    "")
  )
    
;;;DBox1: setten
(defun JB_FAT:Dbox1:set ( / X)
  
  (start_list "JB_1_l1" 3)
  (mapcar 'add_list (mapcar '(lambda(X)
                               (strcat (JB_FAT:BlockDef:Pin:IDString (cdr(assoc "ID" X)))"\t"
                                 (if(and(cdr(assoc "Handles" X))(/=(cdr(assoc "Handles" X))""))"Objekt(e)" "Punkt")"\t"
                                 (if(and(cdr(assoc "Handles" X))(/=(cdr(assoc "Handles" X))""))(JB_FAT:Dbox1:set:Handles->ObjString(cdr(assoc "Handles" X))";")"")))
                      PinList&DBox1))
  (end_list)
  (if l1_sel&Dbox1
    (progn
      (set_tile "JB_1_l1" "")
      (set_tile "JB_1_l1" (itoa l1_sel&Dbox1))
      )
    (set_tile "JB_1_l1" "")
    )
  (mapcar '(lambda(X)
             (set_tile (strcat "JB_1_"(car X))(cadr X)))
    (list
      (list "t1" (if(cdr(assoc "Position" l1&Dbox1))(vl-string-right-trim ","(apply  'strcat(mapcar '(lambda(X)(strcat(rtos X 2 3)","))(trans(cdr(assoc "Position" l1&Dbox1))0 1))))""))
      (list "t3" (rtos (cdr(assoc "JB_1_t3" Settings&dbox1))2 3))
      (list "e1" (if(cdr(assoc "Frage1" l1&Dbox1))(cdr(assoc "Frage1" l1&Dbox1))""))
      (list "e2" (if(cdr(assoc "Frage2" l1&Dbox1))(cdr(assoc "Frage2" l1&Dbox1))""))
      (list "e3" (if(cdr(assoc "Frage3" l1&Dbox1))(cdr(assoc "Frage3" l1&Dbox1))""))
      (list "e4" (if(cdr(assoc "Antwort1" l1&Dbox1))(cdr(assoc "Antwort1" l1&Dbox1))""))
      (list "e5" (if(cdr(assoc "Antwort2" l1&Dbox1))(cdr(assoc "Antwort2" l1&Dbox1))""))
      (list "e6" (if(cdr(assoc "Antwort3" l1&Dbox1))(cdr(assoc "Antwort3" l1&Dbox1))""))
      (list "e7" (if(cdr(assoc "Status" l1&Dbox1))(cdr(assoc "Status" l1&Dbox1))""))
      (list "t2" (if(cdr(assoc "JB_1_t2" Settings&dbox1))(JBf_String:PathFileName:reduce (cdr(assoc "JB_1_t2" Settings&dbox1)) 90)""))
      (list "r1" (itoa(- 1 (cdr(assoc "JB_1_r1-2" Settings&dbox1)))))
      (list "r2" (itoa(cdr(assoc "JB_1_r1-2" Settings&dbox1))))            
           
      )
    )
  )
;;;DBox1, moden
(defun JB_FAT:Dbox1:mode ( / )
  (if (not(cdr(assoc "ID" l1&Dbox1)));;;wenn noch kein kompletter Eintrag (nur initialisierten Eintrag mit Status)
    (progn
      (mode_tile "JB_1_b2" 1)
      (mode_tile "JB_1_b1" 0)
      (mode_tile "JB_1_b1" 2)
      (mode_tile "JB_1_l1" 1)
      (mode_tile "JB_1_b3" 1)
      (mode_tile "JB_1_t1" 1)
      (mode_tile "JB_1_e1" 1)
      (mode_tile "JB_1_e2" 1)
      (mode_tile "JB_1_e3" 1)
      (mode_tile "JB_1_e4" 1)
      (mode_tile "JB_1_e5" 1)
      (mode_tile "JB_1_e6" 1)
      (mode_tile "JB_1_b5" 1)
      (mode_tile "JB_1_b6" 1)
      (mode_tile "JB_1_b8" 1)
      (mode_tile "JB_1_r1" 0)
      (mode_tile "JB_1_r2" 0)
      (alert "Bitte fügen Sie eine Pinnadel-Markierung hinzu.")
      )
    (progn
      (mode_tile "JB_1_b2" 0)
      (mode_tile "JB_1_b1" 0)
      (mode_tile "JB_1_b1" 2)
      (mode_tile "JB_1_l1" 0)
      (mode_tile "JB_1_b3" 0)
      (mode_tile "JB_1_t1" 0)
      (mode_tile "JB_1_e1" 0)
      (mode_tile "JB_1_e2" 0)
      (mode_tile "JB_1_e3" 0)
      (mode_tile "JB_1_e4" 0)
      (mode_tile "JB_1_e5" 0)
      (mode_tile "JB_1_e6" 0)      
      (mode_tile "JB_1_b5" 0)
      (mode_tile "JB_1_b6" 0)
      (mode_tile "JB_1_b8" 0)
      (mode_tile "JB_1_r1" 0)
      (mode_tile "JB_1_r2" 0)
      
      )
    )
   )
;;;DBox2 => Faktor
(defun JB_FAT:Dbox2 ( / DCLID OK)
  (setq wert&Dbox2 (rtos(cdr(assoc "JB_1_t3" Settings&dbox1))2 3))
   
  (while (not (member ok '(1 99)))

    (setq DclId (JBf_Dcl:Load_dialog JB_FAT_$DCL$_File "JB_FAT_2" JB_FAT$DCL$_2_po))

    (set_tile "JB_2_e1" wert&Dbox2)
    (mode_tile "JB_2_e1" 2)
    
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_FAT:Dbox2:action \"" A "\")")))
            '(
	      "accept"
	      "cancel"
	      
             )
    )

    (setq ok (start_dialog))
    (unload_dialog DclId)

    (if(and(= ok 1)(<=(atof wert&Dbox2)0.0))
      (progn
	  (setq ok -1)
	  (alert "Der Faktor muss größer Null sein."))
      
      )    
    )
  (if (= ok 1)
    wert&Dbox2)
  )

;;;Action (Variable global in Aufrufender Funktion)
(defun JB_FAT:Dbox2:action (key / )
  (cond
    ((= key "accept")    ;;;OK
     (setq wert&Dbox2 (vl-string-subst "." ","(get_tile "JB_2_e1")))
     (setq JB_FAT$DCL$_2_po (done_dialog 1)))
    ((= key "cancel")    ;;;Ende
     (setq JB_FAT$DCL$_2_po (done_dialog 99))) 
  )
)
;;;DCL-schreiben
(defun JB_FAT:dcl:Write ( / file)  
  (if (and (setq JB_FAT_$DCL$_File (vl-filename-mktemp (strcat "FAT.dcl")))
           (setq file (open JB_FAT_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "JB_FAT_1: dialog {label = \"Fragen und Antworten mit Hilfe einer Exceltabelle.\";"
                ":boxed_column {label = \"Pinnadel-Markierungen\";"
                ":list_box {key = \"JB_1_l1\"; width = 100; label = \"bitte auswählen\";tabs = \"10 20 30\";}"
                ":row{"
                ":row {fixed_width = true;alignment = centered;"
                ":button {key = \"JB_1_b1\"; label = \"&hinzufügen...\";}"
                ":radio_row{"
                ":radio_button {key = \"JB_1_r1\"; label = \"Punkt\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"Objekte\";}}"
                ":button {key = \"JB_1_b2\"; label = \"&entfernen\";}"
                ":button {key = \"JB_1_b7\"; label = \"Einfügefaktor\";}"
                ":text {key = \"JB_1_t3\"; label = \"0.25\"; width = 10;}"
                "}:button {key = \"JB_1_b8\"; label = \"Objekte anzeigen<\";}"
                "}"
                ":boxed_column {label = \"Eigenschaften\";"
                ":row {"
                ":edit_box {key = \"JB_1_e7\"; label = \"Status, Anmerkung\"; edit_width = 35;}"
                ":button {key = \"JB_1_b3\"; label = \"&Position<\"; fixed_width=true;}"
                ":text {key = \"JB_1_t1\"; label = \"3512345.123,5912345.123,100.123\";width = 35;}}"
                ":boxed_column {label = \"Fragen, Zeile 1-3\";"
                ":edit_box {key = \"JB_1_e1\";}"
                ":edit_box {key = \"JB_1_e2\";}"
                ":edit_box {key = \"JB_1_e3\";}}"
                ":boxed_column {label = \"Antworten, Zeile 1-3\";"
                ":edit_box {key = \"JB_1_e4\";}"
                ":edit_box {key = \"JB_1_e5\";}"
                ":edit_box {key = \"JB_1_e6\";}}"
                "}"
                "}"
                ":boxed_column {label = \"Exceldatei\";"
                ":row {"
                ":button {key = \"JB_1_b4\"; label = \"&Vorlagedatei...\"; fixed_width=true;}"
                ":text {key = \"JB_1_t2\"; label = \"c:\\\\temp\\\\ExcelVorlage\\\\FAT_template.xlsx\";width = 95;}}"
                ":row{fixed_width = true;alignment = centered;"
                ":button {label = \"&Importieren\"; key= \"JB_1_b5\";fixed_width=true;is_default = true;}"
                ":button {label = \"&Exportieren\"; key= \"JB_1_b6\";fixed_width=true;is_default = true;}"
                "}"
                "}"
                ":row{fixed_width = true;alignment = centered;"
                ":retirement_button {label = \"&Ende\"; key= \"cancel\";is_cancel = true; fixed_width=true;}"
                "}}"
                "JB_FAT_2: dialog {label = \"Einfügefaktor\";"
                ":boxed_column {label = \"bitte eingeben\";"
                ":edit_box {key = \"JB_2_e1\"; allow_accept = true;}"
                "}"
                "ok_cancel;}"
               )
              )
      )
      (close file)
      JB_FAT_$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
(defun JBf_String:Userpfad (UserPfad / )
  (setq UserList (JBf_String:Delimiter->List UserPfad "\\")
        Pfad (strcat (car UserList)"\\"))

  ;;;wenn UserPfad noch nicht vorhanden, dann erstellen
  (mapcar '(lambda(A)
             (setq Pfad (strcat Pfad A "\\"))
             (if (not (JBf_String:FilePath? Pfad))
               (vl-mkdir Pfad)))
    (cdr UserList))
  userpfad
  )
;;;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))

;;;Es wird ein String anhand eines Trennzeichens zerlegt, wenn das trennzeichen doppelt vorkommt, dann wird ein Leerzeichen als Zwischenraum zurückgegeben
(defun JBf_string:Trennzeichen->listCharsWithBlanks (str str_trenn / A RETLIST SUB TABN)
  (setq str_trenn (car(vl-string->list str_trenn)))
  (mapcar '(lambda(A)
             (if (/= A str_trenn)
               (setq sub (cons A sub)
                     TabN nil)
               (progn
                 (setq TabN (if (not TabN) 1 (+ TabN 1)))
                 (if (= TabN 1)
                   (setq RetList (cons (reverse sub)RetList)
                         sub nil)
                   (setq RetList (cons nil RetList)))))
             )
    (vl-string->list str))
  (if Sub (setq RetList (cons (reverse Sub) RetList)))
  (mapcar '(lambda(A)
             (if A (vl-list->string A)""))(reverse RetList)))

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

(defun JBf_list:nth:change(liste EintragNew pos / n )
  (setq n -1)
  (mapcar '(lambda (A)
             (setq n (+ n 1))
             (if (= n pos)
               EintragNew
               A))liste))
;********************************************************************************************;;;
;;;JBf_xdaten_write  Es werden X-Daten an auszuwählendes Element angehängt                   ;;;
;;;******************************************************************************************;;;
;;;=> art "Name" als String
;;;=> obj
;;;=> Liste mit Dotted-Pair Elementen
(defun JBf_list_xdaten_append (art obj liste /)
  (regapp art)
  (entmod (append (entget obj) (list (list -3 (cons art liste)))))
  )
;********************************************************************************************;;;
;;;JBf_xdaten_read  Es werden die XDaten eines Elementes zurückgegeben                         ;
;;;******************************************************************************************;;;
;;;=> art "Name" als String
;;;=> obj
;;;=> gc_nr wenn nil dann Rückgabe der ganzen Liste
(defun JBf_list_xdaten_read (art obj gc_nr / liste)
  (setq liste (cdr (assoc art (cdr (assoc -3 (entget obj '( "*")))))))
  (if gc_nr
    (cdr (assoc gc_nr 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))
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Dcl									   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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

;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => vla									   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;FeldBlockFlag: wenn 'T, dann wird bei der Vergabe von Textwerten geprüft, ob im Attribut ein Feld definiert ist, wenn ja, dann wird der Textwert nicht übertragen => das Schriftfeld bleibt erhalten
(defun JBf_VlaAdd:AddBlock (BlockName 3d-InsPoint ScaleFactor Layer Rotation 3d-Normal AttListFill FeldBlockerFlag / ATTLIST SPACE VLA-ATT VLA-OBJ X Y)
  
 (if (or(= (strcase (getvar "CTAB")) "MODEL")
         (/=(getvar "CVPORT")1))
    (setq Space (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
    (setq Space (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
    )
  (setq	vla-obj
         (vla-insertblock
           Space
           (vlax-3d-point '(0 0 0))
           BlockName
	   ScaleFactor
	   ScaleFactor
	   ScaleFactor
	   Rotation
	 ))

  (vla-put-Layer vla-obj Layer)
  (vla-put-Normal vla-obj 3d-Normal)
  ;;;(vla-put-InsertionPoint vla-obj 3d-InsPoint) => musste deaktiviert und durch vla-move ersetzt werden, weil sonst Attribute mit Ausrichtung Mitte-Links die doppelte Höhe erhalten 07.09.18
  (vla-Move vla-obj (vlax-3d-point '(0 0 0)) 3d-InsPoint)
  
  (if (and AttListFill(=(vla-get-HasAttributes vla-obj):vlax-true)
	   (setq AttList (mapcar '(lambda (X)(cons (strcase(vla-get-TagString X))X))
			    (vlax-invoke vla-obj 'getAttributes))))
    (mapcar '(lambda(X)
	       (if (setq vla-att(cdr(assoc (car X)AttList)))		       
		 (mapcar '(lambda(Y)
			    (if(or (not FeldBlockerFlag)
				   (/= (car Y)'TEXTSTRING)
				   (and (=(car Y)'TEXTSTRING)
					(not (JBf_VlaAdd:AddBlock:FieldInAtt? vla-att))))
			      (if (vlax-property-available-p vla-att(car Y))
				(vlax-put vla-att (car Y)(cadr Y))))
			    )
			 (cadr X))))

	    AttListFill))
  
  vla-obj)

  ;;;Prüfen, ob in AttDef ein Schriftfeld vorhanden ist
(defun JBf_VlaAdd:AddBlock:FieldInAtt? (vla-Att / RETVAL)
  (vlax-for ITEM
	    (vla-GetExtensionDictionary
                       vla-Att)
    (if (=(vla-get-name ITEM)"ACAD_FIELD")
      (setq RetVal 'T)))
  RetVal)

;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Diverse								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;alle Objekte eins Auswahlsatzes löschen (ohne Command) ;alle Objekte eins Auswahlsatzes schieben => Koordinaten müssen in Welt übergeben werden
(defun JBf_aws:Vla-DeleteRefresh (aws / n A) 
  (if aws
    (progn
      (setq n 0)
      (repeat (sslength aws)
        (if (and (ssname aws n)
              (entget (ssname aws n)))
          (progn
            (setq A (vlax-ename->vla-object (ssname aws n)))
            (vla-move A(vlax-3D-point '(0.0 0.0))(vlax-3D-point (list 0.0 (*(getvar "VIEWSIZE")10.0))))
            (vlax-invoke A 'Update)
            (vlax-invoke A 'Delete)))
        
        (setq n (+ n 1))))))


;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Excel								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Exceldateien öffnen, Vorlage und die Kopie davon
(defun JBf_Excel:Open:VorlageUndKopie (PathVorlage PathNew  NewFolderName Only4LispList / EXCEL EXCELVORLAGE EXCELWORKBOOK EXCELWORKBOOKVORLAGE FILECOPYFLAG FILEDELETEFLAG SHEETS SHEETSVORLAGE)

  (if (findfile PathVorlage)
    (progn
      

  ;;;;Neues Verzeichnis erstellen, wenn noch nicht vorhanden und dann den PathNew mit neuem Pfad versehen
  (if (and NewFolderName(not(member (strcase NewFolderName)(mapcar 'strcase(vl-directory-files (car(fnsplitl PathNew)) nil -1)))))
    (vl-mkdir (strcat(car(fnsplitl PathNew)) NewFolderName)))
  (setq PathNew (strcat (car (fnsplitl PathNew))(if NewFolderName (strcat NewFolderName "\\")"") (cadr(fnsplitl PathNew))(caddr (fnsplitl PathNew))))
  
   (if (and(or (and(findfile PathNew)
                   (setq FileDeleteFlag (vl-file-delete PathNew))
                   (setq FileCopyFlag(vl-file-copy PathVorlage PathNew)))
               (and(not(findfile PathNew))
                   (setq FileCopyFlag(vl-file-copy PathVorlage PathNew))))
           (setq excel (setq excel (vlax-get-or-create-object "Excel.Application")))
           (if(or(vl-catch-all-error-p
                               (setq ExcelWorkbook(vl-catch-all-apply 'JBf_Excel:Open:Check (list PathNew excel))))
                 (not ExcelWorkbook))
             (alert (strcat "Eventuell ist bereits eine Datei in Excel unter dem Namen \n\"" (vl-filename-base PathNew)(caddr(fnsplitl PathNew)) "\"\ngeöffnet, bitte schließen Sie diese und versuchen es erneut."))
             'T)
           (setq Sheets (vlax-get-property ExcelWorkbook 'Sheets))
           (setq excelVorlage (vlax-get-or-create-object "Excel.Application"))
           (if(or(vl-catch-all-error-p
                                      (setq ExcelWorkbookVorlage(vl-catch-all-apply 'JBf_Excel:Open:Check (list PathVorlage excelVorlage))))
                 (not ExcelWorkbookVorlage))
             (progn
               (alert (strcat "Eventuell ist bereits eine Datei in Excel unter dem Namen \n\"" (vl-filename-base PathVorlage)(caddr(fnsplitl PathVorlage)) "\"\ngeöffnet, bitte schließen Sie diese und versuchen es erneut."))
               (vlax-invoke-method ExcelWorkbook 'Close :vlax-false)
               (vlax-release-object ExcelWorkbook)
               (vlax-release-object excel)
               nil)
             'T)
           ExcelWorkbookVorlage
           (setq SheetsVorlage (vlax-get-property ExcelWorkbookVorlage 'Sheets))
           )
     (list excel excelVorlage ExcelWorkbook ExcelWorkbookVorlage Sheets SheetsVorlage PathNew)
     (progn
       (cond ((not PathVorlage)
              (alert (strcat "Die Vorlagendatei\n\n"
                       PathVorlage
                       "\n\nist nicht vorhanden, es konnte keine Exceldatei \n\n"
                       PathNew
                       "\n\n erstellt werden.")))
             
	    ((and(findfile PathNew)
                 (not FileDeleteFlag))
             (alert (strcat "Die Datei\n\n"
                      PathNew
                      "\n\nist geöffnet oder schreibgeschützt, sie konnte nicht neu erstellt werden.")))
             ((and(not(findfile PathNew))
                  (not FileCopyFlag))
              (alert (strcat "Die Datei\n\n"
                       PathNew
                       "\n\nkonnte nicht neu erstellt werden.")))
             ((not excel)
              (alert (strcat "Die Datei\n\n"
                       PathNew
                       "\n\nkonnte nicht neu erstellt werden, ist Excel auf dem Rechner installiert?"))))
       nil)))
    (alert (strcat "Die Vorlagendatei\n\n"
                       PathVorlage
                       "\n\nist nicht vorhanden, es konnte keine Exceldatei \n\n"
                       PathNew
                       "\n\n erstellt werden.")))
  
   )
;;;Exceldatei öffnen, diese kann dann geändert oder auch nur gelesen werden.
(defun JBf_Excel:Open:EineDatei (Path / EXCEL EXCELVORLAGE EXCELWORKBOOK SHEETS)
   (if (and(findfile Path)
           (setq excel (setq excel (vlax-get-or-create-object "Excel.Application")))
           (if(or(vl-catch-all-error-p
                               (setq ExcelWorkbook(vl-catch-all-apply 'JBf_Excel:Open:Check (list Path excel))))
                 (not ExcelWorkbook))
             (alert (strcat "Eventuell ist bereits eine Datei in Excel unter dem Namen \n\"" (vl-filename-base Path)(caddr(fnsplitl Path)) "\"\ngeöffnet, bitte schließen Sie diese und versuchen es erneut."))
             'T)
           (setq Sheets (vlax-get-property ExcelWorkbook 'Sheets))
           (setq excelVorlage (vlax-get-or-create-object "Excel.Application"))
           )
     (list excel ExcelWorkbook Sheets)
     (progn
       (cond ((or(not Path)(not(findfile Path)))
              (alert (strcat "Die Datei\n\n"
                       Path
                       "\n\nist nicht vorhanden und konnte nicht geöffnet werden.")))
                          
             ((not excel)
              (alert (strcat "Die Datei\n\n"
                       Path
                       "\n\nkonnte nicht neu erstellt werden, ist Excel auf dem Rechner installiert?"))))
       nil))
   )
;;;Exceldatei öffnen, testen, ob bereits geöffnet
(defun JBf_Excel:Open:Check (dateipfad excel / )
  (if(vl-file-rename dateipfad (strcat (car(fnsplitl dateipfad))(cadr(fnsplitl dateipfad))"_JBCheck"(caddr(fnsplitl dateipfad))))
    (progn
      (vl-file-rename (strcat (car(fnsplitl dateipfad))(cadr(fnsplitl dateipfad))"_JBCheck"(caddr(fnsplitl dateipfad)))dateipfad)
      (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'OpenXML dateipfad))))
;;;Schließen der Exceldatei => globale Objektvariablen!
(defun JB_FAT:Excel:Close (flag / )
  (vlax-invoke-method Workbook 'Close flag)
  (vlax-release-object Sheets)
  (vlax-release-object Workbook)
  (vlax-release-object excel)
  )
;;;--------------------------------------------------------------------------------------------------------
;;;Info für Textfenster nach dem laden des Programms							   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|Fragen und Antworten mit Hilfe einer Exceltabelle.          |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: FAT                                    |"
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)












    
      
         
  
  




  





                 

