Recuperer valeur cube visualisation

MLG · Décembre 15, 2023, 10:48

Hello everybody,
revoici le questionneur fou !!!
Je voudrais savoir si il est possible de récuperer les valeurs du cube de visualisation dans une macro afin que je puisse les attribuer à des variables ?

Elles se mettent bien dans les propriétés de la pièce, mais dans la macro lorsque je mets « SW-Longueur totale du cube de visualisation » afin de récuperer la valeur, rien ne se passe …
Auriez vous une piste ?

Et en deuxieme, savez vous si il est possible de faire une raz des noms de fonctions de l’arbre ? Ou est il possible de renommer les fonctions via une macro ?
Merci beaucoup.

Maclane · Décembre 15, 2023, 10:55

Bonjour;

Cela doit être réalisable:
https://help.solidworks.com/2022/english/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IBoundingBoxFeatureData.html

https://help.solidworks.com/2022/English/api/sldworksapi/Get_Part_Bounding_Box_Example_VB.htm?verRedirect=1

Seconde partie, oui il est aussi possible de renommer les fonctions par Macro:
Exemple avec utilisation du dictionnaire

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Sub main()

    Set swApp = Application.SldWorks
    
    Set swModel = swApp.ActiveDoc
    
    Dim passedOrigin As Boolean
    passedOrigin = False
    
    If Not swModel Is Nothing Then
    
        Dim featNamesTable As Object
        Dim processedFeats As Collection
        
        Set featNamesTable = CreateObject("Scripting.Dictionary")
        Set processedFeats = New Collection
        
        featNamesTable.CompareMode = vbTextCompare 'case insensitive
        
        Dim swFeat As SldWorks.Feature
        Set swFeat = swModel.FirstFeature
        
        While Not swFeat Is Nothing
            
            If passedOrigin = 0 Or swFmHoleWzd = 1 Then 'Lister les elements à exclure sous la forme " And InStr(swFeat.Name, "Element a Exclure")"
            
                If Not Contains(processedFeats, swFeat) Then
                    processedFeats.Add swFeat
                    RenameFeature swFeat, featNamesTable
                End If
                
                Dim swSubFeat As SldWorks.Feature
                Set swSubFeat = swFeat.GetFirstSubFeature
                
                While Not swSubFeat Is Nothing
                    
                    If Not Contains(processedFeats, swSubFeat) Then
                        processedFeats.Add swSubFeat
                        RenameFeature swSubFeat, featNamesTable
                    End If
                    
                    Set swSubFeat = swSubFeat.GetNextSubFeature
                    
                Wend
            
            End If
            
            If swFeat.GetTypeName2() = "OriginProfileFeature" Then
                passedOrigin = True
            End If
            
            Set swFeat = swFeat.GetNextFeature
        Wend
        
    Else
        MsgBox "Please open model"
    End If

End Sub

Sub RenameFeature(feat As SldWorks.Feature, featNamesTable As Object)

    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.Pattern = "(.+?)(\d+)$"
    
    Dim regExMatches As Object
    Set regExMatches = regEx.Execute(feat.Name)
    
    If regExMatches.Count = 1 Then
        
        If regExMatches(0).SubMatches.Count = 2 Then
            
            Dim baseFeatName As String
            baseFeatName = regExMatches(0).SubMatches(0)
            
            Dim nextIndex As Integer
            
            If featNamesTable.Exists(baseFeatName) Then
                nextIndex = featNamesTable.item(baseFeatName) + 1
                featNamesTable.item(baseFeatName) = nextIndex
            Else
                nextIndex = 1
                featNamesTable.Add baseFeatName, nextIndex
            End If
            feat.Name = baseFeatName & nextIndex
        End If
    End If

End Sub

Function Contains(coll As Collection, item As Object) As Boolean
    
    Dim i As Integer
    
    For i = 1 To coll.Count
        If coll.item(i) Is item Then
            Contains = True
            Exit Function
        End If
    Next
    
    Contains = False
    
End Function

Cordialement.

Joël_1 · Décembre 15, 2023, 11:31

Merci

MLG · Décembre 18, 2023, 8:01

Bonjour @Maclane
J’ai testé la macro pour renommer les fonctions, ça marche bien, mais c’es trop complexe vu la diversité des pièces que l’on a.

Est il possible de récupérer le nom de la seconde fonction (FirstFeature pour la premère je crois) ?

Comme cela je pourrais en créé une variable afin de faire un retour sur fonction (swMoveRollbackBarTo).

Voici ce que j’ai bricolé pour la LONGUEUR du Cube de visualisation :

Option Explicit

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim swFeat As Object
Dim swFeatMgr As Object

'Suppression Cube de visualistaion existant (pour MAJ longueur)
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.EditDelete

