Macro pour créer des fichiers pdf et dxf à la bonne échelle

Bonjour,
Je suis novice sur le forum et j’ai trouvé pas mal d’infos sur les macros pour automatiser certaines tâches.
Cependant j’ai une demande qui il me semble n’a pas été traité par quelqu’un jusqu’ici.
Je souhaiterai pouvoir créer des exports dxf automatiquement depuis une mise en plan mais selon des critères:
1- S’il existe une vue dépliée, il faudrait que l’export dxf se fasse en prenant en compte l’échelle de la vue dépliée pour une conversion à l’échelle 1
2- S’il n’y a pas de vue dépliée (simple pièce découpée laser) alors on prend en compte l’échelle du plan et pas d’une vue spécifique.

Je ne sais pas si c’est possible de faire ça.
Il faudrait par ailleurs qu’on puisse enregistrer les fichiers pdf et dxf avec leur indice de révision dans le nom du fichier. Et le top serait également de pouvoir le dossier dans lequel on enregistre chaque export.

Merci d’avance à tous les experts VBA sur ce forum pour votre aide

Bonjour @ediatta
Si vous pouvez donner plus de détails,
1 combien de vue dans la feuille
2 sélection manuelle (automatique) de la vue à exporter
3 export de vue dans le même ou différent classeurs (si plusieurs vue existe dans la feuille)
4 si la vue est une deplie (ou pas) avec échelle 1/2,la feuille avec échelle 1/5,c’est quoi l’échelle de sortie pour chaque cas.
5 indice de révision c’est une prp dans la pièce, dans la feuille ou bien dans une table,

Bonjour @Lynkoa15,
Merci de répondre à mon sujet.
Alors pour plus de détails:
1 combien de vue dans la feuille => 1 seule, globalement ce sera une pièce un plan

2 sélection manuelle (automatique) de la vue à exporter => idéalement sélection auto de la vue mais peut -être que ce sera plus simple à gérer une sélection manuelle. Il y aura 2 cas en règle général, soit c’est une tôle pliée et la vue dépliée à une échelle différente des vues pièce finie, soit c’est une simple pièce découpée laser et toutes les vues ont la même échelle qui peut être identique ou pas à celle de la feuille. Dans le cas 1 l’échelle à considérer serait celle de vue dépliée et pour le cas 2 ce sera l’échelle d’une des vue. Par contre c’est bien la mise en plan que je veux exporter mais en ne prenant pas systématiquement en compte l’échelle de la feuille pour la convertir et avoir une échelle de sortie 1 de mon DXF.

3 export de vue dans le même ou différent classeurs (si plusieurs vue existe dans la feuille) => il faudrait qu’on puisse choisir le classeur vers lequel on exporte (via msgbox ou autre)

4 si la vue est une deplie (ou pas) avec échelle 1/2,la feuille avec échelle 1/5,c’est quoi l’échelle de sortie pour chaque cas => l’échelle de sortie doit toujours être 1/1

5 indice de révision c’est une prp dans la pièce, dans la feuille ou bien dans une table => c’est une propriété dans la pièce

Bonjour;

Le plus simple ne serait-il pas que toutes vos vues soient en adéquation avec l’échelle de votre mise en plan ?
D’autant plus valable si vous n’avez qu’une seule vue par Feuille de MEP.

Ainsi tout vos exports pourront êtres convertis en 1/1 vers le format DXF via les réglages Solidworks (Exports).

De base Solidworks exporte vos données en espace « Objet » qui devrait toujours être à l’échelle 1 pour 1. La convention 2D veut que seul l’espace 'Papier" accepte un facteur d’échelle…
C’est d’autant plus pratique pour prendre des cotes.

Cordialement.

Bonjour @Maclane,

