;;;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:ZBS (SperrFlaechen)						        	           
;;;													   
;;;Es werden 2D-Zebrastreifen erzeugt, als Polylinienkonturen und optional als SOLID-Schraffurfläche.	   
;;;Für die Begrenzung sind 2 seitlichen Begrenzungslinien und 1 Kopflinien auszuwählen.  		   
;;;													   
;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_ZBS$DCL$_[x]_po (Positionen der Dialogfenster)						   	   
;;;- JB_ZBS$$List => Liste mit allen Daten zur Erzeugung der Zebrastreifen.				   
;;;                                                                              Jörn Bosse, 22.02.25      

;;;aufrufenden Funktionen
(defun c:ZBS ( / )
  (JB_ZBS)
  )
(defun c:ZebraStreifen ( / )
  (JB_ZBS)
  )

;;;Definition der v_liste, wenn noch nicht vorhanden
(defun JB_ZBS:v_liste ( / )  
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (                             
                             ("JB_1_r1-2" . 0);;;0 = Layer von Begrenzung, 1 = 1 aktueller Layer
			     ("JB_1_to1" . "0");;;SOLID-Flächenfüllung
			     ("JB_1_to2" . "0");;;Außenkonturen löschen
			     ("JB_1_r3-4" . 1);;;0 = lotrecht von Achse, 1 = bündig
			     ("JB_1_te1" . "0.5");;;Breite
			     ("JB_1_te2" . "0.5");;;Kopfabstand 1
			     ("JB_1_to3" . "0");;;unterschiedliche Kopffabstände
			     ("JB_1_te3" . "0.5");;;Kopfabstand 2
			     ("JB_1_to4" . "0");;;Ursprungslinien löschen
			     )))))
  )
			  

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


