Macro-export dxf artikelfamilie

Hallo collega's,

Ik kom naar je toe omdat ik een macroquiche ben en ik heb er een die ik graag had willen verbeteren. Het werkt perfect als ik het run en al mijn dxf van de onderdeelfamilie maak, maar ik kan het niet aanpassen zodat het de buiglijnen in de pers verwijdert.   

Alvast bedankt voor je hulp :-)

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

Goedenavond

Tenzij ik me vergis, is de optie niet toegankelijk in deze oude methode.

 U moet de ExportToDWG2-methode gebruiken, de niet-geoptimaliseerde code die eenvoudigweg uit de help is gehaald, is de volgende:

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

 

Aan de andere kant denk ik dat de variabelen filepath en pathsize  uit de lusverwerking moeten worden verwijderd, aangezien deze macro bestand voor bestand werkt als ik het goed begrijp.

@Cyril.f . eigenlijk de macro die ik gebruik maakt de flatpathern in een kamer van verschillende configuraties door het op te slaan met de naam van de configuratie, het enige wat ontbreekt is de vouwlijn in de DXF.

Ik heb net de macro getest die werkt, het maakt de DXF met de vouwlijnen, maar maakt niet langer de uitgevouwen configuraties . 

Hallo

Ik zag er niet meer uit dan dat gisteravond, maar is het niet in plaats van uitgevouwen configuraties die de macro doet en niet langer de dxf van gevouwen configuraties?

In feite is de macro die ik had gevonden gedaan: de creatie van de dxf in uitgevouwen zonder de vouwlijnen en de configuratie van de uitgevouwen van alle configuraties van het onderdeel en degene die je deelde niet langer de configuraties van de uitgevouwen in de configuraties, maar maakte alle uitgevouwen met de vouwlijnen 

Ik kan een voorbeeldbestand hebben omdat ik er geen bij de hand heb. Ik had net een bestand met een uitgevouwen conf en de standaard conf en het liep goed op beide "configuraties", maar het lijkt mij dat de twee dxfs waren in uitgevouwen visueel (gekoppeld aan de macro code export lijn).

Bijgevoegd zijn voorbeeldbestanden, maar het is onder 2020, de ene met de gonfig uitgeklapt en de andere zonder


lot_de_cornieres.sldprt
lot_de_cornieres_avec_deplie.sldprt

Goedenavond

Op de bijgevoegde code zou het aan de behoefte moeten voldoen.

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

 

Het spijt me, maar de macro genereert niet de uitgevouwen configuraties, hier is mijn stuk met de mijn macro. Kijk naar de configuraties voordat u het start en u zult begrijpen; Ik zou graag willen dat deze de vouwlijn in de DXF toevoegt


lot_de_cornieres.sldprt
export_dxf_famille_de_piece_-_ac_cobra.swp

Hallo

Ik heb de indruk dat we elkaar niet begrijpen of dat de macro niet op dezelfde manier werkt op mijn computer en die van jou.

Deze regel: swPart.ExportToDWG2 NewFilePath, FilePath, swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, 13, Null

Exporteert het uitgevouwen door de vouwlijnen toe te voegen.

Hieronder staan de resultaten volgens de gebruikte macro's.


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

Ja, de ontwikkelde zijn ok, maar wanneer je degene start die ik gebruik, worden de uitgevouwen configuraties automatisch in de kamer gemaakt, vandaar mijn vorige bericht. Als je naar mijn configuraties kijkt en je start mijn macro, dan zie je dat de uitgevouwen configuraties worden gemaakt, terwijl dat in degene die je hebt gemaakt dat niet is.

Hallo

Ok we begrepen elkaar niet, dus we hoeven alleen maar het argument 1 naar 0 door te geven in de regel bRet = swModel.ExportFlatPatternView(NewFilePath, 1).

De herziene code hieronder:

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 like

Hallo @Cyril.f,

 

sorry voor de vertraging, maar ik ben net terug van vakantie; Ik heb het getest en het werkt perfect. Heel erg bedankt dat je de tijd hebt genomen :-) voor mijn probleem.