J’ai imaginé de faire comme vous dites. Seulement il y a plusieurs vues sur une même feuille et si les dimensions de la pièce sont grandes, il est quand même bien pratique d’avoir des échelles différenciées.
Exemple:
Une pièce avec plusieurs plis peut avoir des côtes finies bien plus faibles que celles du déplié qui peut être plus grand d’un facteur 3, 4 ou +. Et donc c’est intéressant de jouer sur l’échelle.
L’inconvénient c’est que le déplié est utilisé pour la découpe laser et s’il est à une échelle différente de celle du plan, les côtes de l’export dxf seront fausses. En clair si les vues de la pièce finie sont à l’échelle 1/5 et celle du déplié à 1/10, l’export en dxf va convertir à partir de l’échelle 1/5 => les côtes du déplié utilisées pour la découpe laser seront fausses.
Sinon la seule option serait de prendre des formats de plan de plus en plus grand pour toujours avoir toutes les vues à la même échelle…ce qui est plutôt dommage

@ediatta, est ce que ce code résout il la partie échelle ?

'-------------------------------------------------------------------------
Option Explicit
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swdrawing               As DrawingDoc
    Dim sPathName               As String
    Dim nErrors                 As Long
    Dim nWarnings               As Long
    Dim bRet                    As Boolean

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swdrawing = swModel
    sPathName = swModel.GetPathName
    sPathName = Left(sPathName, Len(sPathName) - 6)
    sPathName = sPathName + "dxf"
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
    Dim swview As View
    Set swview = swdrawing.GetFirstView
    Set swview = swview.GetNextView
    Do While Not swview Is Nothing
        If swview.IsFlatPatternView Then
            swApp.SetUserPreferenceDoubleValue swDxfOutputScaleFactor, swview.ScaleRatio(1) / swview.ScaleRatio(0)
            Exit Do
        End If
        Set swview = swview.GetNextView
    Loop
    bRet = swModel.Extension.SaveAs(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file.", swMbWarning, swMbOk
    End If

End Sub

Bonjour @Lynkoa15,

Oui j’ai testé et ça résout le problème d’échelle.
Je n’ai pas forcément compris le code (notamment pourquoi on passe sur la vue suivante dès de début de la boucle « tant que », ne risque t-on pas de passer à côté d’une vue?) mais bon ne tout cas ça marche. Merci beaucoup.
Il ne me reste plus qu’à pouvoir dire à partir du même code que si la vue déplié n’existe pas, il faut prendre l’échelle du plan. et ensuite donner la possibilité d’ajouter la révision de pièce ainsi que le dossier d’enregistrement.

Bonjour @tous
En effet Y’a pas de risque à passer une vue, parceque la première vue renvoyé et la feuille active,
Ci joint un code qui devra répondre aux grandes lignes,
Échelle de vue déplié ou de la feuille si la deplie n’existe pas
Implémentation de la révision (nom de la propriété par défaut "révision "
Possibilité de choisir le répertoire.
A noté que j’ai utilisé le paramètre facteur qui est obsolete, vue que sw ne propose pas d’option pour le moment

De ce fait il est nécessaire de faire des tests plus approfondie que dab (de mon côté ça fonctionne pour 2018 et 2022)


'----------------------------------------------------------------------------
Option Explicit
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swdrawing               As DrawingDoc
    Dim spathname               As String
    Dim nErrors                 As Long
    Dim nWarnings               As Long
    Dim bRet                    As Boolean

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swdrawing = swModel
    
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
    swApp.SetUserPreferenceDoubleValue swDxfOutputScaleFactor, getScaleFactor()
    
    Dim path As String, name As String, revision As String
    name = getPathName(swModel)(0)
    path = getPathName(swModel)(1)
    revision = getRevision()
    
    Dim newPath As String
    Select Case MsgBox("Saving folder is : " + Chr(10) + path + Chr(10) + "press yes to save , no to browse for path or cancel to abort", vbYesNoCancel)
    Case 7
        path = browseFolder(path)
    Case 2
        End
    End Select
    Dim spathname As String
    spathname = path + "\" + name + "_" + revision
    savedrawingasdxf spathname
    savedrawingaspdf spathname

End Sub

Sub savedrawingasdxf(path As String)
    bRet = swModel.Extension.SaveAs(path + ".dxf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as dxf.", swMbWarning, swMbOk
    End If
End Sub

Sub savedrawingaspdf(path As String)
    Dim expdata As ExportPdfData
    Set expdata = swApp.GetExportFileData(1)
    bRet = swModel.Extension.SaveAs(path + ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, expdata, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as pdf.", swMbWarning, swMbOk
    End If
End Sub

Function getScaleFactor() As Double
    Dim sview As View
    Dim scalfactor As Double
    Set sview = swdrawing.GetFirstView
    scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
    Set sview = sview.GetNextView
    Do While Not sview Is Nothing
        If sview.IsFlatPatternView Then
            scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
            Exit Do
        End If
        Set sview = sview.GetNextView
    Loop
    getScaleFactor = scalfactor
End Function

Function getPathName(model As ModelDoc2) As Variant
    Dim pathname(1) As String
    Dim spathname As String
    spathname = model.getPathName
    If spathname = "" Then
        swApp.SendMsgToUser2 "Please save file then retry.", swMbStop, swMbOk
        End
    End If
    spathname = Left(spathname, Len(spathname) - 7)
    pathname(0) = Right(spathname, Len(spathname) - InStrRev(spathname, "\", -1, vbTextCompare))
    pathname(1) = Left(spathname, InStrRev(spathname, "\", -1, vbTextCompare) - 1)
    getPathName = pathname
End Function

Function getRevision(Optional prp As String = "revision") As String
    Dim ssheet As Sheet
    Set ssheet = swdrawing.GetCurrentSheet()
    Dim prpsheet As String
    prpsheet = ssheet.CustomPropertyView
    Dim sview As View
    Set sview = swdrawing.GetFirstView
    If prpsheet = "Par défaut" Then
        Set sview = sview.GetNextView
    Else
        Set sview = sview.GetNextView
        Do While Not sview Is Nothing
            If sview.GetName2() = prpsheet Then
                Exit Do
            End If
            Set sview = sview.GetNextView
        Loop
    End If
    Dim srefmodel As ModelDoc2
    Set srefmodel = sview.ReferencedDocument
    Dim scustomprpmgr As CustomPropertyManager
    Set scustomprpmgr = srefmodel.Extension.CustomPropertyManager(sview.ReferencedConfiguration)
    Dim svOut As String
    Dim sWRout As Boolean
    Dim sLPout As Boolean
    Dim srevision As String
    scustomprpmgr.Get6 prp, False, svOut, srevision, sWRout, sLPout
    getRevision = srevision
End Function

Function browseFolder(defpath As String) As String
    browseFolder = defpath
    Dim obgShell As Object
    Dim obgFolder As Object
    Set obgShell = CreateObject("shell.application")
    Set obgFolder = obgShell.browseforfolder(0, "", 0)
    If Not obgFolder Is Nothing Then
        browseFolder = obgFolder.self.path
    End If
    Set obgShell = Nothing
End Function



1 « J'aime »

Bonjour @Lynkoa15 ,
Désolé pour la réponse tardive, les congés sont passés par là…
Merci pour ton retour et ce code.
par contre malheureusement ça ne marche pas chez moi, j’ai une erreur sur la ligne suivante :
scustomprpmgr.Get6 prp, False, svOut, srevision, sWRout, sLPout
Je ne connais pas la source de l’erreur…
Par contre une précision, ma propriété personnalisée pour la révision s’appelle « Indice », peut être que ça vient de là? Si c’est le cas où dois je modifier dans le code?

Est ce que cette macro fonctionne pour créer pdf et dxf du coup? Et est ce que ça crée les pdf/dxf des différents folios de façon séparée.
Encore merci d’avance pour ton aide

Bonjour,
Pour le problème lié au nom de la propriété il faut changer ici

Changer revision par indice

1 « J'aime »

@Cyril.f ça ne marche pas bien mieux.
J’ai le même message d’erreur sur la même ligne

Bonjour ediata et bon courage pour la reprise travail

Concernant lexport pdf et dxf, c’est oui.
Concernant le multifolio, la macro exporte la feuille active uniquement mais populer sur différentes feuilles et faisable,
Pour le moment va falloir trouver ce qui cloche.
Pour la propriété " revision" possible de la déclaré tel indiqué par cyril, en changeant la nomination par défaut, sinon indiez le nom ici

Concernant l’erreur je dirais que vous disposez d’une version inférieur à 2018 est ce le cas ?(une capture de ce message erreur sera bien venue)

1 « J'aime »

Oui je suis effectivement sous SW2017.
Ci-dessous les screenshots :
image

A 1ère vue, le Get6 est compatible à partir de SW2018.
Utilise cette ligne en remplacement de la ligne en erreur, si je me trompe pas cela devrait être mieux à moins que d’autre fonctions soient dans le même cas (incompatible avec SW2017)

scustomprpmgr.Get5 prp, False, svOut, srevision, sWRout
2 « J'aime »

Merci @sbadenis , ça a marché au top.
Dernière question @Lynkoa15, est ce que ce serait possible de faire en sorte qu’on puisse enregistrer dans des dossiers différents le pdf et le dxf ?

Est ce qu’il y aurait une ligne ou un code simple à rajouter pour pouvoir également exporter en step?

Ci dessous un code qui devra convenir,
Les sous dossiers dwg, pdf et step par rapport au dossier du travail sont a déclaré ici, avec prp revision
Capture08

La prp revision et configuration pour le step sont issues de là
Capture07
Ainsi la feuille peut gérer plusieurs composants différents (sinon je vous invite à ouvrir un nouveau poste pour le step )

De mon côté pour les découpe tole J’ajoute toujours une côte, ainsi mon collègue imbrication peut vérifier et me signaler toute erreur d’échelle (sais jamais)

'----------------------------------------------------------------------------
Option Explicit
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swdrawing               As DrawingDoc
    Dim spathname               As String
    Dim nErrors                 As Long
    Dim nWarnings               As Long
    Dim bRet                    As Boolean
    Const dxfSubFolder As String = "\dwg"
    Const pdfSubFolder As String = "\pdf"
    Const stepSubFolder As String = "\step"
    Const prpRevision As String = "indice"
    
Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swdrawing = swModel
    
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
    swApp.SetUserPreferenceDoubleValue swDxfOutputScaleFactor, getScaleFactor()
    
    Dim path As String, name As String, configuration As String, revision As String
    Dim model As ModelDoc2
    getParameters model, configuration, revision, prpRevision
    name = getPathName(swModel)(0)
    name = name + "_" + revision
    path = getPathName(swModel)(1)

    Dim newPath As String
    Select Case MsgBox("Saving folder is : " + name + Chr(10) + "Export configuration for STEP is : " + configuration + Chr(10) + "working folder is : " + path + Chr(10) + Chr(10) + "press yes to save , no to browse for path or cancel to abort", vbYesNoCancel)
    Case 7
        path = browseFolder(path)
    Case 2
        End
    End Select
    
    createpath path + dxfSubFolder
    savedrawingasdxf path + dxfSubFolder + "\" + name
    
    createpath path + pdfSubFolder
    savedrawingaspdf path + pdfSubFolder + "\" + name
    
    createpath path + stepSubFolder
    savedrawingasstep model, configuration, path + stepSubFolder + "\" + name

    swApp.SendMsgToUser2 "Finish", swMbInformation, swMbOk
End Sub

Sub createpath(path As String)
    Dim fold As Variant
    Dim cpath As String
    For Each fold In Split(path, "\", -1, vbTextCompare)
        cpath = cpath + CStr(fold) + "\"
        If Len(Dir(cpath, vbDirectory)) = 0 Then MkDir cpath
    Next fold
End Sub


Sub savedrawingasdxf(path As String)
    bRet = swModel.Extension.SaveAs(path + ".dwg", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as dxf.", swMbWarning, swMbOk
    End If
End Sub

Sub savedrawingaspdf(path As String)
    Dim expdata As ExportPdfData
    Set expdata = swApp.GetExportFileData(1)
    expdata.SetSheets 2, Nothing
    bRet = swModel.Extension.SaveAs(path + ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, expdata, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as pdf.", swMbWarning, swMbOk
    End If
End Sub

Sub savedrawingasstep(model As ModelDoc2, conf As String, path As String)
    If model Is Nothing Then Exit Sub
    Set model = swApp.ActivateDoc3(model.getPathName, False, 1, nErrors)
    model.ShowConfiguration2 conf
    bRet = model.Extension.SaveAs(path + ".step", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings)
    If bRet = False Then
        swApp.SendMsgToUser2 "Problems saving file as step.", swMbWarning, swMbOk
    End If
    swApp.CloseDoc model.GetTitle
End Sub

Function getScaleFactor() As Double
    Dim sview As View
    Dim scalfactor As Double
    Set sview = swdrawing.GetFirstView
    scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
    Set sview = sview.GetNextView
    Do While Not sview Is Nothing
        If sview.IsFlatPatternView Then
            scalfactor = sview.ScaleRatio(1) / sview.ScaleRatio(0)
            Exit Do
        End If
        Set sview = sview.GetNextView
    Loop
    getScaleFactor = scalfactor
End Function

Function getPathName(model As ModelDoc2) As Variant
    Dim pathname(1) As String
    Dim spathname As String
    spathname = model.getPathName
    If spathname = "" Then
        swApp.SendMsgToUser2 "Please save file then retry.", swMbStop, swMbOk
        End
    End If
    spathname = Left(spathname, Len(spathname) - 7)
    pathname(0) = Right(spathname, Len(spathname) - InStrRev(spathname, "\", -1, vbTextCompare))
    pathname(1) = Left(spathname, InStrRev(spathname, "\", -1, vbTextCompare) - 1)
    getPathName = pathname
End Function

Sub getParameters(ByRef model As ModelDoc2, ByRef configuration As String, ByRef revision As String, Optional prp As String = "revision")
    Dim ssheet As Sheet, csheet As Sheet
    Set csheet = swdrawing.GetCurrentSheet()
    Set ssheet = csheet
    Dim prpDoc As Boolean
    prpDoc = ssheet.GetProperties2()(7)
    If prpDoc = True Then
            swdrawing.ActivateSheet swdrawing.GetSheetNames()(0)
            Set ssheet = swdrawing.GetCurrentSheet()
    End If
    Dim prpsheet As String
    prpsheet = ssheet.CustomPropertyView
    Dim sview As View
    If prpsheet = "Par défaut" Then
        Set sview = swdrawing.GetFirstView
        Set sview = sview.GetNextView
    Else
        Dim views As Variant
        Dim found As Boolean
        found = False
        views = swdrawing.GetViews()
        Dim i As Long
        For i = 0 To UBound(views)
            If UBound(views(i)) = 0 Or found = True Then Exit For
            Dim j As Long
            For j = 1 To UBound(views(i))
                Set sview = views(i)(j)
                If sview.GetName2() = prpsheet Then
                    found = True
                    Exit For
                End If
            Next j
        Next i
    End If
    swdrawing.ActivateSheet csheet.GetName
    If sview Is Nothing Then Exit Sub
    Set model = sview.ReferencedDocument
    Dim scustomprpmgr As CustomPropertyManager
    configuration = sview.ReferencedConfiguration
    If sview.IsFlatPatternView Then
        Dim confvf As configuration
        Set confvf = model.GetConfigurationByName(configuration)
        Set confvf = confvf.GetParent()
        configuration = confvf.name
    End If
    Set scustomprpmgr = model.Extension.CustomPropertyManager(configuration)
    Dim svOut As String
    Dim sWRout As Boolean
    Dim sLPout As Boolean
    Dim srevision As String
    'scustomprpmgr.Get6 prp, False, svOut, srevision, sWRout, sLPout
    scustomprpmgr.Get5 prp, False, svOut, srevision, sWRout
    revision = srevision
End Sub

Function browseFolder(defpath As String) As String
    browseFolder = defpath
    Dim obgShell As Object
    Dim obgFolder As Object
    Set obgShell = CreateObject("shell.application")
    Set obgFolder = obgShell.browseforfolder(0, "", 0)
    If Not obgFolder Is Nothing Then
        browseFolder = obgFolder.self.path
    End If
    Set obgShell = Nothing
End Function

1 « J'aime »

Merci @Lynkoa15 .
La macro fonctionne bien pour créer les différents folder. C’est top !
Par contre chose bizarre, l’indice (révision) de la pièce n’est pas ajouté au nom des fichiers (pdf/dxf/step). Serait ce parce que la macro ne trouve pas ? Normalement l’indice est dans les propriétés personnalisées de la pièce mise en plan (le 3D).