;| acmZIPx

Zippen von Dateien oder Ordner innerhalb von AutoCAD mithilfe von Powershell-Befehlen

acmZIPAD - speichert die aktuelle DWG und zippt sie in einen ausgewählten Ordner
acmZIPMD - zippt eine Auswahl von Dateien aus verschiedenen Ordnern
acmZIPO - zippt einen Ordner in einen ausgewählten Ordner

Plattform: ab AutoCAD 2024

Copyright
Markus Hoffmann, www.CADmaro.de

Mai 2025
|;


;|acmZIPAD

speichert und zippt die aktuelle Date
|;
(defun c:acmZIPAD (/ sPath sDest)
  (mx:Init)
  (if
    (and
      (setq sDest
             (strcat
               (getvar 'TEMPPREFIX)
               (vla-get-Name oAD)
             )
      )
      (vl-file-copy (vla-get-Fullname oAD) sDest)
      (setq sPath
             (mx:GetFolder
               "Zielordner für ZIP-Datei wählen:"
             )
      )
    )
     (progn
       (startapp
         (strcat
           "powershell -command Compress-Archive -Path '"
           sDest
           "' -DestinationPath '"
           sPath
           "\\"
           (vl-filename-base (vla-get-Name oAD))
           ".zip'"
         )
       )
       (alert "Fertig!")
       (vl-file-delete sDest)
     )
  )
  (mx:Reset)
  (princ)
)

;| acmZIPO

zippt einen ausgewählten Ordner
|;
(defun c:acmZIPO (/ sPathSource sPathDestination)
  (mx:Init)
  (if
    (and
      (setq sPathSource
             (mx:GetFolder
               "Ordner wählen, der gezippt werden soll:"
             )
      )
      (setq sPathDestination
             (mx:GetFolder
               "Zielordner für ZIP-Datei wählen:"
             )
      )
    )
     (progn
       (startapp
         (strcat
           "powershell -command Compress-Archive -Path '"
           sPathSource
           "' -DestinationPath '"
           sPathDestination
           "\\"
           (vl-filename-base spathsource)
           ".zip'"
         )
       )
       (alert "Fertig!")
     )
  )
  (mx:Reset)
  (princ)
)

;|acmZIPD

Zippt mehrere ausgewählten Dateien
|;
(defun c:acmZIPMD (/ lFiles sPath f)
  (mx:Init)
  (MakeDCL:GetFiles
    (setq dclfile (strcat (getvar "TEMPPREFIX") "mxGetFiles.dcl"))
  )
  (if
    (and
      (setq lFiles (c:mxMultiFileSelect dclfile))
      (setq sPathDestination
             (mx:GetFolder
               "Zielordner für ZIP-Datei wählen:"
             )
      )
    )
     (progn
       (setq s
              (mx:ListOfStrings2TokenedString
                (mapcar
                  '(lambda (s)
                     (strcat "'" s "'")
                   )
                  lFiles
                )
                ", "
              )
       )
       (startapp
         (strcat
           "powershell -command Compress-Archive -Path "
           s
           " -DestinationPath '"
           sPathDestination
           "\\"
           "acmZIPMD"
           ".zip'"
          )
       )
       (alert "Fertig!")
     )
  )
  (vl-file-delete dclfile)
  (mx:Reset)
  (princ)
)

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

;| 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     "*.*"                 ; 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" "*.dxf") ; 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 oAD
         (vlax-get-property
           (vlax-get-acad-object)
           'ActiveDocument
         )
  )
  (setq oADUtils
         (vlax-get-property
           oAD
           'Utility
         )
  )
  (setq iECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq errorMX *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)
  (setq *error* errorMX)
  (mapcar
    '(lambda (arg)
       (set
         arg
         'nil
       )
     )
    (list
      'errorMX
      'iECHO
      'oADUtils
      'oAD
    )
  )
)

 ;| mx:Error

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

;; Feedback beim Laden
(princ
  "\nacmZIPx.lsp wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start mit \"acmZIPAD\" (aktuelle Datei zippen), \"acmZIPO\" (Ordner zippen) oder \"acmZIPMD\" (mehrere Dateien zippen)."
)
(princ)