;;;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:HDI (HoehenDifferenzen)						        	           
;;;													   
;;;A) Es werden Blöcke "HDI" mit 4 Attributen in ein Ursprungs-WKS/BKS eingefügt			   
;;;1. HOEHE1 => Ursprungshöhe										   
;;;2. HDIFF => bleibt erstmal leer									   
;;;3. HOEHE2 => Höhe aus Vergleichs-BKS									   
;;;4. PNR => optionale Punktnummer kann aus vorh. Blöcken übernommen werden oder ab einer Nummer	   
;;;          hochgezählt werden										   
;;;B) Es manuell ein neues BKS erstellt.								   
;;;C) Es werden die Attribute HDIFF und HOEHE2 mit den Werten entsprechend des neuen BKS's gefüllt.   	   
;;;													   
;;;													   
;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_HDI$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;                                                                              Jörn Bosse, 20.05.25      
;;;--------------------------------------------------------------------------------------------------------




;;;aufrufenden Funktionen
(defun c:HDI ( / )
  (JB_HDI)
  )

(defun c:HoehenDifferenzen ( / )
  (JB_HDI)
  )

;;;Definition der v_liste, wenn noch nicht vorhanden
(defun JB_HDI:v_liste ( / )  
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (                             
                             ("JB_1_e1" . 2);;;0 = Nachkommastellen as INT
			     ("JB_1_to1" . "1");;;Punktnummer
			     ("JB_1_r1-2" . 0);;;0 = Punktnummer ab, 1 = aus Attribut
			     ("JB_1_e2" . 1);;;Punktnummer ab As INT
			     ("JB_1_r3-4" . 1);;;0 = Einfügen auf Blöcke, 1 = Einfügen auf Punkte
			     ("JB_1_t1" . nil);;;Blockname, auf dem einfügt werden soll
			     ("JB_1_p1" . nil);;;Attributname für die Punktnummer
			     ("JB_1_e3" . "0.25");;;Einfügefaktor
                             )
                          )
			 
                         )
      ))
  )

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

 

