
;;;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: LGZ - Wenn Zeichnungselemente (i.d.R. eine Legende) zeilenmäßig angeordnet sind können durch
;;; eine Kopie von einer oder mehreren Zeilen Objekte diese eingefügt werden, dabei werden vorhandene Zei- 
;;; len nach oben oder unten aufgerückt. Beim Löschen von einer oder mehrerer Zeilen werden wieder die	   
;;; verbleibenden Zeilen von unten oder oben nachgerückt.						   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:											   
;;;- JB_LGZ$$vla-objList (Liste mit x,y-Angaben und den VLA-Objekten, die berücksichtigt werden sollen)    
;;;- JB_LGZ$DCL$_[x]_po (Positionen der Dialogfenster)							   
;;;- JB_LGZ_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 09.04.24	   
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:LGZ ( / )
  (JB_LGZ)
  )

;;;Intro
(defun JB_LGZ:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------LGZ(1.0), 09.04.24----------------------")
  (princ str)
  (princ "\n--------------------------------------------------------------")
  )




;;;Variablenliste
(defun JB_LGZ:v_liste ( / )
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ("LastButton" . "JB_1_b0")
                             ("JB_1_r1-2" . 1);;;0 = Oben, 1 = Unten
                             )
                          )
                         )
      ))
  )


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

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

  (setq pfad_ini (JB_LGZ: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_LGZ:v_liste))pfad_ini nil))
  
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))

  (setq Osmode_Alt (getvar "OSMODE"))
  
  
  (JB_LGZ:Intro "\nLegendenzeilen kopieren oder löschen.")

  
  (if (not
            (or (and JB_LGZ_$DCL$_File(findfile JB_LGZ_$DCL$_File))
                (setq JB_LGZ_$DCL$_File (JB_LGZ:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))
  (if (JB_LGZ:Bks-WKS:parallel-p)
    (JB_LGZ:Dbox1 v_liste pfad_ini)
    )
      
   
  (princ "\nEnde.")
  (JBf_Reinit)
  (setvar "OSMODE" Osmode_Alt)
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) 
  (princ)
  )


;;;Prüfen, ob WKS oder BKS in xy-Ausrichtung zum WKS
(defun JB_LGZ:Bks-WKS:parallel-p ( / )
  (or(and(if (/=(getvar "WORLDUCS")1);;;wenn BKS
    (and(equal(caddr(trans '(1 0 0)1 0))0.0 0.0001)
        (equal(caddr(trans '(0 1 0)1 0))0.0 0.0001))
    'T)
      (equal(car (getvar "VIEWDIR"))0.0 0.0001)
      (equal(cadr (getvar "VIEWDIR"))0.0 0.0001))
  (alert (strcat "Für die Verwendung des Programms \"LGZ\" müssen Sie sich im WKS oder einem BKS, dessen xy-Ebenen-Ausrichtung der xy-Ebenen-Ausrichtung des Weltkoordinatensystems entspricht.\n"
                 "Zudem muss die DRAUFSICHT auf das aktuelle Koordinatensystem aktiviert sein."))
     )
  )

 

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


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


;;;Legenden-Vla-ObjektListe prüfen, ob Objekte gültig
(defun JB_LGZ:Dbox1:vla-objList:Check  ( / )
  (setq WcsAktiv (=(getvar "WORLDUCS")1))
  (setq JB_LGZ$$vla-objList
         (vl-remove-if 'not
           (mapcar '(lambda(X)
                      (if (and (handent (car X))
                               (entget (handent (car X))))
                        (progn
                          (setq coords (JBf_PointInPoly:BoundingBox (caddr X) WcsAktiv 'T))
                          (setq mp (JBf_list:MidPoint(car coords)(caddr coords)))
                        (list (car X)mp(caddr X))
                        )
                        ))JB_LGZ$$vla-objList)))
  )
                    


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

  (JB_LGZ:Dbox1:vla-objList:Check)

  (setq Settings&Dbox1 (JB_LGZ:v_liste:DboxSettings:get "Dbox1" v_liste))
  
  (while (not (member ok '(1 99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_LGZ_$DCL$_File "JB_LGZ_1" JB_LGZ$DCL$_1_po))
    (JB_LGZ:Dbox1:set)
    (JB_LGZ:Dbox1:mode)
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_LGZ:Dbox1:action \"" A "\")")))
            '("JB_1_b0" "JB_1_b1" "JB_1_b2" 
              "JB_1_r1" "JB_1_r2" 
              "cancel"
             )
    )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    (cond
      ((= ok 10) ;;;Legenden Objekte auswählen
       (JB_LGZ:Dbox1:vla-Objs:get)
       )

      ((= ok 11) ;;;Zeilen kopieren
       (JB_LGZ:Dbox1:Rows:Copy)
       )

      ((= ok 12) ;;;Zeilen löschen
       (JB_LGZ:Dbox1:Rows:Delete)
       )
      ((= ok 99) ;;;Ende
       (setq v_liste (JB_LGZ:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
       (JBf_SIC:sichern v_liste pfad_ini nil)
       )
      )
    )
  
  )



;;;Legenden Objekte als vla-Objekte in Liste mit x und y Wert
(defun JB_LGZ:Dbox1:vla-Objs:get ( / AWS COORDS MP N OBJ VLA-OBJ WCSAKTIV)
  (if (and (princ "\nBitte wählen Sie die Legendenobjekte:")
           (setq aws (ssget)))
    (progn
      (setq JB_LGZ$$vla-objList nil)
      (setq n 0)
      (setq WcsAktiv (=(getvar "WORLDUCS")1))
      (repeat (sslength aws)
        (setq vla-obj (vlax-ename->vla-object(ssname aws n)))
        (setq coords (JBf_PointInPoly:BoundingBox vla-obj WcsAktiv 'T))
        (setq mp (JBf_list:MidPoint(car coords)(caddr coords)))
        (setq JB_LGZ$$vla-objList (cons (list (vla-get-Handle vla-obj) mp vla-obj)JB_LGZ$$vla-objList))
        (setq n (+ n 1))
        )
      )
    )
  )

;;;P1 und P2 für Zeilen
(defun JB_LGZ:Dbox1:Rows:Copy:p1-P2 (Msg / P1 P2)
  (if(and(setq p1 (getpoint (strcat "\nBasispunkt für " Msg ":")))
         (or (= Msg "Aufrücken")
             (setq p2 (getpoint p1 (strcat "\nZweiter Punkt für " Msg ":"))))
         (or (= Msg "Aufrücken")
             (or (/=(abs(- (cadr p2)(cadr p1)))0.0)
                 (alert "Die Differenz beider Punkte in Y muss ungleich 0 sein.")))
         (setq p1 (JBf_list_xyz->xy0(trans p1 1 0)))
         (or (= Msg "Aufrücken")
             (setq p2 (JBf_list_xyz->xy0(trans p2 1 0))))
         )
    (list p1 p2))
  )
  


;;;Zeilen kopieren
(defun JB_LGZ:Dbox1:Rows:Copy ( / COORDS FLAG FUNC MP P1 P2 VLA-OBJ VLA-OBJCOPYLIST VLA-OBJLIST VLA-OBJMOVELIST WCSAKTIV X)
  (if (and(setq vla-ObjList(JB_LGZ:Dbox1:Rows:vla-objList))
          (setq p1(JB_LGZ:Dbox1:Rows:Copy:p1-P2 "Kopie"))
          (setq p2 (cadr p1))
          (setq p1 (car p1)))
          
    (progn
      (setq WcsAktiv (=(getvar "WORLDUCS")1))
      (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))1);;;dann untere Elemente aufrücken
        (progn
          (setq Flag "kleiner")
          (setq Func '<)
          )
        (setq Func '>)
        )
      (setq vla-ObjCopyList
             (mapcar '(lambda(X)
                        (setq vla-obj(vla-copy(caddr X)))
                        (vla-move vla-obj(vlax-3d-Point p1)(vlax-3d-Point p2))
                        (vla-update vla-obj)
                        (setq coords (JBf_PointInPoly:BoundingBox vla-obj WcsAktiv 'T))
                        (setq mp (JBf_list:MidPoint(car coords)(caddr coords)))
                        
                        (list (vla-get-Handle vla-obj) (list mp (if (= Flag "kleiner")
                                                                  (cadddr coords)
                                                                  (car coords))
                                                             )vla-obj)
                              )
               vla-ObjList)
            )

      

      (setq vla-objMoveList(JB_LGZ:Dbox1:Rows:MoveList vla-ObjCopyList Flag Func))
      

      (setq JB_LGZ$$vla-objList (append JB_LGZ$$vla-objList (mapcar '(lambda(X)(list (car X)(car(cadr X))(caddr X)))vla-ObjCopyList)))

      (JB_LGZ:Dbox1:Rows:Copy:Move:Command vla-ObjMoveList)
      )
    )
  )
;;;SchiebenListe
(defun JB_LGZ:Dbox1:Rows:MoveList (vla-objList Flag Func / X YCOPY)
  (setq yCopy (cadr(trans(cadr(cadr(car
                                     (vl-sort vla-ObjList
                                       (function(lambda(e1 e2)
                                                  ((if(= Flag "kleiner") > <)
                                                    (cadr(trans(cadr(cadr e1))0 1))
                                                    (cadr(trans(cadr(cadr e2))0 1)))
                                                  ))))))0 1)))

  (vl-remove-if 'not
    (mapcar '(lambda(X)
               (if((eval Func)(cadr(trans(cadr X)0 1))yCopy)X)
               )
      JB_LGZ$$vla-objList))
  )
  


;;;Zeilen löschen
(defun JB_LGZ:Dbox1:Rows:Delete ( / COORDS FLAG FUNC MP VLA-OBJ VLA-OBJDELETELIST VLA-OBJLIST VLA-OBJMOVELIST WCSAKTIV X Handle)
  (if (setq vla-ObjList(JB_LGZ:Dbox1:Rows:vla-objList))
    (progn
      (setq WcsAktiv (=(getvar "WORLDUCS")1))
      (if (=(cdr(assoc "JB_1_r1-2" Settings&dbox1))1);;;dann untere Elemente aufrücken
        (progn
          (setq Flag "kleiner")
          (setq Func '<)
          )
        (setq Func '>)
        )
      (setq vla-ObjDeleteList
             (mapcar '(lambda(X)
                        (setq vla-obj(caddr X))                        
                        (setq coords (JBf_PointInPoly:BoundingBox vla-obj WcsAktiv 'T))
                        (setq mp (JBf_list:MidPoint(car coords)(caddr coords)))
                        (setq Handle (vla-get-Handle vla-obj))
                        
                        (JBf_aws:Vla-DeleteRefresh (ssadd(vlax-vla-object->ename vla-obj)))
                        (list Handle (list mp (if (= Flag "kleiner")
                                                                  (cadddr coords)
                                                                  (car coords))
                                                             )nil)
                        )
               vla-ObjList)
            )

      (setq JB_LGZ$$vla-objList (vl-remove-if 'not (mapcar '(lambda(X)(if(not(assoc (car X)vla-ObjDeleteList))X)) JB_LGZ$$vla-objList)))

      (setq vla-objMoveList(JB_LGZ:Dbox1:Rows:MoveList vla-ObjDeleteList Flag Func))
      

       

      (JB_LGZ:Dbox1:Rows:Copy:Move:Command vla-ObjMoveList)
      )
    )
  )


;;;Aufrücken-Elemente schieben
(defun JB_LGZ:Dbox1:Rows:Copy:Move:Command (vla-ObjMoveList / AWS P1 X)

  
  (if vla-ObjMoveList
    (progn
      (setq aws (ssadd))
      (mapcar '(lambda(X)(ssadd(vlax-vla-object->ename (caddr X))aws))vla-ObjMoveList)
      

      (setvar "CMDECHO" 1)
      (command"_.move" aws "" pause pause)
      (setvar "CMDECHO" 0)
      )
    )
  )

;;;Zeile auswählen
(defun JB_LGZ:Dbox1:Rows:vla-objList ( / AWS N NMINUS VLA-OBJ VLA-OBJLIST)
  (if (and (princ "\nWählen Sie Zeilenobjekte:")
           (setq aws (ssget)))
    (progn
      (setq n 0)
      (setq nMinus 0)
      
      (repeat (sslength aws)
        (setq vla-obj (vlax-ename->vla-object(ssname aws n)))
        (if (assoc (vla-get-Handle vla-obj)JB_LGZ$$vla-objList)
          (setq vla-ObjList (append vla-objList(list(assoc (vla-get-Handle vla-obj)JB_LGZ$$vla-objList))))
          (setq nMinus (+ nMinus 1))
          )
        (setq n (+ n 1))
        )
      (if (= nMinus (sslength aws))
        (alert "Die ausgewählten Objekte waren keine LegendenObjekte.")
        (if (> nMinus 0)
          (alert (strcat "Von den ausgewählten Objekte wurde " (itoa nMinus) " Objekt(e) entfernt, weil es keine Legendenobjekte waren.")))
        )
      )
    )
  (reverse vla-objList))


        
            
     

;;;Action (Variable global in Aufrufender Funktion)
(defun JB_LGZ:Dbox1:action (key / )
  (cond
    ((= key "JB_1_b0")
     (setq JB_LGZ$DCL$_1_po (done_dialog 10))
     )
    ((= key "JB_1_b1")
     (setq JB_LGZ$DCL$_1_po (done_dialog 11))
     )
    ((= key "JB_1_b2")
     (setq JB_LGZ$DCL$_1_po (done_dialog 12))
     )
    ((= key "JB_1_r1")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (- 1(atoi $value))"JB_1_r1-2"))
     )
    ((= key "JB_1_r2")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (atoi $value)"JB_1_r1-2"))
     )    
    ((= key "cancel") ;;;Ende
     (setq JB_LGZ$DCL$_1_po (done_dialog 99))
     )
    )
  )

;;;DBox1: setten
(defun JB_LGZ:Dbox1:set ( / X)
  (mapcar '(lambda(X)(set_tile (strcat "JB_1_"(car X))(cadr X)))
    (list
      (list "r1" (itoa(- 1(cdr(assoc "JB_1_r1-2" Settings&dbox1)))))
      (list "r2" (itoa(cdr(assoc "JB_1_r1-2" Settings&dbox1))))
      
      )
    )
  )
;;;DBox1, moden
(defun JB_LGZ:Dbox1:mode ( / )
  (if JB_LGZ$$vla-objList
    (progn
      (mode_tile "JB_1_b1" 0)
      (mode_tile "JB_1_b2" 0)     
      (mode_tile (cdr(assoc "LastButton" Settings&dbox1)) 2))
    (progn
      (mode_tile "JB_1_b1" 0)
      (mode_tile "JB_1_b2" 0)      
      (mode_tile "JB_1_b0" 2)
      (alert "Sie müssen Legenden-Objekte auswählen.")
      )
    )
  )
      
 

   
;;;DCL-schreiben
(defun JB_LGZ:dcl:Write ( / file)  
  (if (and (setq JB_LGZ_$DCL$_File (vl-filename-mktemp (strcat "LGZ.dcl")))
           (setq file (open JB_LGZ_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "//Hauptdialog"
                "JB_LGZ_1: dialog {label= \"Legendenzeilen\";"
                ":button {key = \"JB_1_b0\"; label = \"Le&gendenobjekte auswählen<\";}"
                ":boxed_column {label = \"Zeilen\";"
                ":radio_column {label = \"Aufrücken\";"
                ":radio_row {"
                ":radio_button {key = \"JB_1_r1\"; label = \"oben\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"unten\";}}}"
                ":button {key = \"JB_1_b1\"; label = \"&Kopieren<\";}"
                ":button {key = \"JB_1_b2\"; label = \"&Löschen<\";}}"
                ":row{fixed_width = true;alignment = centered;"
                ":retirement_button {label = \"&Ende\"; key= \"cancel\"; fixed_width = true;is_cancel=true;}"
                "}"
                "}"


               )
              )
      )
      (close file)
      JB_LGZ_$DCL$_File
    )
  )
)
;;;--------------------------------------------------------------------------------------------------------
;;;alLGZmeine 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)
)
;;;--------------------------------------------------------------------------------------------------------
;;;alLGZmeine 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)
	  
;;;--------------------------------------------------------------------------------------------------------
;;;alLGZmeine Funktionen => Listen								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Es wird der GcN-Eintrag gesubst
(defun JBf_list:subst:gc (liste Wert GcN / )
  (subst (cons GcN Wert)(assoc GcN liste)liste))



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

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


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


;;;--------------------------------------------------------------------------------------------------------
;;;alLGZmeine Funktionen => Bounding-Box's							   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Transformationsmatrix 4x4
(defun JBf_PointInPoly:TransMatrix:VonNach (von nach / X Y)
  (append
    (mapcar
      '(lambda(X Y)
         (append (trans X von nach 'T) (list Y))
         )
      (list '(1.0 0.0 0.0) '(0.0 1.0 0.0) '(0.0 0.0 1.0))
      (trans '(0.0 0.0 0.0) nach von)
      )
    (list '(0.0 0.0 0.0 1.0))
    )
  )

;;;Bonding-Box, Welt oder BKS
;;;Argumente: vla-obj => wenn Boundingbox verfügbar, dann Rückgabe der Liste ((p1 p2 p3 p4)vla-obj)
;;;WcsAktiv: 'T or NIL
;;;ucsFlag:  'T or NIL => wenn 'T und WcsAktiv NIL, dann wird vor der Bounding-Funktion das vla-obj in das BKS transformiert, gilt nur, wenn die Hochzugsrichtung des BKS's dem WKS entspricht

(defun JBf_PointInPoly:BoundingBox (vla-obj WcsAktiv ucsFlag / COORDS MAXXYZ MINXYZ X)
  (if (vlax-method-applicable-p vla-obj 'getboundingbox)
    (progn
      (if (and (not WcsAktiv)ucsFlag)
        (vla-TransformBy vla-obj (vlax-tmatrix (JBf_PointInPoly:TransMatrix:VonNach 1 0)))
        )
      (vla-getboundingbox vla-obj 'minXYZ 'maxXYZ)
      (setq minXYZ(vlax-safeArray->list minXYZ))
      (setq maxXYZ(vlax-safeArray->list maxXYZ))
      (setq coords (list (list (car minXYZ)(cadr minXYZ)0.0)
                         (list (car maxXYZ)(cadr minXYZ)0.0)
                         (list (car maxXYZ)(cadr maxXYZ)0.0)
                         (list (car minXYZ)(cadr maxXYZ)0.0)))
      (if (and (not WcsAktiv)ucsFlag)
        (progn
          (vla-TransformBy vla-obj (vlax-tmatrix (JBf_PointInPoly:TransMatrix:VonNach 0 1)))
          (setq coords(mapcar '(lambda(X)
                                 (trans X 1 0))coords))
          )
        )
      )
    )
  coords)



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


(defun c:LGZTEST ( / COORDS OBJ WCSAKTIV)
  (setq WcsAktiv (=(getvar "WORLDUCS")1))
  (if (setq obj (car(entsel)))
    (progn
      (setq coords(JBf_PointInPoly:BoundingBox (vlax-ename->vla-object obj)WcsAktiv 'T))
      (entmake (list (cons 0 "LINE")(cons 10 (car coords))(cons 11 (cadr coords))(cons 62 6)))
      (entmake (list (cons 0 "LINE")(cons 10 (cadr coords))(cons 11 (caddr coords))(cons 62 6)))
      (entmake (list (cons 0 "LINE")(cons 10 (caddr coords))(cons 11 (cadddr coords))(cons 62 6)))
      (entmake (list (cons 0 "LINE")(cons 10 (cadddr coords))(cons 11 (car coords))(cons 62 6)))
      )
    )
  )

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

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|Legendenzeilen kopieren oder löschen.                       |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: LGZ                                    |"          
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)








                  