'Création Cube de visualisation (permettant d'avoir la longueur du poteau)
Set swFeatMgr = Part.FeatureManager
Dim swFeatData As Object
Set swFeatData = swFeatMgr.CreateDefinition(swFeatureNameID_e.swFmBoundingBox)
swFeatData.IncludeHiddenBodies = False
swFeatData.IncludeSurfaces = False
swFeatData.ReferenceFaceOrPlane = 1
Set swFeat = swFeatMgr.CreateFeature(swFeatData)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.BlankSketch
    
    '''-----------------------------------------------
    
    'Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swConfigMgr                 As SldWorks.ConfigurationManager
    Dim swConfig                    As SldWorks.Configuration
    Dim vConfigName                 As Variant
    Dim vConfigNameArr              As Variant
    Dim sSpecConfigNameArr(0)       As String
    Dim vSpecConfigNameArr          As Variant
    Dim dimValue                    As Variant
    Dim stnameConfig                As String
    'Dim boolstatus                  As Boolean
    Dim i                           As Integer
    Dim swErrors                    As Long
    Dim swWarnings                  As Long
    Dim swPart                      As SldWorks.PartDoc
    Dim tConfig()                   As String
    Dim swModelDocExt               As ModelDocExtension
    Dim swCustProp                  As CustomPropertyManager
    Dim sLongueur                      As String
    Dim sCentreMasseY               As String
    Dim sValout                     As String
    Dim sValSurf                    As String
    Dim sValLong                    As String
    Dim bRet                        As String

    '''-----------------------------------------------

   
    'on récupére le document actif
    Set swModel = swApp.ActiveDoc
    Set swConfigMgr = swModel.ConfigurationManager
    
    'on récupére la configuration active
    Set swConfig = swConfigMgr.ActiveConfiguration
    stnameConfig = swConfig.Name
    vConfigNameArr = swModel.GetConfigurationNames
    
    Set swModelDocExt = swModel.Extension
    
    
    '''-----------------------------------------------
   
   'on boucle sur toutes les configurations
    For Each vConfigName In vConfigNameArr
    'on test si la configuration est différente de la configuration active et de la configuration Default
        
    If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
    boolstatus = swModel.DeleteConfiguration2(vConfigName)
        
    End If
        
    If vConfigName <> swConfig.Name And vConfigName <> "Défaut" Then
    boolstatus = swModel.DeleteConfiguration2(vConfigName)
        
    End If
                    
    Next vConfigName
 
    'on reconstruit la pièce
    swModel.ForceRebuild3 False

    'récupère le document actif dans SW
    Set swModel = swApp.ActiveDoc
    If Not swModel Is Nothing Then

    Set swPart = swModel
    
    'Boucle sur toutes les configurations
    tConfig = swModel.GetConfigurationNames
    For i = 0 To UBound(tConfig)
        
    Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
    
    'Récupération de la propriété de Longueur Cube Visualisation
    bRet = swCustProp.Get6("Longueur totale du cube de visualisation", False, sValout, sLongueur, False, False)
   
    'Renseignement de la propriété LONGUEUR avec la valeur "sVal"
    bRet = swCustProp.Add3("LONGUEUR", 30, sLongueur, 1)
    
    Next i
    
    End If
    
    MsgBox "MAJ LONGUEUR OK"
    
End Sub

Ca fonctionne bien, cela permet de mettre à jour la variable LONGUEUR lorsque l’on modifie la longueur de notre pièce.

MLG · Décembre 21, 2023, 12:01

Bonjour,

J’ai pas mal avancé dans ma macro. Elle fonctionne bien sur une pièce la première fois.
Mais si je relance la macro (changement de longueur de la pièce pour tester et même sans rien changer) la macro plante ainsi :

Et le débogage me donne ceci :

Je ne parviens pas à comprendre et donc à corriger ce soucis. Est ce que quelqu’un pourrait m’aider ?

Voici le code complet :

Option Explicit
    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swConfigMgr                 As SldWorks.ConfigurationManager
    Dim swConfig                    As SldWorks.Configuration
    Dim vConfigName                 As Variant
    Dim vConfigNameArr              As Variant
    Dim sSpecConfigNameArr(0)       As String
    Dim vSpecConfigNameArr          As Variant
    Dim dimValue                    As Variant
    Dim Part                        As Object
    Dim stnameConfig                As String
    Dim boolstatus                  As Boolean
    Dim longstatus                  As Long, longwarnings As Long
    Dim i                           As Integer
    Dim swErrors                    As Long
    Dim swWarnings                  As Long
    Dim swPart                      As SldWorks.PartDoc
    Dim tConfig()                   As String
    Dim swModelDocExt               As ModelDocExtension
    Dim swCustProp                  As CustomPropertyManager
    Dim sMasse                      As String
    Dim sValout                     As String
    Dim sValSurf                    As String
    Dim sValLong                    As String
    Dim bRet                        As String
    Dim NamePiece                   As String
    Dim confName                    As String
    Dim confNameF                   As String
    Dim MaterialFilePath            As String
    Dim ConfigNameSuffix            As String
    Dim colorName                    As String
    Dim CodArt                      As String
    Dim CodeArticle                 As String
    Dim sLongueur                   As String
    Dim sCentreMasseY               As String

Type ConfigData
    MaterialFilePath                As String
    ConfigNameSuffix                As String
    colorName                       As String
    confName                        As String
    confNameF                       As String
    NamePiece                       As String
    CodArt                          As String
    CodeArticle                     As String
    
End Type
    Const PROP_RAL                  As String = "RAL"
    Const PROP_CodeArticle          As String = "Code Article"


Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    ''' Récupération du document actif
    Set swModel = swApp.ActiveDoc
    Set swConfigMgr = swModel.ConfigurationManager
    
    ''' Récupération de la configuration active
    Set swConfig = swConfigMgr.ActiveConfiguration
    stnameConfig = swConfig.Name
    vConfigNameArr = swModel.GetConfigurationNames
    
    Set swModelDocExt = swModel.Extension
    

    Set Part = swApp.ActiveDoc
    Dim swFeat As Object
    Dim swFeatMgr As Object

    ''' Suppression Cube de visualistaion éxistant
    Set Part = swApp.ActiveDoc
    boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
    Part.EditDelete

    ''' Création Cube de visualisation
    Set swFeatMgr = Part.FeatureManager
    Dim swFeatData As Object
    Set swFeatData = swFeatMgr.CreateDefinition(swFeatureNameID_e.swFmBoundingBox)
    swFeatData.IncludeHiddenBodies = False
    swFeatData.IncludeSurfaces = False
    swFeatData.ReferenceFaceOrPlane = 1
    Set swFeat = swFeatMgr.CreateFeature(swFeatData)
    Part.ClearSelection2 True
    boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
    Part.BlankSketch
    
    ''' Réglages Préférences SolidWorks
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
    boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
    boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)

    
    ''' Création Configuration 00 et suppression configurations Défaut, xx, PC
    Set swPart = swModel
    boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
    boolstatus = swModel.DeleteConfiguration2("Défaut")
    boolstatus = swModel.DeleteConfiguration2("xx")
    boolstatus = swModel.DeleteConfiguration2("PC")
    
    ''' Mise en place du matériaux
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"

    
    ''' Récupération de la variable NomDeFichier sans extension
    NamePiece = GetFileNameWithoutExtension(swModel.GetPathName())

    ''' Création des Configurations 00 et RAL avec ajout des textures RAL MAT
    Dim CONFIGS_DATA(14) As ConfigData

    CONFIGS_DATA(1).colorName = "ALUMINIUM BRUT"
    CONFIGS_DATA(1).ConfigNameSuffix = "00"
    CONFIGS_DATA(1).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\APPARENCES\alu inox.p2m"

    CONFIGS_DATA(2).colorName = "RAL 1013"
    CONFIGS_DATA(2).ConfigNameSuffix = "R1013"
    CONFIGS_DATA(2).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 1013 mat.p2m"

    CONFIGS_DATA(3).colorName = "RAL 1018"
    CONFIGS_DATA(3).ConfigNameSuffix = "R1018"
    CONFIGS_DATA(3).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 1018 mat.p2m"

    CONFIGS_DATA(4).colorName = "RAL 2008"
    CONFIGS_DATA(4).ConfigNameSuffix = "R2008"
    CONFIGS_DATA(4).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 2008 mat.p2m"

    CONFIGS_DATA(5).colorName = "RAL 3000"
    CONFIGS_DATA(5).ConfigNameSuffix = "R3000"
    CONFIGS_DATA(5).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 3000 mat.p2m"

    CONFIGS_DATA(6).colorName = "RAL 3004"
    CONFIGS_DATA(6).ConfigNameSuffix = "R3004"
    CONFIGS_DATA(6).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 3004 mat.p2m"

    CONFIGS_DATA(7).colorName = "RAL 5015"
    CONFIGS_DATA(7).ConfigNameSuffix = "R5015"
    CONFIGS_DATA(7).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 5015 mat.p2m"

    CONFIGS_DATA(8).colorName = "RAL 6005"
    CONFIGS_DATA(8).ConfigNameSuffix = "R6005"
    CONFIGS_DATA(8).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 6005 mat.p2m"

    CONFIGS_DATA(9).colorName = "RAL 6018"
    CONFIGS_DATA(9).ConfigNameSuffix = "R6018"
    CONFIGS_DATA(9).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 6018 mat.p2m"

    CONFIGS_DATA(10).colorName = "RAL 6029"
    CONFIGS_DATA(10).ConfigNameSuffix = "R6029"
    CONFIGS_DATA(10).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 6029 mat.p2m"

    CONFIGS_DATA(11).colorName = "RAL 7016"
    CONFIGS_DATA(11).ConfigNameSuffix = "R7016"
    CONFIGS_DATA(11).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 7016 mat.p2m"

    CONFIGS_DATA(12).colorName = "RAL 7035"
    CONFIGS_DATA(12).ConfigNameSuffix = "R7035"
    CONFIGS_DATA(12).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 7035 mat.p2m"

    CONFIGS_DATA(13).colorName = "RAL 7037"
    CONFIGS_DATA(13).ConfigNameSuffix = "R7037"
    CONFIGS_DATA(13).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 7037 mat.p2m"

    CONFIGS_DATA(14).colorName = "RAL 9005"
    CONFIGS_DATA(14).ConfigNameSuffix = "R9005"
    CONFIGS_DATA(14).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 9005 mat.p2m"

    ''' Ajout de propriétés à toutes les configurations
    
    Dim i As Integer
    
    For i = 0 To UBound(CONFIGS_DATA)
        
        confName = ""

        If CONFIGS_DATA(i).ConfigNameSuffix <> "" Then
            confName = CONFIGS_DATA(i).ConfigNameSuffix
            CodArt = NamePiece & "-" & CONFIGS_DATA(i).ConfigNameSuffix
        End If
        
       
        If i <> 0 Then
            swModel.AddConfiguration3 confName, "", "", 0
            
        ''' Ajout de la propriété "Code Article"
        CodeArticle = CodArt
        bRet = swModel.DeleteCustomInfo2(confName, "Code Article")
        bRet = swModel.AddCustomInfo3(confName, "Code Article", swCustomInfoText, CodeArticle)
            
        ''' Ajout de la propriété "PROFILS"
        bRet = swModel.DeleteCustomInfo2(confName, "DESIGNATION 2")
        bRet = swModel.DeleteCustomInfo2(confName, "PROFILS")
        bRet = swModel.AddCustomInfo3(confName, "PROFILS", swCustomInfoText, "POTEAUXHEXA")
    
        ''' Ajout de la propriété "MASSE" avec la valeur swMasse
        ''' Chr(34) permet d'ajouter le caractère "
        bRet = swModel.DeleteCustomInfo2(confName, "masse")
        bRet = swModel.AddCustomInfo3(confName, "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
    
        ''' Ajout de la propriété "POIDS" avec la valeur swMasse
        ''' Chr(34) permet d'ajouter le caractère "
        bRet = swModel.DeleteCustomInfo2(confName, "POIDS")
        bRet = swModel.AddCustomInfo3(confName, "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
    
        ''' ajoute un propriété personnalisée edition avec la valeur MATERIAUX
        ''' Chr(34) permet d'ajouter le caractère "
        bRet = swModel.DeleteCustomInfo2(confName, "MATERIAUX")
        bRet = swModel.AddCustomInfo3(confName, "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
        
        ''' on reconstruit la pièce
        swModel.ForceRebuild3 False
    
        Set swCustProp = swModelDocExt.CustomPropertyManager(confName)
        
        ''' Récupération de la propriété de Longueur Cube Visualisation
        bRet = swCustProp.Get6("Longueur totale du cube de visualisation", False, sValout, sLongueur, False, False)
   
        ''' Renseignement de la propriété LONGUEUR avec la valeur "sVal"
        bRet = swCustProp.Add3("LONGUEUR", 30, sLongueur, 1)
        
        ''' Renseignement de la propriété DESIGNATION 2 avec la valeur "sVal"
        bRet = swCustProp.Add3("DESIGNATION 2", 30, sLongueur, 1)
        
        ''' on reconstruit la pièce
        swModel.ForceRebuild3 False
    
        ''' Conversion du texte en valeur décimale, multiplication LONGUEUR x RATIO SURFACE et conversion en donné de type texte
        sValSurf = CStr(Format(CDec(sLongueur) * 0.000304, "0.000"))
     
        ''' Renseignement de la propriété SURFACE PIECE avec la valeur "sVal"
        bRet = swCustProp.Add3("SURFACE PIECE", 30, sValSurf, 1)
    
        End If
        
        swModel.ConfigurationManager.ActiveConfiguration.Name = confName
        
                
        If CONFIGS_DATA(i).MaterialFilePath <> "" Then
            AddRenderMaterial swModel, CONFIGS_DATA(i).MaterialFilePath
        End If
        
        AddConfigProperty swModel, CONFIGS_DATA(i).colorName
        
    Next

