
;;;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: SFD - SymbolFinder: es wird ein Punktblock bestimmt, über ein Attribut kann per numerischen 
;;;oder Zeichenkettenvergleich eine Auswahl getroffen werden. Pro Punktblock wird dann nach einem Symbol   
;;;mit einem festgelegten Symbolnamen gesucht, welches die identischen xy-Koordinaten aufweist, optional   
;;;auch der z-Wert.											   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:										   	   
;;;- JB_SFD$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_SFD_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 21.12.23	   
;;;--------------------------------------------------------------------------------------------------------




;;;aufrufenden Funktionen
(defun c:SFD ( / )
  (JB_SFD)
  )

;;;Intro
(defun JB_SFD:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------SFD(1.0), 21.12.23----------------------")
  (princ str)
  (princ "\n--------------------------------------------------------------")
  )




;;;Variablenliste
(defun JB_SFD:v_liste ( / )
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ("JB_1_t1" . nil);;;PunktBlockname
                             ("JB_1_p1" . nil);;;Name Attribut
                             ("JB_1_r1-2" . 0);;;0 = numerischer Vergleich, 1 = Zeichnenkettenvergleich
                             ("JB_1_e1" . 1.0);;;von numerisch
                             ("JB_1_e2" . 100.0);;;bis numerisch
                             ("JB_1_e3" . "*");;;Filterwert Zeichenkettenvergleich
                             ("JB_1_e4" . "MeinSymbol");;;Blockname für Symbolblock
                             ("JB_1_to1" . "0");;;z-Wert verwenden
                             ("JB_1_to2" . "1");;;Attributfilter
                                                         
                             )
                          )
                         )
      ))
  )


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

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

  (setq pfad_ini (JB_SFD: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_SFD:v_liste))pfad_ini nil))
  
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))
  
  
  (JB_SFD:Intro "\nSFD: Symbolfinder pro Punktblock.")

  
  

  (if (not
            (or (and JB_SFD_$DCL$_File(findfile JB_SFD_$DCL$_File))
                (setq JB_SFD_$DCL$_File (JB_SFD:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))


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

 

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


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

;;;DBox1: Listen Initialisieren
(defun JB_SFD:Dbox1:Ini ( / VLA-ATTLIST)
  (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)))))
    (progn
      (setq p1&DBox1(mapcar 'vla-get-Tagstring vla-attList))
      (if (member(strcase(cdr(assoc "JB_1_p1" Settings&Dbox1)))(mapcar 'strcase p1&DBox1))
        (setq p1_sel&Dbox1 (-(length p1&DBox1)(length(member(strcase(cdr(assoc "JB_1_p1" Settings&Dbox1)))(mapcar 'strcase p1&DBox1)))))
        (progn
          (setq p1_sel&Dbox1 0)
          (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (car p1&DBox1)"JB_1_p1")))
        )
      )
    )
  )
    
;;;Block picken
(defun JB_SFD:Dbox1:Action:BlockPick (AttFlag / AWS VLA-ATTLIST X)
  (if (and
        (or
          (and AttFlag
               (princ "\nPicken Sie einen Block mit mindestens einem Attribut:"))
          (and (not AttFlag)
               (princ "\nPicken Sie einen Symbolblock:")))
        (setq aws (ssget "_:S"(list (cons 0 "INSERT"))))
        (or
          (and AttFlag
               (or(setq vla-attList(JBf_list_att_aus_block_vla-obj(vlax-ename->vla-object(ssname aws 0))))
                  (alert "Der Block enthielt keine Attribute.")))
          (not AttFlag)))
    (progn
      (if AttFlag
        (progn
          (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (vla-get-effectivename(vlax-ename->vla-object(ssname aws 0)))"JB_1_t1"))
          (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (vla-get-Tagstring(cadr(car vla-attList)))"JB_1_p1"))
          (setq p1&DBox1 (mapcar '(lambda(X)(vla-get-TagString (cadr X)))vla-attList))
          (setq p1_sel&Dbox1 0))
        (setq Settings&Dbox1 (JBf_list:subst:gc Settings&Dbox1 (vla-get-effectivename(vlax-ename->vla-object(ssname aws 0)))"JB_1_e4"))
        )
      (JB_SFD:Dbox1:set)
      (JB_SFD:Dbox1:mode)
      (if AttFlag
        (mode_tile "JB_1_p1" 2)
        (mode_tile "JB_1_e4" 2))
      )
    )
  )

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

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

  (JB_SFD:Dbox1:Ini)

  
  
  (while (not (member ok '(1 99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_SFD_$DCL$_File "JB_SFD_1" JB_SFD$DCL$_1_po))
    (JB_SFD:Dbox1:set)
    (JB_SFD:Dbox1:mode)
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_SFD:Dbox1:action \"" A "\")")))
            '("JB_1_b1"
              "JB_1_p1"
              "JB_1_r1" "JB_1_r2"
              "JB_1_b2"
              "JB_1_to1"
              "JB_1_to2"
              "JB_1_b3" "JB_1_b4" "JB_1_b5"
              "cancel"
              "accept"
             )
    )
    (setq ok (start_dialog))
    (unload_dialog DclId)
    
    
    (cond  ((= ok 11) ;;;PunktBlock
            (JB_SFD:Dbox1:Action:BlockPick 'T))
           ((= ok 12) ;;;Symbolblock
            (JB_SFD:Dbox1:Action:BlockPick nil))
           ((= ok 13) ;;;Text Picken von
            (JB_SFD:Dbox1:Action:TextPick 'T "JB_1_e1"))
           ((= ok 14) ;;;Text Picken bis
            (JB_SFD:Dbox1:Action:TextPick 'T "JB_1_e2"))
           ((= ok 15) ;;;Text Picken Textfilter
            (JB_SFD:Dbox1:Action:TextPick nil "JB_1_e3"))
           ((= ok 99) ;;;Ende
           (setq v_liste (JB_SFD:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
           (JBf_SIC:sichern v_liste pfad_ini nil)
           )
          ((= ok 1) ;;;Polylinien wählen
           (setq v_liste (JB_SFD:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
           (JBf_SIC:sichern v_liste pfad_ini nil)
           (JB_SFD:Dbox1:exe)
           )
          )
    ) 
  )



;;;Textobjekt picken
(defun JB_SFD:Dbox1:Action:TextPick (RealFlag key / TEXTWERT VLA-OBJ)
  (if (and(not(vl-catch-all-error-p
            (setq TextWert(vl-catch-all-apply 'nentsel(list "\nPicken Sie ein Textobjekt:")))))
          TextWert
          (setq vla-obj (vlax-ename->vla-object(car TextWert)))
          (or(vlax-property-available-p vla-obj 'TextString)
             (alert "Das gepickte Objekt beinhaltet keinen Textwert."))
          (setq TextWert (vla-get-TextString vla-obj)))
    (progn
      (if RealFlag
        (setq TextWert (atof(vl-string-subst "." "," TextWert))))
      (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 TextWert key)))
    )
  )



             

;;;Action (Variable global in Aufrufender Funktion)
(defun JB_SFD:Dbox1:action (key / LayerList)
  (cond
    ((= key "JB_1_b1")
     (JB_SFD:Dbox1:get)
     (setq JB_SFD$DCL$_1_po (done_dialog 11))
     )
    ((= key "JB_1_b2")
     (JB_SFD:Dbox1:get)
     (setq JB_SFD$DCL$_1_po (done_dialog 12))
     )
    ((= key "JB_1_b3")
     (JB_SFD:Dbox1:get)
     (setq JB_SFD$DCL$_1_po (done_dialog 13))
     )
    ((= key "JB_1_b4")
     (JB_SFD:Dbox1:get)
     (setq JB_SFD$DCL$_1_po (done_dialog 14))
     )
    ((= key "JB_1_b5")
     (JB_SFD:Dbox1:get)
     (setq JB_SFD$DCL$_1_po (done_dialog 15))
     )
    ((= key "JB_1_r1")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (- 1(atoi $value))"JB_1_r1-2"))
     (JB_SFD:Dbox1:mode)
     )
    ((= key "JB_1_r2")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi $value)"JB_1_r1-2"))
     (JB_SFD: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"))
     (JB_SFD:Dbox1:mode)
     )
    ((= 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 "accept") ;;;OK, Polylinie wählen
    (JB_SFD:Dbox1:get) 
     (setq JB_SFD$DCL$_1_po (done_dialog 1))
     )
    
    ((= key "cancel") ;;;Ende
    (JB_SFD:Dbox1:get) 
     (setq JB_SFD$DCL$_1_po (done_dialog 99))
     )
    )
)


;;;DBox1: getten
(defun JB_SFD:Dbox1:get ( / )
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1(atof(rtos(atof(vl-string-subst "." ","(get_tile "JB_1_e1")))2 12))"JB_1_e1"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1(atof(rtos(atof(vl-string-subst "." ","(get_tile "JB_1_e2")))2 12))"JB_1_e2"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1(get_tile "JB_1_e3")"JB_1_e3"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1(get_tile "JB_1_e4")"JB_1_e4"))
 
  )

;;;Reelle Zahl zu String
;;;Nachführende Nullen von REAL-String entfernen, bis auf die erste
(defun JB_SFD:Dbox1:set:Real->String (wert / PRAE STRING SUF)
  (setq String (rtos wert 2 12))
  (if (vl-string-search "." String)
    (progn
      (setq Prae (substr String 1 (vl-string-search "." String)))
      (setq Suf (substr String (+(vl-string-search "." String)2)))
      (if (or(= Suf "")(=(atof Suf)0.0))
        (setq Suf "")
        (setq Suf (strcat "."(vl-string-right-trim "0" Suf)))
        )
      (strcat Prae Suf))
    String
    )
  )
    
;;;DBox1: setten
(defun JB_SFD:Dbox1:set ( / X)
  (mapcar '(lambda(X)(set_tile (strcat "JB_1_"(car X))(cadr X)))
    (list
      (list "t1" (if(cdr(assoc "JB_1_t1" Settings&dbox1))(cdr(assoc "JB_1_t1" Settings&dbox1))""))
      (list "r1" (itoa(- 1(cdr(assoc "JB_1_r1-2" Settings&dbox1)))))
      (list "r2" (itoa(cdr(assoc "JB_1_r1-2" Settings&dbox1))))
      (list "e1" (JB_SFD:Dbox1:set:Real->String(cdr(assoc "JB_1_e1" Settings&dbox1))))
      (list "e2" (JB_SFD:Dbox1:set:Real->String(cdr(assoc "JB_1_e2" Settings&dbox1))))
      (list "e3" (cdr(assoc "JB_1_e3" Settings&dbox1)))
      (list "e4" (cdr(assoc "JB_1_e4" Settings&dbox1)))      
      (list "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
      (list "to2" (cdr(assoc "JB_1_to2" Settings&dbox1)))
      
      )
    )
  (if p1&Dbox1
    (progn
      (JBf_Dcl:AddList:New "JB_1_p1" p1&Dbox1)
      (set_tile "JB_1_p1" (itoa p1_sel&Dbox1)))
    )
  )
;;;DBox1, moden
(defun JB_SFD:Dbox1:mode ( / )
  (if (=(cdr(assoc "JB_1_to2" Settings&dbox1))"1")
    (progn
      (mode_tile "JB_1_r1" 0)
      (mode_tile "JB_1_r2" 0)
      (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))0)
        (progn
          (mode_tile "JB_1_e1" 0)
          (mode_tile "JB_1_e2" 0)
          (mode_tile "JB_1_e3" 1)
          (mode_tile "JB_1_b3" 0)
          (mode_tile "JB_1_b4" 0)
          (mode_tile "JB_1_b5" 1)
          )
        (progn
          (mode_tile "JB_1_e1" 1)
          (mode_tile "JB_1_e2" 1)
          (mode_tile "JB_1_e3" 0)
          (mode_tile "JB_1_b3" 1)
          (mode_tile "JB_1_b4" 1)
          (mode_tile "JB_1_b5" 0))
        )
      )
    (progn
      (mode_tile "JB_1_r1" 1)
      (mode_tile "JB_1_r2" 1)
      (mode_tile "JB_1_e1" 1)
      (mode_tile "JB_1_e2" 1)
      (mode_tile "JB_1_e3" 1)
      (mode_tile "JB_1_b3" 1)
      (mode_tile "JB_1_b4" 1)
      (mode_tile "JB_1_b5" 1)
      )
    )
  
  (if (or (not(cdr(assoc "JB_1_t1" Settings&Dbox1)))
          (not(tblsearch "BLOCK"(cdr(assoc "JB_1_t1" Settings&Dbox1))))
          (not p1&Dbox1))
    (progn
      (mode_tile "JB_1_p1" 1)
      (mode_tile "JB_1_b1" 2)
      (alert "Bitte wählen Sie ein Punktblock mit mindestens einem Attribut aus."))
    (progn
      (mode_tile "JB_2_p1" 0)
      (mode_tile "JB_1_e4" 2)))  
  )

;;;Filterwert prüfen
(defun JB_SFD:Dbox1:exe:FilterWert:Check-p (FilterWert / FILTERWERTINT)
  (if (=(cdr(assoc "JB_1_r1-2" Settings&Dbox1))0)
    (progn
      (setq FilterWertInt(atof(vl-string-subst "." "," FilterWert)))
      (and (>= FilterWertInt (cdr(assoc "JB_1_e1" Settings&Dbox1)))
           (<= FilterWertInt (cdr(assoc "JB_1_e2" Settings&Dbox1))))
      )
    (wcmatch (strcase FilterWert) (strcase(cdr(assoc "JB_1_e3" Settings&Dbox1))))
    )
  )
    

;;;vla-objList
(defun JB_SFD:Dbox1:exe:vla-objList (aws / FILTERWERT N VLA-ATT VLA-OBJ VLA-OBJLIST)
  (setq n 0)
  (repeat (sslength aws)
    (setq vla-obj (vlax-ename->vla-object(ssname aws n)))
    (if (or (=(cdr(assoc "JB_1_to2" Settings&Dbox1))"0")
            (and(setq vla-att(cadr(assoc (strcase(cdr(assoc "JB_1_p1" Settings&Dbox1)))
                                         (JBf_list_att_aus_block_vla-obj vla-obj))))
                (setq FilterWert (vla-get-TextString vla-att))
                (JB_SFD:Dbox1:exe:FilterWert:Check-p FilterWert))
            )
      (setq vla-objList (cons (list (vlax-get vla-obj 'InsertionPoint)vla-obj) vla-objList))
      )
    (setq n (+ n 1))
    )

  (if (not vla-objList)
    (alert "Es entsprach kein Punktblock den aktuellen Filtereinstellungen.")
    vla-objList)
  )
;;;MinMax - Punktblöcke
(defun JB_SFD:Dbox1:exe:MinMaxList (vla-objList / COORDS X)
  (setq coords (mapcar 'car vla-objList))
  (list(list (apply 'min (mapcar 'car coords))
             (apply 'min (mapcar 'cadr coords))
             0)
       (list (apply 'max (mapcar 'car coords))
             (apply 'max (mapcar 'cadr coords))
             0)))


;;;Symbolblöcke in vla-List
(defun JB_SFD:Dbox1:exe:vla-SymbList (awsSymb / AWS N OBJLISTSYMB VLA-OBJ)
  (setq n 0)
  (repeat (sslength awsSymb)
    (setq vla-obj(vlax-ename->vla-object (ssname awsSymb n)))
    (setq objListSymb(cons (list
                             (if(=(cdr(assoc "JB_1_to1" Settings&Dbox1))"0")
                               (JBf_list_xyz->xy0(vlax-get vla-obj 'InsertionPoint))
                               (vlax-get vla-obj 'InsertionPoint)
                               )
                               vla-obj)objListSymb))
    (setq n (+ n 1)))
  objListSymb)


;;;Koordinatenvergleich
(defun JB_SFD:Dbox1:exe:coords-p (p1 p2 / )
  (equal (distance p1 p2)0.0 0.000001)
  )

;;;gefundenes Symbol und restliche Symbolliste
(defun JB_SFD:Dbox1:exe:RetSymbol (awsRet p1 vla-SymbListEnd / OBJRET VLA-SYMBLISTSTART)
  
  
  (while vla-SymbListEnd
    (if (JB_SFD:Dbox1:exe:coords-p p1(car(car vla-SymbListEnd)))
      (progn
        (ssadd (vlax-vla-object->ename (cadr (car vla-SymbListEnd)))awsRet)
        (setq vla-SymbListEnd (cdr vla-SymbListEnd))
        )
      (setq vla-SymbListStart (cons (car vla-SymbListEnd)vla-SymbListStart)
            vla-SymbListEnd (cdr vla-SymbListEnd)))
    )
  (list awsRet
        (append vla-SymbListStart vla-SymbListEnd)))



;;;Maximale Ausdehnung des Bildschirms
(defun JB_SFD:Dbox1:exe:ScreenCoords ( / )
  (mapcar '(lambda(X)(trans X 1 0))
    (list
      (list(-(car(getvar "VIEWCTR"))
             (*(/(getvar "VIEWSIZE")(cadr(getvar "SCREENSIZE")))
               (car(getvar "SCREENSIZE"))0.5))
           (-(cadr(getvar "VIEWCTR"))
             (/(getvar "VIEWSIZE")2.0)
             )
           )
      (list(+(car (getvar "VIEWCTR"))
             (*(/(getvar "VIEWSIZE")(cadr(getvar "SCREENSIZE")))
               (car(getvar "SCREENSIZE"))
               0.5)
             )
           (+(cadr (getvar "VIEWCTR"))
             (/(getvar "VIEWSIZE")2.0)
             )
           )
      )
    )
  )

;;;Ausführung
(defun JB_SFD:Dbox1:exe ( / AWS AWSRET AWSSYMB MINMAXLIST VLA-OBJLIST VLA-SYMBLIST X pul por ScreenCoords)
  (if (and (princ (strcat "\nWählen Sie Punktblöcke \"" (cdr(assoc "JB_1_t1" Settings&Dbox1))"\" aus:"))
           (setq aws (ssget (list (cons 0 "INSERT")(cons 2 (cdr(assoc "JB_1_t1" Settings&Dbox1))))))
           (setq vla-objList (JB_SFD:Dbox1:exe:vla-objList aws))
           (setq MinMaxList(JB_SFD:Dbox1:exe:MinMaxList vla-objList)))
    (progn
      (setq awsRet (ssadd))
      (if (=(length vla-objList)1)
        (JBf_Zoom:Pan2Pkt (car MinMaxList))
        (progn
          (setq pul(polar (car MinMaxList)(angle (cadr MinMaxList)(car MinMaxList))(*(distance (cadr MinMaxList)(car MinMaxList))1.2)))
          (setq por(polar (cadr MinMaxList)(angle (car MinMaxList)(cadr MinMaxList))(*(distance (car MinMaxList)(cadr MinMaxList))1.2)))
          (if (> (getvar "viewsize")(- (cadr por)(cadr pul)))
            (JBf_Zoom:Pan2Pkt (mapcar '(lambda(X)(/ X 2.0))(mapcar '+ pul por)))
            (vla-zoomwindow(vlax-get-acad-object)
              (vlax-3d-point pul)
              (vlax-3d-point por))
            )
          )
        )

      (setq ScreenCoords (JB_SFD:Dbox1:exe:ScreenCoords))
      (setq pul (car ScreenCoords))
      (setq por (cadr ScreenCoords))


      (if (and (setq awsSymb (ssget "_w" (trans pul 0 1) (trans por 0 1)(list (cons 0 "INSERT")(cons 2 (cdr(assoc "JB_1_e4" Settings&Dbox1))))))
               (setq vla-SymbList (JB_SFD:Dbox1:exe:vla-SymbList awsSymb)))
        (progn
          (mapcar '(lambda(X)
                     (if vla-SymbList
                       (progn
                         (setq vla-SymbList(JB_SFD:Dbox1:exe:RetSymbol awsRet
                                             (if (=(cdr(assoc "JB_1_to1" Settings&Dbox1))"0")
                                               (JBf_list_xyz->xy0 (car X))(car X))vla-SymbList))
                         (setq awsRet(car vla-SymbList))                           
                         (setq vla-SymbList (cadr vla-SymbList))
                         )
                       )
                     )
            vla-objList)
          (if (and awsRet (/=(sslength awsRet)0))
            (sssetfirst awsRet awsRet)
            (alert "Es wurden keine Symbolblöcke gefunden.")
            )
          )
        )
      (vla-zoomprevious (vlax-get-acad-object))
      )
    )
  )
         
;;;DCL-schreiben
(defun JB_SFD:dcl:Write ( / file)  
  (if (and (setq JB_SFD_$DCL$_File (vl-filename-mktemp (strcat "SFD.dcl")))
           (setq file (open JB_SFD_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "//Hauptdialog"
                "JB_SFD_1: dialog {label= \"Symbolfinder pro Punktblock\";	 "
                ":boxed_column {label = \"Punktblock\";"
                ":row {"
                ":button {key = \"JB_1_b1\"; label = \"Blockname<\";}"
                ":text {key = \"JB_1_t1\"; width = 40; label = \"MeinPunktBlock\";}}"
                ":popup_list {key = \"JB_1_p1\"; label = \"Attribut\";edit_width = 40;}"
                ":toggle {key = \"JB_1_to2\"; label = \"Attributfilter\";}"
                ":radio_row{"
                ":radio_button {key = \"JB_1_r1\"; label = \"Numerischer Vergleich\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"Zeichenkettenvergleich\";}}"
                ":row{"
                ":edit_box{key = \"JB_1_e1\"; label = \"von\";edit_width = 40;allow_accept=true;}"
                ":button {key = \"JB_1_b3\"; label = \"<\";fixed_width = true;}}"
                ":row{"
                ":edit_box{key = \"JB_1_e2\"; label = \"bis\";edit_width = 40;allow_accept=true;}"
                ":button {key = \"JB_1_b4\"; label = \"<\";fixed_width = true;}}"
                ":row{"
                ":edit_box{key = \"JB_1_e3\"; label = \"Filterwert\";edit_width = 40;allow_accept=true;}"
                ":button {key = \"JB_1_b5\"; label = \"<\";fixed_width = true;}}"
                "}"
                ":boxed_column {label = \"Suchoptionen\";"
                ":row {"
                ":button {key = \"JB_1_b2\"; label = \"Blockname &Symbol<\";}"
                ":edit_box{key =\"JB_1_e4\"; label = \"\";edit_width = 40;allow_accept=true;}}"
                ":toggle {key = \"JB_1_to1\"; label = \"z-Wert verwenden\";}"
                "}"
                ":row{fixed_width = true;alignment = centered;"
                ":button {key = \"accept\"; label = \"Suche starten<\";width=20; is_default=true;}"
                ":spacer {width = 2;}"
                ":retirement_button {label = \"&Ende\"; key= \"cancel\"; fixed_width = true;is_cancel=true;}"
                "}"
                "}"


               )
              )
      )
      (close file)
      JB_SFD_$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 auf dem Benutzer von Windows
;;;Übergeben wird der relative Pfad, der hinter den Windows-Pfad angehängt wird. Wenn die Verzeichnisse nicht vorhanden sind werden sie erstellt.
(defun JBf_String:Userpfad:WinUser (UserPfad / )
  
  (setq UserList (JBf_String:Delimiter->List UserPfad "\\"))
  (setq Pfad (strcat "c:\\Users\\"(getvar "LOGINNAME")"\\"))
        

  ;;;wenn UserPfad noch nicht vorhanden, dann erstellen
  (mapcar '(lambda(A)
             (setq Pfad (strcat Pfad A "\\"))
             (if (not (JBf_String:FilePath? Pfad))
               (vl-mkdir Pfad)))
    UserList)
  Pfad
  )
;;;String anhand Trennzeichen in Liste zurückgeben
(defun JBf_String:Delimiter->List (Str Delim / StrList)
  (setq Str (vl-string-left-trim Delim Str)
	Str (vl-string-right-trim Delim Str))
  (if (vl-string-search Delim Str)
    (progn
      (while (vl-string-search Delim Str)
        (setq StrList (cons (substr Str 1 (vl-string-search Delim Str))StrList)
	      Str (vl-string-left-trim Delim(substr Str(+(vl-string-search Delim Str)(+ (strlen Delim)1))))))
      (if (/= Str "")
        (setq StrList (cons Str StrList))))
    (setq StrList (cons Str StrList)))
  (reverse StrList))


;;;Dateipfad prüfen
(defun JBf_String:FilePath? (Pfad / FSO TRUE-FALSE)
  (setq Pfad (if(vl-string-search "." Pfad)(car(fnsplitl  Pfad))Pfad))
  (if (setq FSO (vlax-create-object "Scripting.FilesystemObject"))
    (progn
      (if (vlax-method-applicable-p FSO 'FOLDEREXISTS)
        (setq TRUE-FALSE
               (=(vl-catch-all-apply
                   'vlax-invoke-method
                   (list FSO 'FOLDEREXISTS Pfad)):vlax-true))
        (vlax-release-object FSO))))
  TRUE-FALSE)
	  
;;;--------------------------------------------------------------------------------------------------------
;;;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_vla-blockdef (name / LISTE)
  (if name
  (if (tblsearch "BLOCK" name)
    (progn
  (vlax-for ITEM
    (vla-item
      (vla-get-blocks
        (vla-get-activedocument
          (vlax-get-acad-object)))name)
    (if (= (vla-get-Objectname ITEM) "AcDbAttributeDefinition")
      (setq liste (cons ITEM liste))))
  (reverse liste)))))


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


 ;;;Rückgabe als 3-erTripel mit z=0.0
(defun JBf_list_xyz->xy0 (list_xyz / )
  (if (=(length list_xyz)2)
    (reverse(cons 0.0 (reverse list_xyz)))
    (reverse(cons 0.0 (cdr(reverse list_xyz)))))
  )
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine VLa-Funktionen 							       			   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


;;;PANNEN auf Punkt
;;;ZoomFunktion zum "pannen"
(defun JBf_Zoom:Pan2Pkt (pkt / )
  (vla-zoomcenter (vlax-get-acad-object) (vlax-3d-point pkt) (getvar "VIEWSIZE"))
  )





;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Listen in SIC-Datei sichern  					   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Liste in LSP-Datei sichern
;;;Sichern von Einstellungen, Ausführung
;;;liste => DottetPairList, die es zu sichern gilt
;;;path => vollständiger Dateipfad mit Dateiname
;;;AcadTrustCheck => 'T or NIL, es wird bei 'T ein temnporärer TrustedPath erstellt und danach auch gleich wieder gelöscht
(defun JBf_SIC:sichern (liste FilePath AcadTrustCheck / FILESTREAM X)

  (setq FileStream (open FilePath "w"))
  (write-line "'(" FileStream)
  (mapcar '(lambda (X)
                   (JBf_SIC:sichern:prin1 X FileStream)
           )
          liste
  )
  (write-line ")" FileStream)
  (close FileStream)

  (if
    (if AcadTrustCheck
      (car (JBf_SIC:load:Catch FilePath nil))
      (vl-catch-all-error-p
        (vl-catch-all-apply 'JBf_SIC:load (list FilePath))
      )
    )


    (if (findfile (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
      (progn
        (alert (strcat "Die Sicherungsdatei \n\n"
                       FilePath
                       "\n\n ist fehlerhaft und wird automatisch durch die BAK-Datei\n\n"
                       (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                       "\n\nersetzt."
               )
        )
        (if (vl-file-delete FilePath)
          (vl-file-copy (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak") FilePath)
          (alert (strcat "Die Sicherungsdatei \n\n"
                         FilePath
                         "\n\n ist fehlerhaft und konnte nicht automatisch durch die BAK-Datei\n\n"
                         (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                         "\n\nersetzt werden. Bitte führen Sie diesen Arbeitsgang manuell durch."
                 )
          )
        )
      )

      (alert (strcat "Die Sicherungsdatei \n\n"
                     FilePath
                     "\n\n ist fehlerhaft, bitte löschen Sie diese, anderfalls kann das Programm nicht mehr\n"
                     "ordnungsgemäß starten."
             )
      )
    )
    (if (findfile (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
      (if (vl-file-delete (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
        (vl-file-copy FilePath (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
        (alert (strcat "Für die Sicherungsdatei \n\n"
                       FilePath
                       "\n\n konnte keine BAK-Datei erstellt werden. Bitte löschen Sie die vorh. BAK-Datei\n\n"
                       (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                       "\n\nmanuell."
               )
        )
      )
      (vl-file-copy FilePath (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
    )
  )
)
;;;Laden der Datei um zu prüfen, ob diese korrekt ist!
  (defun JBf_SIC:load (FilePath /)
    (load FilePath)
  )
;;;Pfad muss existieren, Prüfung in aufrufender Funktion und temporärem TrustPath
  (defun JBf_SIC:load:Catch (PathFile ErrMsg / ERROR RETVAL TRUTHPATHSET)
    (if (JBf_AcadSystem:TrustedPaths?)
      (progn
        (setq TruthPathSet 'T)
        (JBf_AcadSystem:TrustedPaths:Add (strcat (car (fnsplitl PathFile)) "..."))
      )
    )

    (setq error (vl-catch-all-error-p
                  (setq RetVal (vl-catch-all-apply 'JBf_SIC:load (list PathFile)))
                )
    )
    (if (and error ErrMsg)
      (alert ErrMsg)
    )

    (if TruthPathSet
      (JBf_AcadSystem:TrustedPaths:Delete (strcat (car (fnsplitl PathFile)) "..."))
    )
    (list error RetVal)
  )
;;;Iteratives lustiges Listenschreiben
  (defun JBf_SIC:sichern:prin1 (A FileStream / B)

    (cond  ;;;wenn einzelner Eintrag
                 ((atom A)
                        (write-line (vl-prin1-to-string A) FileStream)
                 )
      ((and (atom (car A)) (not (cdr A)))  ;;;GC ohne Wert
            (write-line (vl-prin1-to-string A) FileStream)
      )
      ((and (atom (car A)) (cdr A) (not (listp (cdr A))))  ;;;DottedPair
            (write-line (vl-prin1-to-string A) FileStream)
      )
      ((and (atom (car A)) (cdr A) (listp (cdr A)) (= (length (cdr A)) 1) (atom (car (cdr A))))  ;;;GC + Wert
            (write-line (strcat "(" (vl-prin1-to-string (car A))) FileStream)
            (mapcar '(lambda (B)
                             (JBf_SIC:sichern:prin1 B FileStream)
                     )
                    (cdr A)
            )
         (write-line ")" FileStream)
      )
      ((and (atom (car A)) (cdr A) (listp (cdr A)))  ;;;GC + Liste
            (write-line (strcat "(" (vl-prin1-to-string (car A))) FileStream)
            (mapcar '(lambda (B)
                             (JBf_SIC:sichern:prin1 B FileStream)
                     )
                    (cdr A)
            )
         (write-line ")" FileStream)
      )
      ( 'T
        (write-line "(" FileStream)
        (mapcar '(lambda (B)
                         (JBf_SIC:sichern:prin1 B FileStream)
                 )
                A
        )
         (write-line ")" FileStream)
      )
    )
  )             

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

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

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

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

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

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

;;;DCL-Liste komplett neu füllen
(defun JBf_Dcl:AddList:New (key liste / )
  (start_list key 3)
  (mapcar 'add_list liste)
  (end_list)
  )

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

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|Symbolfinder pro Punktblock.                                |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: SFD                                    |"
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)










