Routine pour realiser en lot des fichiers Etransmit.zip

[HotFoot]

Bonjour à toutes et tous

J’appelle à votre expertise afin d’améliorer une routine qui permet que traiter en lot la réalisation de fichier .zip avec la fonction Etransmit.

L’idée est :

- De sélectionner, à partir une boite de dialogue .dcl, des fichiers .dwg.

- D’écrire un fichier Scripte .scr dans un répertoire temporaire. Le Scripte lance l’ouverture du dwg et réalise le .zip au nom du fichier .dwg dans le répertoire défini dans les options Etransmit.

Les problèmes rencontrés sont :

- quand le fichier est déjà ouvert

- quand un scripte se lance à l’ouverture du fichier.

- à un enregistrement « intempestif » à fermeture du fichier.

- tout automatisme qui est en dehors de la boucle du scripte.

Si vous le cœur et l’intérêt vous interpelle, alors, un grand merci pour votre contribution.

 

(defun *error* ( msg )
   (and Undo  (vla-EndUndoMark doc))
   (and dcl_id    (unload_dialog dcl_id))    
   (and fichier (close fichier))
   
   (or (wcmatch (strcase msg) "*BREAK,*Annuler*,*EXIT*")
       (princ (strcat "\n** Erreur " msg " **")))    
   (princ)
 )