End Sub

Sub AddRenderMaterial(model As SldWorks.ModelDoc2, path As String)
    
    Dim swRenderMaterial As SldWorks.RenderMaterial
    Set swRenderMaterial = model.Extension.CreateRenderMaterial(path)
    
    If False <> swRenderMaterial.AddEntity(model) Then
        If False = model.Extension.AddDisplayStateSpecificRenderMaterial(swRenderMaterial, swDisplayStateOpts_e.swThisDisplayState, Empty, -1, -1) Then
            Err.Raise vbError, "", "Failed to apply render material to display state"
        End If
    Else
        Err.Raise vbError, "", "Failed to add model as entity to render material"
    End If
   
End Sub

''' Attribution Propriété "RAL"

Sub AddConfigProperty(model As SldWorks.ModelDoc2, colorName As String)

   
    Dim swCustPrpMgr As SldWorks.CustomPropertyManager
    
    Set swCustPrpMgr = model.Extension.CustomPropertyManager("")
    
    Dim propRal As String

    
    swCustPrpMgr.Get4 PROP_RAL, False, "", propRal

    
    Set swCustPrpMgr = model.ConfigurationManager.ActiveConfiguration.CustomPropertyManager
    
    swCustPrpMgr.Add3 PROP_RAL, swCustomInfoType_e.swCustomInfoText, propRal & colorName, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue

End Sub

Function GetFileNameWithoutExtension(filePath As String) As String
    GetFileNameWithoutExtension = Mid(filePath, InStrRev(filePath, "\") + 1, InStrRev(filePath, ".") - InStrRev(filePath, "\") - 1)
           
End Function

Merci d’avance

sbadenis · Décembre 21, 2023, 12:28

Lance la macro en mode édition et pas à pas et regarde les valeurs des différentes variables utilisées dans cette ligne (en erreur) si l’une est vide ou non numérique possible que ce soit lié.
Pour cela ajoute un debug.print sLongueur, un autre avec debug.print Format(Cdec…) par exemple pour voir si cela fonctionne bien ou pas.
Pas le temps de regarder précisément ta macro.
Le mode pas à pas permet et l’ajout de debug.print permet au début de voir l’état des différentes variable dans la fenêtre exécution (sinon voir la fenêtre Variables locales) mais moins pratique pour moi.

MLG · Décembre 21, 2023, 3:05

Merci @sbadenis
J’ai essayé mais je n’arrive pas à visualiser d’où vient ce soucis.
Faudrait il ajouter une RAZ des valeur en début de macro (si cela existe) ? J’ai l’impression qu’une fois que c’est renseigné, la macro bloque

sbadenis · Décembre 21, 2023, 3:55

Ton problème est que tes propriété du cube de visualisation sont créer dans la config R9005:

Hors l’un d’un 2ème lancement il passe en revue les configs et commence par la 00 hors la propriété n’existant pas dans cette config:

Donc pas de valeur trouvé, pas de valeur reporté dans sLongueur et erreur macro.
Solution 1: écrire les propriétés de la bounding box dans chaque configs.
Solution 2 si les dimensions de la bounding box sont identique dans chaque configs les écrirent 1 fois dans l’onglet personnalisé et peut importe la config en allant les chercher dans cet onglet il seront identique. (Attention uniquement les prop de la bounding box les autres doivent rester dans Spécifiques à la configuration)

Pour voir que ta valeur est vide avec le mode pas à pas quand tu as passé la ligne tu passe la souris sur la variable sLongueur et tu vois qu’elle est égale à rien:

sbadenis · Décembre 21, 2023, 4:07

Plus simple tu créer ta bounding box après le nettoyage de tes config et là cela fonctionne:

Option Explicit
    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swConfigMgr                 As SldWorks.ConfigurationManager
    Dim swConfig                    As SldWorks.Configuration
    Dim vConfigName                 As Variant
    Dim vConfigNameArr              As Variant
    Dim sSpecConfigNameArr(0)       As String
    Dim vSpecConfigNameArr          As Variant
    Dim dimValue                    As Variant
    Dim Part                        As Object
    Dim stnameConfig                As String
    Dim boolstatus                  As Boolean
    Dim longstatus                  As Long, longwarnings As Long
    Dim i                           As Integer
    Dim swErrors                    As Long
    Dim swWarnings                  As Long
    Dim swPart                      As SldWorks.PartDoc
    Dim tConfig()                   As String
    Dim swModelDocExt               As ModelDocExtension
    Dim swCustProp                  As CustomPropertyManager
    Dim sMasse                      As String
    Dim sValout                     As String
    Dim sValSurf                    As String
    Dim sValLong                    As String
    Dim bRet                        As String
    Dim NamePiece                   As String
    Dim confName                    As String
    Dim confNameF                   As String
    Dim MaterialFilePath            As String
    Dim ConfigNameSuffix            As String
    Dim colorName                    As String
    Dim CodArt                      As String
    Dim CodeArticle                 As String
    Dim sLongueur                   As String
    Dim sCentreMasseY               As String

Type ConfigData
    MaterialFilePath                As String
    ConfigNameSuffix                As String
    colorName                       As String
    confName                        As String
    confNameF                       As String
    NamePiece                       As String
    CodArt                          As String
    CodeArticle                     As String
    
End Type
    Const PROP_RAL                  As String = "RAL"
    Const PROP_CodeArticle          As String = "Code Article"


Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    ''' Récupération du document actif
    Set swModel = swApp.ActiveDoc
    Set swConfigMgr = swModel.ConfigurationManager
    
    ''' Récupération de la configuration active
    Set swConfig = swConfigMgr.ActiveConfiguration
    stnameConfig = swConfig.Name
    vConfigNameArr = swModel.GetConfigurationNames
    
    Set swModelDocExt = swModel.Extension
    

    Set Part = swApp.ActiveDoc
    Dim swFeat As Object
    Dim swFeatMgr As Object



    
    ''' Création Configuration 00 et suppression configurations Défaut, xx, PC
    Set swPart = swModel
    boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
    boolstatus = swModel.DeleteConfiguration2("Défaut")
    boolstatus = swModel.DeleteConfiguration2("xx")
    boolstatus = swModel.DeleteConfiguration2("PC")
    
    
    
    ''' Suppression Cube de visualistaion éxistant
    Set Part = swApp.ActiveDoc
    boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
    Part.EditDelete

    ''' Création Cube de visualisation
    Set swFeatMgr = Part.FeatureManager
    Dim swFeatData As Object
    Set swFeatData = swFeatMgr.CreateDefinition(swFeatureNameID_e.swFmBoundingBox)
    swFeatData.IncludeHiddenBodies = False
    swFeatData.IncludeSurfaces = False
    swFeatData.ReferenceFaceOrPlane = 1
    Set swFeat = swFeatMgr.CreateFeature(swFeatData)
    Part.ClearSelection2 True
    boolstatus = Part.Extension.SelectByID2("Cube de visualisation", "BBOXSKETCH", 0, 0, 0, False, 0, Nothing, 0)
    Part.BlankSketch
    
    ''' Réglages Préférences SolidWorks
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
    boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
    boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
    boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)
    
    
    
    ''' Mise en place du matériaux
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"

    
    ''' Récupération de la variable NomDeFichier sans extension
    NamePiece = GetFileNameWithoutExtension(swModel.GetPathName())

    ''' Création des Configurations 00 et RAL avec ajout des textures RAL MAT
    Dim CONFIGS_DATA(14) As ConfigData

    CONFIGS_DATA(1).colorName = "ALUMINIUM BRUT"
    CONFIGS_DATA(1).ConfigNameSuffix = "00"
    CONFIGS_DATA(1).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\APPARENCES\alu inox.p2m"

    CONFIGS_DATA(2).colorName = "RAL 1013"
    CONFIGS_DATA(2).ConfigNameSuffix = "R1013"
    CONFIGS_DATA(2).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 1013 mat.p2m"

    CONFIGS_DATA(3).colorName = "RAL 1018"
    CONFIGS_DATA(3).ConfigNameSuffix = "R1018"
    CONFIGS_DATA(3).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 1018 mat.p2m"

    CONFIGS_DATA(4).colorName = "RAL 2008"
    CONFIGS_DATA(4).ConfigNameSuffix = "R2008"
    CONFIGS_DATA(4).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 2008 mat.p2m"

    CONFIGS_DATA(5).colorName = "RAL 3000"
    CONFIGS_DATA(5).ConfigNameSuffix = "R3000"
    CONFIGS_DATA(5).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 3000 mat.p2m"

    CONFIGS_DATA(6).colorName = "RAL 3004"
    CONFIGS_DATA(6).ConfigNameSuffix = "R3004"
    CONFIGS_DATA(6).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 3004 mat.p2m"

    CONFIGS_DATA(7).colorName = "RAL 5015"
    CONFIGS_DATA(7).ConfigNameSuffix = "R5015"
    CONFIGS_DATA(7).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 5015 mat.p2m"

    CONFIGS_DATA(8).colorName = "RAL 6005"
    CONFIGS_DATA(8).ConfigNameSuffix = "R6005"
    CONFIGS_DATA(8).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 6005 mat.p2m"

    CONFIGS_DATA(9).colorName = "RAL 6018"
    CONFIGS_DATA(9).ConfigNameSuffix = "R6018"
    CONFIGS_DATA(9).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 6018 mat.p2m"

    CONFIGS_DATA(10).colorName = "RAL 6029"
    CONFIGS_DATA(10).ConfigNameSuffix = "R6029"
    CONFIGS_DATA(10).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 6029 mat.p2m"

    CONFIGS_DATA(11).colorName = "RAL 7016"
    CONFIGS_DATA(11).ConfigNameSuffix = "R7016"
    CONFIGS_DATA(11).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 7016 mat.p2m"

    CONFIGS_DATA(12).colorName = "RAL 7035"
    CONFIGS_DATA(12).ConfigNameSuffix = "R7035"
    CONFIGS_DATA(12).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 7035 mat.p2m"

    CONFIGS_DATA(13).colorName = "RAL 7037"
    CONFIGS_DATA(13).ConfigNameSuffix = "R7037"
    CONFIGS_DATA(13).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 7037 mat.p2m"

    CONFIGS_DATA(14).colorName = "RAL 9005"
    CONFIGS_DATA(14).ConfigNameSuffix = "R9005"
    CONFIGS_DATA(14).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 9005 mat.p2m"

    ''' Ajout de propriétés à toutes les configurations
    
    Dim i As Integer
    
    For i = 0 To UBound(CONFIGS_DATA)
        
        confName = ""

        If CONFIGS_DATA(i).ConfigNameSuffix <> "" Then
            confName = CONFIGS_DATA(i).ConfigNameSuffix
            CodArt = NamePiece & "-" & CONFIGS_DATA(i).ConfigNameSuffix
        End If
        
       
        If i <> 0 Then
            swModel.AddConfiguration3 confName, "", "", 0
            
        ''' Ajout de la propriété "Code Article"
        CodeArticle = CodArt
        bRet = swModel.DeleteCustomInfo2(confName, "Code Article")
        bRet = swModel.AddCustomInfo3(confName, "Code Article", swCustomInfoText, CodeArticle)
            
        ''' Ajout de la propriété "PROFILS"
        bRet = swModel.DeleteCustomInfo2(confName, "DESIGNATION 2")
        bRet = swModel.DeleteCustomInfo2(confName, "PROFILS")
        bRet = swModel.AddCustomInfo3(confName, "PROFILS", swCustomInfoText, "POTEAUXHEXA")
    
        ''' Ajout de la propriété "MASSE" avec la valeur swMasse
        ''' Chr(34) permet d'ajouter le caractère "
        bRet = swModel.DeleteCustomInfo2(confName, "masse")
        bRet = swModel.AddCustomInfo3(confName, "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
    
        ''' Ajout de la propriété "POIDS" avec la valeur swMasse
        ''' Chr(34) permet d'ajouter le caractère "
        bRet = swModel.DeleteCustomInfo2(confName, "POIDS")
        bRet = swModel.AddCustomInfo3(confName, "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
    
        ''' ajoute un propriété personnalisée edition avec la valeur MATERIAUX
        ''' Chr(34) permet d'ajouter le caractère "
        bRet = swModel.DeleteCustomInfo2(confName, "MATERIAUX")
        bRet = swModel.AddCustomInfo3(confName, "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
        
        ''' on reconstruit la pièce
        swModel.ForceRebuild3 False
    
        Set swCustProp = swModelDocExt.CustomPropertyManager(confName)
        
        ''' Récupération de la propriété de Longueur Cube Visualisation
        bRet = swCustProp.Get6("Longueur totale du cube de visualisation", False, sValout, sLongueur, False, False)
   
        ''' Renseignement de la propriété LONGUEUR avec la valeur "sVal"
        bRet = swCustProp.Add3("LONGUEUR", 30, sLongueur, 1)
        
        ''' Renseignement de la propriété DESIGNATION 2 avec la valeur "sVal"
        bRet = swCustProp.Add3("DESIGNATION 2", 30, sLongueur, 1)
        
        ''' on reconstruit la pièce
        swModel.ForceRebuild3 False
    
        ''' Conversion du texte en valeur décimale, multiplication LONGUEUR x RATIO SURFACE et conversion en donné de type texte
        sValSurf = CStr(Format(CDec(sLongueur) * 0.000304, "0.000"))
     
        ''' Renseignement de la propriété SURFACE PIECE avec la valeur "sVal"
        bRet = swCustProp.Add3("SURFACE PIECE", 30, sValSurf, 1)
    
        End If
        
        swModel.ConfigurationManager.ActiveConfiguration.Name = confName
        
                
        If CONFIGS_DATA(i).MaterialFilePath <> "" Then
            AddRenderMaterial swModel, CONFIGS_DATA(i).MaterialFilePath
        End If
        
        AddConfigProperty swModel, CONFIGS_DATA(i).colorName
        
    Next

