Mise à jour Code VBA Obsolète

[bart]

  Bonjour à tous,

J'ai une macro Solidworks codée en VBA qui date de plusieurs années.

Depuis le temps, je vois que plusieurs fonctions sont devenues obsolète et doivent donc être remplacées.

J'aimerais utiliser cette macro sous la version Sw2020 et supérieure. 

En regardant l'aide APi Solidworks je vois bien les fonctions obsolètes à remplacer avec leur nouvelles dénominations.

Par contre, je n'arrive toujours pas à faire fonctionner ce code...

Je ne suis pas du tout à l'aise avec le VBA et c'est pour cela que je demande votre aide.

C'est un sujet qui traîne depuis pas mal de temps mais je n'ai pas pris le temps de m'en occuper.

Si une âme charitable pouvait y jeter un oeil pour me dire comment mettre à jour le code.

J'ai déjà commencé à mettre à jour le code avec les nouvelles fonctions mais je bloque...

Pour expliquer dans les grandes lignes, la macro est censé :

- Exporter le déplié de chaque configurations d'une pièce de tôlerie en dxf ou dwg avec un nom variable défini dans le code.

Je vous joins la macro, pour l'instant j'ai une erreur sur le swModel.GetConfigurationNames

Merci d'avance pour votre aide ! =)

 

oldvba.txt

[Maclane]

Bonjour;
Voici ma proposition:
-Nota : essayer de publier votre code dans le message plutôt qu'en pièce jointe, c'est plus rassurant de "Voir" un Code plutôt que de le Telecharger.
-Note 2 : Evitez à tout prix les Accents dans un Code VB (Visual Basic)
 

Dim swApp As Object
Option Explicit

'Enumeration des Option Choisies pour les Exports en DXF (A plat)
' Voir https://help.solidworks.com/2020/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.ipartdoc~exporttodwg2.html

Enum SheetMetalOptions_e
    ExportFlatPatternGeometry = 1
    IncludeHiddenEdges = 2
    ExportBendLines = 4
    IncludeSketches = 8
    MergeCoplanarFaces = 16
    ExportLibraryFeatures = 32
    ExportFormingTools = 64
    ExportBoundingBox = 2048
End Enum

Sub main()
' Declaration:
Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim config                  As SldWorks.Configuration
Dim vConfNameArr            As Variant
Dim sConfigName             As String
Dim i                       As Long
Dim bShowConfig             As Boolean
Dim bRebuild                As Boolean
Dim bRet                    As Boolean
Dim FilePath                As String
Dim PathSize                As Long
Dim PathNoExtension         As String
Dim NewFilePath             As String
Dim Value_T                 As String
Dim ResolvedValOut          As String
Dim cusPropMgr              As SldWorks.CustomPropertyManager
Dim wasResolved             As Boolean
Dim Error                   As Long


    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

vConfNameArr = swModel.GetConfigurationNames 'Creation de la liste des configurations

For i = 0 To UBound(vConfNameArr) 'Boucle la liste : de l'element 0 jusqu'au nombre d'element dans la liste (Ubound)
    Set config = swModel.GetActiveConfiguration
    Set cusPropMgr = config.CustomPropertyManager
    sConfigName = vConfNameArr(i) 'Recupere l'elementt Numero i de la liste
    bShowConfig = swModel.ShowConfiguration2(sConfigName) 'Affiche la configuration
    
    Error = cusPropMgr.Get5("TYPE", True, Value_T, ResolvedValOut, wasResolved) 'Recupere la valeur de la proriete "T" dans la variable "Value_T"
    bRebuild = swModel.ForceRebuild3(False) 'Reconstruction du modèle
    
    FilePath = swModel.GetPathName 'Recupere le chemin du fichier SW
    PathSize = Strings.Len(FilePath) 'Compte le nombre de caracteres du chemin
    
        PathNoExtension = Strings.Left(FilePath, PathSize - 6) 'Recupere le nom de la piecece en enlevant .Sldrt
        NewFilePath = Left(FilePath, InStrRev(FilePath, "\")) & sConfigName & ".DXF" 'Remplace le nom par Type + Lg + Nom de la config (sans Flat pattern).dxf

    If False = swModel.ExportToDWG2(NewFilePath, FilePath,  swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, Empty, False, False, SheetMetalOptions_e.ExportFlatPatternGeometry + SheetMetalOptions_e.ExportBendLines, Empty) Then
        Err.Raise vbError, "", "Failed to export flat pattern"
    End If
    
Next i 'Passe a la prochaine config

bShowConfig = swModel.ShowConfiguration2(vConfNameArr(0)) 'Retour sur la Configuration Principale
End Sub

 

Cordialement.

[bart]

Je viens de tester la macro !

Elle n'a aucune erreur et ça c'est cool !

Il ne reste plus qu'a enlever la sauvegarde à chaque config car je dois cliquer sur "enregistrer" à chaque fois et lui dire de ne pas exporter les lignes de pliage.

Donc je suppose que je change la ligne ExportBendLines=4 en ExportBendLines=0 ou un autre indice^^

puis pour enlever l'enregistrement, je ne vois pas quelle ligne je dois modifier. Peut être juste une option dans Sw à modifier..

 

En tout cas un grand merci car le code est vraiment top ! =)