Visualisatie van waardekubussen herstellen

MLG · 15 december 2023 om 10:48

Hallo allemaal,
Hier is de gekke vragensteller weer!!
Ik wil weten of het mogelijk is om de waarden van de visualisatiekubus in een macro op te halen, zodat ik ze aan variabelen kan toewijzen?

Ze zijn goed geplaatst in de eigenschappen van het onderdeel, maar in de macro wanneer ik " SW-Totale lengte van de visualisatiekubus " zet om de waarde op te halen, gebeurt er niets...
Heb je een voorsprong?

En ten tweede, weet je of het mogelijk is om een golf te maken van de namen van de functies van de boom? Of is het mogelijk om functies via een macro te hernoemen?
Hartelijk dank.

Maclane · 15 december 2023 om 10:55

Hallo;

Dit moet haalbaar zijn:
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

Tweede deel, ja het is ook mogelijk om de functies te hernoemen naar Macro:
Voorbeeld met woordenboekgebruik

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

Vriendelijke groeten.

Joël_1 · 15 december 2023 om 23:31

Bedankt

MLG · 18 december 2023 om 08:01

Welkom @Maclane
Ik heb de macro getest om de functies te hernoemen, het werkt goed, maar het is te complex gezien de diversiteit aan onderdelen die we hebben.

Is het mogelijk om de naam van de tweede functie op te halen (FirstFeature voor de eerste denk ik)?

Op die manier kon ik een variabele aanmaken om terug te keren naar de functie (swMoveRollbackBarTo).

Dit is waar ik aan heb gesleuteld voor de LENGTE van de Visualisatie Kubus:

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

Het werkt goed, het stelt u in staat om de variabele LENGTH bij te werken wanneer u de lengte van uw onderdeel wijzigt.

MLG · 21 december 2023 om 12:01

Hallo

Ik heb veel vooruitgang geboekt in mijn macro. Het werkt de eerste keer goed op een onderdeel.
Maar als ik de macro opnieuw start (verander de lengte van het te testen onderdeel en zelfs zonder iets te veranderen) crasht de macro als volgt:

En debuggen geeft me dit:

Ik kan dit probleem niet begrijpen en daarom oplossen. Kan iemand mij helpen?

Hier is de volledige code:

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

Bij voorbaat dank

sbadenis · 21 december 2023 om 12:28

Voert de macro uit in de bewerkingsmodus en stap voor stap en kijkt naar de waarden van de verschillende variabelen die in deze regel worden gebruikt (ten foute) als er een leeg of niet-numeriek is, mogelijk dat het gerelateerd is.
Om dit te doen, voegt u een debug.print sLength toe, een andere met debug.print Format(Cdec...) bijvoorbeeld om te zien of het goed werkt of niet.
Geen tijd om precies naar je macro te kijken.
De stap voor stap modus maakt het mogelijk en de toevoeging van debug.print maakt het mogelijk om aan het begin de status van de verschillende variabelen in het uitvoeringsvenster te zien (anders zie het venster Lokale variabelen), maar minder praktisch voor mij.

MLG · 21 december 2023 om 15:05

Dank je wel @sbadenis
Ik heb het geprobeerd, maar ik kan niet visualiseren waar dit probleem vandaan komt.
Moeten we een RAZ van de waarden aan het begin van de macro toevoegen (als die bestaat)? Ik heb de indruk dat als het eenmaal is ingevuld, de macro vastloopt

sbadenis · 21 december 2023 om 15:55

Uw probleem is dat uw eigenschappen van de visualisatiekubus worden gemaakt in de R9005-configuratie:

Met uitzondering van een van een 2e lancering, beoordeelt het de configuraties en begint met de 00 uit de eigenschap die niet bestaat in deze configuratie:

Dus geen waarde gevonden, geen waarde gerapporteerd in sLength en macrofout.
Oplossing 1: schrijf de eigenschappen van het begrenzingsvak in elke configuratie.
Oplossing 2: als de afmetingen van het begrenzingsvak in elke configuratie identiek zijn, schrijf ze dan 1 keer op het aangepaste tabblad en ongeacht de configuratie door ze op dit tabblad te zoeken, zullen ze identiek zijn. (Wees voorzichtig, alleen de rekwisieten van het begrenzingsvak, de andere moeten in de configuratie-specifieke blijven)