End Sub

Sub AddRenderMaterial(model As SldWorks.ModelDoc2, path As String)
    
    Dim swRenderMaterial As SldWorks.RenderMaterial
    Set swRenderMaterial = model.Extension.CreateRenderMaterial(path)
    
    If False <> swRenderMaterial.AddEntity(model) Then
        If False = model.Extension.AddDisplayStateSpecificRenderMaterial(swRenderMaterial, swDisplayStateOpts_e.swThisDisplayState, Empty, -1, -1) Then
            Err.Raise vbError, "", "Failed to apply render material to display state"
        End If
    Else
        Err.Raise vbError, "", "Failed to add model as entity to render material"
    End If
   
End Sub

''' Attribution Propriété "RAL"

Sub AddConfigProperty(model As SldWorks.ModelDoc2, colorName As String)

   
    Dim swCustPrpMgr As SldWorks.CustomPropertyManager
    
    Set swCustPrpMgr = model.Extension.CustomPropertyManager("")
    
    Dim propRal As String

    
    swCustPrpMgr.Get4 PROP_RAL, False, "", propRal

    
    Set swCustPrpMgr = model.ConfigurationManager.ActiveConfiguration.CustomPropertyManager
    
    swCustPrpMgr.Add3 PROP_RAL, swCustomInfoType_e.swCustomInfoText, propRal & colorName, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue

End Sub

Function GetFileNameWithoutExtension(filePath As String) As String
    GetFileNameWithoutExtension = Mid(filePath, InStrRev(filePath, "\") + 1, InStrRev(filePath, ".") - InStrRev(filePath, "\") - 1)
           
End Function

MLG · Décembre 22, 2023, 10:35

Merci @sbadenis , J’ai testé le code avec le cube après le nettoyage des configs mais j’ai toujours l’erreur 13 à cette ligne :

        ''' Conversion du texte en valeur décimale, multiplication LONGUEUR x RATIO SURFACE et conversion en donné de type texte
        sValSurf = CStr(Format(CDec(sLongueur) * 0.000304, "0.000"))

