VBA propriétés personnalisées : créer et remplir

Out of category
1

Bonjour,

Je travaille sur une macro et j'aimerai pouvoir facilement créer et écrire une propriété personnalisée.

J'ai trouvé comment faire pour les propriétés spécifiques à une configuration mais je n'ai pas trouvé pour les propriétés personnalisées.
Merci pour votre aide, je suis certain que c'est tout simple pour vous !

2

Si ça peut aider quelqu'un pour le reste...

Sub Valid()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim configNames()  As String
    Dim configName As String
    Dim swConfig As SldWorks.Configuration
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set FileSys = CreateObject("Scripting.FileSystemObject")

' Mettre la valeur de Ma_variable dans une propriété Ma_Variable_Value de chaque config
    configNames = swModel.GetConfigurationNames
    vConfigNameArr = swModel.GetConfigurationNames
    For Each vConfigName In vConfigNameArr
        vCustInfoNameArr = swModel.GetCustomInfoNames2(vConfigName)
        If Not IsEmpty(vCustInfoNameArr) Then
            'For Each vCustInfoName In vCustInfoNameArr
            
                swModel.CustomInfo2(vConfigName, "Ma_Variable_Value") = Ma_variable
                
            'Next
        End If
    Next
    
Exit Sub
    
End Sub

 

3

J'ai trouvé la fonction suivant permet de mettre la valeur dans la Propriété personnalisée correspondante...

swModel.CustomInfo2("", "Ma_Variable_Value") = Ma_variable

... si cette Propriété Personnalisée existe

mais comment faire pour la créer avant, si elle n'existe pas de base

4

Bonjour

Ci dessous une macro qui créé des propriétés personnalisées sur le fichier et sur les configurations (pompée chez SW et adaptée par nous vu les commentaires):

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

' Postconditions: The custom property Input1 is added to the file.

' NOTE: Because configurations are not supported in drawings, pass a blank string when the file is a drawing.

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

 

Dim swApp       As SldWorks.SldWorks

Dim swModel     As SldWorks.ModelDoc2

Dim retval      As String

   Dim vConfigNameArr              As Variant

    Dim vConfigName                 As Variant

    Dim swActiveConf                As SldWorks.Configuration

    Dim swConf                      As SldWorks.Configuration

    Dim swConfMgr                   As SldWorks.ConfigurationManager

    Dim swDerivConf                 As SldWorks.Configuration

    Dim bRet                        As Boolean

Sub main()
Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

    Set swConfMgr = swModel.ConfigurationManager

     Set swConfig = swConfMgr.ActiveConfiguration

        vConfigNameArr = swModel.GetConfigurationNames

retval = swModel.AddCustomInfo3("", "IsFastener", swCustomInfoYesOrNo, "No")
retval = swModel.AddCustomInfo3("", "Bibliotheque", swCustomInfoYesOrNo, "No")
retval = swModel.AddCustomInfo3("", "Piece_standard", swCustomInfoYesOrNo, "No")
retval = swModel.AddCustomInfo3("", "Rechange", swCustomInfoText, "-")
retval = swModel.AddCustomInfo3("", "Repère", swCustomInfoText, "0")
retval = swModel.AddCustomInfo3("", "Repère_soudure", swCustomInfoText, "-")
retval = swModel.AddCustomInfo3("", "Révision", swCustomInfoText, "-")

    vConfigNameArr = swModel.GetConfigurationNames

 For Each vConfigName In vConfigNameArr

        Set swConf = swModel.GetConfigurationByName(vConfigName)

                ' Do not assert; will be NULL if (derived) configuration already exists

retval = swModel.AddCustomInfo3(swConf.Name, "Numero_plan", swCustomInfoText, "$PRPSHEET:""SW-Nom de fichier(File Name)""")
retval = swModel.AddCustomInfo3(swConf.Name, "Description_Francais", swCustomInfoText, "-")
retval = swModel.AddCustomInfo3(swConf.Name, "Description_Francais_2", swCustomInfoText, "-")
retval = swModel.AddCustomInfo3(swConf.Name, "Observation", swCustomInfoText, "-")
retval = swModel.AddCustomInfo3(swConf.Name, "Weight", swCustomInfoText, """SW-Mass@@Défaut@ModelDoc2.SLDPRT""")
retval = swModel.AddCustomInfo3(swConf.Name, "Material", swCustomInfoText, """SW-Material@@Défaut@ModelDoc2.SLDPRT""")
retval = swModel.AddCustomInfo3(swConf.Name, "CREATIONAUTO", swCustomInfoText, "NON")
     

    Next

MsgBox retval

End Sub

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

 

 

1 « J'aime »
5

Super, merci beaucoup, c'est intéressant

ça marche, mais je ne ne pige pas pourquoi il faut mettre le fonction création d'une propriété personnalisée dans une variable type Boolean.

Dim value As System.Boolean
 
value = instance.AddCustomInfo3(Configuration, FieldName, FieldType, FieldValue)