Renommer tous les composants d'un assemblage même ceux inclus dans un sous assemblage

3D Design
,
1

Bonjour, 

j'ai commencé a écrire une macro avec des petits morceaux trouvés par ci et par la sur le net. 

L'idée étant de renommer ( fichiers 3D + feature manager ) tous les composants dont la propriété " SWOODCP_PanelStockLength " est différente de "".

Je n'arrive pas a ce que les pièces soient renommées dans l'assemblage et dans l'explorateur windows. 

Je vous joint le début de mon code si vous pouviez m'aider. 

Merci d'avance 

 

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swRootComp As SldWorks.Component2
Dim Children As Variant
Dim swChild As SldWorks.Component2
Dim SwSelData As SldWorks.SelectData
Dim ChildCount As Long
Dim oldName As String
Dim newName As String
Dim i As Long
Dim j As Long
Dim NomParent As String

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent3(True)

Children = swRootComp.GetChildren

ChildCount = UBound(Children)

Set SwSelData = swModel.SelectionManager.CreateSelectData

 

For i = 0 To ChildCount

j = 1

Set swChild = Children(i)

swChild.Select4 False, SwSelData, False
NomParent = Left(swModel.GetTitle, 7)
newName = NomParent & "-" & "000" & j
swModel.Extension.RenameDocument newName
j = j + 1

Next i
swModel.ForceRebuild3 True

End Sub

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swRootComp As SldWorks.Component2
Dim Children As Variant
Dim swChild As SldWorks.Component2
Dim SwSelData As SldWorks.SelectData
Dim ChildCount As Long
Dim oldName As String
Dim newName As String
Dim i As Long
Dim j As Long
Dim NomParent As String

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent3(True)

Children = swRootComp.GetChildren

ChildCount = UBound(Children)

Set SwSelData = swModel.SelectionManager.CreateSelectData

 

For i = 0 To ChildCount

j = 1

Set swChild = Children(i)

swChild.Select4 False, SwSelData, False
NomParent = Left(swModel.GetTitle, 7)
newName = NomParent & "-" & "000" & j
swModel.Extension.RenameDocument newName
j = j + 1

Next i
swModel.ForceRebuild3 True

End Sub

 

2

Bonjour,

Pour pouvoir aider, il faudrait savoir quel est le problème rencontré. En première approche, pour que ça fonctionne il faut enregistrer pour sauvegarder les modifications et voir pour mettre à jour tous les cas d'emplois si nécessaire.

De base , la fonction ne fait que faire une modification temporaire, si pas d'enregistrement, le changement n'est pas sauvegardé.

1 « J'aime »
3

Bonjour Cyril, 

la fonction ne prend pas en compte les enfants dans les sous-assemblages et ne renomme pas correctement les fichiers 3D mais uniquement ceux de l'arbre.

4

Bonjour,

Ci-joint le code pour traverser l'assemblage et les sous-assemblages.

Ce qui bloquait de base dans le code, c'est la position du j=1 qui faisait que ça tournait en boucle sur cette valeur et par conséquent ça cherchait systématiquement à renommer avec l'incrément 0001.

Pour la mise à jour dans l'explorateur, il faut sauvegarder pour que l'impact soit reflété sur le nom d'enregistrement des fichiers puisque la fonction rename ne fait que modifier temporairement les noms de fichiers (mis à jour dans le featuremanager uniquement).

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swRootComp As SldWorks.Component2
Dim Children As Variant
Dim swChild As SldWorks.Component2
Dim SwSelData As SldWorks.SelectData
Dim ChildCount As Long
Dim oldName As String
Dim newName As String
Dim i As Long
Dim j As Long
Dim NomParent As String
Dim errorsRename As Long
Dim status As Boolean
Dim warnings As Long
Dim errorsSave As Long

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc
NomParent = Left(swModel.GetTitle, 7)
Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent3(True)
j = 1
TraverseComponent swRootComp, 1
swModel.ForceRebuild3 True
status = swModel.Save3(swSaveAsOptions_SaveReferenced, errorsSave, warnings)


End Sub
Sub TraverseComponent _
(swComp As SldWorks.Component2, nLevel As Long)
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swCompConfig As SldWorks.Configuration
    Dim sPadStr As String
    Dim i As Long
   
    
    For i = 0 To nLevel - 1
        sPadStr = sPadStr + "  "
    Next i
    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp, nLevel + 1
        swChildComp.Select4 False, SwSelData, False
        newName = "Test" & "-" & "000" & j
        errorsRename = swModel.Extension.RenameDocument(newName)
        j = j + 1
    Next i
End Sub

 

Le code reste à adapter pour cibler les fichiers à renommer, de plus je n'ai pas cherché plus longtemps mais l'ordre est un peu aléatoire.

3 « J'aime »
5

Super Cyril, 

 

merci énormément, j'adorerais que ce soit aussi facile que ca en a l'air ! 

Il ne me reste plus qu'a tester si une propriété de configuration de chaque des enfants existe et si c'est le cas je la renomme sinon je passe a l'enfant suivant. ( peu importe l'ordre.. )

