;| acmBatchETransmit

Alle DWGs, die mithilfe des Multifile-Dialogfensters hinzugefügt wurden,
an den Befehl ETRANSMIT übergeben und jeweils eine eigene ZIP-Datei erstellen.


Plattform: ab AutoCAD 2024

Copyright
Markus Hoffmann, www.CADmaro.de

Februar 2026
|;
(defun c:acmBatchETransmit (/ dclfile lOpenFiles lFiles sFolder fScript f flag)
  (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))
      (findfile
	(setq
	  sFolder (mx:GetFolder "Zielordner für ZIP-Dateien wählen")
	)
      )
    )
     (progn
       (setq fScript (strcat (getvar "TEMPPREFIX") "acmBET.scr"))
       (setq f (open fScript "w"))
       (if lFiles
	 (foreach s lFiles
	   (if
	     (not (member (strcase s) (mapcar 'strcase lOpenFiles)))
	      (progn
		(princ "_.open\n" f)
		(princ (strcat "\"" s "\"" "\n") f)
		(princ "_.-etransmit\n" f)
		(princ "_c\n" f)
		(princ
		  (strcat
		    "\""
		    sFolder
		    "\\"
		    (vl-filename-base s)
		    ".zip"
		    "\""
		    "\n"
		  )
		  f
		)
		(princ "_.close\n" f)
	      )
	      (setq flag 'T)
	   )
	 )
       )
       (close f)
       (command-s "_Script" fScript)
       ;; aktuelle Datei, wenn sie dabei war
       (if flag
	 (progn
	   (command "_.qsave")
	   (command "_.-etransmit"
		    "_c"
		    (strcat
		      "\""
		      sFolder
		      "\\"
		      (getvar "DWGNAME")
		      ".zip"
		      "\""
		    )
	   )
	 )
       )
     )
  )
  (mx:Reset)
  (princ)
)

 ;| 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
       )
       (setq lFolders (append (mapcar '(lambda (s)(strcat s ":\\"))(mx:GetDrives)) lFolders))
       (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)
;;;       (start_list "dspec")
;;;       (mapcar 'add_list lDrivelist)
       (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 "dspec" "(mx:GetDrives $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) "\\"))
;;;    )
;;;  )
(cond
  (
   (= (nth iFolder lFolders) ".")
   (setq sFolder "C:\\")
  )
  (
   (= (nth iFolder lFolders) "..")
   (setq c (- (strlen sFolder) 2))
   (while (/= (substr sFolder c 1) "\\")
     (setq c (- c 1))
   )
   (if (> c 0)
     (setq sFolder (substr sFolder 1 c))
   )
  )
  (
   (setq i (member (substr (nth iFolder lFolders) 1 1) (mx:GetDrives)))
   (setq sFolder (car i))
  )
  (
   '
    T
   (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: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
)

;| mx:GetDrives

Laufwerksliste
|;
(defun mx:GetDrives ( / oFSO cDrives lDrives)
  (if
    (setq oFSO (vlax-create-object "Scripting.FilesystemObject"))
    (progn
      (setq cDrives (vlax-get-property oFSO 'Drives))
      (vlax-for i cDrives
        (setq lDrives (cons (vlax-get-property i 'DriveLetter) lDrives)) 
      )
      (vlax-release-object oFSO)
      (reverse lDrives)
    )    
  )  
)

 ;| 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 iFDIA (getvar "FILEDIA"))
  (setvar "FILEDIA" 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)
  (setvar "FILEDIA" iFDIA)
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-release-object oAD)
  (setq *error* mx-err)
  (mapcar
    '(lambda (arg)
       (set
         arg
         'nil
       )
     )
    (list 'mx-err 'iECHO 'iFDIA 'oAD 'oAC)
  )
)

 ;| mx:Error

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

(defun c:aBET ()
  (c:acmBatchETransmit)
)

;;; Feedback beim Laden
(princ
  "\n\"acmBatchETransmit\" zum multiplen ETRANSMITen von DWGs verschiedener Ordners wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
  Start mit \"acmBatchETransmit\" oder \"aBET\"."
)
(princ)