(defun JB_HDI:Intro ( / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n---------------------HDI(1.0), 20.05.25----------------------")
  (princ "\nHoehenDifferenzen: Höhendifferenz in Attribut.               ")
  (princ "\n-------------------------------------------------------------")
  )


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

  (setq pfad_ini (JB_HDI: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_HDI:v_liste))pfad_ini nil))
  
  
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))  
  
  (JB_HDI:Intro)

  
  (if (not
            (or (and JB_HDI_$DCL$_File(findfile JB_HDI_$DCL$_File))
                (setq JB_HDI_$DCL$_File (JB_HDI:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))
  (JB_HDI:Dbox1 v_liste pfad_ini)
      
   
  (princ "\nEnde.")
  (JBf_Reinit)
  
  
  (princ)
  

)



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


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

  
;;;Liste p1 mit Attributen
(defun JB_HDI:Dbox1:p1 ( / VLA-ATTLIST)
  (setq p1&DBox1 nil
	p1_sel&Dbox1 nil)
  (if(and(cdr(assoc "JB_1_t1" Settings&dbox1))
	 (tblsearch "BLOCK" (cdr(assoc "JB_1_t1" Settings&dbox1))))
    (setq vla-attList(JBf_list_att_aus_vla-blockdef(cdr(assoc "JB_1_t1" Settings&dbox1)))))

  (if  vla-attList
    (progn
      (setq p1&DBox1(mapcar 'vla-get-TagString vla-attList))
      (if (and (cdr(assoc "JB_1_p1" Settings&dbox1))
	       (member(cdr(assoc "JB_1_p1" Settings&dbox1))p1&DBox1))
	(setq p1_sel&Dbox1 (- (length p1&DBox1)(length(member(cdr(assoc "JB_1_p1" Settings&dbox1))p1&DBox1))))
	(setq p1_sel&Dbox1 0
	      Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (car p1&DBox1)"JB_1_p1"))
	)
      )
    )
  )


;;;DBox 1
(defun JB_HDI:Dbox1(v_liste pfad_ini / A DCLID OK P1&DBOX1 P1_SEL&DBOX1 SETTINGS&DBOX1 )

  (setq Settings&Dbox1 (JB_HDI:v_liste:DboxSettings:get "Dbox1" v_liste))

  (JB_HDI:Dbox1:p1)
  
    
  (while  (not(member ok '(1 99)))

    (setq DclId(JBf_Dcl:Load_dialog JB_HDI_$DCL$_File "HDI_1" JB_HDI$DCL$_1_po))
    
    (JB_HDI:Dbox1:set)
    (JB_HDI:Dbox1:mode)
           
    (mapcar '(lambda(A)(action_tile A (strcat "(JB_HDI:Dbox1:action \""A"\")")))
      '("JB_1_r1" "JB_1_r2" "JB_1_r3" "JB_1_r4" "JB_1_to1" "JB_1_p1" "JB_1_b1" 
        "accept" "cancel"))

    (setq ok (start_dialog))
    (unload_dialog DclId)

     (setq v_liste (JB_HDI:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
    (JBf_SIC:sichern v_liste pfad_ini nil)


    ;;;Prüfung der Eingabefelder
    (if (= ok  1)
      (cond ((or (< (cdr(assoc "JB_1_e1" Settings&dbox1))0)
		 (> (cdr(assoc "JB_1_e1" Settings&dbox1))12)
		 )
	     (setq error&Dbox1 "e1")
	     (setq ok -1)
	     (alert "Die Anzahl der Nachkommastellen muss zwischen 0 und 12 liegen.")
	     )
	    ((<=(atof(cdr(assoc "JB_1_e3" Settings&dbox1)))0)	
	     (setq error&Dbox1 "e3")
	     (setq ok -1)
	     (alert "Der Faktor muss größer Null sein.")
	     )
	    )
      )
   
    (cond((= ok 1);;;Blöcke einfügen	  
	 (if(JB_HDI:Dbox1:insert)
	   (progn
	     (setq v_liste (JB_HDI:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
	     (JBf_SIC:sichern v_liste pfad_ini nil)
	     )
	   )
	   
	  )
	 
	 ((= ok 11);;;Blöcke aus Zeichnung picken
	  (JB_HDI:Dbox1:pick)
	  )
	 )
    )
  )


;;;Dbox 1, getten
(defun JB_HDI:Dbox1:get ( / )
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi(get_tile "JB_1_e1"))"JB_1_e1")
	Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi(get_tile "JB_1_e2"))"JB_1_e2")
	Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vl-string-subst "." ","(get_tile "JB_1_e3"))"JB_1_e3"))
  )
  


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

  (cond ((= key "JB_1_r1")
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (- 1 (atoi $value))"JB_1_r1-2"))
	 (JB_HDI:Dbox1:mode)         
         )
	((= key "JB_1_r2")
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi $value)"JB_1_r1-2"))
	 (JB_HDI:Dbox1:mode)         
         )
	((= key "JB_1_to1")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to1"))
	 )

	((= key "JB_1_p1")
	 (setq p1_sel&DBox1 (atoi $value))
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (nth p1_sel&DBox1 p1&Dbox1)"JB_1_p1"))
	 )
	
	((= key "JB_1_r3")
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (- 1 (atoi $value))"JB_1_r3-4"))
	(JB_HDI:Dbox1:mode)
         )
	((= key "JB_1_r4")
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi $value)"JB_1_r3-4"))
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 0 "JB_1_r1-2"))
	 (JB_HDI:Dbox1:set)
	 (JB_HDI:Dbox1:mode)	 
         )
	((= key "JB_1_b1")
	 (JB_HDI:Dbox1:get)
         (setq JB_HDI$DCL$_1_po (done_dialog 11))
         )
	((= key "cancel")
	 (JB_HDI:Dbox1:get)
         (setq JB_HDI$DCL$_1_po (done_dialog 99))
         )
	((= key "accept")
	 (JB_HDI:Dbox1:get)
         (setq JB_HDI$DCL$_1_po (done_dialog 1))
         )
        )

  
  )

         
     
