Wiederherstellen der Wertcube-Visualisierung

MLG · 15. Dezember 2023 um 10:48

Hallo zusammen
Hier ist wieder der verrückte Fragesteller!!
Ich möchte wissen, ob es möglich ist, die Werte des Visualisierungswürfels in einem Makro abzurufen, um sie Variablen zuordnen zu können?

Sie sind gut in den Eigenschaften des Teils platziert, aber im Makro, wenn ich " SW-Gesamtlänge des Visualisierungswürfels " eingebe, um den Wert abzurufen, passiert nichts...
Haben Sie einen Hinweis?

Und zweitens, wissen Sie, ob es möglich ist, eine Welle der Namen der Funktionen des Baumes zu machen? Oder ist es möglich, Funktionen über ein Makro umzubenennen?
Vielen Dank.

Maclane · 15. Dezember 2023 um 10:55

Hallo;

Dies muss erreichbar sein:
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

Zweiter Teil, ja, es ist auch möglich, die Funktionen per Makro umzubenennen:
Beispiel mit Wörterbuchverwendung

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

Herzliche Grüße.

Joël_1 · 15. Dezember 2023 um 23:31

Vielen Dank

MLG · 18. Dezember 2023 um 08:01

Hallo @Maclane
Ich habe das Makro getestet, um die Funktionen umzubenennen, es funktioniert gut, aber es ist zu komplex angesichts der Vielfalt der Teile, die wir haben.

Ist es möglich, den Namen der zweiten Funktion abzurufen (FirstFeature für die erste, glaube ich)?

Auf diese Weise könnte ich eine Variable erstellen, um eine Rückkehr zur Funktion (swMoveRollbackBarTo) vorzunehmen.

Hier ist, was ich für die LÄNGE des Visualisierungswürfels ausprobiert habe:

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

Es funktioniert gut, es ermöglicht Ihnen, die Variable LENGTH zu aktualisieren, wenn Sie die Länge Ihres Teils ändern.

MLG · 21. Dezember 2023 um 12:01

Hallo

Ich habe in meinem Makrobereich große Fortschritte gemacht. Es funktioniert bei einem Teil beim ersten Mal gut.
Aber wenn ich das Makro neu starte (die Länge des zu testenden Teils ändere und sogar ohne etwas zu ändern), stürzt das Makro wie folgt ab:

Und das Debuggen gibt mir Folgendes:

Ich kann dieses Problem nicht verstehen und daher beheben. Kann mir jemand helfen?

Hier ist der vollständige 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

Vielen Dank im Voraus

sbadenis · 21. Dezember 2023 um 12:28

Führt das Makro im Bearbeitungsmodus und Schritt für Schritt aus und schaut sich die Werte der verschiedenen Variablen an, die in dieser Zeile (irrtümlich) verwendet werden, wenn eine leer oder nicht numerisch ist, möglicherweise ist sie verwandt.
Fügen Sie dazu eine debug.print sLength hinzu, eine weitere mit debug.print Format(Cdec...), um beispielsweise zu sehen, ob es gut funktioniert oder nicht.
Keine Zeit, sich Ihr Makro genau anzusehen.
Der Schritt-für-Schritt-Modus ermöglicht und das Hinzufügen von debug.print ermöglicht es zu Beginn, den Zustand der verschiedenen Variablen im Ausführungsfenster zu sehen (ansonsten siehe das Fenster Lokale Variablen), aber für mich weniger praktisch.

MLG · 21. Dezember 2023 um 15:05

Vielen Dank @sbadenis
Ich habe es versucht, aber ich kann mir nicht vorstellen, woher dieses Problem kommt.
Sollten wir ein RAZ der Werte am Anfang des Makros hinzufügen (falls vorhanden)? Ich habe den Eindruck, dass das Makro einfriert, sobald es ausgefüllt ist

sbadenis · 21. Dezember 2023 um 15:55

Ihr Problem besteht darin, dass Ihre Eigenschaften des Visualisierungswürfels in der R9005-Konfiguration erstellt werden:

Mit Ausnahme eines 2. Starts überprüft es die Konfigurationen und beginnt mit der 00 aus der Eigenschaft, die in dieser Konfiguration nicht vorhanden ist:

Es wurde also kein Wert gefunden, kein Wert in sLength und Makrofehler gemeldet.
Lösung 1: Schreiben Sie die Eigenschaften des Begrenzungsrahmens in jede Konfiguration.
Lösung 2: Wenn die Abmessungen des Begrenzungsrahmens in jeder Konfiguration identisch sind, schreiben Sie sie 1 Mal in die Registerkarte "Benutzerdefiniert" und unabhängig von der Konfiguration, indem Sie in dieser Registerkarte nach ihnen suchen, sind sie identisch. (Seien Sie vorsichtig, nur die Requisiten der Bounding Box, die anderen müssen in der Konfigurationsspezifischen bleiben)

