Zaktualizowany nieaktualny kod VBA

3D Design
1

  Cze wszystkim

Mam makro Solidworks zakodowane w VBA, które ma kilka lat.

Od tego czasu zauważyłem, że kilka funkcji stało się przestarzałych i dlatego należy je wymienić.

Chciałbym użyć tego makra w wersji Sw2020 i nowszych. 

Patrząc na pomoc APi Solidworks, widzę przestarzałe funkcje, które należy zastąpić ich nowymi nazwami.

Z drugiej strony nadal nie mogę zmusić tego kodu do działania...

W ogóle nie czuję się komfortowo z VBA i dlatego proszę o pomoc.

Jest to temat, który ciągnie się już od dłuższego czasu, ale nie poświęciłem czasu, aby się nim zająć.

Gdyby życzliwa dusza mogła rzucić na to okiem i powiedzieć mi, jak zaktualizować kod.

Zacząłem już aktualizować kod o nowe funkcje, ale blokuję...

Mówiąc ogólnie, makro ma na celu:

- Eksportuj rozwiniętą wersję każdej konfiguracji części arkusza blachy w formacie dxf lub dwg z nazwą zmiennej zdefiniowaną w kodzie.

Załączam makro, na razie mam błąd na swModel.GetConfigurationNames

Z góry dziękuję za pomoc! =)

 


oldvba.txt
2

Witam;
Oto moja propozycja:
-Uwaga: spróbuj opublikować swój kod w wiadomości, a nie jako załącznik, bardziej uspokajające jest "zobacz" kod niż go pobierać.
-Uwaga 2: Unikaj akcentów w kodzie VB (Visual Basic) za wszelką cenę
 

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

 

Pozdrowienia.

3 polubienia
3

Właśnie przetestowałem makro!

Nie popełnia błędów i to jest fajne!

Pozostaje tylko usunąć zapis przy każdej konfiguracji, ponieważ za każdym razem muszę kliknąć "zapisz" i powiedzieć mu, aby nie eksportował linii zagięcia.

Więc chyba zmieniam linię ExportBendLines=4 na ExportBendLines=0 lub jakąś inną podpowiedź^^

Następnie, aby usunąć nagranie, nie widzę, którą linię muszę zmienić. Może po prostu opcja w Sw do modyfikacji.

 

W każdym razie wielkie dzięki, ponieważ kod jest naprawdę świetny! =)