Et ensuite, il faut que je gère correctement le compteur pour que le total de mon nom de fichier ne dépasse pas 12 digits. 

6

Sinon avec les outil MycadTools auquel tu dois avoir accès vu ta médail sur ton profil,  cela doit être faisable via ProjectManager sans avoir de connaissance en programmation

2 « J'aime »
7

Bonjour sbadenis, 

Oui projectManager fonctionne mais c'est trop long pour le peu de programmation que ca coute. 

Grace a Cyril, il ne me manque plus qu'a reussir a accéder aux propriétés de configurations dont je ne trouve aucune information sur internet et ce sera fini :) 

Merci du conseil, 

Cordialement,

8

Pas de soucis @vincent.bottier pour les propriétés de configurations voici un exemple de ma macrotèque:


 '---------------------------------------------------------------------------
' Preconditions:
' 1. Open a part document.
' 2. Open the Immediate window.
'
' Postconditions:
' 1. Adds a date custom property to the part's configuration.
' 2. Tests whether the custom property is editable, and if so,
'    edits it.
' 3. Gets all custom properties in the configuration.
' 4. Deletes a custom property.
' 5. Examine the Immediate window.
'---------------------------------------------------------------------------

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim linkToProp As Boolean
Dim resolved As Variant
Dim linkProp As Variant
Dim nNbrProps As Long
Dim j As Long
Dim custPropType As Long
Dim bRet As Boolean

Sub main()


    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set config = swModel.GetActiveConfiguration
    Set cusPropMgr = config.CustomPropertyManager
   

    ' Get the number of custom properties for this configuration
    nNbrProps = cusPropMgr.Count
    Debug.Print "Number of properties for this configuration:            " & nNbrProps
   

    ' Gets the custom properties
    lRetVal = cusPropMgr.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)

    ' For each custom property, print its name, type, and evaluated value
    For j = 0 To nNbrProps - 1
        custPropType = cusPropMgr.GetType2(vPropNames(j))
        Debug.Print "    Name, swCustomInfoType_e value, and resolved value:  " & vPropNames(j) & ", "; custPropType & ", " & vPropValues(j)
    Next j

   
    ' Get the number of custom properties for this configuration
    nNbrProps = cusPropMgr.Count
    Debug.Print "Number of properties for this configuration:            " & nNbrProps

End Sub

 

1 « J'aime »
9

Bonjour,

Voici un petit exemple pour relever la valeur de ta propriété :

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)
    Dim vChildComp As Variant
    Dim swChildComp As Component2
    Dim i As Long
    Dim swModelChild As SldWorks.ModelDoc2
    Dim swCustProp As CustomPropertyManager
    Dim val As String
    Dim valout As String

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp, nLevel + 1
        swChildComp.Select4 False, SwSelData, False
        Set swModelChild = swChildComp.GetModelDoc2
        Set swCustProp = swModelChild.Extension.CustomPropertyManager("Défaut") 'mettre le nom de la configuration comprenant la propriété
        status = swCustProp.Get4("SWOODCP_PanelStockLength", False, val, valout)
        If valout <> "" Then
            newName = Left(swModelChild.GetTitle, 4) & "-" & "000" & j
            errorsRename = swModel.Extension.RenameDocument(newName)
            Debug.Print swModelChild.GetTitle & " : " & j & " - " & errorsRename
            j = j + 1
        End If
    Next i
End Sub

Petite information aussi, si une pièce est présente plusieurs fois dans ton assemblage alors elle sera traitée autant de fois et prendra donc le nom du dernier compteur avec lequel elle à été traitée, je ne sais pas si cela est gênant pour ton application.

Cordialement,

5 « J'aime »
10

Bonjour, 

merci pour vos réponses, je vais essayer d'adapter ce code ! 

@d.roger : je devrais réussir a lui dire que s'il a tant de digit dans son nom et que les 7 premiers sont égaux aux 7 premiers de l'assemblage alors il ne traite pas et ca n'effectuera pas de doublons dans ce cas :) 

Je vous tiens au courant et posterais mon code final ! 

Merci encore de votre aide.

1 « J'aime »
11

Comme promis d.roger; 

j'ai essayé avec votre code. J'ai une erreur sur la ligne : Set swCustProp = swModelChild.Extension.CustomPropertyManager("Défaut")

Pourtant la configuration de toutes mes pièces est bien celle-ci. Avez vous une idée ? 

Merci 

12

Bonsoir,

Il y a probablement un fichier qui n'a pas cette configuration dans ses paramètres.

Ci-joint le code modifié pour prendre en compte l'existence ou non de la configuration Défaut

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)
    Dim vChildComp As Variant
    Dim swChildComp As Component2
    Dim i As Long
    Dim swModelChild As SldWorks.ModelDoc2
    Dim swCustProp As CustomPropertyManager
    Dim val As String
    Dim valout As String

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp, nLevel + 1
        swChildComp.Select4 False, SwSelData, False
        Set swModelChild = swChildComp.GetModelDoc2
        Set swCustProp = swModelChild.Extension.CustomPropertyManager("Défaut") 'mettre le nom de la configuration comprenant la propriété
        If Not swCustProp Is Nothing Then
        status = swCustProp.Get4("SWOODCP_PanelStockLength", False, val, valout)
        If valout <> "" Then
            newName = Left(swModelChild.GetTitle, 4) & "-" & "000" & j
            errorsRename = swModel.Extension.RenameDocument(newName)
            Debug.Print swModelChild.GetTitle & " : " & j & " - " & errorsRename
            j = j + 1
        End If
        End If
    Next i