Et j’ai bien le cube qui est en mode supprimé dans l’arbre, donc la macro bloque car elle ne récupère pas la longueur

sbadenis · Décembre 22, 2023, 10:40

Avec la pièce que j’avais cela fonctionnait.
Peut être que ta config était déjà créer avant dans ce cas lors du défilement de chaque config il faudrait annulé la suppression du cube de visualisation
Sinon fournit une pièce ou cela ne fonctionne pas (pièce fabriquée pour l’exemple si confidentialité) pour ma part je suis en sw2020. (avec accès à 1 sw223)

MLG · Décembre 22, 2023, 11:02

J’ai testé avec et sans la suppression du cube mais j’ai la même erreur qui revient.

Ne faudrait-il pas mettre la suppression du cube de vusualisation à la fin de la macro. Une fois que les propriétés sont renseignées, il n’y en a plus forcément besoin ?

Mais j’ai du mal à savoir ou je dois caler cela pour que ça se réalise à la fin…

Ci joint la pièce réalisée sur SW 2022.
Après il s’agit juste d’une extrusion basique… Mais je voudrais qu’en modifiant la longueur, on puisse actualiser les propriétés en relançant la même macro
PIECE TEST.SLDPRT (161,7 Ko)

sbadenis · Décembre 26, 2023, 2:08

