;;;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:LFT (LayerFrier-Tool)						        	           
;;;													   
;;;Es werden Layer von zu pickenden oder auszuwählenden Objkten gefroren. Für die Layerauswahl von Blöcken 
;;;gibt es ein Einstellungs-Dialogfenster, so dass Attributlayer, Objektlayer und Einfügelayer gesondert   
;;;betrachtet werden können.										   
;;;													   
;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_LFT$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;                                                                              Jörn Bosse, 03.03.17      
;;;--------------------------------------------------------------------------------------------------------
;;;V(1.0a) 07.03.17
;;;- Vertauschen der Eingabefelder für Stationierung und Höhe
;;;- Skalierung des Attribut-Blockes über Command
;;;- Schnittpunkt mit Polylinie über Schnittpunkt mit temporärer Linie berechnen, damit auch Beschriftungen korrekt positioniert werden, die nicht exakt auf der Polylinie gepickt werden.
;;;- Systemvariable OSNAPCOORD für die Laufzeit auf 1 setzen



;;;aufrufenden Funktionen
(defun c:LFT ( / )
  (JB_LFT nil)
  )

(defun c:LFTE ( / )
  (JB_LFT 'T)
  )

(defun c:LayerFrierTool ( / )
  (JB_LFT nil)
  )

;;;Definition der v_liste, wenn noch nicht vorhanden
(defun JB_LFT:v_liste ( / )  
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (                             
                             ("JB_1_r1-2" . 0);;;0 = Objekte picken; 1 = Mehrfachauswahl
			     ("JB_1_to1" . "1");;;Attributlayer aus Blöcken
			     ("JB_1_to2" . "0");;;Objektlayer aus Blöcken
			     ("JB_1_r3-4" . 0);;;0 = Block-Auswahl-Layer-Dialog; 1 = bei Blöcken nur Einfügelayer
                             )
                          )
			 ( "Dbox2" .
                            (                             
                             ("JB_2_l1" . 1);;;Einfügelayer: 1 = alle, -1 = keine, 0 = individuelle Auswahl
			     ("JB_2_l2" . 1);;;Einfügelayer: 1 = alle, -1 = keine, 0 = individuelle Auswahl
			     ("JB_2_l3" . 1);;;Einfügelayer: 1 = alle, -1 = keine, 0 = individuelle Auswahl
			     
                             )
                          )
                         )
      ))
  )

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

 

(defun JB_LFT:Intro ( / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n---------------------LFT(1.0), 25.03.25----------------------")
  (princ "\nLayerFrier-Tool: Layer von Objekten frieren.                 ")
  (princ "\n-------------------------------------------------------------")
  )


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

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

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

)



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


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

  



;;;DBox 1
(defun JB_LFT:Dbox1(v_liste pfad_ini / A DCLID OK Settings&Dbox1)

  (setq Settings&Dbox1 (JB_LFT:v_liste:DboxSettings:get "Dbox1" v_liste))
  
    
  (while  (not(member ok '(1 99)))

    (setq DclId(JBf_Dcl:Load_dialog JB_LFT_$DCL$_File "LFT_1" JB_LFT$DCL$_1_po))
    
    (JB_LFT:Dbox1:set)
    (JB_LFT:Dbox1:mode)
           
    (mapcar '(lambda(A)(action_tile A (strcat "(JB_LFT:Dbox1:action \""A"\")")))
      '("JB_1_r1" "JB_1_r2" "JB_1_r3" "JB_1_r4" "JB_1_to1" "JB_1_to2"
        "accept" "cancel"))

    (setq ok (start_dialog))
    (unload_dialog DclId)

     (setq v_liste (JB_LFT:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
    (JBf_SIC:sichern v_liste pfad_ini nil)
   
    (if(= ok 1);;;Objekte picken / Auswählen
      (JB_LFT:Dbox1:exe v_liste pfad_ini)
      )
    )
  )

  

;;;Action (Variable global in Aufrufender Funktion)
(defun JB_LFT: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_LFT:Dbox1:mode)         
         )
	((= key "JB_1_r2")
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi $value)"JB_1_r1-2"))
	 (JB_LFT:Dbox1:mode)         
         )
	((= key "JB_1_to1")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to1"))
	 )
	((= key "JB_1_to2")
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to2"))
	 )
	((= key "JB_1_r3")
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (- 1 (atoi $value))"JB_1_r3-4"))	          
         )
	((= key "JB_1_r4")
         (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi $value)"JB_1_r3-4"))	          
         )	
        ((= key "cancel")         
         (setq JB_LFT$DCL$_1_po (done_dialog 99))
         )
	((= key "accept")         
         (setq JB_LFT$DCL$_1_po (done_dialog 1))
         )
        )

  
  )

         
     
