(vl-load-com)

(defun BrowseForFolder (text / ret y)
  (setq y (vlax-get-or-create-object "shell.application"))
  (if (setq ret (vlax-invoke y "BrowseForFolder" 0 text 1))
    (setq ret (vlax-get (vlax-get ret "Self") "Path"))
  )
  (vlax-release-object y)
  ret
)

(defun purge_list (liste / dummy_list ent)
  (setq dummy_list (list))
  (foreach ent liste
    (if	(not (member ent dummy_list))
      (setq dummy_list (cons ent dummy_list))
    )
  )
  (reverse dummy_list)
)

(defun k_sort_list (sort_list stelle / dummy_list dummy n i)
  (if (/= (type stelle) 'list)
    (setq stelle (list stelle))
  )
  (foreach n stelle
    (setq dummy_list (list))
    (mapcar '(lambda (dummy)
	       (if (= (type dummy) 'list)
		 (setq dummy_list (cons (nth n dummy) dummy_list))
		 (setq dummy_list (cons dummy dummy_list))
	       )
	     )
	    sort_list
    )
    (setq dummy_list (reverse dummy_list))
    (setq sort_i (reverse (vl-sort-i dummy_list '>)))
    (setq n (length sort_i))
    (setq
      sort_list	(mapcar
		  '(lambda (i)
		     (princ (strcat "\r" (itoa (setq n (1- n))) "  "))
		     (nth i sort_list)
		   )
		  sort_i
		)
    )
  )
  sort_list
)

(defun mk_tree_files (pfad	    verz_nicht	  filter
		      /		    alle_pfad_list
		      startpfad_list		  verz_list
		      dummy_list    pfade
		     )
  (apply
    'append
    (vl-remove 'nil
	       (mapcar '(lambda	(pfad)
			  (mapcar '(lambda (file) (strcat pfad file))
				  (vl-directory-files pfad filter 0)
			  )
			)
		       (mk_tree pfad verz_nicht)
	       )
    )
  )
)


(defun mk_tree (pfad verz_nicht)

  (defun mk_tree_work (liste pfad / directory dummy files)
    (if	(setq files (vl-directory-files pfad nil 1))
      (setq liste (append liste
			  (mapcar '(lambda (filename)
				     (strcat pfad filename)
				   )
				  (vl-directory-files pfad nil 1)
			  )
		  )
      )
    )
    (mapcar '(lambda (directorys)
	       (setq liste
		      (mk_tree_work liste (strcat pfad directorys "\\"))
	       )
	     )
	    (vl-remove-if
	      '(lambda (dummy)
		 (member dummy (append verz_nicht '("." "..")))
	       )
	      (vl-directory-files pfad nil -1)
	    )
    )
    liste
  )

  (mk_tree_work nil pfad)
)

(defun k_dbx_get_layer_tree ()
  (k_sort_list
    (purge_list
      (apply 'append
	     (odbx-tree-grundfunktion
	       '(lambda	(dbx_interface / layerliste)
		  (vlax-for
			    layer
				 (vla-get-layers
				   dbx_interface
				 )
		    (setq layerliste
			   (append
			     layerliste
			     (list (list (strcase (vla-get-name layer))
					 (vla-get-color layer)
					 (strcase (vla-get-linetype layer))
				   )
			     )
			   )
		    )
		  )
		)
	     )
      )
    )
    0
  )
)

(defun k_dbx_put_layer_tree (layerliste)
  (odbx-tree-grundfunktion
    '(lambda (dbx_interface)

;;;(vlax-dump-object (vla-get-activedocument (vlax-get-acad-object)))

;;;  (setq datei (vla-get-activedocument (vlax-get-acad-object)))

       (setq ziellayerliste
	      (mapcar '(lambda (layer)
			 (subst	(nth 1 (assoc "Name neu" layer))
				(assoc "Name neu" layer)
				layer
			 )
		       )
		      (cdr (assoc "Ziellayerdaten" layerliste))
	      )
       )
       (setq zuordnungsliste
	      (mapcar
		'(lambda (layer)
		   (cons
		     (nth 1 (assoc "Name alt" layer))
		     (append
		       layer
		       (cdr (assoc (nth 1 (assoc "Name neu" layer))
				   ziellayerliste
			    )
		       )
		     )
		   )
		 )
		(cdr (assoc "Zuordnung" layerliste))
	      )
       )