(defun JB_ZBS:Intro ( / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n---------------------ZBS(1.0), 22.02.26----------------------")
  (princ "\nZebraStreifen: Erzeugen von 2D-Zebrastreifen.                ")
  (princ "\n-------------------------------------------------------------")
  )

;;;Hauptfunktion
(defun JB_ZBS ( / PFAD_INI V_LISTE)
  (vl-load-com)
  (setq pfad_ini (JB_ZBS: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_ZBS:v_liste))pfad_ini nil))

  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))    
  (JB_ZBS:Intro)  
  (if (not
            (or (and JB_ZBS_$DCL$_File(findfile JB_ZBS_$DCL$_File))
                (setq JB_ZBS_$DCL$_File (JB_ZBS:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))

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

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

(defun JB_ZBS: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
  )
;;;2 Linien auswählen
(defun JB_ZBS:Lines:get:aws:2Lines (ArtStr / AWS)
  (if (and
	(princ (strcat "\nWählen Sie 2 Linien für die " ArtStr ":"))
	(setq aws (ssget(list (cons 0 "LINE"))))
	(or
	  (= (sslength aws) 2)
	  (alert (strcat "Sie müssen exakt 2 Linien für die " ArtStr " auswählen."))
	  )
	(or
	  (not(JBf_List:ObjSchnitt (ssname aws 0)(ssname aws 1)))
	  (alert (strcat "Die 2 Linien für die " ArtStr " dürfen sich nicht schneiden."))
	  ))
    (list (ssname aws 0)(ssname aws 1)))
  )


;;;Schnittdaten zusammen fassen für Liste
(defun JB_ZBS:Lines:get:Schnittdata (objList1 objList2 / SPKOPF1A SPKOPF1B SPKOPF2A SPKOPF2B)
  (setq spKopf1A(car(JBf_List:ObjSchnitt (car objList2)(car objList1))))
  (setq spKopf1B(car(JBf_List:ObjSchnitt (car objList2)(cadr objList1))))
  (setq spKopf2A(car(JBf_List:ObjSchnitt (cadr objList2)(car objList1))))
  (setq spKopf2B(car(JBf_List:ObjSchnitt (cadr objList2)(cadr objList1))))

  

;;;  (entmake (list (cons 0 "LINE")(cons 10 spKopf1A)(cons 11 spKopf1B)(cons 62 1)))
;;;  (entmake (list (cons 0 "LINE")(cons 10 spKopf1B)(cons 11 spKopf2B)(cons 62 3)))
;;;  (entmake (list (cons 0 "LINE")(cons 10 spKopf2B)(cons 11 spKopf2A)(cons 62 5)))
;;;  (entmake (list (cons 0 "LINE")(cons 10 spKopf2A)(cons 11 spKopf1A)(cons 62 6)))

  (list (cons "Kopf1"
	      
	      (list (cons "1A" spKopf1A)
		    (cons "1B" spKopf1B)
		    (cons "obj" (car objList2))))
	(cons "Kopf2"
	      (list (cons "2A" spKopf2A)
		    (cons "2B" spKopf2B)
		    (cons "obj" (cadr objList2))))

	(cons "Seite1"
	      (list (cons "1A" spKopf1A)
		    (cons "2A" spKopf2A)
		    (cons "obj" (car objList1))))
	(cons "Seite2"
	      (list (cons "1B" spKopf1B)
		    (cons "2B" spKopf2B)
		    (cons "obj" (cadr objList1))))
	)
  )

	
	      
  
  
	     

;;;Linien auswählen
(defun JB_ZBS:Lines:get ( / HANDLELIST1 HANDLELIST2 OBJLIST1 OBJLIST2 X)
  (setq JB_ZBS$$List nil)
  (if(and(setq objList1 (JB_ZBS:Lines:get:aws:2Lines "seitl. Begrenzungen"))
	 (setq objList2 (JB_ZBS:Lines:get:aws:2Lines "Kopfseiten"))
	 (setq HandleList1 (mapcar '(lambda(X)(cdr(assoc 5(entget X))))objList1))
	 (setq HandleList2 (mapcar '(lambda(X)(cdr(assoc 5(entget X))))objList2))
	 (or(=(length(vl-remove-if '(lambda(X)(member X HandleList1))HandleList2))2)
	    (alert "Für die Kopfseiten dürfen keine Linien gewählt werden, die bereits für die seitl. Begrenzungen ausgewählt worden sind."))
	 (or
	   (and (JBf_List:ObjSchnitt (car objList2)(car objList1))
		(JBf_List:ObjSchnitt (car objList2)(cadr objList1))
		(JBf_List:ObjSchnitt (cadr objList2)(car objList1))
		(JBf_List:ObjSchnitt (cadr objList2)(cadr objList1)))
	   (alert "Die Kopfseiten müssen jeweils beide seitl. Begrenzungen schneiden."))
	 )
    (setq JB_ZBS$$List(JB_ZBS:Lines:get:Schnittdata objList1 objList2))
    )
  )
  

;;;DBox 1
(defun JB_ZBS:Dbox1 (v_liste pfad_ini / A DCLID OK SETTINGS&DBOX1 vla-objList&DBox1 NAdd&DBox1 NBest&DBox1 NPossibleList&DBox1)

  (setq NAdd&DBox1 0)
  
  (setq Settings&Dbox1 (JB_ZBS:v_liste:DboxSettings:get "Dbox1" v_liste))
  (JB_ZBS:Dbox1:Draw)
  (while  (not(member ok '(1 99)))
    (setq DclId(JBf_Dcl:Load_dialog JB_ZBS_$DCL$_File "JB_ZBS_1" JB_ZBS$DCL$_1_po))
    
    (JB_ZBS:Dbox1:set)
    (JB_ZBS:Dbox1:mode)
           
    (mapcar '(lambda(A)(action_tile A (strcat "(JB_ZBS:Dbox1:action \""A"\")")))
      '("JB_1_r1" "JB_1_r2" "JB_1_r3" "JB_1_r4"
	"JB_1_to1" "JB_1_to2" "JB_1_to3" "JB_1_to4"
	"JB_1_b1" "JB_1_b2" "JB_1_b3"
	"JB_1_be1" "JB_1_be2" "JB_1_be3"
        "accept" "cancel"))

    (setq ok (start_dialog))
    (unload_dialog DclId)

    (if (= ok 11)
      (vl-catch-all-apply 'getpoint (list "\nmit ENTER zurück ins Dialogfenster."))
      )
      
    )
  
  (setq v_liste (JB_ZBS:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
  (JBf_SIC:sichern v_liste pfad_ini nil)

  (if (= ok 1)
    (if (=(cdr(assoc "JB_1_to4" Settings&dbox1))"1")
      (mapcar 'entdel(mapcar '(lambda(X)(cdr(assoc "obj"(cdr X))))JB_ZBS$$List))
      )
    )
      
    	 
  )

;;;action b2-3
(defun JB_ZBS:Dbox1:action:b2-3 (n / )
  (setq NAdd&DBox1 (+ NAdd&DBox1 n))  
  (JB_ZBS:Dbox1:action:Update)
  (JB_ZBS:Dbox1:set)
  (JB_ZBS:Dbox1:mode)
  )

;;;Update
(defun JB_ZBS:Dbox1:action:Update ( / )
  (JB_ZBS:Dbox1:Delete)
  (JB_ZBS:Dbox1:Draw)
  )
			    
;;;Action (Variable global in Aufrufender Funktion)
(defun JB_ZBS:Dbox1:action (key /  )
  (cond ((= key "JB_1_r1")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 0 "JB_1_r1-2"))
	 (JB_ZBS:Dbox1:action:Update))
	((= key "JB_1_r2")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 1 "JB_1_r1-2"))
	 (JB_ZBS:Dbox1:action:Update))
	((= key "JB_1_r3")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 0 "JB_1_r3-4"))
	 (JB_ZBS:Dbox1:action:Update))
	((= key "JB_1_r4")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 1 "JB_1_r3-4"))
	 (JB_ZBS:Dbox1:action:Update))
	((= key "JB_1_to1")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to1"))
	 (JB_ZBS:Dbox1:mode)
	 (JB_ZBS:Dbox1:action:Update))
	((= key "JB_1_to2")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to2"))
	 (JB_ZBS:Dbox1:action:Update))
	((= key "JB_1_to3")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to3"))
	 (JB_ZBS:Dbox1:mode)
	 (JB_ZBS:Dbox1:action:Update))
	((= key "JB_1_to4")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to4"))
	 (JB_ZBS:Dbox1:action:Update))

	((= key "JB_1_b1");;;Zoom
	 (setq JB_ZBS$DCL$_1_po (done_dialog 11))
	 )
	((= key "JB_1_b2");;;+
	 (JB_ZBS:Dbox1:action:b2-3 1)
	 (JB_ZBS:Dbox1:action:Update)
	 (JB_ZBS:Dbox1:mode))
	((= key "JB_1_b3");;;-
	 (JB_ZBS:Dbox1:action:b2-3 -1)
	 (JB_ZBS:Dbox1:action:Update)
	 (JB_ZBS:Dbox1:mode))

	((= key "JB_1_be1");;;Breite
	 (if (setq wert (JB_ZBS:DBox2 (cdr(assoc "JB_1_te1" Settings&dbox1))'(list(> (atof wert&DBox2)0.0))"Die Breite für die Zebrastreifen muss größer Null sein."))
	   (progn
	     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 wert "JB_1_te1"))
	     (JB_ZBS:Dbox1:action:Update)
	     (JB_ZBS:Dbox1:set)
	     (JB_ZBS:Dbox1:mode)
	     )
	   )
	 )

	((= key "JB_1_be2");;;Kopf-Abstand 1
	 (if (setq wert (JB_ZBS:DBox2 (cdr(assoc "JB_1_te2" Settings&dbox1))'(list(>= (atof wert&DBox2)0.0))"Der Kopf-Abstand 1 für die Zebrastreifen muss größergleich Null sein."))
	   (progn
	     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 wert "JB_1_te2"))
	     (JB_ZBS:Dbox1:action:Update)
	     (JB_ZBS:Dbox1:set)
	     (JB_ZBS:Dbox1:mode)
	     )
	   )
	 )

	((= key "JB_1_be3");;;Kopf-Abstand 2
	 (if (setq wert (JB_ZBS:DBox2 (cdr(assoc "JB_1_te3" Settings&dbox1))'(list(>= (atof wert&DBox2)0.0))"Der Kopf-Abstand 2 für die Zebrastreifen muss größergleich Null sein."))
	   (progn
	     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 wert "JB_1_te3"))
	     (JB_ZBS:Dbox1:action:Update)
	     (JB_ZBS:Dbox1:set)
	     (JB_ZBS:Dbox1:mode)
	     )
	   )
	 )
	     
	 
        ((= key "cancel");;;Ende
	 (JB_ZBS:Dbox1:Delete)
	 (setq JB_ZBS$DCL$_1_po (done_dialog 99)))
	((= key "accept");;;OK
	 (setq JB_ZBS$DCL$_1_po (done_dialog 1))
	 )))


      
;;;Dbox1; Werte setzen 
(defun JB_ZBS:Dbox1:set ( / )
  (mapcar '(lambda(X)
	     (set_tile (strcat "JB_1_" (car X))(cadr X)))
	  (list
	    (list "r1" (itoa(- 1(cdr(assoc "JB_1_r1-2" Settings&dbox1)))))
	    (list "r2" (itoa(cdr(assoc "JB_1_r1-2" Settings&dbox1))))
	    (list "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
	    (list "to2" (cdr(assoc "JB_1_to2" Settings&dbox1)))
	    (list "r3" (itoa(- 1(cdr(assoc "JB_1_r3-4" Settings&dbox1)))))
	    (list "r4" (itoa(cdr(assoc "JB_1_r3-4" Settings&dbox1))))
	    (list "te1" (cdr(assoc "JB_1_te1" Settings&dbox1)))
	    (list "te2" (cdr(assoc "JB_1_te2" Settings&dbox1)))
	    (list "to3" (cdr(assoc "JB_1_to3" Settings&dbox1)))
	    (list "te3" (cdr(assoc "JB_1_te3" Settings&dbox1)))
	    (list "to4" (cdr(assoc "JB_1_to4" Settings&dbox1)))
	    (list "t1" (itoa(+ NBest&DBox1 NAdd&DBox1)))
	    )
	  )
  )
;;;DBOX 1, moden
(defun JB_ZBS:Dbox1:mode ( / )
  (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
    (mode_tile "JB_1_to2" 0)
    (mode_tile "JB_1_to2" 1)
    )

  (if (=(cdr(assoc "JB_1_to3" Settings&dbox1))"1")
    (progn
      (mode_tile "JB_1_be3" 0)
      (mode_tile "JB_1_te3" 0))
    (progn
      (mode_tile "JB_1_be3" 1)
      (mode_tile "JB_1_te3" 1))
    )

  (if(not(assoc(+(+ NBest&DBox1 NAdd&DBox1)1)NPossibleList&DBox1))
    (mode_tile "JB_1_b2" 1)
    (mode_tile "JB_1_b2" 0)
    )

  (if(not(assoc(-(+ NBest&DBox1 NAdd&DBox1)1)NPossibleList&DBox1))
    (mode_tile "JB_1_b3" 1)
    (mode_tile "JB_1_b3" 0)
    )

    
    
  
  )

;;;Anzahl der Streifen und Lücken
(defun JB_ZBS:Dbox1:Draw:NL_List (l b / LL N RESTLIST RESTSUB RETLIST)
  (setq n (fix(/ l b)))
  (if (= n 1);;;dannn nur ein Streifen und 2 Abstände außen, Sonderfall
    (setq RetList (list (cons "StreifenN" 1)
			(cons "LueckeL" (/(- l b)2.0))
			(cons "LAussen" 'T)
			(cons "Breite" b)
			))
    (progn      
      (while (> n 1)	
	(setq ll (/(- l (* n b))(- n 1))		 
		RestList(cons(list n ll)RestList))
	(setq n (- n 1))
	)
      (setq NPossibleList&DBox1(vl-sort RestList '(lambda(e1 e2)(<(abs(- b (cadr e1)))(abs(- b (cadr e2)))))))
      (setq NBest&DBox1 (car(car NPossibleList&DBox1)))
      
     
      (setq RestSub (assoc (+ NBest&DBox1 NAdd&DBox1)NPossibleList&DBox1))
      (if (and(= (car RestSub)2)
	      (>(/(- l b)2.0)(cadr RestSub)))
	(setq RetList (list (cons "StreifenN" 1)
			    (cons "LueckeL" (/(- l b)2.0))
			    (cons "LAussen" 'T)
			    (cons "Breite" b)))
	(setq RetList (list (cons "StreifenN" (car RestSub))
			    (cons "LueckeL" (cadr RestSub))
			    (cons "LAussen" nil)
			    (cons "Breite" b)))
	)
      )
    )
  
  RetList)


;;;Fußpunktliste
(defun JB_ZBS:Dbox1:Draw:FussPunktList (pk1 pk2 NL_List / FUSSPUNKTLIST PK1A PNEXT)
  (if (cdr(assoc "LAussen" NL_List))
    (list(JBf_list:MidPoint pk1 pk2))
    (progn
      (setq pk1a (polar pk1 (angle pk1 pk2)(/(cdr(assoc "Breite" NL_List))2.0)))
      
      (setq pNext pk1a)
      (repeat (- (cdr(assoc "StreifenN" NL_List))1)
	(setq pNext (polar pNext (angle pk1 pk2)(+ (cdr(assoc "LueckeL" NL_List))(cdr(assoc "Breite" NL_List)))))
	(setq FussPunktList (cons pNext FussPunktList))
	)
      (append
	(list pk1a)
	(reverse FussPunktList)
	)
      )
    )
  )


;;;Nächster Schnittpunkt
(defun JB_ZBS:Dbox1:Draw:StreifenList:NextSP (p1 p2 p1A p1B p2A p2B / SPLIST)
  (setq spList(vl-remove-if 'not
			     (list
			       (inters p1 p2 p1B p2B nil)
			       (inters p1 p2 p1A p2A nil)
			       (inters p1 p2 p1A p1B nil)
			       (inters p1 p2 p2A p2B nil))))
  (car(vl-sort spList
	       '(lambda(e1 e2)
		  (<(distance p1 e1)(distance p1 e2)))))
  )

;;;Längen für Randinterpüolation
(defun JB_ZBS:Dbox1:Draw:StreifenList:Int:lList (FussPunktList pk1 pk2 lk1 lk2 / N X)
  
  (setq n -1)
  (setq liste
	 (append
	     (list(setq Add(+ lk1(distance pk1 (car FussPunktList)))))
	     (vl-remove-if 'not
	       (mapcar '(lambda(X)
			  (setq n (+ n 1))
			  (if (> n 0)
			    (setq Add(+ Add(distance X (nth (- n 1)FussPunktList))))))
		       FussPunktList))
	     )
	)

  
  )
	     
  
  


;;;Interpolationsspunkte für die Ränder
(defun JB_ZBS:Dbox1:Draw:StreifenList:Int (FussPunktList pk1 pk2 lk1 lk2 p1A p1B p2A p2B / )
  (setq lList (JB_ZBS:Dbox1:Draw:StreifenList:Int:lList FussPunktList pk1 pk2 lk1 lk2))
  (list
    (JB_ZBS:Dbox1:Draw:StreifenList:Int:RandKoordList lList p1A p2A pk1 pk2 lk1 lk2)
    (JB_ZBS:Dbox1:Draw:StreifenList:Int:RandKoordList lList p1B p2B pk1 pk2 lk1 lk2)
    )
  )

    
  
					   
;;;RandKooridinaten
(defun JB_ZBS:Dbox1:Draw:StreifenList:Int:RandKoordList (lList p1 p2 pk1 pk2 lk1 lk2 / STAT X Faktor)
  (setq Faktor(/ (distance p1 p2)(+(distance pk1 pk2)lk1 lk2)))
  (mapcar '(lambda(X)
	     (setq stat(* X Faktor))
	     (polar p1 (angle p1 p2)stat))
	  lList)
  )
		 

		 

;;;StreifenList - Rechteckkoordinaten pro Streifen
(defun JB_ZBS:Dbox1:Draw:StreifenList (FussPunktList pk1 pk2 lk1 lk2 b / P1A P1B P2A P2B PL PLO PLU PR PRO PRU X ALIST BLIST N W)

;;;  (mapcar '(lambda(X)
;;;	     (entmake (list (cons 0 "POINT")(cons 10 X)(cons 62 6)))
;;;	     )
;;;	  FussPunktList)
  
  (setq p1A(cdr(assoc "1A"(cdr(assoc "Kopf1" JB_ZBS$$List))))
	p1B(cdr(assoc "1B"(cdr(assoc "Kopf1" JB_ZBS$$List))))
	p2A(cdr(assoc "2A"(cdr(assoc "Kopf2" JB_ZBS$$List))))
	p2B(cdr(assoc "2B"(cdr(assoc "Kopf2" JB_ZBS$$List)))))

;;;  (if (<(distance (car FussPunktList)(JBf_list:MidPoint p1A p1B))
;;;	(distance (car FussPunktList)(JBf_list:MidPoint p2A p2B)))
;;;    (alert "erster fusspunkt bei Linie 1A-1B")
;;;    (alert "Falsch rumerster fusspunkt bei Linie 2A-2B")
;;;    
;;;    )
;;;
;;;  (exit)


  (setq Alist(JB_ZBS:Dbox1:Draw:StreifenList:Int FussPunktList pk1 pk2 lk1 lk2 p1A p1B p2A p2B )
	BList (cadr AList)
	AList (car AList))

  


  (setq n -1)
  
  (mapcar '(lambda(X)
	     (setq n (+ n 1))
	     (setq w(angle(nth n AList)(nth n BList)))
	     
	     (setq pl (polar X w 1)
		   pr (polar X (+ w pi)1)
		   plo (polar pl (- w (* 0.5 pi)) (* b 0.5))
		   plu (polar pl (+ w (* 0.5 pi))(* b 0.5))
		   pro (polar pr (- w (* 0.5 pi)) (* b 0.5))
		   pru (polar pr (+ w (* 0.5 pi))(* b 0.5)))

	     (setq plo (JB_ZBS:Dbox1:Draw:StreifenList:NextSP plo pro p1A p1B p2A p2B))
	     (setq plu (JB_ZBS:Dbox1:Draw:StreifenList:NextSP plu pru p1A p1B p2A p2B))
	     (setq pro (JB_ZBS:Dbox1:Draw:StreifenList:NextSP pro plo p1A p1B p2A p2B))
	     (setq pru (JB_ZBS:Dbox1:Draw:StreifenList:NextSP pru plu p1A p1B p2A p2B))

	     
;;;  (entmake (list (cons 0 "LINE")(cons 10 plu)(cons 11 pru)(cons 62 1)))
;;;  (entmake (list (cons 0 "LINE")(cons 10 pru)(cons 11 pro)(cons 62 3)))
;;;  (entmake (list (cons 0 "LINE")(cons 10 pro)(cons 11 plo)(cons 62 5)))
;;;  (entmake (list (cons 0 "LINE")(cons 10 plo)(cons 11 plu)(cons 62 6)))
	    
	     (list plu pru pro plo)
		   
	     )
	  FussPunktList)
  )

(defun JB_ZBS:Dbox1:Draw:vla-objPlList:Lotrecht (StreifenList / B P1 P2 PLM PRM X)
  (setq b (atof(cdr(assoc "JB_1_te1" Settings&dbox1))))
 (mapcar '(lambda(X)
	    (setq p1 (polar (car X)(+(angle (car X)(cadr X))(* 0.5 pi))(/ b 2.0)))
	    (setq p2 (polar (cadr X)(-(angle (cadr X)(car X))(* 0.5 pi))(/ b 2.0)))
	    (setq plm (inters (car X)(cadddr X)p1 p2 nil))
	    (setq prm (inters (cadr X)(caddr X)p1 p2 nil))
	    (list (polar plm (-(angle (car X)(cadr X))(* 0.5 pi))(/ b 2.0))
		  (polar prm (-(angle (car X)(cadr X))(* 0.5 pi))(/ b 2.0))
		  (polar prm (+(angle (car X)(cadr X))(* 0.5 pi))(/ b 2.0))
		  (polar plm (+(angle (car X)(cadr X))(* 0.5 pi))(/ b 2.0)))
	    )
	 StreifenList)
  )
  

;;;Die Polylinien erstellen
(defun JB_ZBS:Dbox1:Draw:vla-objPlList (StreifenList / COORDS COORDSARRAY VLA-OBJ X space layer)
  (setq space(JBf_VlaObjects:vla-space))
  (setq layer (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0)
		(vla-get-layer(vlax-ename->vla-object(cdr(assoc "obj"(cdr(assoc "Kopf1" JB_ZBS$$List))))))
		(getvar "CLAYER")))

  (if (=(cdr(assoc "JB_1_r3-4" Settings&dbox1))0);;;lotrecht von Achse
    (setq StreifenList (JB_ZBS:Dbox1:Draw:vla-objPlList:Lotrecht StreifenList))
    )
    
    
  (mapcar '(lambda(X)
	     (setq coords (apply 'append(mapcar 'JBf_list_xyz->xy X)))
	     (setq coordsArray (vlax-make-safearray vlax-vbDouble (cons 0 (- (length coords) 1))))
	     (vlax-safearray-fill coordsArray coords)
	     (setq vla-obj(vla-addLightweightPolyline (JBf_VlaObjects:vla-space)coordsArray))
	     (vla-put-closed vla-obj :vlax-true)
	     (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0)
	       (vla-put-layer vla-obj (vla-get-layer(vlax-ename->vla-object(cdr(assoc "obj"(cdr(assoc "Kopf1" JB_ZBS$$List)))))))
	       (vla-put-layer vla-obj (getvar "CLAYER")))
	     (vla-put-color vla-obj 256)
	     (vla-update vla-obj)
	     vla-obj)
	  StreifenList)
  )