;;;Dbox1; Werte setzen 
(defun JB_LFT:Dbox1:set ( / A X)
  (mapcar '(lambda(A)
             (set_tile (strcat "JB_1_"(car A))(cadr A)))
    (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 "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 "to2" (cdr(assoc "JB_1_to2" Settings&dbox1)))
      )) 
  )


;;;DBOX 1, moden
(defun JB_LFT:Dbox1:mode ( / )
  (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0)
    (progn
      (mode_tile "JB_1_to1" 0)
      (mode_tile "JB_1_to2" 0)
      (mode_tile "JB_1_r3" 1)
      (mode_tile "JB_1_r4" 1)
      )
    (progn
      (mode_tile "JB_1_to1" 1)
      (mode_tile "JB_1_to2" 1)
      (mode_tile "JB_1_r3" 0)
      (mode_tile "JB_1_r4" 0)
      )
    )
  )


;;;aktuellen Layer aus LayerListe ausschließen
(defun JB_LFT:Dbox1:exe:CurrentLayer (LayerList / LAYERLIST1)
  (setq LayerList1 (vl-remove-if '(lambda(X)(=(strcase X)(strcase(getvar "CLAYER"))))LayerList))
  (if(or (not LayerList1)
	 (< (length LayerList1)(length LayerList))
	 )
    (alert (strcat "Der Layer \"" (getvar "CLAYER") "\" ist der aktuelle und kann deshalb nicht gefroren werden."))
    )
  LayerList1)
		  
;;;Layer frieren
(defun JB_LFT:Dbox1:exe:Freeze (layerList / X)
  (if (and(/=(strcase(getvar "CTAB"))"MODEL")
	  (/=(getvar "CVPORT")1));;;wenn im aktiven Ansichtsfenster
    (command "._vplayer" "_f" (vl-string-right-trim ","(apply 'strcat(mapcar '(lambda(X)(strcat X ","))LayerList))) "_c" "")
    (mapcar '(lambda(X)
	       (vla-put-freeze (vla-item (vla-get-layers (vla-get-activedocument(vlax-get-acad-object)))X) :vlax-true)
	       )
      LayerList))
  )


