macro/script pour sauvegarder les CATDrawing d'un dossier en pdf

Aller en bas

Astuce macro/script pour sauvegarder les CATDrawing d'un dossier en pdf

Message par jer75 le Jeu 19 Juil 2018 - 22:07

Bonjour,

Je voudrais lancer une macro qui va chercher dans un dossier tous les CATDrawing et les enregistre sous le même nom en pdf.

J'ai recherché sur le net et sur notre forum mais je n'ai rien trouvé qui fonctionnait.

Si quelqu'un a la solution....

merci d'avance,

JER75

jer75
timide
timide

Messages : 18
Date d'inscription : 28/05/2015
Age : 40
Localisation : paris

Revenir en haut Aller en bas

Astuce Re: macro/script pour sauvegarder les CATDrawing d'un dossier en pdf

Message par lumpazepfel le Jeu 19 Juil 2018 - 22:43

Bonjour,

Ci joint un code en VBA, il faut préciser les dossiers d'origine et de destination en dur dans la macro.
J'ai quelque part un bout de code qui permet de sélectionner un dossier, dès que je le retrouve je le poste.
Code:
' -----------------------------------------------------------------------
' Conversion en Lot Drawing / PDF

' -----------------------------------------------------------------------


Public repertoire_import As String
Public repertoire_export As String
Public compteur As Integer


Sub CATMain()


' Repertoire source des Drawings
repertoire_import = "C:\Temp\"

' Repertoire destination pour les PDF
repertoire_export = "C:\Temp\"


' -------------------------
' INITIALISATION DU BATCH
' -------------------------

' Verification presence répertoires
    If Dir(repertoire_export, vbDirectory) = "" Then
        MkDir repertoire_export
    Else
    End If


    If Dir(repertoire_import, vbDirectory) = "" Then
      MsgBox "Attention, le répertoire d'import n'existe pas Exclamation"
      End
    Else
    End If

' -----------------------------------------------
' FIN CONFIGURATION
' -----------------------------------------------


' ------------------------
' Lancement de la tache
' ------------------------
CATIA.DisplayFileAlerts = False
Call conversion_PDF
CATIA.DisplayFileAlerts = True

End


End Sub

' ---------------------------------
' Conversion du Drawing vers PDF
' ---------------------------------


Sub conversion_PDF()
Dim extension As String
Dim file As String

compteur = 0

extension = "*.CATDrawing"

' Creation de la liste des fichiers à traiter


file = Dir(repertoire_import & extension)

    Do While Len(file)
    
    Call export_PDF(file)
        file = Dir
        
    Loop

End Sub

'Export vers PDF
Sub export_PDF(fichier_catia)
Dim fichier_pdf As String

fichier_pdf = Left(fichier_catia, Len(fichier_catia) - 11)

Dim documents1 As Documents
Set documents1 = CATIA.Documents

Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = documents1.Open(repertoire_import & fichier_catia)

Set drawingDocument1 = CATIA.ActiveDocument


drawingDocument1.ExportData repertoire_export & fichier_pdf & ".pdf", "pdf"
drawingDocument1.Close

End Sub



Dernière édition par lumpazepfel le Jeu 19 Juil 2018 - 22:49, édité 1 fois (Raison : Correction dans le code)
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Astuce Re: macro/script pour sauvegarder les CATDrawing d'un dossier en pdf

Message par jer75 le Jeu 19 Juil 2018 - 23:56

Merci, je vais essayer.
c'est unMS VBScript ou CATScript?




lumpazepfel a écrit:Bonjour,

Ci joint un code en VBA, il faut préciser les dossiers d'origine et de destination en dur dans la macro.
J'ai quelque part un bout de code qui permet de sélectionner un dossier, dès que je le retrouve je le poste.
Code:
' -----------------------------------------------------------------------
' Conversion en Lot Drawing / PDF

' -----------------------------------------------------------------------


Public repertoire_import As String
Public repertoire_export As String
Public compteur As Integer


Sub CATMain()


' Repertoire source des Drawings
repertoire_import = "C:\Temp\"

' Repertoire destination pour les PDF
repertoire_export = "C:\Temp\"


' -------------------------
' INITIALISATION DU BATCH
' -------------------------