(defun Popup (title flags msg / WSHShell result)
   (setq WSHShell (vlax-create-object "WScript.Shell"))
   (setq result (vlax-invoke WSHShell 'Popup msg 0 title flags))
   (vlax-release-object WSHShell)
   result
 )

(defun Repertoires (dir typ sub)
 (setq dir (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)))
 (setq lstFch (vl-directory-files dir typ 1))
 (setq lstRepFch (append (mapcar '(lambda (x) (strcat dir "\\" x)) lstFch)))
 (setq lstNomFch (mapcar '(lambda (x) (vl-string-right-trim ".dwg" x)) lstFch))
 lstRepFch
 lstNomFch
)

(defun Registre	(/ acadHKCU)
 (cond
   ((= (getvar "ACADVER") "20.1s (LMS Tech)")
    (setq acadHKCU "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R20.1\\ACAD-F001:40C")
   )
   ((= (getvar "ACADVER") "20.0s (LMS Tech)")
    (setq acadHKCU "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R20.0\\ACAD-E001:40C")
   )
   ((= (getvar "ACADVER") "19.1s (LMS Tech)")
    (setq acadHKCU "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R19.1\\ACAD-D001:40C")
   )
   ((= (getvar "ACADVER") "19.0s (LMS Tech)")
    (setq acadHKCU "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R19.0\\ACAD-C001:40C")
   )
   ((= (getvar "ACADVER") "18.2s (LMS Tech)")
    (setq acadHKCU "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R18.2\\ACAD-B001:40C")
   )
   (T (setq acadHKCU '("Version AutoCAD non consernée")))
 )
 (if (vl-position "ETransmit" (vl-registry-descendents acadHKCU))
   (setq chemin (vl-registry-read (strcat acadHKCU "\\ETransmit\\setups\\Standard") "DestFolder"))
   (setq chemin "### Pas de répertoire cible repéré ###")
 )
 chemin
)

(defun DirDialog (Message Chemin Drapeau / repfch shell)
 (setq shell (vlax-create-object "Shell.Application"))
 (if (setq repfch (vlax-invoke shell 'browseforfolder 0 Message Drapeau Chemin))
   (setq repfch (vlax-get-property (vlax-get-property repfch 'self) 'path))
   (setq repfch nil)
 )
 (vlax-release-object shell)
 repfch
)

(defun DirText (key str nbstr)
 (set_tile key
    (if	str
      (if (< 50 (strlen str))
	(strcat (substr str 1 nbstr) "...")
	str
      )
      ""
    )
 )
)

(defun RepDwgSource (/)
 (start_list "lstFchDwg")
 (mapcar 'add_list lstNomFch)
 (end_list)

)

(defun Dialogue	(/)
 (if (not (findfile "Etransmit.dcl"))
   (alert "le fichier Etransmit.dcl est introuvable.")
 )
 (setq dcl_id (load_dialog "Etransmit.dcl"))
 (new_dialog "scrtransmit" dcl_id)
 (set_tile "00" "GENERATION DU SCRIPT ETRANSMIT")
 (set_tile "01" "Répertoire Sources")
 (set_tile "02" "Sélection")

 (DirText "03" (strcat "Répertoire Cible : " chemin) 37)
 (DirText "04" (strcat "Source par Défaut : " dir) 37)

 (RepDwgSource)

 (action_tile
   "dir"
   "(setq repFch (DirDialog \"Répertoire des fichiers\" nil 512))(Repertoires repFch \"*.dwg\" nil)(DirText \"dir_text\" repfch 60)(RepDwgSource)"
 )

 (setq ok (start_dialog))
)

(defun CreeFichier (lstRepFch lstNomFch / index x fichier)
 (setq fichier (open (strcat RepTemp nomFchScr) "w"))
 (setq index 0)
 (repeat (length lstRepFch)
   (setq x
   (strcat "_.open"
	   (chr 32);;; Retour chariot
	   (chr 34);;; Ouverture guillemet
	   (nth index lstRepFch)
	   (chr 34);;; Fermeture guillemet
	   (chr 32);;; Retour chariot
	   "_.qsave"
	   (chr 32);;; Retour chariot
	   "_.etransmit _c"
	   (chr 32);;; Retour chariot
	   (chr 34);;; Ouverture guillemet
	   (nth index lstNomFch)
	   (chr 34);;; Fermeture guillemet
   )
   )
   (write-line x fichier)
   (setq index (1+ index))
 )
 (close fichier)
)

(defun c:ScrMit (/ repTemp dir lstNomFch nomFchScr dcl_id ok chemin lstRepFch repFch nomFchScr lstFch lstRepFch)	
 (setq	repTemp	  (vla-get-TempFilePath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object))))
dir	  (getvar "dwgprefix")
lstNomFch '("Aucun fichier DWG")
nomFchScr "Etrans.scr"
 )

 (vl-file-delete (strcat repTemp nomFchScr))

 (Registre)
 (Dialogue)

 (cond
   ((and (= ok 0) (= lstRepFch nil)) (unload_dialog dcl_id))
   ((and (= ok 1) (= lstRepFch nil))
    (unload_dialog dcl_id)
    (Popup "ALERTE" 48 "PAS FICHIERS DWG TROUVES")
   )
   ((and (= ok 1) (/= lstRepFch nil))
    (unload_dialog dcl_id)
    (CreeFichier lstRepFch lstNomFch)
;;;;;;     (vl-cmdf "_.script" (strcat RepTemp "Etrans.scr"))
   )
 )

)

(princ "\n:: Saisir \"Scrmit\" pour lancer la commande ::")
(princ)

	butt12	: button { width = 12; fixed_width = true; alignment = centered; }
butt15	: button { width = 15; fixed_width = true; alignment = centered; }
butt18	: button { width = 18; fixed_width = true; alignment = centered; height = 2.5; fixed_height = true; }

scrtransmit : dialog { key = "00";
               
spacer;

	: boxed_row { label = "Répertoire des Fichiers Sources"; alignment = left;
	: butt18 { key = "dir"; label = "Sélection"; }
spacer;
	: edit_box { label = "Chemin : "; key = "dir_text"; edit_width = 51.5; edit_limit = 2048; fixed_width = true; alignment = centered; }
                 
	}
spacer;

	: boxed_row { label = "Liste des Fichiers"; alignment = left;
	: list_box { key = "lstFchDwg"; multiple_select = true; height = 10; }
 		  
	}
               
spacer;
                                
	: text { label = "Répertoire Cible : "; key="03"; }

ok_cancel;