La raison c’est que dans les option de configuration tu as cette coche:

Lorsque tu lance la macro depuis une autre config que la 00
Il te crée le cube dans la config active par exemple R9005.
Donc le cube est à l’état supprimé dans toute les autres config.
Et comme tu supprime jamais la 00 elle reste à l’état supprimé.
Un moyen de contrée ce soucis est de rendre la config 00 active juste après la création de la config 00 et la suppression des autre config.
Ajoute les 2 dernières lignes ci-dessousau même endroit dans ton code et cela devrait être bon.

    ''' Création Configuration 00 et suppression configurations Défaut, xx, PC
    Set swPart = swModel
    boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
    boolstatus = swModel.DeleteConfiguration2("Défaut")
    boolstatus = swModel.DeleteConfiguration2("xx")
    boolstatus = swModel.DeleteConfiguration2("PC")
    'On active la config 00
    boolstatus = swModel.ShowConfiguration2("00")

MLG · Janvier 11, 2024, 12:20

Merci @sbadenis !!!
j’ai même été plus loin, car l’esquisse du cube de visualisation restait visible lorsque je relançais la macro.
J’ai donc ajouter la suppression des config RAL en début de macro. Comme cal, tout repars de zéro et cela fonctionne .

    ''' Création Configuration 00 et suppression configurations Défaut, xx, PC
    Set swPart = swModel
    boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
    boolstatus = swModel.DeleteConfiguration2("Défaut")
    boolstatus = swModel.DeleteConfiguration2("xx")
    boolstatus = swModel.DeleteConfiguration2("PC")
    
    ''' Activation de la config 00
    boolstatus = swModel.ShowConfiguration2("00")
    
    ''' Suppression des configurations RAL
    boolstatus = swModel.DeleteConfiguration2("R1013")
    boolstatus = swModel.DeleteConfiguration2("R1018")
    boolstatus = swModel.DeleteConfiguration2("R2008")
    boolstatus = swModel.DeleteConfiguration2("R3000")
    boolstatus = swModel.DeleteConfiguration2("R3004")
    boolstatus = swModel.DeleteConfiguration2("R5015")
    boolstatus = swModel.DeleteConfiguration2("R6005")
    boolstatus = swModel.DeleteConfiguration2("R6018")
    boolstatus = swModel.DeleteConfiguration2("R6029")
    boolstatus = swModel.DeleteConfiguration2("R7016")
    boolstatus = swModel.DeleteConfiguration2("R7035")
    boolstatus = swModel.DeleteConfiguration2("R7037")
    boolstatus = swModel.DeleteConfiguration2("R9005")

MLG · Janvier 11, 2024, 2:44

Pour finir, est il possible de modifier la profondeur d’un enlevement de matière via une macro ?

J’ai fait la manip en enregistrant la macro, mais le code ne contient pas de profondeur :

Option Explicit

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Face gauche", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
Part.SelectionManager.EnableContourSelection = False
End Sub

Cyril.f · Janvier 12, 2024, 6:09

Bonjour,

Faut regarder dans les fonctions FeatureCut
FeatureCut4 Method (IFeatureManager) - 2022 - SOLIDWORKS API Help

MLG · Janvier 15, 2024, 8:15

Merci @Cyril.f

Avec la fonction FeatureCut4 j’arrive à créer des enlevement de matière à partir d’une esquisse, mais je ne parviens pas à modifier la profondeur d’une fonction existante
Est-ce possible ?

Cyril.f · Janvier 15, 2024, 10:34

Bonjour,
A vrai dire, joker. Il est possible que sur des anciens fichier la fonction ne permette pas d’accéder aux options qui n’existait peut-être pas sur ces anciennes versions.