;;;Dbox1; Werte setzen 
(defun JB_HDI:Dbox1:set ( / A X)
  (mapcar '(lambda(A)
             (set_tile (strcat "JB_1_"(car A))(cadr A)))
    (list
      (list "e1" (itoa(cdr(assoc "JB_1_e1" Settings&dbox1))))
      (list "e2" (itoa(cdr(assoc "JB_1_e2" Settings&dbox1))))
      (list "e3" (cdr(assoc "JB_1_e3" Settings&dbox1)))
      (list "r1" (itoa(- 1(cdr(assoc "JB_1_r1-2" Settings&dbox1)))))
      (list "r2" (itoa(cdr(assoc "JB_1_r1-2" 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 "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
      (list "t1" (if(cdr(assoc "JB_1_t1" Settings&dbox1))(cdr(assoc "JB_1_t1" Settings&dbox1))""))
      ))

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


;;;DBOX 1, moden
(defun JB_HDI:Dbox1:mode ( / )
  
  (if (=(cdr(assoc "JB_1_r3-4" Settings&dbox1))0);;;wenn  auf Blöcke einfügen
    (progn
      (if p1&DBox1
	(progn
	  (mode_tile "JB_1_r1" 0)
	  (mode_tile "JB_1_r2" 0))
	(progn
	  (mode_tile "JB_1_r1" 1)
	  (mode_tile "JB_1_r2" 1))
	)
      (mode_tile "JB_1_b1" 0)
      (mode_tile "JB_1_t1" 0)
      (if p1&DBox1
	(mode_tile "JB_1_p1" 0)
	(mode_tile "JB_1_p1" 1)
	)
      
      )
    (progn
      (mode_tile "JB_1_r1" 1)
      (mode_tile "JB_1_r2" 1)
      (mode_tile "JB_1_b1" 1)
      (mode_tile "JB_1_t1" 1)
      (mode_tile "JB_1_p1" 1)
      
      )
    )

  (if (= (cdr(assoc "JB_1_r1-2" Settings&dbox1))0)
    (progn
      (mode_tile "JB_1_e2" 0)
      (mode_tile "JB_1_e2" 2)
      )
    (mode_tile "JB_1_e2" 1)
    )
  (if error&Dbox1
    (progn
      (mode_tile (strcat "JB_1_" error&Dbox1)2)
      (setq error&Dbox1 nil)
      )
    )
  )




;;;DCL-Datei schreiben
(defun JB_HDI:Dcl:Write ( / A  FILE)
  (if(and(setq JB_HDI_$DCL$_File(vl-filename-mktemp (strcat "HDI.dcl")))
         (setq file (open JB_HDI_$DCL$_File "w")))
    (progn
    (mapcar '(lambda(A)
               (write-line A file))
      (mapcar '(lambda(A)
                 (strcat "\n" A))
        '(
                "//Hauptdialog"
                "HDI_1: dialog {label = \"Höhendifferenzen\";"
                ":boxed_column {label = \"Blöcke einfügen im WKS/BKS\";"
                ":edit_box {key =\"JB_1_e1\"; label = \"Nachkommastellen\";edit_width = 15;}"
                ":column {label = \"Punktnummer\";"
                ":toggle {key = \"JB_1_to1\";}"
                ":radio_row {"
                ":radio_button {key = \"JB_1_r1\"; label = \"ab\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"aus Attribut\";}}"
                ":edit_box {key =\"JB_1_e2\"; label = \"Puntnummer ab\";edit_width = 15;}"
                "}"
                ":radio_row {label = \"Einfügen auf\";"
                ":radio_button {key = \"JB_1_r3\"; label = \"Blöcke\";}"
                ":radio_button {key = \"JB_1_r4\"; label = \"Punkte\";}}"
                ":column {label = \"vorhandene Blöcke\";"
                ":button {key = \"JB_1_b1\"; label = \"&Block<\";fixed_width = true;}"
                ":text {key = \"JB_1_t1\"; label = \"MeinBlockName\";width = 30;}"
                ":popup_list{key = \"JB_1_p1\";label = \"Attribut für Punktnummer\";edit_width=15;}"
                ":spacer {height=1;}"
                "}"
                ":edit_box {key =\"JB_1_e3\"; label = \"Faktor\";edit_width = 15;}"
                "}"
                ":row {fixed_width = true;alignment = centered;"
                ":button {label = \"&Einfügen<\";  key= \"accept\";is_default=true;}"
                ":spacer {width = 2;}"
                ":button {label = \"&Ende\";  key= \"cancel\";is_cancel=true;}"
                "}}"


          )))
    (close file)
    JB_HDI_$DCL$_File)
    )
  )


;;;Block picken
(defun JB_HDI:Dbox1:pick ( / AWS VLA-OBJ)
  (if (and (princ "\nPicken Sie einen Block:")
	   (setq aws (ssget "_:S"(list (cons 0 "INSERT"))))
	   (setq vla-obj(vlax-ename->vla-object(ssname aws 0))))
    (progn
      (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vla-get-Effectivename vla-obj)"JB_1_t1"))
      (JB_HDI:Dbox1:p1)
      )
    )
  )

