Macro export dxf famille de pièce

Hello les collègues,

je viens vers vous car je suis une quiche en macro et j'en ai une que j'aurais bien aimé améliorer. Elle fonctionne parfaitement lorsque je la lance et me fais tous mes dxf de la famille de pièce mais je n'arrive pas à la modifier pour qu'elle me sorte les lignes de pliage dans le développé.   

Merci d'avance pour votre aide :-)

Dim swApp As Object
Option Explicit
Sub main()
'Déclarations :
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_                 As String
Dim ResolvedValOut          As String
Dim cusPropMgr              As SldWorks.CustomPropertyManager
Dim wasResolved             As Boolean
Dim Error As Long
Set swApp = CreateObject("SldWorks.Application") 'Lancement de SW
Set swModel = swApp.ActiveDoc 'Récuperation du modèle actif dans SW

vConfNameArr = swModel.GetConfigurationNames 'Création de la liste des configurations
For i = 0 To UBound(vConfNameArr) 'Boucle la liste : de l'élément 0 jusqu'au nombre d'élément dans la liste (Ubound)
    Set config = swModel.GetActiveConfiguration
    Set cusPropMgr = config.CustomPropertyManager
    sConfigName = vConfNameArr(i) 'Recupère l'élément N°i de la liste
    bShowConfig = swModel.ShowConfiguration2(sConfigName) 'Affiche la configuration
    Error = cusPropMgr.Get5("TYPE", True, Value_, ResolvedValOut, wasResolved) 'Récupère la valeur de la proriété "" dans la variable "Value_"
    bRebuild = swModel.ForceRebuild3(False) 'Reconstruction du modèle
    FilePath = swModel.GetPathName 'Récupère le chemin du fichier SW
    PathSize = Strings.Len(FilePath) 'Compte le nombre de caractères du chemin
    
        PathNoExtension = Strings.Left(FilePath, PathSize - 6) 'Récupère le nom de la pièce en enlevant .Sldrt
        NewFilePath = Left(FilePath, InStrRev(FilePath, "\")) & "" & (sConfigName) & ".DXF" 'Remplace le nom par Type + Lg + Nom de la config (sans Flat pattern).dxf
        bRet = swModel.ExportFlatPatternView(NewFilePath, 1) 'Exporte le déplié
    
Next i 'Passe à la prochaine config
End Sub

 


export_dxf_famille_de_piece_-_ac_cobra.swp

Bonsoir,

Sauf erreur de ma part, l'option n'est pas accessible dans cette ancienne méthode.

 Il faut utiliser la méthode ExportToDWG2, le code non optimisé repris simplement de l'aide est le suivant:

Dim swApp As Object
Option Explicit
Sub main()
'Déclarations :
Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim config                  As SldWorks.Configuration
Dim swPart                  As SldWorks.PartDoc
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_                 As String
Dim ResolvedValOut          As String
Dim cusPropMgr              As SldWorks.CustomPropertyManager
Dim wasResolved             As Boolean
Dim Error As Long
Dim varAlignment As Variant
 Dim dataAlignment(11) As Double
 Dim varViews As Variant
 Dim dataViews(1) As String
Set swApp = CreateObject("SldWorks.Application") 'Lancement de SW
Set swModel = swApp.ActiveDoc 'Récuperation du modèle actif dans SW
Set swPart = swModel

vConfNameArr = swModel.GetConfigurationNames 'Création de la liste des configurations
For i = 0 To UBound(vConfNameArr) 'Boucle la liste : de l'élément 0 jusqu'au nombre d'élément dans la liste (Ubound)
    Set config = swModel.GetActiveConfiguration
    Set cusPropMgr = config.CustomPropertyManager
    sConfigName = vConfNameArr(i) 'Recupère l'élément N°i de la liste
    bShowConfig = swModel.ShowConfiguration2(sConfigName) 'Affiche la configuration
    Error = cusPropMgr.Get5("TYPE", True, Value_, ResolvedValOut, wasResolved) 'Récupère la valeur de la proriété "" dans la variable "Value_"
    bRebuild = swModel.ForceRebuild3(False) 'Reconstruction du modèle
    FilePath = swModel.GetPathName 'Récupère le chemin du fichier SW
    PathSize = Strings.Len(FilePath) 'Compte le nombre de caractères du chemin
    
        PathNoExtension = Strings.Left(FilePath, PathSize - 6) 'Récupère le nom de la pièce en enlevant .Sldrt
        NewFilePath = Left(FilePath, InStrRev(FilePath, "\")) & "" & (sConfigName) & ".DXF" 'Remplace le nom par Type + Lg + Nom de la config (sans Flat pattern).dxf
        'bRet = swModel.ExportFlatPatternView(NewFilePath, 1) 'Exporte le déplié
    dataAlignment(0) = 0#
    dataAlignment(1) = 0#
    dataAlignment(2) = 0#
    dataAlignment(3) = 1#
    dataAlignment(4) = 0#
    dataAlignment(5) = 0#
    dataAlignment(6) = 0#
    dataAlignment(7) = 1#
    dataAlignment(8) = 0#
    dataAlignment(9) = 0#
    dataAlignment(10) = 0#
    dataAlignment(11) = 1#
     

    varAlignment = dataAlignment
     

    dataViews(0) = "*Current"
    dataViews(1) = "*Front"
     

    varViews = dataViews

    swPart.ExportToDWG2 NewFilePath, FilePath, swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, 13, varViews
    
Next i 'Passe à la prochaine config
End Sub

 

Je pense par contre qu'il faudrait retirer les variables filepath et pathsize du traitement de la boucle vu que cette macro fonctionne fichier par fichier si j'ai bien compris.

@Cyril.f en fait la macro que j'utilise créé les flatpathern dans une pièce de plusieurs configurations en l'enregistre avec le nom de la configuration la seul chose qui manque c'est la ligne de pli dans le DXF.

je viens de tester la macro qui fonctionne, elle me crée bien les DXF avec les lignes de pli mais ne crée plus les configurations des dépliés. 

Bonjour,

Je n'ai pas regardé plus que ça hier soir, mais ce n'est pas plutôt que des dépliés que la macro réalise et ne fait plus les dxf des configurations pliées?

En fait la macro que j'avais trouvé fait : création du dxf en déplié sans les lignes de pliage et l'a configuration du déplié de toutes les configurations de la pièce et celle que vous avez partagé ne me créer plus les configurations des dépliés dans les configurations mais fait tous les déplié avec les ligne de pli 

Je peux avoir un fichier exemple car je n'en ai pas sous la main. J'avais juste un fichier avec une conf dépliée et la conf défaut et ça a bien bouclé sur les deux "configurations" mais il me semble que les deux dxf étaient en visuel déplié (lié à la ligne d'export du code de la macro).

Ci-joint des fichiers exemple mais il est sous 2020 une avec la gonfig déplié et l'autre sans


lot_de_cornieres.sldprt
lot_de_cornieres_avec_deplie.sldprt

Bonsoir,

Sur le code ci-joint ça devrait répondre au besoin.

Option Explicit

'Déclarations :
Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim config                  As SldWorks.Configuration
Dim cusPropMgr              As SldWorks.CustomPropertyManager
Dim swPart                  As SldWorks.PartDoc
Dim i                       As Long
Dim PathSize                As Long
Dim Error                   As Long
Dim bShowConfig             As Boolean
Dim bRebuild                As Boolean
Dim bRet                    As Boolean
Dim wasResolved             As Boolean
Dim FilePath                As String
Dim PathNoExtension         As String
Dim NewFilePath             As String
Dim Value_                  As String
Dim ResolvedValOut          As String
Dim sConfigName             As String
Dim varAlignment            As Variant
Dim vConfNameArr            As Variant
Dim dataAlignment(11)       As Double
Sub main()

Set swApp = CreateObject("SldWorks.Application") 'Lancement de SW
Set swModel = swApp.ActiveDoc 'Récuperation du modèle actif dans SW
Set swPart = swModel
FilePath = swModel.GetPathName 'Récupère le chemin du fichier SW
PathSize = Strings.Len(FilePath) 'Compte le nombre de caractères du chemin
PathNoExtension = Strings.Left(FilePath, PathSize - 6) 'Récupère le nom de la pièce en enlevant .Sldrt

vConfNameArr = swModel.GetConfigurationNames 'Création de la liste des configurations
For i = 0 To UBound(vConfNameArr) 'Boucle la liste : de l'élément 0 jusqu'au nombre d'élément dans la liste (Ubound)
    If InStr(UCase(vConfNameArr(i)), "SM-FLAT-PATTERN") = 0 Then 'Vérification si Flat Pattern est dans le nom de la configuration
        Set config = swModel.GetActiveConfiguration
        Set cusPropMgr = config.CustomPropertyManager
        sConfigName = vConfNameArr(i) 'Recupère l'élément N°i de la liste
        bShowConfig = swModel.ShowConfiguration2(sConfigName) 'Affiche la configuration
        Error = cusPropMgr.Get5("TYPE", True, Value_, ResolvedValOut, wasResolved) 'Récupère la valeur de la proriété "" dans la variable "Value_"
        bRebuild = swModel.ForceRebuild3(False) 'Reconstruction du modèle
        NewFilePath = Left(FilePath, InStrRev(FilePath, "\")) & "" & (sConfigName) & ".DXF" 'Remplace le nom par Type + Lg + Nom de la config (sans Flat pattern).dxf
        dataAlignment(0) = 0#
        dataAlignment(1) = 0#
        dataAlignment(2) = 0#
        dataAlignment(3) = 1#
        dataAlignment(4) = 0#
        dataAlignment(5) = 0#
        dataAlignment(6) = 0#
        dataAlignment(7) = 1#
        dataAlignment(8) = 0#
        dataAlignment(9) = 0#
        dataAlignment(10) = 0#
        dataAlignment(11) = 1#
        varAlignment = dataAlignment
        swPart.ExportToDWG2 NewFilePath, FilePath, swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, 13, Null
    End If
Next i 'Passe à la prochaine config

End Sub

 

Je suis désolé mais la macro ne me génère pas les configurations des dépliés, ci joint ma pièce avec la ma macro. Regardez les configurations avant de la lancer et vous comprendrez; j'aimerai que celle-ci me rajoute les ligne de pli dans les DXF


lot_de_cornieres.sldprt
export_dxf_famille_de_piece_-_ac_cobra.swp

Bonjour,

J'ai l'impression que l'on ne se comprend pas ou alors la macro ne fonctionne pas de la même façon sur mon poste et le votre.

Cette ligne: swPart.ExportToDWG2 NewFilePath, FilePath, swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, 13, Null

Exporte le déplié en ajoutant les lignes de plis.

Ci-dessous les résultats en fonction des macros utilisées.


1_-_30x30x2_lg_1825_x120-macro_ac_cobra.jpg
1_-_30x30x2_lg_1825_x120-macro_modifie.jpg

Oui les développé c'est ok mais lorsque vous lancez celle que j'utilise les configurations déplié sont créé automatiquement dans la pièce d'ou mon précédent poste. Si vous observez mes configurations et vous lancez ma macro vous verrez les configurations déplié se créer alors que dans celle que vous avez créé elle ne ce créé pas.

Bonjour,

Ok on ne s'était pas compris donc il faut juste passer l'argument 1 à 0 dans la ligne bRet = swModel.ExportFlatPatternView(NewFilePath, 1).

Le code remanié ci-dessous:

Option Explicit

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

Set swApp = CreateObject("SldWorks.Application") 'Lancement de SW
Set swModel = swApp.ActiveDoc 'Récuperation du modèle actif dans SW
FilePath = swModel.GetPathName 'Récupère le chemin du fichier SW
PathSize = Strings.Len(FilePath) 'Compte le nombre de caractères du chemin
PathNoExtension = Strings.Left(FilePath, PathSize - 6) 'Récupère le nom de la pièce en enlevant .Sldrt

vConfNameArr = swModel.GetConfigurationNames 'Création de la liste des configurations
For i = 0 To UBound(vConfNameArr) 'Boucle la liste : de l'élément 0 jusqu'au nombre d'élément dans la liste (Ubound)
    Set config = swModel.GetActiveConfiguration
    Set cusPropMgr = config.CustomPropertyManager
    sConfigName = vConfNameArr(i) 'Recupère l'élément N°i de la liste
    bShowConfig = swModel.ShowConfiguration2(sConfigName) 'Affiche la configuration
    Error = cusPropMgr.Get5("TYPE", True, Value_, ResolvedValOut, wasResolved) 'Récupère la valeur de la proriété "" dans la variable "Value_"
    bRebuild = swModel.ForceRebuild3(False) 'Reconstruction du modèle
    NewFilePath = Left(FilePath, InStrRev(FilePath, "\")) & "" & (sConfigName) & ".DXF" 'Remplace le nom par Type + Lg + Nom de la config (sans Flat pattern).dxf
    bRet = swModel.ExportFlatPatternView(NewFilePath, 0) 'Export le déplié
Next i 'Passe à la prochaine config

End Sub

 

1 « J'aime »

Bonjour @Cyril.f,

 

désolé pour le retard mais je viens de revenir de congés; j'ai testé et ça fonctionne parfaitement. Merci beaucoup d'avoir pris le temps :-) pour mon problème.