;;;SOLIDS erstellen
(defun JB_ZBS:Dbox1:Draw:vla-objHatchList (vla-objPlList / LAYER SPACE VLA-ARRAY VLA-DICTSORTENTS VLA-HATCHNEW VLA-OBJHATCHLIST X)
  (setq space(JBf_VlaObjects:vla-space))
  (setq layer (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0)
		(vla-get-layer(vlax-ename->vla-object(cdr(assoc "obj"(cdr(assoc "Kopf1" JB_ZBS$$List))))))
		(getvar "CLAYER")))


  (setq vla-objHatchList
	 (mapcar '(lambda(X)
		    (setq vla-hatchNew(vla-AddHatch space acHatchPatternTypePredefined "SOLID" :vlax-false))
		    (vla-put-layer vla-hatchNew layer)
		    (vla-put-color vla-hatchNew 256)
		    (vla-AppendOuterLoop vla-hatchNew (vlax-safearray-fill(vlax-make-safearray vlax-vbObject '(0 . 0))(list X)))
		    (vla-update vla-hatchNew)
		    vla-hatchNew
		    )
		 vla-objPlList))

  (setq vla-array (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 (- (length vla-objHatchList)1)))vla-objHatchList))
  (or(and
       (not(zerop (vla-get-count (vla-getExtensionDictionary Space))))
       (not(vl-catch-all-error-p
	     (setq vla-DictSortents(vl-catch-all-apply 'vla-GetObject (list(vla-getExtensionDictionary Space) "ACAD_SORTENTS"))))
	   )
       )
     (setq vla-DictSortents(vla-AddObject (vla-getExtensionDictionary Space) "ACAD_SORTENTS" "ACDBSORTENTSTABLE"))
     )
  (vla-MoveToBottom vla-DictSortents vla-array)

  
  (if (=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")
    (progn
      (mapcar 'vla-delete vla-objPlList)
      (list vla-objHatchList nil)
      )
      
    (list vla-objHatchList vla-objPlList)
    )
  )

  
;;;DBox1, Zebrastreifen zeichnen
(defun JB_ZBS:Dbox1:Draw ( / B FUSSPUNKTLIST L LK1 LK2 NL_LIST PK1 PK2 STREIFENLIST VLA-OBJHATCHLIST VLA-OBJPLLIST)
  (setq pk1 (JBf_list:MidPoint (cdr(assoc "1A"(cdr(assoc "Kopf1" JB_ZBS$$List))))(cdr(assoc "1B"(cdr(assoc "Kopf1" JB_ZBS$$List))))))
  (setq pk2 (JBf_list:MidPoint (cdr(assoc "2A"(cdr(assoc "Kopf2" JB_ZBS$$List))))(cdr(assoc "2B"(cdr(assoc "Kopf2" JB_ZBS$$List))))))
  (setq lk1 (atof(cdr(assoc "JB_1_te2" Settings&dbox1))))
  (setq lk2 (if (=(cdr(assoc "JB_1_to3" Settings&dbox1))"1")
	      (atof(cdr(assoc "JB_1_te3" Settings&dbox1)))
	      (atof(cdr(assoc "JB_1_te2" Settings&dbox1))))) 
  (setq l (- (distance pk1 pk2)lk1 lk2))
  (setq b (atof(cdr(assoc "JB_1_te1" Settings&dbox1))))

  (setq pk1 (polar pk1 (angle pk1 pk2)lk1))
  (setq pk2 (polar pk2 (angle pk2 pk1)lk2))
  (setq NL_List (JB_ZBS:Dbox1:Draw:NL_List l b))
  (setq FussPunktList (JB_ZBS:Dbox1:Draw:FussPunktList pk1 pk2 NL_List))
  (setq StreifenList (JB_ZBS:Dbox1:Draw:StreifenList FussPunktList  pk1 pk2 lk1 lk2 b))
  (setq vla-objPlList (JB_ZBS:Dbox1:Draw:vla-objPlList StreifenList))
  (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1");;;wenn SOLIDS
    (setq vla-objHatchList(JB_ZBS:Dbox1:Draw:vla-objHatchList vla-objPlList)
	  vla-objPlList (cadr vla-objHatchList)
	  vla-objHatchList (car vla-objHatchList))
    )

  (setq vla-objList&DBox1 (list (cons "vlaHatch" vla-objHatchList)
				(cons "vlaPoly" vla-objPlList)))
  )

;;;Alle Objekte löschen mit Aktualisierung
(defun JB_ZBS:Dbox1:Delete ( / AWS X)
  (setq aws (ssadd))
  (mapcar '(lambda(X)
	     (ssadd X aws))
	  (mapcar 'vlax-vla-object->ename(apply 'append (mapcar 'cdr vla-objList&DBox1))))

  (if (/=(sslength aws)0)
    (JBf_aws:Vla-DeleteRefresh aws)
    )
  (setq vla-objList&DBox1 nil)
  
  )


;;;Wert eingeben
(defun JB_ZBS:DBox2 (wert&Dbox2 func&DBox2 Msg&DBox2 / A DCLID OK)
      
  (while  (not(member ok '(1 99)))
    (setq DclId(JBf_Dcl:Load_dialog JB_ZBS_$DCL$_File "JB_ZBS_2" JB_ZBS$DCL$_2_po))

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

    (setq ok (start_dialog))
    (unload_dialog DclId)
    )
  
  (if (= ok 1)
    wert&Dbox2
    )	 
  )


;;;DBox WertGet
(defun JB_ZBS:Dbox2:get ( / )
  (setq wert&Dbox2 (vl-string-subst "." ","(get_tile "JB_2_e1")))
  (or (car(eval func&DBox2))
      (alert Msg&DBox2))
  )

;;;DBox 2, acztioin
(defun JB_ZBS:Dbox2:action (key / )
  (cond ((= key "accept")
	 (if (JB_ZBS:Dbox2:get)
	   (setq JB_ZBS$DCL$_2_po (done_dialog 1))
	   (mode_tile "JB_2_e1" 2)))
	((= key "cancel")
	 (setq JB_ZBS$DCL$_2_po (done_dialog 99))
	 )
	)
  )


;;;DCL-Datei schreiben
(defun JB_ZBS:Dcl:Write ( / A  FILE)
  (if(and(setq JB_ZBS_$DCL$_File(vl-filename-mktemp (strcat "ZBS.dcl")))
         (setq file (open JB_ZBS_$DCL$_File "w")))
    (progn
    (mapcar '(lambda(A)
               (write-line A file))
      (mapcar '(lambda(A)
                 (strcat "\n" A))
        '(
                "JB_ZBS_1: dialog {label = \"Zebrastreifen\";"
                ":boxed_column {label = \"Optionen\";"
                ":radio_column {"
                ":radio_button {key = \"JB_1_r1\"; label = \"Layer von Begrenzung\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"aktueller Layer\";}"
                "}"
                ":toggle {key = \"JB_1_to1\"; label = \"SOLID-Flächenfüllung\";}"
                ":toggle {key = \"JB_1_to2\"; label = \"Außenkonturen löschen\";}"
                ":toggle {key = \"JB_1_to4\"; label = \"Ursprungs-(Poly)Linien löschen\";}"
                "}"
                ":boxed_column {label = \"Optionen seitliche Begrenzung\";"
                ":radio_column {"
                ":radio_button {key = \"JB_1_r3\"; label = \"lotrecht von Achse\";}"
                ":radio_button {key = \"JB_1_r4\"; label = \"bündig\";}"
                "}"
                "}"
                ":boxed_column {label = \"Optionen Zebrastreifen\";"
                ":row {"
                ":button {key = \"JB_1_be1\";width=20;label = \"&Breite[m]...\";}"
                ":text {key = \"JB_1_te1\"; width = 20; label = \"0.50\";}}"
                ":row {"
                ":button {key = \"JB_1_be2\";width=20;label = \"&Kopf-Abstand 1[m]...\";}"
                ":text {key = \"JB_1_te2\"; width = 20; label = \"0.20\";}}"
                ":toggle {key = \"JB_1_to3\"; label = \"unterschiedliche Kopf-Abstände\";}"
                ":row {"
                ":button {key = \"JB_1_be3\";width=20;label = \"Kopf-&Abstand 2[m]...\";}"
                ":text {key = \"JB_1_te3\"; width = 20; label = \"0.20\";}}"
                ":boxed_row {label = \"Anzahl Zebrastreifen\";"
                ":text {key = \"JB_1_t1\"; label = \"123\"; width = 20;}"
                ":button {key = \"JB_1_b2\"; label = \"+\";fixed_width=true;}"
                ":button {key = \"JB_1_b3\"; label = \"-\";fixed_width=true;}}"
                "}"
                ":row{fixed_width = true;alignment = centered;"
                ":retirement_button {label = \"&OK\"; key= \"accept\";fixed_width=true;is_default = true;}"
                ":spacer {width = 2;}"
                ":retirement_button {label = \"&Ende\"; key= \"cancel\";is_cancel = true; fixed_width=true;}"
                ":spacer {width = 2;}"
                ":button {key = \"JB_1_b1\"; label = \"&Zoom\";}"
                "}"
                "}"
                "JB_ZBS_2: dialog {label = \"Wert eingeben\";"
                ":edit_box {key = \"JB_2_e1\"; allow_accept=true;}"
                "ok_cancel;}"


          )))
    (close file)
    JB_ZBS_$DCL$_File)
    )
  )
;;;Aktueller Space für VLA-Kram
(defun JB_ZBS:CurrentSpace ( / )
  (if (or(= (strcase (getvar "CTAB")) "MODEL")
	   (/=(getvar "CVPORT")1))
      (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
      (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
  )

;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine verwaltungstechnische Funktionen							   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Fehlermeldung
;;;Fehlermeldung;;;
(defun JBf_Error  (s)
  (print (strcat "***Fehler*** " s))
  (JBf_Reinit))

;;;Initialisierungsfunktion
(defun JBf_init (InitVaris / )
  (setq	JB_Error *error*
        *error* JBf_Error)
  (vl-load-com)
  ;;;Systemvariablen aktuelle Einstellungen für ReInit speichern
  (setq JBf$ReInit$Varis
         (mapcar '(lambda(A)
                    (list (car A)(getvar (car A))))InitVaris))
  ;;;Vorgabeeistellungen für Systemvariablen
  (mapcar '(lambda(A)
             (if (cadr A)
               (setvar (car A)(cadr A))))InitVaris)
                   
                   
  )
;;;Reinitialisierung
(defun JBf_Reinit ( / n)
  ;;;Systemvariablen ReInitialisieren
  (mapcar '(lambda(A)
             (setvar (car A)(cadr A)))JBf$ReInit$Varis)
  (setq JBf$ReInit$Varis nil)
  (princ)
)
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Strings								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;benutzerspezifischer Pfad zum Speichern von Programmeinstellungen
(defun JBf_String:Userpfad:WinUser (UserPfad / )
  
  (setq UserList (JBf_String:Delimiter->List UserPfad "\\"))
  (setq Pfad (strcat "c:\\Users\\"(getvar "LOGINNAME")"\\"))
        

  ;;;wenn UserPfad noch nicht vorhanden, dann erstellen
  (mapcar '(lambda(A)
             (setq Pfad (strcat Pfad A "\\"))
             (if (not (JBf_String:FilePath? Pfad))
               (vl-mkdir Pfad)))
    UserList)
  Pfad
  )

;;;String anhand Trennzeichen in Liste zurückgeben
(defun JBf_String:Delimiter->List (Str Delim / StrList)
  (setq Str (vl-string-left-trim Delim Str)
	Str (vl-string-right-trim Delim Str))
  (if (vl-string-search Delim Str)
    (progn
      (while (vl-string-search Delim Str)
        (setq StrList (cons (substr Str 1 (vl-string-search Delim Str))StrList)
	      Str (vl-string-left-trim Delim(substr Str(+(vl-string-search Delim Str)(+ (strlen Delim)1))))))
      (if (/= Str "")
        (setq StrList (cons Str StrList))))
    (setq StrList (cons Str StrList)))
  (reverse StrList))

;;;Dateipfad prüfen
(defun JBf_String:FilePath? (Pfad / FSO TRUE-FALSE)
  (setq Pfad (if(vl-string-search "." Pfad)(car(fnsplitl  Pfad))Pfad))
  (if (setq FSO (vlax-create-object "Scripting.FilesystemObject"))
    (progn
      (if (vlax-method-applicable-p FSO 'FOLDEREXISTS)
        (setq TRUE-FALSE
               (=(vl-catch-all-apply
                   'vlax-invoke-method
                   (list FSO 'FOLDEREXISTS Pfad)):vlax-true))
        (vlax-release-object FSO))))
  TRUE-FALSE)

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


;;;Schnittpunkte zweier Linienobjekte
(defun JBf_List:ObjSchnitt (obj1 obj2 / SpArray)

  (setq SpArray (vlax-invoke-method (vlax-ename->vla-object obj1)
                                    'IntersectWith
                                    (vlax-ename->vla-object obj2) acExtendNone
                )
  )

  (if (/= -1 (vlax-safearray-get-u-bound (vlax-variant-value SpArray) 1))
    (JBf_List:ObjSchnitt:ArrayList->List (vlax-safearray->list (vlax-variant-value SpArray)) 3)
  )
)

;;;ArrayList in normale Liste
(defun JBf_List:ObjSchnitt:ArrayList->List (ArrayList i / A N RETLIST SUBLIST)
  (setq n 0)
  (mapcar '(lambda (A)
                   (setq n (+ n 1)
                         subList (cons A subList)
                   )
                   (if (= n i)
                     (setq retList (cons (reverse subList) retList)
                           n 0
                           subList nil
                     )
                   )
           )
          ArrayList
  )
  retList
  )
(defun JBf_list_xyz->xy (list_xyz / )
  (if (>(length list_xyz)2)
    (reverse(cdr(reverse list_xyz)))
  list_xyz))
;;Arithmetisches Mittel zweier Koordinaten
(defun JBf_list:MidPoint (p1 p2 /)
  (mapcar '(lambda (X)
                   (/ X 2.0)
           )
          (mapcar '+ p1 p2)
  )
)


;;;Arithmetisches Mittel zweier Koordinaten
(defun JBf_list:MidPoint (p1 p2 /)
  (mapcar '(lambda (X)
                   (/ X 2.0)
           )
          (mapcar '+ p1 p2)
  )
)




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


;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => VLA				 						   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun JBf_VlaObjects:vla-space ( / )
  (if (or(= (strcase (getvar "CTAB")) "MODEL")
	 (/=(getvar "CVPORT")1))
    (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
    (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
  )


;;;--------------------------------------------------------------------------------------------------------
;;;Setzen von "TrustedPaths's" ab ACAD  2014								   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Prüfen, ob bereits TrustedPaths in der aktuelle Version verwendet werden können
(defun JBf_AcadSystem:TrustedPaths? ( / )
  (and (= "ACAD" (strcase (getvar "PROGRAM"))) (getvar "SECURELOAD"))
  )

;;;Pfadangaben immer mit BackSlashes, "\\..." hinten angestellt, damit alle untergeordneten Verzeichnisse berücksichtigt werden
(defun JBf_AcadSystem:TrustedPaths:Add (pfad / TRUSTEDPATHS)
  (setq TrustedPaths(if (getvar "TRUSTEDPATHS")(getvar "TRUSTEDPATHS")""))
  (if(not(member (strcase pfad)(mapcar 'strcase (JBf_AcadSystem:TrustedPath:Split TrustedPaths))))
    (setvar "TRUSTEDPATHS"(strcat TrustedPaths ";" pfad)))
  )

;;;Pfad entfernen
(defun JBf_AcadSystem:TrustedPaths:Delete (pfad / A TRUSTEDPATHS)
  (setq TrustedPaths(if (getvar "TRUSTEDPATHS")(getvar "TRUSTEDPATHS")""))
  (setvar "TRUSTEDPATHS"
	  (vl-string-right-trim ";"(apply 'strcat(mapcar '(lambda(A)
							   (strcat A ";"))
							(vl-remove-if 'not (mapcar '(lambda(A)
										      (if(/= (strcase pfad)(strcase A))A))
										   (JBf_AcadSystem:TrustedPath:Split TrustedPaths)))))))
  )		     

;;;String splitten an Semikolons, als Liste zurückgeben
(defun JBf_AcadSystem:TrustedPath:Split (TrustedPaths / A RETLIST TEMP)
  (mapcar '(lambda(A)
	     (if (/= A 59)
	       (setq temp (cons A temp))
	       (setq RetList (cons (vl-list->string(reverse temp))RetList)
		     temp nil))
	     )
	     (vl-string->list TrustedPaths))
  (if temp
    (setq RetList (cons (vl-list->string (reverse temp))RetList)))
  (reverse RetList))

;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Dcl									   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;DCL-Dialogfenster laden
(defun JBf_Dcl:Load_dialog (FileName DialogName JB_$DCL$_x_po / DclId)
  (setq DclId (load_dialog FileName))
  (if	JB_$DCL$_x_po
    (if (not (new_dialog DialogName DclId "" JB_$DCL$_x_po))
      (exit))
    (if (not (new_dialog DialogName DclId))
      (exit)))
  DclId
  )
;;;--------------------------------------------------------------------------------------------------------
;;;Info für Textfenster nach dem laden des Programms							   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|ZebraStreifen: Erzeugen von 2D-Zebrastreifen.               |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: ZBS oder ZEBRASTREIFEN.                |"
	  "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )

(princ)










    