;;;Blockdefinition, wenn  noch nicht vorhanden
(defun JB_HDI:Dbox1:insert:BlockDef ( / )
  (if (not(tblsearch "BLOCK" "HDI"))
    (progn
      (entmake '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "HDI-ARIAL") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "arial.ttf") (4 . "")))      
      (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "HDI-Block-DIFF") (70 . 0) (62 . 1) (6 . "Continuous") (290 . 1)))
      (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "HDI-Block-PNR") (70 . 0) (62 . 7) (6 . "Continuous") (290 . 1)))
      (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "HDI-Block") (70 . 0) (62 . 1) (6 . "Continuous") (290 . 1)))
      (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "0") (70 . 0) (62 . 7) (6 . "Continuous") (290 . 1)))
      (entmake '((0 . "BLOCK") (2 . "HDI") (70 . 2) (4 . "") (10 0.0 0.0 0.0)))
      (entmake '((0 . "POINT") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 0) (100 . "AcDbPoint") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (50 . 0.0)))
      
      (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "HDI-Block-PNR") (100 . "AcDbText") (10 1.0 2.85 0.0) (40 . 1.8) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "HDI-ARIAL")
		 (71 . 0) (72 . 0) (11 1.0 3.75 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Punkt-Nr.") (2 . "PNR") (70 . 0) (73 . 0) (74 . 2) (280 . 0)))  
      
      (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "HDI-Block-DIFF") (100 . "AcDbText") (10 1.0 0.1 0.0) (40 . 1.8) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "HDI-ARIAL")
		 (71 . 0) (72 . 0) (11 1.0 1.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Differenz zur xy-Ebene") (2 . "DIFF") (70 . 0) (73 . 0) (74 . 2) (280 . 0)))      
      
      (entmake (list '(0 . "endblk")'(8 . "0")))
      )
    )
  )
  