End Sub

 

2 « J'aime »
13

Bonjour, 

je commence a faire les tests réels et effectivement je vois ce que vous vouliez me dire. 

Le nom du composants dans les propriétés ne correspond pas au nom du fichier 3D. 

J'ai pourtant ajouté une ligne et je pensais que ca fonctionnerait quitte a ce que tous les numéros ne soient pas pris. Et j'ai aussi des pièces qui ont une configurations "default" ( satanés américains :) ).. 

If Not swCustProp Is Nothing Then
            status = swCustProp.Get4("SWOODCP_PanelStockLength", False, val, valout)
            If valout <> "" Then
                newName = NomParent & "-" & "000" & j
                errorsRename = swModel.Extension.RenameDocument(newName)
                swChildComp.Name2 = newName
                Debug.Print swModelChild.GetTitle & " : " & j & " - " & errorsRename
                j = j + 1
            End If
        End If

 

Pour le coup, il n'y a quasiment aucun composant qui ont le même nom dans l'arbre que dans le dossier windows.. 

14

Bonjour,

Je ne comprends pas ce que tu essaies de faire avec la ligne ajoutée.

De plus, comme je l'ai déjà dit dans la première réponse, s'il n'y pas d'enregistrement avec les paramètres de mise à jour des enfants, il n'y aura aucune modification des noms d'enregistrements des fichiers et sous-assemblages d'où l'absence de visibilité dans l'explorateur Windows.

15

Bonjour, 

j'essaie que le nom de fichier windows corresponde au nom du composant. 

Et pour moi, je fais bien une sauvegarde voir ci-dessous

 

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swRootComp As SldWorks.Component2
Dim Children As Variant
Dim swChild As SldWorks.Component2
Dim SwSelData As SldWorks.SelectData
Dim ChildCount As Long
Dim oldName As String
Dim newName As String
Dim i As Long
Dim j As Long
Dim NomParent As String
Dim errorsRename As Long
Dim status As Boolean
Dim warnings As Long
Dim errorsSave As Long
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim val As String
Dim valout As String

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc
NomParent = Left(swModel.GetTitle, 7)
Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent3(True)
j = 1
TraverseComponent swRootComp, 1
swModel.ForceRebuild3 True
status = swModel.Save3(swSaveAsOptions_SaveReferenced, errorsSave, warnings)

End Sub


Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)
    Dim vChildComp As Variant
    Dim swChildComp As Component2
    Dim i As Long
    Dim swModelChild As SldWorks.ModelDoc2
    Dim swCustProp As CustomPropertyManager
    Dim val As String
    Dim valout As String

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp, nLevel + 1
        swChildComp.Select4 False, SwSelData, False
        Set swModelChild = swChildComp.GetModelDoc2
        Set swCustProp = swModelChild.Extension.CustomPropertyManager("Défaut") 'mettre le nom de la configuration comprenant la propriété
        If Not swCustProp Is Nothing Then
            status = swCustProp.Get4("SWOODCP_PanelStockLength", False, val, valout)
            If valout <> "" Then
                newName = NomParent & "-" & "000" & j
                errorsRename = swModel.Extension.RenameDocument(newName)
                swChildComp.Name2 = newName
                Debug.Print swModelChild.GetTitle & " : " & j & " - " & errorsRename
                j = j + 1
            End If
        End If
    Next i
End Sub
 


capture.png
16

La ligne swChildComp.Name2 = newName n'apporte rien de plus que ce que ne fait déjà la fonction de renommage.

Pour la capture d'écran, je ne vois pas ce qui cloche. Le nom de fichier est bon.

Reste à vérifier que les fichiers ne sont pas ouvert en lecture seule, je ne vois plus que ça.

17

Oui car je l'ai renommée a la main, mais quand j'exécute ma macro avec un assemblage quelquonque, il ne donne pas le même nom comme si le compteur n'agissait pas. 

Et quand je renomme une pièce a la main, en faisant clic droit renommer la pièce, il change bien le nom windows mais pas le nom du composant. 

Es ce normal ? 

18

Je ne comprends pas le problème ou alors il y a une subtilité avec Swood que je ne maitrise pas.

19

Et bien je suis du genre un peu maniaque et je trouve confusant que le nom affiché dans le featuremanager ne soit pas le même que celui du fichier windows. Non ? 

Y'a t'il une ligne de commande qui permettre de renommer le nom du composant que je puisse l'accorder avec le nom du fichier directement  ? 

20

C'est plus du paramétrage des modèles dans ce cas. Chez moi, nom de fichier = nom affiché dans le featuremanager.