;;;Objekt picken, Blockobjjekt oder Attriut? Wenn ja, dann Rückgabe des vla-Blocks
(defun JB_LFT:Dbox1:exe:Pick:BlockRef (obj / VLA-BLOCKREF)
  (if (= (vla-get-ObjectName (vlax-ename->vla-object (car obj))) "AcDbAttribute")
    (setq vla-BlockRef (vlax-ename->vla-object(cdr(assoc 330 (entget (car obj))))))
    (if(and (cadddr obj)
	    (=(type(car(cadddr obj)))'ENAME)
	    (=(vla-get-ObjectName(setq vla-BlockRef(vlax-ename->vla-object (car(cadddr obj))))) "AcDbBlockReference")
	    )
      vla-BlockRef)
    )
  vla-BlockRef)

;;;Objekte picken
(defun JB_LFT:Dbox1:exe:Pick ( / LAYER LAYERLIST OBJ VLA-BLOCKREF VLA-OBJ)
  (while (setq obj (nentsel "\nObjekt picken um dessen Layer zu frieren (ENTER=Ende):"))

    (setq vla-obj (vlax-ename->vla-object (car obj)))
    (cond ((= (vla-get-ObjectName vla-obj) "AcDbAttribute")
	   (if(=(cdr(assoc "JB_1_to1" Settings&dbox1))"1")
	     (setq layer (vla-get-layer vla-obj));;;AttributLayer
	     (setq layer(vla-get-layer(JB_LFT:Dbox1:exe:Pick:BlockRef obj)));;;Einfügelayer
	     )
	   )
	  ((setq vla-BlockRef(JB_LFT:Dbox1:exe:Pick:BlockRef obj))
	   (if(=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")
	     (setq layer (vla-get-layer vla-obj));;;Objektlayer
	     (setq layer(vla-get-layer vla-BlockRef));;;Einfügelayer
	     )
	   )
	  ('T
	   (setq layer (vla-get-layer vla-obj))))
    
    (if (setq LayerList (JB_LFT:Dbox1:exe:CurrentLayer (list Layer)))
      (progn
	(vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
	(JB_LFT:Dbox1:exe:Freeze layerList)
	(vla-endundomark (vla-get-activedocument(vlax-get-acad-object)))
	)
	)
    )
  )

;;;Layer einsubsten
(defun JB_LFT:Dbox1:exe:Ssget:LayerList:Block:Subst (BlockLayerList Layer Key / )
  (if (not(member layer (cdr(assoc key BlockLayerList))))
    (JBf_list:subst:gc BlockLayerList (cons Layer(cdr(assoc Key BlockLayerList)))Key)
    BlockLayerList)
  )
;;;Layerliste von Block
(defun JB_LFT:Dbox1:exe:Ssget:LayerList:Block (vla-BlockRef BlockLayerList / BLOCKLAYERLIST LAYER N X)
  
  (setq BlockLayerList(JB_LFT:Dbox1:exe:Ssget:LayerList:Block:Subst BlockLayerList (vla-get-Layer vla-BlockRef)"EinfLayer"))
  (if (=(cdr(assoc "JB_1_r3-4" Settings&dbox1))0);;;wenn Auswahl LayerDialog
    (progn
      (mapcar '(lambda(X)
		 (setq BlockLayerList(JB_LFT:Dbox1:exe:Ssget:LayerList:Block:Subst BlockLayerList (vla-get-Layer (cadr X))"AttLayer"))
		 )
	(JBf_list_att_aus_block_vla-obj vla-BlockRef))
      (setq n 0)
      (vlax-for ITEM (vla-item (vla-get-blocks (vla-get-activedocument(vlax-get-acad-object)))(vla-get-Effectivename vla-BlockRef))
	(setq n (+ n 1))
	(if (> n 5000)
	  (progn
	    (alert "Sie haben einen Block mit über 5000 Blockobjekten ausgewählt, das Programm wird vorsichthalber beendet ;-)")
	    (exit)
	    )
	  )
	(setq Layer(vla-get-Layer ITEM))
	(if (not(member Layer (cdr(assoc "AttLayer" BlockLayerList))))
	  (setq BlockLayerList(JB_LFT:Dbox1:exe:Ssget:LayerList:Block:Subst BlockLayerList (vla-get-Layer ITEM)"ObjLayer"))
	  )
	)
      )
    )
  BlockLayerList)

;;;LAyerliste mit gefrorenen Layern, die dann nicht im Dialogfenster für Blocklayer angezeigt werden
(defun JB_LFT:Dbox1:exe:Ssget:LayerList:FreezeIstList ( / LAYERFREEZEISTLIST)
  (vlax-for ITEM (vla-get-layers (vla-get-activedocument(vlax-get-acad-object)))
      (if (= (vla-get-freeze ITEM):vlax-true)
	(setq LayerFreezeIstList (cons (vla-get-name ITEM)LayerFreezeIstList))
	)
      )
  
  (if (and(/=(strcase(getvar "CTAB"))"MODEL")
	  (/=(getvar "CVPORT")1));;;wenn im aktiven Ansichtsfenster
    (setq LayerFreezeIstList (append LayerFreezeIstList
			       (mapcar '(lambda(X)(vla-get-name(vlax-ename->vla-object (cdr X))))
				 (vl-remove-if '(lambda(X)
						  (/=(car X)331))
				   (entget(vlax-vla-object->ename
					    (vla-get-activepviewport
					      (vla-get-activedocument
						(vlax-get-acad-object))))))))))
  LayerFreezeIstList)

  

;;;LayerListe von Aws
(defun JB_LFT:Dbox1:exe:Ssget:LayerList (aws v_liste pfad_ini / BLOCKLAYERLIST LAYERLIST N VLA-OBJ LayerFreezeIstList)
  
  (setq n 0)
  (setq BlockLayerList (list (cons "AttLayer" nil)
			     (cons "ObjLayer" nil)
			     (cons "EinfLayer" nil)))

  
  (repeat (sslength aws)
    (setq vla-obj (vlax-ename->vla-object (ssname aws n)))
    (if (=(vla-get-Objectname vla-obj)"AcDbBlockReference")
      (setq BlockLayerList (JB_LFT:Dbox1:exe:Ssget:LayerList:Block vla-obj BlockLayerList))
      (if (not (member (vla-get-layer vla-obj)LayerList))
	(setq LayerList (cons (vla-get-layer vla-obj)LayerList))
	)
      )
    (setq n (+ n 1))
    )

  (if (and BlockLayerList(=(cdr(assoc "JB_1_r3-4" Settings&dbox1))0));;;wenn Auswahl LayerDialog
    (progn
      (setq LayerFreezeIstList (JB_LFT:Dbox1:exe:Ssget:LayerList:FreezeIstList))
      (setq LayerList(JB_LFT:Dbox2 BlockLayerList LayerFreezeIstList v_liste pfad_ini))
      )
    (setq LayerList (cdr(assoc "EinfLayer" BlockLayerList)))
    )
  (if LayerList
    (setq LayerList (JB_LFT:Dbox1:exe:CurrentLayer LayerList))
    )
  LayerList)
    
      

;;;Objekte auswählen
(defun JB_LFT:Dbox1:exe:Ssget (v_liste pfad_ini / )
  (setq Do 'T)
  (while Do
    (if (and
	  (princ "\nObjekte wählen um dessen Layer zu frieren (ENTER=Ende):")
	  (setq aws (ssget))
	  (setq LayerList(JB_LFT:Dbox1:exe:Ssget:LayerList aws v_liste pfad_ini))
	  )
      (progn
	(vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
	(JB_LFT:Dbox1:exe:Freeze layerList)
	(vla-endundomark (vla-get-activedocument(vlax-get-acad-object)))
	)
      (setq Do nil)
      )
    )
  )lft

    
  
;;;Ausführung
(defun JB_LFT:Dbox1:exe (v_liste pfad_ini / )
  (setq Settings&Dbox1 (JB_LFT:v_liste:DboxSettings:get "Dbox1" v_liste))

  (if (=(cdr(assoc "JB_1_r1-2" Settings&Dbox1))0);;;wenn picken
    (JB_LFT:Dbox1:exe:Pick)
    (JB_LFT:Dbox1:exe:Ssget v_liste pfad_ini)
    )
  )


;;;Liste füllen und Einträge selektieren
(defun JB_LFT:Dbox2:set:Lists (LayerList key selFlag / LN_SEL N X)
  (start_list key 3)
  (mapcar 'add_list LayerList)
  (end_list)
  (set_tile key "")
  (if LayerList
    (cond((= selFlag 1);;;alle auswählen
	  (setq n -1)
	  (set_tile key(vl-string-right-trim " "(apply 'strcat(mapcar '(lambda(X)(strcat(itoa X)" "))(setq ln_sel(mapcar '(lambda(X)(setq n (+ n 1)))LayerList)))))))
	 ((= selFlag 0);;;Individuell auswählen
	  (set_tile key (itoa(car(setq ln_sel '(0))))))
	 )
      )
  ln_sel)
	  
	
  


;;;DBox2, setten
(defun JB_LFT:Dbox2:set ( / )
  (setq l1_sel&Dbox2(JB_LFT:Dbox2:set:Lists (cdr(assoc "EinfLayer" BlockLayerList&Dbox2)) "JB_2_l1" (cdr(assoc "JB_2_l1" Settings&Dbox2))))
  (setq l2_sel&Dbox2(JB_LFT:Dbox2:set:Lists (cdr(assoc "AttLayer" BlockLayerList&Dbox2)) "JB_2_l2" (cdr(assoc "JB_2_l2" Settings&Dbox2))))
  (setq l3_sel&Dbox2(JB_LFT:Dbox2:set:Lists (cdr(assoc "ObjLayer" BlockLayerList&Dbox2)) "JB_2_l3" (cdr(assoc "JB_2_l3" Settings&Dbox2))))
  )

;;;pro Liste moden
(defun JB_LFT:Dbox2:mode:Lists (LayerList ln_sel key_bAll key_bNot key_list / )
  (mode_tile key_bAll 0)
  (mode_tile key_bNot 0)
  (if (=(length LayerList)(length ln_sel))
    (mode_tile key_bAll 1)
    )
  (if (not ln_sel)
    (mode_tile key_bNot 1)
    )

  (if (not LayerList)
    (progn
      (mode_tile key_bAll 1)
      (mode_tile key_bNot 1)
      (mode_tile key_List 1)
      )
    )
  )

;;;DBox2, moden
(defun JB_LFT:Dbox2:mode ( / )
  (JB_LFT:Dbox2:mode:Lists (cdr(assoc "EinfLayer" BlockLayerList&Dbox2)) l1_sel&Dbox2 "JB_2_b1" "JB_2_b2" "JB_2_l1")
  (JB_LFT:Dbox2:mode:Lists (cdr(assoc "AttLayer" BlockLayerList&Dbox2)) l2_sel&Dbox2 "JB_2_b3" "JB_2_b4" "JB_2_l2")
  (JB_LFT:Dbox2:mode:Lists (cdr(assoc "ObjLayer" BlockLayerList&Dbox2)) l3_sel&Dbox2 "JB_2_b5" "JB_2_b6" "JB_2_l3")
  )

;;;RetLayerList zusammenstellen
(defun JB_LFT:Dbox2:RetLayerList ( / RETLAYERLIST X)
  (mapcar '(lambda(X)
	     (if (not (member X RetLayerList))
	       (setq RetLayerList (cons X RetLayerList))
	       )
	     )
    (append
      (mapcar '(lambda(X)
		 (nth X (cdr(assoc "EinfLayer" BlockLayerList&Dbox2)))
		 )
	l1_sel&Dbox2)
      (mapcar '(lambda(X)
		 (nth X (cdr(assoc "AttLayer" BlockLayerList&Dbox2)))
		 )
	l2_sel&Dbox2)
      (mapcar '(lambda(X)
		 (nth X (cdr(assoc "ObjLayer" BlockLayerList&Dbox2)))
		 )
	l3_sel&Dbox2)))

  RetLayerList)

;;;Initialisierung der Layerliste
(defun JB_LFT:DBox2:Ini (LayerFreezeIstList / X Y)
  (setq BlockLayerList&Dbox2 (mapcar'(lambda(X)
				       (cons (car X)(vl-sort
						      (vl-remove-if
							'(lambda(Y)(member Y LayerFreezeIstList))(cdr X))
						      '(lambda(e1 e2)(< e1 e2)))))BlockLayerList&Dbox2))
  )
  
      


;;;DBox2
(defun JB_LFT:Dbox2 (BlockLayerList&Dbox2 LayerFreezeIstList v_liste pfad_ini / A DCLID OK Settings&Dbox2 l1_sel&Dbox2 l21_sel&Dbox2 l3_sel&Dbox2)

  (JB_LFT:DBox2:Ini LayerFreezeIstList)
  
  (setq Settings&Dbox2 (JB_LFT:v_liste:DboxSettings:get "Dbox2" v_liste))
  
  (while  (not(member ok '(1 99)))

    (setq DclId(JBf_Dcl:Load_dialog JB_LFT_$DCL$_File "LFT_2" JB_LFT$DCL$_2_po))
    
    (JB_LFT:Dbox2:set)
    (JB_LFT:Dbox2:mode)
           
    (mapcar '(lambda(A)(action_tile A (strcat "(JB_LFT:Dbox2:action \""A"\")")))
      '("JB_2_b1" "JB_2_b2" "JB_2_b3" "JB_2_b4" "JB_2_b5" "JB_2_b6" "JB_2_l1" "JB_2_l2" "JB_2_l3" "accept" "cancel"))

    (setq ok (start_dialog))
    (unload_dialog DclId)

    (setq v_liste (JB_LFT:v_liste:DboxSettings:put "Dbox2" Settings&dbox2 v_liste))
    (JBf_SIC:sichern v_liste pfad_ini nil)
   
    
    )
  (if(= ok 1)
     (JB_LFT:Dbox2:RetLayerList)
     )
  )
     

;;;Action (Variable global in Aufrufender Funktion)
(defun JB_LFT:Dbox2:action (key / N X)

  (cond ((= key "JB_2_b1")
         (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 1 "JB_2_l1"))
	 (setq n -1)
	 (setq l1_sel&Dbox2 (mapcar '(lambda(X)(setq n (+ n 1)))(cdr(assoc "EinfLayer" BlockLayerList&Dbox2))))
	 (set_tile "JB_2_l1" "")
	 (set_tile "JB_2_l1"(vl-string-right-trim " "(apply 'strcat(mapcar '(lambda(X)(strcat(itoa X)" "))l1_sel&Dbox2))))
	 
	 (JB_LFT:Dbox2:mode)
	 )
	((= key "JB_2_b3")
         (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 1 "JB_2_l2"))
	 (setq n -1)
	 (setq l2_sel&Dbox2 (mapcar '(lambda(X)(setq n (+ n 1)))(cdr(assoc "AttLayer" BlockLayerList&Dbox2))))
	 (set_tile "JB_2_l2" "")
	 (set_tile "JB_2_l2"(vl-string-right-trim " "(apply 'strcat(mapcar '(lambda(X)(strcat(itoa X)" "))l2_sel&Dbox2))))
	 (JB_LFT:Dbox2:mode)
	 )
	((= key "JB_2_b5")	 
         (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 1 "JB_2_l3"))
	 (setq n -1)
	 (setq l3_sel&Dbox2 (mapcar '(lambda(X)(setq n (+ n 1)))(cdr(assoc "ObjLayer" BlockLayerList&Dbox2))))
	 (set_tile "JB_2_l3" "")
	 (set_tile "JB_2_l3"(vl-string-right-trim " "(apply 'strcat(mapcar '(lambda(X)(strcat(itoa X)" "))l3_sel&Dbox2))))
	 
	 (JB_LFT:Dbox2:mode)
	 )
	 ((= key "JB_2_b2")
         (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 -1 "JB_2_l1"))
	 (setq l1_sel&Dbox2 nil)
	  (set_tile "JB_2_l1" "")
	 (JB_LFT:Dbox2:mode)
	 )
	((= key "JB_2_b4")
         (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 -1 "JB_2_l2"))
	 (setq l2_sel&Dbox2 nil)
	  (set_tile "JB_2_l2" "")
	 (JB_LFT:Dbox2:mode)
	 )
	((= key "JB_2_b6")
         (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 -1 "JB_2_l3"))
	 (setq l3_sel&Dbox2 nil)
	  (set_tile "JB_2_l3" "")
	 (JB_LFT:Dbox2:mode)
	 )
	((= key "JB_2_l1")
	 (setq l1_sel&Dbox2(mapcar 'atoi(JBf_String:Delimiter->List $value " ")))
	 (if (=(length l1_sel&Dbox2)(length (cdr(assoc "EinfLayer" Settings&dbox2))))
	   (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 1 "JB_2_l1"))
	   (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 0 "JB_2_l1"))
	   )	   
	 (JB_LFT:Dbox2:mode)
	 )
	((= key "JB_2_l2")
	 (setq l2_sel&Dbox2(mapcar 'atoi(JBf_String:Delimiter->List $value " ")))
	 (if (=(length l2_sel&Dbox2)(length (cdr(assoc "AttLayer" Settings&dbox2))))
	   (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 1 "JB_2_l2"))
	   (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 0 "JB_2_l2"))
	   )
	 (JB_LFT:Dbox2:mode)
	 )
	((= key "JB_2_l3")
	 (setq l3_sel&Dbox2(mapcar 'atoi(JBf_String:Delimiter->List $value " ")))
	 (if (=(length l3_sel&Dbox2)(length (cdr(assoc "ObjLayer" Settings&dbox2))))
	   (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 1 "JB_2_l3"))
	   (setq Settings&dbox2 (JBf_list:subst:gc Settings&dbox2 0 "JB_2_l3"))
	   )
	 (JB_LFT:Dbox2:mode)
	 )
        ((= key "accept");;OK
	 (setq JB_LFT$DCL$_2_po (done_dialog 1))
         )	
        ((= key "cancel");;;Abbrechen
         (setq JB_LFT$DCL$_2_po (done_dialog 99))
         )
        )

  
  )




;;;DCL-Datei schreiben
(defun JB_LFT:Dcl:Write ( / A  FILE)
  (if(and(setq JB_LFT_$DCL$_File(vl-filename-mktemp (strcat "LFT.dcl")))
         (setq file (open JB_LFT_$DCL$_File "w")))
    (progn
    (mapcar '(lambda(A)
               (write-line A file))
      (mapcar '(lambda(A)
                 (strcat "\n" A))
        '(
                "//Hauptdialog"
                "LFT_1: dialog {label = \"LayerFrier-Tool: Einstellungen\";"
                ":boxed_column {label = \"Auswahl\";"
                ":radio_column {"
                ":radio_button {key = \"JB_1_r1\"; label = \"Objekte picken\";width =30;}"
                ":radio_button {key = \"JB_1_r2\"; label = \"Mehrfachauswahl\";}"
                "}"
                "}"
                ":boxed_column {label = \"Optionen \\\"Objekte picken\\\"\";"
                ":toggle {key = \"JB_1_to1\"; label = \"Attributlayer aus Blöcken\";}"
                ":toggle {key = \"JB_1_to2\"; label = \"Objektlayer aus Blöcken\";}"
                "}"
                ":boxed_column {label = \"Optionen - \\\"Mehrfachauswahl\\\"\";"
                ":radio_column {"
                ":radio_button {key = \"JB_1_r3\"; label = \"Blocklayer-Auswahl-Dialog\";}"
                ":radio_button {key = \"JB_1_r4\"; label = \"bei Blöcken nur Einfügelayer\";}"
                "}"
                "}"
                ":row {fixed_width = true;alignment = centered;"
                ":button {label = \"&OK\";  key= \"accept\";is_default=true;}"
                ":spacer {width = 2;}"
                ":button {label = \"&Ende\";  key= \"cancel\";is_cancel=true;}"
                "}}"
                "LFT_2: dialog {label = \"LayerFrier-Tool: Block-Layer-Auswahl\";"
                ":boxed_column {label = \"Mehrfachauswahl mit STRG+UMSCHALT\";"
                ":boxed_column {label = \"Einfügelayer\";"
                ":list_box {key = \"JB_2_l1\"; width = 50; multiple_select=true;}"
                ":row {"
                ":button {key = \"JB_2_b1\"; label = \"alle\"; fixed_width = true;}"
                ":button {key = \"JB_2_b2\"; label = \"keine\"; fixed_width = true;}"
                "}"
                "}"
                ":boxed_column {label = \"Attributlayer\";"
                ":list_box {key = \"JB_2_l2\"; width = 50; multiple_select=true;}"
                ":row {"
                ":button {key = \"JB_2_b3\"; label = \"alle\"; fixed_width = true;}"
                ":button {key = \"JB_2_b4\"; label = \"keine\"; fixed_width = true;}"
                "}"
                "}"
                ":boxed_column {label = \"Objektlayer\";"
                ":list_box {key = \"JB_2_l3\"; width = 50; multiple_select=true;}"
                ":row {"
                ":button {key = \"JB_2_b5\"; label = \"alle\"; fixed_width = true;}"
                ":button {key = \"JB_2_b6\"; label = \"keine\"; fixed_width = true;}"
                "}"
                "}"
                "}"
                "ok_cancel;}"

          )))
    (close file)
    JB_LFT_$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: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))))
  ))



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



;;;--------------------------------------------------------------------------------------------------------
;;;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|layerFrier-Tool: Layer von Objekten frieren.                |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: LFT oder LAYFRIERTOOL                  |"
	  "\n|Befehlszeilenaufruf: LFTE (Einstellungen)                   |"
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )

(princ)



