Bijgewerkte verouderde VBA-code

3D Design
1

  Hoi allemaal

Ik heb een Solidworks-macro gecodeerd in VBA die enkele jaren oud is.

Sindsdien heb ik gezien dat verschillende functies verouderd zijn en dus aan vervanging toe zijn.

Ik wil deze macro gebruiken onder versie Sw2020 en hoger. 

Als ik naar de APi Solidworks-help kijk, kan ik de verouderde functies zien die moeten worden vervangen door hun nieuwe namen.

Aan de andere kant krijg ik deze code nog steeds niet aan de praat...

Ik voel me helemaal niet op mijn gemak bij de VBA en daarom vraag ik uw hulp.

Het is een onderwerp dat al geruime tijd aansleept, maar ik heb niet de tijd genomen om me ermee bezig te houden.

Als een vriendelijke ziel er eens naar zou kunnen kijken en me zou kunnen vertellen hoe ik de code kan bijwerken.

Ik ben al begonnen met het updaten van de code met de nieuwe functies, maar ik blokkeer...

Om het in grote lijnen uit te leggen, wordt de macro verondersteld:

- Exporteer de uitgevouwen versie van elke configuratie van een plaatwerkonderdeel in dxf of dwg met een variabelenaam die in de code is gedefinieerd.

Ik voeg de macro toe, voor nu heb ik een fout op de swModel.GetConfigurationNames

Alvast bedankt voor je hulp! =)

 


oldvba.txt
2

Hallo;
Hier is mijn voorstel:
-Opmerking: probeer uw code in het bericht te publiceren in plaats van als bijlage, het is geruststellender om een code te "zien" in plaats van deze te downloaden.
-Opmerking 2: Vermijd ten koste van alles accenten in VB (Visual Basic) Code
 

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

 

Vriendelijke groeten.

3 likes
3

Ik heb net de macro getest!

Ze maakt geen fouten en dat is cool!

Het enige dat overblijft is om de save bij elke configuratie te verwijderen, omdat ik elke keer op "save" moet klikken en moet zeggen dat ik de buiglijnen niet mag exporteren.

Dus ik denk dat ik de regel ExportBendLines=4 verander in ExportBendLines=0 of een andere hint^^

Om vervolgens de opname te verwijderen, zie ik niet welke regel ik moet wijzigen. Misschien gewoon een optie in Sw om aan te passen.

 

In ieder geval een grote dankjewel want de code is echt geweldig! =)