;;;Blöcke Einfügen
(defun JB_HDI:Dbox1:insert ( / ATTLIST AWS FILTERLIST MSG N PNR VLA-ATTLIST VLA-OBJ X SaveFlag z)
  (JB_HDI:Dbox1:insert:BlockDef)
  (if (=(cdr(assoc "JB_1_r3-4" Settings&dbox1))0)
    (setq FilterList(list '(0 . "INSERT")(cons 2 (cdr(assoc "JB_1_t1" Settings&dbox1))))
	  Msg (strcat "\nWählen Sie Blöcke \"" (cdr(assoc "JB_1_t1" Settings&dbox1))"\" aus:"))
    (setq FilterList '((0 . "POINT"))
	  Msg "\nWählen Sie Punkte aus:")
    )
   
  (if (and (princ Msg)
	   (setq aws(ssget FilterList)))
   (progn

     (JBf_progress_01:DBox:Start "Höhendifferenzen: Blöcke einfügen" (sslength aws)  nil)
     (setq n 0)
     (repeat (sslength aws)
       (JBf_progress_01:DBox:Fortschritt)
       (setq vla-obj (vlax-ename->vla-object(ssname aws n)))
       (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"1");;;wenn PNR
	 (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0)
	   (setq Pnr (cdr(assoc "JB_1_e2" Settings&dbox1))
		 Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (+(cdr(assoc "JB_1_e2" Settings&dbox1))1)"JB_1_e2")
		 SaveFlag 'T)
	   (if (and (cdr(assoc "JB_1_p1" Settings&dbox1))
		    (member (strcase(cdr(assoc "JB_1_p1" Settings&dbox1)))(mapcar 'car(setq vla-attList(JBf_list_att_aus_block_vla-obj vla-obj)))))
	     (setq Pnr (vla-get-TextString (cadr(assoc (strcase(cdr(assoc "JB_1_p1" Settings&dbox1)))vla-attList))))
	     (setq Pnr nil)
	     )
	   )
	 (setq pnr nil))
       (setq z(caddr(trans(vlax-get vla-obj
				    (if(=(cdr(assoc "JB_1_r3-4" Settings&dbox1))0)
				      'InsertionPoint
				      'Coordinates)
				    )0 1)))
       (cond ((> z 0.0)
	      (setq z (strcat "+" (rtos z 2 (cdr(assoc "JB_1_e1" Settings&dbox1))))))
	     ((< z 0.0)
	      (setq z (rtos z 2 (cdr(assoc "JB_1_e1" Settings&dbox1)))))
	     ('T
	      (setq z (strcat "%%p" (rtos z 2 (cdr(assoc "JB_1_e1" Settings&dbox1)))))))
	      
       (setq vla-attList(JBf_list_att_aus_vla-blockdef "HDI"))
       (setq AttList (mapcar '(lambda(X)
				(list (vla-get-TagString X)
				      (list(list 'TextString
						 (cond ((= (vla-get-TagString X)"PNR")
							(if pnr pnr ""))
						       ((= (vla-get-TagString X)"DIFF")
							z))
						 )
					   )))vla-attList))
       (JBf_VlaAdd:AddBlock
	 "HDI"
	 (vlax-3d-point (vlax-get vla-obj
				  (if(=(cdr(assoc "JB_1_r3-4" Settings&dbox1))0)
				    'InsertionPoint
				    'Coordinates)))
	 (atof(cdr(assoc "JB_1_e3" Settings&dbox1)))
	 "HDI-Block"
	 0.0
	 (vlax-3d-point (trans'(0.0 0.0 1.0)1 0))
	 AttList
	 'T;;;FeldBlockerFlag
	 )
       (setq n (+ n 1))
       )

     (JBf_progress_01:DBox:End)

       )
     )
  SaveFlag)

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


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

;;;Att_liste aus vla-object
(defun JBf_list_att_aus_vla-blockdef (name / LISTE)
  (if name
  (if (tblsearch "BLOCK" name)
    (progn
  (vlax-for ITEM
    (vla-item
      (vla-get-blocks
        (vla-get-activedocument
          (vlax-get-acad-object)))name)
    (if (= (vla-get-Objectname ITEM) "AcDbAttributeDefinition")
      (setq liste (cons ITEM liste))))
  (reverse liste)))))




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


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



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



;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => ProgressBar 							   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Progress_01-INI => es wird die DCL-Datei geschrieben!
(defun JBf_progress_01:Ini ( / )
  (if (not
        (or (and JBf_progress_01$DCL$_File(findfile JBf_progress_01$DCL$_File))
            (setq JBf_progress_01$DCL$_File (JBf_progress_01:DclWrite))))
            (progn
              (alert "Die DCL-Datei konnte nicht geschrieben werden.")
              (exit)))
)

;;;DCL-Datei schreiben
(defun JBf_progress_01:DclWrite (/ A FILE)
  (if (and (setq JBf_progress_01$DCL$_File (vl-filename-mktemp (strcat "JBf_progress_01.dcl")))
           (setq file (open JBf_progress_01$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              '(


                 "JBf_Progress_01_1 : dialog {key = \"JB_1_d\";label = \"\"; spacer;"
                 ":row{"
                 ":text{key = \"JB_1_t1\"; label = \"\";}"
                 ":image {key = \"cancel\";is_cancel=true;width = 0.5; height = 0.5;fixed_width = true;fixed_height = true;aspect_ratio = 1; color = -15;vertical_margin = none;}}"
                 ":row{"
                 ":column{"
                 ":spacer{ height = 0.12; fixed_height = true;}"
                 ":image{key = \"JB_1_i1\";width = 58.92; fixed_width = true;height = 1.51; fixed_height = true;aspect_ratio = 1;color = -15; vertical_margin = none;}"
                 "       }"
                 "//spacer;}"
                 "}"
                 ":text {key = \"JB_1_t3\";label = \"\";}"
                 ":row {"
                 ":text{key = \"JB_1_t2\";label = \"\";}"
                 "     }"
                 "//ok_only;"
                 "}"
                 "JBf_Progress_01_Counter_1 : dialog {key = \"JB_1_d\";label = \"\"; spacer;"
                 ":row{"
                 ":image{key = \"JB_1_i1\";width = 4; fixed_width = true;height = 2; fixed_height = true;aspect_ratio = 1;color = -15; vertical_margin = none;}"
                 ":text_part{key = \"JB_1_t1\"; label = \"Zeile\";width=20;}"
                 ":text_part{key = \"JB_1_t2\";label= \"1\";width=6;}"
                 ":image {key = \"cancel\";is_cancel=true;width = 0.5; height = 0.5;fixed_width = true;fixed_height = true;aspect_ratio = 1; color = -15;vertical_margin = none;}"
                 "}"
                 "//ok_only;"
                 "}"
                 "JBf_Progress_01_Counter_2 : dialog {key = \"JB_1_d\";label = \"\"; spacer;"
                 ":row{"
                 ":image{key = \"JB_1_i1\";width = 5.42; height = 2.51; fixed_height = true;aspect_ratio = 1;color = -15; vertical_margin = none;}"
                 ":text_part{key = \"JB_1_t1\"; label = \"Zeile\";width=20;}"
                 ":text_part{key = \"JB_1_t2\";label= \"1\";width=20;}"
                 ":image {key = \"cancel\";is_cancel=true;width = 0.5; height = 0.5;fixed_width = true;fixed_height = true;aspect_ratio = 1; color = -15;vertical_margin = none;}"
                 "}"
                 "//ok_only;"
                 "}"




               )
              )
      )
      (close file)
      JBf_progress_01$DCL$_File
    )
  )
)

;;;Prozenzwert aus l (Gesamtlänge) und n (aktueller Stand)
(defun JBf_progress_01:prz (l n / )
  (/(* n 100)l)
)

;;;Standard-ProgressBar starten
(defun JBf_progress_01:DBox:Start (Titel l msg /)
  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (JBf_progress_01:Ini)
      (setq JBf_progress_01$$dat (load_dialog JBf_progress_01$DCL$_File))
      (if (not (new_dialog "JBf_Progress_01_1" JBf_progress_01$$dat "" '(-1 -1))) (exit))

      (if Titel (set_tile "JB_1_d" Titel))
      (if msg (set_tile "JB_1_t3" msg))

      (setq JBf_progress_01$$Xi1 (1- (dimx_tile "JB_1_i1")))
      (setq JBf_progress_01$$Yi1 (1- (dimy_tile "JB_1_i1")))

      (JBf_progress_01:DBox:Start:i1:Frame)
      (if redraw_dialog (redraw_dialog)) ;; bricsys - if new "redraw_dialog" is available

      (setq JBf_progress_01$$n 0)
      (setq JBf_progress_01$$l l)
      (setq JBf_progress_01$$prz 0)
      
    )
  )
)



;;;Standard-ProgressBar Fortschritt
(defun JBf_progress_01:DBox:Fortschritt (/ prz)
  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (setq JBf_progress_01$$n (+ JBf_progress_01$$n 1))
      (if (= JBf_progress_01$$n JBf_progress_01$$l)
        (setq prz 100)
        (setq prz (JBf_progress_01:prz JBf_progress_01$$l JBf_progress_01$$n))
      )

      
      (if (> prz JBf_progress_01$$prz)
        (progn
          (set_tile "JB_1_t1" (strcat "(" (itoa JBf_progress_01$$n) " von " (itoa JBf_progress_01$$l) ")"))
          (JBf_progress_01:DBox:Start:i1:Balken prz)
          (set_tile "JB_1_t2" (strcat (itoa prz) "% erledigt."))
          (if redraw_dialog (redraw_dialog)) ;; bricsys - if new "redraw_dialog" is available
          (setq JBf_progress_01$$prz prz)
        )
      )
                                     
    )
  )
)



;;;Beenden der ProgressBar
(defun JBf_progress_01:DBox:End (/)
  (if (not JB_Bosse_tools$$DebugModus)
    (progn
      (done_dialog)
      ;(start_dialog)
      (if JBf_progress_01$$dat
        (progn
          (unload_dialog JBf_progress_01$$dat)
          (setq JBf_progress_01$$dat nil
                JBf_progress_01$$Xi1 nil
                JBf_progress_01$$Yi1 nil
                
                JBf_progress_01$$n nil
                JBf_progress_01$$l nil
                JBf_progress_01$$prz nil
          )
        )
      )
    )
  )
)



  
;;;Rahmen zeichnen
(defun JBf_progress_01:DBox:Start:i1:Frame (/ i1X i1Y)
  
   (setq i1X JBf_progress_01$$Xi1
        i1Y JBf_progress_01$$Yi1
  )
  (start_image "JB_1_i1")
  (vector_image 1 4 4 1 8)
     (vector_image 4 1 (- i1X 4) 1 8)
	     
	     (vector_image (- i1X 4) 1 (- i1X 1) 4 8)
	     
	     (vector_image (- i1X 1) 4 (- i1X 1) (- i1Y 4) 8)
	     
	     (vector_image (- i1X 1) (- i1Y 4) (- i1X 4) (- i1Y 1) 8)
	     
	     (vector_image (- i1X 4) (- i1Y 1) 4 (- i1Y 1) 8)
	     
	     (vector_image  4 (- i1Y 1) 1 (- i1Y 4) 8)
	     (vector_image  1 (- i1Y 4) 1 4 8)
  (end_image)
)

;;;ProgressBalken im Aufbau 
(defun JBf_progress_01:DBox:Start:i1:Balken (prz / i1X i1Y)

(if (= 100 prz)
    (setq i1X (- JBf_progress_01$$Xi1 7))
    (setq i1X (atoi(rtos(+(*(/(- JBf_progress_01$$Xi1 7)100.0)prz)2)2 0)))
    )
  (setq i1Y JBf_progress_01$$Yi1)
  
  (start_image "JB_1_i1")
  (fill_image 4 4 i1X (- i1Y 7) 74)

  (end_image)
  )



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

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|HoehenDifferenzen: Höhendifferenz in Attribut.              |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: HDI oder HOEHENDIFFERENZ               |"
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )

(princ)