' Verification presence répertoires
    If Dir(repertoire_export, vbDirectory) = "" Then
        MkDir repertoire_export
    Else
    End If


    If Dir(repertoire_import, vbDirectory) = "" Then
      MsgBox "Attention, le répertoire d'import n'existe pas Exclamation"
      End
    Else
    End If

' -----------------------------------------------
' FIN CONFIGURATION
' -----------------------------------------------


' ------------------------
' Lancement de la tache
' ------------------------
CATIA.DisplayFileAlerts = False
Call conversion_PDF
CATIA.DisplayFileAlerts = True

End


End Sub

' ---------------------------------
' Conversion du Drawing vers PDF
' ---------------------------------


Sub conversion_PDF()
Dim extension As String
Dim file As String

compteur = 0

extension = "*.CATDrawing"

' Creation de la liste des fichiers à traiter


file = Dir(repertoire_import & extension)

    Do While Len(file)
    
    Call export_PDF(file)
        file = Dir
        
    Loop

End Sub

'Export vers PDF
Sub export_PDF(fichier_catia)
Dim fichier_pdf As String

fichier_pdf = Left(fichier_catia, Len(fichier_catia) - 11)

Dim documents1 As Documents
Set documents1 = CATIA.Documents

Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = documents1.Open(repertoire_import & fichier_catia)

Set drawingDocument1 = CATIA.ActiveDocument


drawingDocument1.ExportData repertoire_export & fichier_pdf & ".pdf", "pdf"
drawingDocument1.Close

End Sub


jer75
timide
timide

Messages : 18
Date d'inscription : 28/05/2015
Age : 40
Localisation : paris

Revenir en haut Aller en bas

Astuce Re: macro/script pour sauvegarder les CATDrawing d'un dossier en pdf

Message par lumpazepfel le Ven 20 Juil 2018 - 19:15

Salut Jérôme,

Les codes sont en CATVBA .
Ci dessous la fonction de sélection de dossier : le chemin est écrit dans la variable "mySource" et dans la variable "nbFile2D" il y a le nombre de fichiers CATDrawing trouvés dans ce dossier.

A intégrer dans le code précédent.

Code:

Sub Source_Dir()
Const ssfTous = &H1
nbFile2D = 0
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionner le répertoire source", ssfTous)
    If objFolder Is Nothing Then Exit Sub
    Set oFolderItem = objFolder.Items.Item
    mySource = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
    File = Dir(mySource & "\*.CATDrawing")
    Do While Len(File)
        nbFile2D = nbFile2D + 1
        File = Dir
    Loop
    Msgbox ( "Source : " & mySource & " : " & nbFile2D & " fichier(s)")
    End Sub
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Astuce Re: macro/script pour sauvegarder les CATDrawing d'un dossier en pdf

Message par jer75 le Ven 28 Sep 2018 - 20:47

Salut Marc,

D'abord merci pour ton aide et désolé de ma réponse tardive.

Bon c'est quand même compliqué, je n'ai pas réussi à faire fonctionner cette macro.

Pourrais tu me renvoyer le code complet avec l'ajout de la sélection de dossier?

Merci d'avance de ton aide,
JER


lumpazepfel a écrit:Salut Jérôme,

Les codes sont en CATVBA .
Ci dessous la fonction de sélection de dossier : le chemin est écrit dans la variable "mySource" et dans la variable "nbFile2D" il y a le nombre de fichiers CATDrawing trouvés dans ce dossier.

A intégrer dans le code précédent.

Code:

Sub Source_Dir()
Const ssfTous = &H1
nbFile2D = 0
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionner le répertoire source", ssfTous)
    If objFolder Is Nothing Then Exit Sub
    Set oFolderItem = objFolder.Items.Item
    mySource = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
    File = Dir(mySource & "\*.CATDrawing")
    Do While Len(File)
        nbFile2D = nbFile2D + 1
        File = Dir
    Loop
    Msgbox ( "Source : " & mySource & " : " & nbFile2D & " fichier(s)")
    End Sub

jer75
timide
timide

Messages : 18
Date d'inscription : 28/05/2015
Age : 40
Localisation : paris

Revenir en haut Aller en bas

Astuce Re: macro/script pour sauvegarder les CATDrawing d'un dossier en pdf

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum