;| acmListLayoutsOfFiles

Alle Layoutnamen aus DWGs und DWts, die mit einem integrierten Dialogfeld aus verschiedenen Ordnern ausgewählt wurden,
in eine Liste speichern.
Diese Liste wird im Textfenster ausgegeben und in einer CSV-Datei gespeichert.


Plattform: ab AutoCAD 2024

Copyright
Markus Hoffmann, www.CADmaro.de

August 2025
|;
(defun c:acmListLayoutsOfFiles (/ dclfile lOpenFiles lFiles sPathDestination ll sCSVFile)
  (mx:Init)
  (MakeDCL:GetFiles
    (setq dclfile
           (strcat (getvar "TEMPPREFIX") "mxGetFiles.dcl")
    )
  )
  (vlax-for o (vla-get-documents oAC)
    (setq lOpenFiles
           (cons
             (strcase (vla-get-Fullname o))
             lOpenFiles
           )
    )
  )
  (if
    (and
      (setq lFiles (c:mxMultiFileSelect dclfile))
      (setq sPathDestination
             (mx:GetFolder
               "Zielordner für Layoutliste wählen:"
             )
      )
    )
     (progn
       (mapcar 'mx:GetLayoutnames lFiles)
       (foreach s ll
         (princ (car s))
         (princ ": ")
         (princ (mx:ListOfStrings2TokenedString (last s) ","))
         (princ "\n")
       )
       (setq sCSVFile
              (strcat
                sPathDestination
                "\\acmListLayoutsOfFiles.csv"
              )
       )
       (LM:writecsv (mapcar 'flat ll) sCSVFile)
       (princ
         (strcat
           "\n Datei "
           sCSVFile
           " mit diesen Daten wurde erstellt."
         )
       )
       (textscr)
     )
     (alert "Keine DWG-Dateien spezifiziert.")
  )
  (mx:Reset)
  (princ)
)

 ;| mx:GetLayoutnames

Layouts des übergebenen DWG-Namens als Liste zurückgeben
|;
(defun mx:GetLayoutnames (sFile / oDBX l)
  (setq oDBX
         (vla-GetInterfaceObject
           oAC
           (strcat "ObjectDBX.AxDbDocument."
                   (substr (getvar "ACADVER") 1 2)
           )
         )
  )
  (if
    (and
      lOpenFiles
      (not (member (strcase sFile) lOpenFiles))
    )
     (progn
       (vla-Open oDBX sFile :vlax-true)
       (vlax-for oLayout (vla-get-Layouts oDBX)
         (if
           (/= "MODEL"
               (strcase (setq sName (vlax-get-property oLayout 'Name)))
           )
            (setq l (cons sName l))
         )
       )
       (setq ll (cons (list sFile (reverse l)) ll))
     )
     (alert
       (strcat
         "Prüfung gegen bereits geöffnete Dateien konnte nicht durchgeführt werden.\nKonnte "
         sFile
         " nicht öffnen."
       )
     )
  )
  (vlax-release-object oDBX)
)

 ;| mx:GetFolder

Ordnerauswahl
|;
(defun mx:GetFolder (s / dir item path)
  (cond
    (
     (setq dir
            (vlax-invoke
              (vlax-get-or-create-object "Shell.Application")
              'browseforfolder
              0
              s
              1
              ""
            )
     )
     (cond
       (
        (not
          (vl-catch-all-error-p
            (vl-catch-all-apply
              'vlax-invoke-method
              (list dir 'items)
            )
          )
        )
        (setq item
               (vlax-invoke-method
                 (vlax-invoke-method dir 'items)
                 'item
               )
        )
        (setq path (vla-get-path item))
       )
     )
    )
  )
  path
)

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil
(defun LM:writecsv (lst csv / des sep)
  (if (setq des (open csv "w"))
    (progn
      (setq
        sep (cond ((vl-registry-read
                     "HKEY_CURRENT_USER\\Control Panel\\International"
                     "sList"
                   )
                  )
                  (",")
            )
      )
      (foreach row lst (write-line (LM:lst->csv row sep) des))
      (close des)
      t
    )
  )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token
(defun LM:lst->csv (lst sep)
  (if (cdr lst)
    (strcat (LM:csv-addquotes (car lst) sep)
            sep
            (LM:lst->csv (cdr lst) sep)
    )
    (LM:csv-addquotes (car lst) sep)
  )
)
(defun LM:csv-addquotes (str sep / pos)
  (cond
    ((wcmatch str (strcat "*[`" sep "\"]*"))
     (setq pos 0)
     (while (setq pos (vl-string-position 34 str pos))
       (setq str (vl-string-subst "\"\"" "\"" str pos)
             pos (+ pos 2)
       )
     )
     (strcat "\"" str "\"")
    )
    (str)
  )
)

 ;| flat

Ebnet eine Liste ein, egal wie viele Verschachtlungs-Ebenen es gibt
|;
(defun flat (lst)
  (cond
    ((null lst) nil)
    ((atom (car lst))
     (cons (car lst) (flat (cdr lst)))
    )
    ('sonst
     ;; kann Probleme verursachen, wenn DottedPairs verwendet werden -> bei Bedarf anpassen
     (append (flat (car lst)) (flat (cdr lst)))
    )
  )
)

 ;| mxMultiFileSelect

Dateiauswahl für mehrerer Dateien
Dialogdatei mxGetFiles.dcl wird zur Laufzeit generiert
|;
(defun c:mxMultiFileSelect (dclfile    /          sFolder    iFolder
                            diafiles   lFolders   sExt       iFile
                            lFiles     lFilelist  lExtlist   idDia
                            diaSel     lDiaFiles
                           )
  (if
    (setq idDia dclfile)
     (progn
       (setq
         sFolder  (strcase (getvar 'DWGPREFIX)) ; Startordner
         sExt     "*.dwg"               ; Dateiendung für Dateiauswahl
         lFolders (mapcar 'strcase (vl-directory-files sFolder nil -1))
                                        ; Ordner im Startordner
         lFiles   (vl-directory-files sFolder sExt 1)
                                        ; Dateien im Startordner
         lExtlist (list "*.dwg" "*.dwt")
                                        ; weitere mögliche Dateiendungen zur Auswahl
         iFolder  0                     ; Startcounter
         iFile    0                     ; Startcounter
         idDia    (load_dialog idDia)   ; Dialogdatei
       )
       (new_dialog "mxMultiFileSelect" idDia)
       (start_list "dirs")
       (mapcar 'add_list lFolders)
       (end_list)
       (start_list "fils")
       (mapcar 'add_list lFiles)
       (end_list)
       (start_list "fspec")
       (mapcar 'add_list lExtlist)
       (end_list)
       (set_tile "directory" sFolder)
       (set_tile "dirs" (itoa iFolder))
       (set_tile "fils" (itoa iFile))
       (action_tile
         "dirs"
         "(progn (setq iFolder (atoi $value)) (mx:SetDir))"
       )
       (action_tile
         "fils"
         "(progn (setq diaFiles $value)(mx:GetFilelist))"
       )
       (action_tile "sels" "(setq diaSel $value)")
       (action_tile "fspec" "(mx:SetExt $value)")
       (action_tile ">" "(mx:AddFile)")
       (action_tile "<" "(mx:RemoveFile)")
       (action_tile "clear" "(mx:Clear)")
       (if
         (not (= (start_dialog) 1))
          (setq lFilelist nil)
       )
       (unload_dialog idDia)
       lFilelist
     )
  )
)

 ;| mx:AddFile

Fügt ausgewählte Dateien ("fils") in der Dialogbox in die Ergebnisliste ("sels) ein
|;
(defun mx:AddFile ()
  (if lDiaFiles
    (progn
      (setq
        lDiaFiles
         (mapcar
           '(lambda (X)
              (strcat sFolder X)
            )
           lDiaFiles
         )
      )
      (foreach i lDiaFiles
        (if (not (member i lFilelist))
          (if lFilelist
            (setq lFilelist (append lFilelist (list i)))
            (setq lFilelist (list i))
          )
        )
      )
      (setq lFilelist (acad_strlsort lFilelist))
      (start_list "sels")
      (mapcar 'add_list lFilelist)
      (end_list)
      (mode_tile "fils" 2)
    )
  )
  (setq lDiaFiles nil)
)

 ;| mx:RemoveFile

Entfernt ausgeählte Dateien aus der Ergebnisliste im Dialogfeld
|;
(defun mx:RemoveFile (/ c lFilelist2 iNum1 lNums)
  (if diaSel
    (progn
      (setq
        lNums      (reverse
                     (vl-sort
                       (read
                         (strcat "(" diaSel ")")
                       )
                       '<
                     )
                   )
        lFilelist2 nil
        c          0
      )
      (repeat (length lFilelist)
        (if (not (member c lNums))
          (setq lFilelist2 (cons (nth c lFilelist) lFilelist2))
        )
        (setq c (1+ c))
      )
      (if lFilelist2
        (setq lFilelist (acad_strlsort lFilelist2))
        (setq lFilelist lFilelist2)
      )
      (start_list "sels")
      (mapcar 'add_list lFilelist)
      (end_list)
      (setq iNum1 (car (reverse lNums)))
      (if (= iNum1 (length lFilelist))
        (setq iNum1 (1- iNum1))
      )
      (if (< iNum1 0)
        (setq iNum1 0)
      )
      (setq diaSel (itoa iNum1))
      (if (> (length lFilelist) 0)
        (progn
          (set_tile "sels" (itoa iNum1))
          (mode_tile "sels" 2)
        )
      )
    )
  )
)

 ;| mx:SetExt

Ändert die angezeigte Dateiliste entsprechend der gewählten Extension
|;
(defun mx:SetExt (sInt)
  (setq
    sExt   (nth (atoi sInt) lExtlist)
    lFiles (vl-directory-files sFolder sExt 1)
    iFile  0
  )
  (start_list "fils")
  (mapcar 'add_list lFiles)
  (end_list)
  (if lFiles
    (progn
      (set_tile "fils" "0")
      (mode_tile "fils" 2)
      (setq diaFiles "0")
      (mx:GetFilelist)
    )
  )
)

 ;| mx:Clear

Leert das Feld der ausgewählten Dateien
|;
(defun mx:Clear ()
  (setq lFilelist nil)
  (start_list "sels")
  (mapcar 'add_list lFilelist)
  (end_list)
)

 ;| mx:GetFilelist

Gewählte Dateien auslesen
|;
(defun mx:GetFilelist (/ lNums)
  (setq lNums
         (reverse
           (read
             (strcat "(" diaFiles ")")
           )
         )
        lDiaFiles nil
  )
  (foreach i lNums
    (setq lDiaFiles
           (cons
             (nth i lFiles)
             lDiaFiles
           )
    )
  )
)

 ;| mx:SetDir

Ordner und Dateien des ausgewählten Ordners holen
|;
(defun mx:SetDir (/ c)
  (if (= (nth iFolder lFolders) ".")
    (setq sFolder "C:\\")
    (if (= (nth iFolder lFolders) "..")
      (progn
        (setq c (- (strlen sFolder) 2))
        (while (/= (substr sFolder c 1) "\\")
          (setq c (- c 1))
        )
        (if (> c 0)
          (setq sFolder (substr sFolder 1 c))
        )
      )
      (setq sFolder (strcat sFolder (nth iFolder lFolders) "\\"))
    )
  )
  (setq
    lFolders (vl-directory-files sFolder nil -1)
    lFiles   (vl-directory-files sFolder sExt 1)
    iFolder  0
    iFile    0
  )
  (start_list "dirs")
  (mapcar 'add_list lFolders)
  (end_list)
  (start_list "fils")
  (mapcar 'add_list lFiles)
  (end_list)
  (set_tile "directory" sFolder)
  (set_tile "dirs" "0")
  (set_tile "fils" "0")
  (mode_tile "fils" 2)
  (if lFiles
    (progn
      (setq diaFiles "0")
      (mx:GetFilelist)
    )
  )
)

 ;| MakeDCL:GetFiles

DCL-Datei für mx:MultiFileSelect zur Auswahl mehrerer Dateien erzeugen
|;
(defun MakeDCL:GetFiles (fname / fh)
  (setq fh (open fname "w"))
  (mapcar
    '(lambda (arg)
       (write-line arg fh)
     )
    (list
      "mxMultiFileSelect : dialog {"
      "label = \"Dateien auswählen\";"
      ": column {"
      ": spacer {"
      "}"
      ": text {"
      "value = \"Aktueller Ordner\";"
      "}"
      ": text_part {"
      "key  = \"directory\";"
      "fixed_width_font = true;"
      "}"
      ": spacer {"
      "}"
      ": boxed_column {"
      ": popup_list   {"
      "key   = \"fspec\";"
      "label = \"Dateityp:\";"
      "width = 20;"
      "fixed_width_font = true;"
      "fixed_width = true;"
      "}"
      ": spacer_1 {"
      "}"
      "}"
      ": row {"
      ": column {"
      ": row {"
      ": list_box {"
      "key = \"dirs\";"
      "label = \"Ordner:\";"
      "height = 20;"
      "width = 40;"
      "fixed_width_font = true;"
      "fixed_width = true;"
      "}"
      ": list_box {"
      "key = \"fils\";"
      "label = \"Dateien\";"
      "height = 10;"
      "width = 60;"
      "multiple_select = true;"
      "fixed_width_font = true;"
      "fixed_width = true;"
      "}"
      "}"
      "}"
      "}"
      ": row {"
      ": column {"
      ": spacer {"
      "}"
      "}"
      ": column {"
      ": spacer{"
      "}"
      "}"
      ": column {"
      ": spacer {"
      "}"
      "}"
      ": row {"
      ": button {"
      "alignment = right;"
      "key = \">\";"
      "label = \"Hinzufügen\";"
      "height = 2;"
      "width = 20;"
      "fixed_width = true;"
      "}"
      ": button {"
      "alignment = right;"
      "key = \"<\";"
      "label = \"Entfernen\";"
      "height = 2;"
      "width = 20;"
      "fixed_width = true;"
      "}"
      ": button {"
      "alignment = right;"
      "key = \"clear\";"
      "label = \"Auswahl leeren\";"
      "height = 2;"
      "width = 20;"
      "fixed_width = true;"
      "}"
      "}"
      "}"
      ": row {"
      ": list_box {"
      "key = \"sels\";"
      "label = \"Ausgewählte Dateien\";"
      "height = 10;"
      "width = 105;"
      "multiple_select = true;"
      "fixed_width_font = true;"
      "fixed_width = true;"
      "}"
      "}"
      "}"
      "ok_cancel;"
      "}"
     )
  )
  (close fh)
)

 ;| mx:ListOfStrings2TokenedString

Liste von Strings in einen String konvertieren mit sToken als Trenner
|;
(defun mx:ListOfStrings2TokenedString (lStrings sToken)
  (apply
    'strcat
    (cons
      (car lStrings)
      (mapcar
        (function
          (lambda (x)
            (strcat sToken x)
          )
        )
        (cdr lStrings)
      )
    )
  )
)

 ;| mx:Init

Initialisierung
|;
(defun mx:Init ()
  (vl-load-com)
  (setq oAC (vlax-get-acad-object))
  (setq oAD (vlax-get-property oAC 'ActiveDocument))
  (setq oADUtils
         (vlax-get-property
           oAD
           'Utility
         )
  )
  (setq iECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq mx-err  *error*
        *error* mx:Error
  )
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-invoke-method oAD 'StartUndomark)
)

 ;| mx:Reset

Zurücksetzen
|;
(defun mx:Reset ()
  (setvar "CMDECHO" iECHO)
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-release-object oAD)
  (if oDBX
    (vlax-release-object oDBX)
  )
  (setq *error* mx-err)
  (mapcar
    '(lambda (arg)
       (set
         arg
         'nil
       )
     )
    (list 'mx-err 'iECHO 'oAD 'oAC 'oDBX)
  )
)

 ;| mx:Error

Errorfunktion
|;
(defun mx:Error (s)
  (print (strcat "Fehler " s))
  (command-s "_.undo" "_back")
  (mx:Reset)
  (princ)
)

(defun c:LLOF ()
  (c:acmListLayoutsOfFiles)
)

;;; Feedback beim Laden
(princ
  "\n\"acmListLayoutsOfFiles\" zur Analyse von DWGs und DWTs verschiedener Ordners wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
  Start mit \"acmListLayoutsOfFiles\" oder \"LLOF\"."
)
(princ)