Um zu sehen, dass Ihr Wert im Schrittmodus leer ist, wenn Sie die Zeile übergeben haben, bewegen Sie die Maus über die Variable sLength und sehen, dass sie gleich nichts ist:

sbadenis · 21. Dezember 2023 um 16:07

Einfacher ist es, Sie erstellen Ihre Bounding Box, nachdem Sie Ihre Konfiguration bereinigt haben, und dort funktioniert es:

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. Dezember 2023 um 10:35

Dank @sbadenis , ich habe den Code mit dem Würfel getestet, nachdem ich die Konfigurationen bereinigt habe, aber ich habe immer noch Fehler 13 in dieser Zeile:

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

Und ich habe den Würfel, der sich im gelöschten Modus im Baum befindet, also blockiert das Makro, weil es die Länge nicht wiederherstellt

sbadenis · 22. Dezember 2023 um 10:40

Mit dem Teil, das ich hatte, funktionierte es.
Vielleicht wurde Ihre Config bereits erstellt, in diesem Fall müssten Sie beim Scrollen durch jede Config das Löschen des Visualisierungswürfels abbrechen
Andernfalls stellen Sie einen Teil zur Verfügung oder es funktioniert nicht (Teil für das Beispiel gemacht, wenn Vertraulichkeit) für meinen Teil bin ich in sw2020. (mit Zugang zu 1 SW223)

MLG · 22. Dezember 2023 um 11:02

Ich habe mit und ohne das Löschen des Würfels getestet, aber ich habe den gleichen Fehler, der zurückkommt.

Sollten wir nicht das Löschen des vusualization-Würfels an das Ende des Makros setzen? Sind die Immobilien erst einmal zugeschüttet, besteht nicht mehr unbedingt ein Bedarf dafür?

Aber es fällt mir schwer zu wissen, wo ich das einklemmen muss, damit es am Ende passiert...

Anbei ist das Stück, das am SW 2022 entstanden ist.
Danach ist es nur noch eine grundlegende Extrusion... Aber ich möchte, dass wir durch Ändern der Länge die Eigenschaften aktualisieren können, indem wir dasselbe Makro erneut ausführen
PROBESTÜCK. SLDPRT (161.7 KB)

sbadenis · 26. Dezember 2023 um 14:08

Der Grund dafür ist, dass Sie in den Konfigurationsoptionen dieses Häkchen haben:

Wenn Sie das Makro aus einer anderen Konfiguration als der 00
Er erstellt den Cube für Sie in der aktiven Konfiguration, z. B. R9005.
Der Cube befindet sich also in allen anderen Konfigurationen im gelöschten Zustand.
Und da Sie die 00 nie löschen, bleibt sie im gelöschten Zustand.
Eine Möglichkeit, dieses Problem zu lösen, besteht darin, die Konfiguration 00 direkt nach dem Anlegen der Konfiguration 00 und dem Löschen der anderen Konfigurationen aktiv zu machen.
Fügen Sie die letzten 2 Zeilen unten an der gleichen Stelle in Ihrem Code hinzu und es sollte gut sein.

    ''' 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. Januar 2024 um 12:20

Vielen Dank @sbadenis !!
Ich bin sogar noch weiter gegangen, denn die Skizze des Visualisierungswürfels war auch beim Neustart des Makros noch sichtbar.
Also habe ich das Löschen der RAL-Konfigurationen am Anfang des Makros hinzugefügt. Wie bei Cal fängt alles bei Null an und es funktioniert .

    ''' 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. Januar 2024 um 14:44

Ist es schließlich möglich, die Tiefe eines Materialabtrags über ein Makro zu ändern?

Ich habe die Manipulation durchgeführt, indem ich das Makro aufgezeichnet habe, aber der Code enthält keine Tiefe:

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. Januar 2024 um 06:09

Hallo

Sie müssen in den FeatureCut-Funktionen nachsehen
FeatureCut4-Methode (IFeatureManager) - 2022 - SOLIDWORKS API-Hilfe

MLG · 15. Januar 2024 um 08:15

Vielen Dank @Cyril.f

Mit der Funktion FeatureCut4 kann ich aus einer Skizze Materialabtrag erstellen, aber ich kann die Tiefe eines vorhandenen Merkmals nicht ändern
Ist das möglich?

Cyril.f · 15. Januar 2024 um 10:34

Hallo
Um die Wahrheit zu sagen, Joker. Es ist möglich, dass die Funktion bei älteren Dateien den Zugriff auf Optionen nicht zulässt, die in diesen älteren Versionen möglicherweise nicht vorhanden waren.