;;; Layer umbenennen und Layer merken die nicht umbenennt werden können
       (setq kill_list nil)
       (vlax-for layer (vla-get-layers dbx_interface)
	 (if (assoc (vla-get-name layer) zuordnungsliste)
	   (progn
	     (setq
	       data (cdr (assoc (vla-get-name layer) zuordnungsliste))
	     )
	     (if (vl-catch-all-error-p
		   (vl-catch-all-apply
		     'vla-put-name
		     (list layer (nth 1 (assoc "Name neu" data)))
		   )
		 )
	       (setq kill_list (cons (vla-get-name layer) kill_list))
	     )
	   )
	 )
       )
;;; Layereingenschaften ändern
       (vlax-for layer (vla-get-layers dbx_interface)
	 (if (assoc (vla-get-name layer) ziellayerliste)
	   (progn
	     (setq
	       data (cdr (assoc (vla-get-name layer) ziellayerliste))
	     )
	     (vla-put-color layer (nth 1 (assoc "Farbe" data)))
	     (vla-put-linetype layer (nth 1 (assoc "Linientyp" data)))
	   )
	 )
       )
;;; Objekteigenschaften ändern (übriggebliebene Layer)
       (setq layouts
	      (vla-get-layouts
		dbx_interface
	      )
       )
       (vlax-for layout	layouts
	 (setq layoutname (vla-get-name layout))
	 (print layoutname)
	 (vlax-for obj_name (vla-get-block layout)
	   (if (setq
		 lay_data
		  (cdr (assoc (vla-get-layer obj_name) zuordnungsliste)
		  )
	       )
	     (progn
	       (vla-put-layer
		 obj_name
		 (nth 1 (assoc "Name neu" lay_data))
	       )
	       (print lay_data)
	     )
	   )

;;; Unterobjekte bearbeiten (Attribute, SEQEND)



	 )
       )

;;; Blockdefinitionen bearbeiten

;;; Layer bereinigen

       (princ)
     )
  )
)

(defun odbx-tree-grundfunktion (funktion / rückgabe)

  (defun k_odbx_funktion
	 (files_list / dateiname dbx_interface rückgabe)

    (setq rückgabe
	   (mapcar '(lambda (dateiname / rückgabe)
		      (print)
		      (print (vl-filename-base dateiname))
		      (princ)
		      (vla-open
			(setq dbx_interface (k_get_interface_object))
			dateiname
		      )
		      (setq rückgabe ((eval funktion) dbx_interface))
		      (vla-saveas dbx_interface dateiname)
		      (vlax-release-object dbx_interface)
		      rückgabe
		    )
		   files_list
	   )
    )
  )
  (command "zurück" "b")