Om te zien dat je waarde leeg is met de stapmodus, als je de lijn bent gepasseerd, beweeg je de muis over de variabele sLength en zie je dat deze gelijk is aan niets:

sbadenis · 21 december 2023 om 16:07

Eenvoudiger maakt u uw begrenzingsvak na het opschonen van uw configuratie en daar werkt het:

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 · 22 december 2023 om 10:35

Dankzij @sbadenis heb ik de code getest met de kubus na het opschonen van de configuraties, maar ik heb nog steeds fout 13 op deze regel:

        ''' 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"))

En ik heb de kubus die in de verwijderde modus in de boom staat, dus de macro blokkeert omdat hij de lengte niet herstelt

sbadenis · 22 december 2023 om 10:40

Met het deel dat ik had, werkte het.
Misschien is uw configuratie al eerder gemaakt, in dit geval zou u bij het scrollen door elke configuratie de verwijdering van de visualisatiekubus moeten annuleren
Anders een deel verstrekken of het werkt niet (deel gemaakt voor het voorbeeld als vertrouwelijkheid) voor mijn deel ben ik in sw2020. (met toegang tot 1 SW223)

MLG · 22 december 2023 om 11:02

Ik heb getest met en zonder het verwijderen van de kubus, maar ik heb dezelfde fout die terugkomt.

Moeten we het verwijderen van de vusualisatiekubus niet aan het einde van de macro plaatsen. Als de eigenschappen eenmaal zijn ingevuld, is er niet meer per se behoefte aan?

Maar ik vind het moeilijk om te weten waar ik dit moet klemmen om het uiteindelijk te laten gebeuren...

Bijgevoegd is het stuk gemaakt op SW 2022.
Daarna is het gewoon een eenvoudige extrusie... Maar ik zou graag willen dat we, door de lengte te wijzigen, de eigenschappen kunnen bijwerken door dezelfde macro opnieuw uit te voeren
PROEFSTUK. SLDPRT (161.7 KB)

sbadenis · 26 december 2023 om 14:08

De reden is dat je in de configuratie-opties dit vinkje hebt:

Wanneer u de macro start vanuit een andere configuratie dan de 00
Het maakt de kubus voor u aan in de actieve configuratie, bijvoorbeeld R9005.
De kubus bevindt zich dus in de verwijderde staat in alle andere configuraties.
En aangezien u de 00 nooit verwijdert, blijft deze in de verwijderde staat.
Een manier om dit probleem op te lossen is om config 00 actief te maken direct na het maken van config 00 en het verwijderen van de andere configs.
Voeg de laatste 2 regels hieronder op dezelfde plek in je code toe en het zou goed moeten zijn.

    ''' 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 · 11 januari 2024 om 12:20

Dank je wel @sbadenis !!
Ik ging zelfs nog verder, want de schets van de visualisatiekubus was nog zichtbaar toen ik de macro opnieuw opstartte.
Dus heb ik het verwijderen van de RAL-configuraties aan het begin van de macro toegevoegd. Net als cal begint alles vanaf nul en het werkt .

    ''' 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 · 11 januari 2024 om 14:44

Tot slot, is het mogelijk om de diepte van een materiaalafname via een macro te wijzigen?

Ik heb de manipulatie gedaan door de macro op te nemen, maar de code bevat geen diepte:

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 · 12 januari 2024 om 06:09

Hallo

Je moet in de FeatureCut-functies kijken
FeatureCut4-methode (IFeatureManager) - 2022 - SOLIDWORKS API Help

MLG · 15 januari 2024 om 08:15

Dank je wel @Cyril_f

Met de FeatureCut4-functie kan ik materiaalverwijderingen maken van een schets, maar ik kan de diepte van een bestaand object niet wijzigen
Is dit mogelijk?

Cyril_f · 15 januari 2024 om 10:34

Hallo
Om de waarheid te zeggen, grappenmaker. Het is mogelijk dat de functie op oudere bestanden geen toegang geeft tot opties die mogelijk niet bestonden op deze oudere versies.