;;;  ("C:/Dokumente und Einstellungen/Andreas/Eigene Dateien/")
;;;
;;;"C:\\Dokumente und Einstellungen\\Andreas\\Eigene Dateien"

  (if (setq pfad (strcat (BrowseForFolder "Startordner wählen") "\\"))
    (setq files_list (mk_tree_files pfad '("alt") "*.dwg"))
  )

;;;  (if (null pfad)
;;;    (setq pfad (getvar "dwgprefix"))
;;;  )
;;;  (if (setq pfad (k_pfadwahl pfad nil nil nil nil))
;;;    (progn
;;;      (setq pfad (nth 0 pfad))
;;;      (setq files_list (mk_tree_files pfad '("alt") "*.dwg"))
;;;    )
;;;  )
  (setq rückgabe (k_odbx_funktion files_list))
  (command "zurück" "e")
  rückgabe
)

(defun k_get_interface_object ()
  (vl-catch-all-apply
    'vla-getinterfaceobject
    (append
      (list (vlax-get-acad-object))
      (vl-remove-if
	'not
	(mapcar
	  (function
	    (lambda (version)
	      (if
		(findfile
		  (vl-registry-read
		    (strcat
		      "HKEY_CLASSES_ROOT\\CLSID\\"
		      (vl-registry-read
			(strcat	"HKEY_CLASSES_ROOT\\"
				version
				"\\CLSID"
			)
		      )
		      "\\InProcServer32"
		    )
		  )			;prüft, welche dll-Datei für die ObjectDBX-Version registriert ist, ->
		)			;wenn file in den Supportpfaden, dann isses gut
		 version
		 nil
	      )
	    )
	  )
	  (vl-remove-if-not
	    '(lambda (VARIABLE)
	       (wcmatch VARIABLE "ObjectDBX.AxDbDocument.*")
	     )
	    (vl-registry-descendents "HKEY_CLASSES_ROOT")
	  )				;Rückgabe: Liste aller registrierten ObjectDBX-Versionen
	)
      )					;Liste mit einer gültigen Version als Text
    )
  )					;Rückgabewert ist VLA-Object der aktuellen DBX-Variante
)

(defun k_write_datei (pfad liste / datei)

  (defun k_write_datei_do (data_list)
    (defun k_write_datei_re (data_list)
      (if (vl-every 'atom data_list)
	(print data_list datei)
	(progn
	  (write-line "" datei)
	  (write-char (ascii "(") datei)
	  (mapcar '(lambda (data)
		     (if (atom data)
		       (print data datei)
		       (k_write_datei_re data)
		     )
		   )
		  data_list
	  )
	  (write-char (ascii ")") datei)
	)
      )
    )
    (if	(vl-every 'atom data_list)
      (print data_list)
      (k_write_datei_re data_list)
    )
  )

  (setq datei (open pfad "w"))
  (write-line "(quote " datei)
  (k_write_datei_do liste)
  (write-line "" datei)
  (write-line ")" datei)
  (close datei)
  (princ)
)

(defun c:k_dbx_txt_layer_tree (/ layerliste)
  (setq layerliste (k_dbx_get_layer_tree))
  (setq	layerliste
	 (list (cons "Zuordnung"
		     (mapcar '(lambda (layer)
				(list (list "Name alt" (nth 0 layer))
				      (list "Name neu" (nth 0 layer))
				)
			      )
			     layerliste
		     )
	       )
	       (cons "Ziellayerdaten"
		     (mapcar '(lambda (layer)
				(list (list "Name neu" (nth 0 layer))
				      (list "Farbe" (nth 1 layer))
				      (list "Linientyp" (nth 2 layer))
				)
			      )
			     layerliste
		     )
	       )
	 )
  )
  (k_write_datei (strcat pfad "layer.txt") layerliste)
  (princ)
)

(defun k_lay_chg (layerliste)

;;;(vlax-dump-object (vla-get-activedocument (vlax-get-acad-object)))

;;;  (setq datei (vla-get-activedocument (vlax-get-acad-object)))

  (setq	ziellayerliste
	 (mapcar '(lambda (layer)
		    (subst (nth 1 (assoc "Name neu" layer))
			   (assoc "Name neu" layer)
			   layer
		    )
		  )
		 (cdr (assoc "Ziellayerdaten" layerliste))
	 )
  )
  (setq	zuordnungsliste
	 (mapcar
	   '(lambda (layer)
	      (cons
		(nth 1 (assoc "Name alt" layer))
		(append
		  layer
		  (cdr (assoc (nth 1 (assoc "Name neu" layer)) ziellayerliste)
		  )
		)
	      )
	    )
	   (cdr (assoc "Zuordnung" layerliste))
	 )
  )

  (vlax-for layer (vla-get-layers dbx_interface)
    (if	(assoc (vla-get-name layer) zuordnungsliste)
      (progn
	(setq data (cdr (assoc (vla-get-name layer) zuordnungsliste)))
	(vla-put-name layer (nth 1 (assoc "Name neu" data)))

	(vla-put-color layer (nth 1 (assoc "Farbe" data)))
	(vla-put-linetype layer (nth 1 (assoc "Linientyp" data)))
      )
    )
  )

  (vlax-for layer (vla-get-layers dbx_interface)
    (if	(assoc (vla-get-name layer) ziellayerliste)
      (progn
	(setq data (cdr (assoc (vla-get-name layer) ziellayerliste)))
	(vla-put-color layer (nth 1 (assoc "Farbe" data)))
	(vla-put-linetype layer (nth 1 (assoc "Linientyp" data)))
      )
    )
  )

  (setq	layouts
	 (vla-get-layouts
	   dbx_interface
	 )
  )

  (vlax-for layout layouts
    (setq layoutname (vla-get-name layout))
    (print layoutname)
    (vlax-for obj_name (vla-get-block layout)
      (if (setq
	    lay_data
	     (cdr (assoc (vla-get-layer obj_name) zuordnungsliste)
	     )
	  )
	(progn
	  (vla-put-layer obj_name (nth 1 (assoc "Name neu" lay_data)))
	  (print lay_data)
	)
      )
    )
  )
  (princ)
)

(defun c:k_dbx_konv_layer_tree (/ layerliste)
  (setq
    pfad (getfiled "Layerdatei öffnen" (getvar "dwgprefix") "txt" 2)
  )
  (setq layerliste (load pfad))

  (k_dbx_put_layer_tree layerliste)
  (princ)
)

(print
  "zum Erstellen der Textdatei mit den Layereinstellungen -> k_dbx_txt_layer_tree ausführen"
)
(print
  "zum Konvertieren der Layer nach ändern der Textdatei -> k_dbx_konv_layer_tree ausführen"
)
(princ)