Macro creation of folders in the fearture + classification by property

Hello

In my assemblies, I would like to create the FI and Screws folder using a macro (vba) and move all the 1st level parts or assemblies to these folders.

For this I am looking for ways to:

1-Retrieve the name of each 1st level part or assembly

2-Retrieve the category property of each of these parts or assembly

3-Create a folder in the Feature manager

4-Move parts or assemblies with the property category = to Screws or Industrial Supply to the appropriate folder

 

If you have any leads for one or the other of the steps (procedure or even example) it could help me a lot ;-)

 

Thank you

Sebastian

Hello

Point 1: GetChildren function with an example HERE

Point 2: GetModelDoc2 function

Point 3: I don't remember, it will come back later.

Point 4: Same as point 3

Kind regards

2 Likes

Points 3 and 4: InsertFeatureTreeFolder2 function with an example HERE

Kind regards

2 Likes

Hello

And here is the full example:

Option Explicit

' ce code nécessite que la référence "Microsoft Scripting Runtime" soit activée
Dim MonDico As New Scripting.Dictionary

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swAssy As SldWorks.AssemblyDoc
    Dim featureMgr As SldWorks.FeatureManager
    Dim feature As SldWorks.feature
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Dim bRet As Boolean
    Dim Compteur As Long
    Dim TestValeurDico As Variant

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent

    TraverseComponent swRootComp, swRootComp.Name2, "catégorie", "visserie"
    
    Compteur = 1
    For Each TestValeurDico In MonDico.Keys
        Classement swModel, MonDico(TestValeurDico), Compteur, "Visserie"
        Compteur = Compteur + 1
    Next TestValeurDico
    Set MonDico = Nothing
    
    Set swModel = swApp.ActiveDoc
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent
    
    TraverseComponent swRootComp, swRootComp.Name2, "catégorie", "Fourniture industrielle"
    
    Compteur = 1
    For Each TestValeurDico In MonDico.Keys
        Classement swModel, MonDico(TestValeurDico), Compteur, "FI"
        Compteur = Compteur + 1
    Next TestValeurDico
    Set MonDico = Nothing
End Sub

Sub TraverseComponent(swComp As SldWorks.Component2, nomAsm As String, nomVar As String, resultVar As String)
    Dim vChildCompArr As Variant
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swSelModel As SldWorks.ModelDoc2
    Dim swCompConfig As SldWorks.Configuration
    Dim Compteur As Long
    
    Compteur = 1
    vChildCompArr = swComp.GetChildren
    For Each vChildComp In vChildCompArr
        Set swChildComp = vChildComp
        If Not swChildComp Is Nothing Then
            Set swSelModel = swChildComp.GetModelDoc2
            GetPropChildren swSelModel, nomAsm, swChildComp.Name2, nomVar, resultVar, Compteur
        End If
        Compteur = Compteur + 1
    Next
End Sub

Sub GetPropChildren(swChild As SldWorks.ModelDoc2, nomAsm As String, nomPrt As String, nomVar As String, resultVar As String, Cle As Long)
    Dim swModelDocExtension As SldWorks.ModelDocExtension
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Dim nbrProps As Long
    Dim vpropsnames As Variant
    Dim k As Long
    Dim valeur As String
    Dim val As String
    Dim valout As String
    Dim boolstatus As Boolean
    
    Set swModelDocExtension = swChild.Extension
    Set swCustPropMgr = swModelDocExtension.CustomPropertyManager("")
    
    nbrProps = swCustPropMgr.count
    vpropsnames = swCustPropMgr.GetNames
    
    For k = 0 To nbrProps - 1
        If vpropsnames(k) = nomVar Then
            boolstatus = swCustPropMgr.Get4(nomVar, False, val, valout)
            If valout = resultVar Then
                valeur = nomPrt & "@" & nomAsm
                If Not MonDico.Exists(Cle) Then
                    MonDico.Add Cle, valeur
                End If
            End If
        End If
    Next k
End Sub

Sub Classement(swModel As SldWorks.ModelDoc2, nomComposant As String, Nbr As Long, nomDossier As String)
    Dim swAssy As SldWorks.AssemblyDoc
    Dim featureMgr As SldWorks.FeatureManager
    Dim feature As SldWorks.feature
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Dim bRet As Boolean
    Dim modelDocExt As SldWorks.ModelDocExtension
    Dim selectionMgr As SldWorks.selectionMgr
    Dim selObj As Object
    Dim status As Long
    Dim count As Long
    Dim i As Long
    Dim componentToMove As SldWorks.Component2
    Dim componentsToMove() As Object
    Dim retVal As Boolean

    swModel.ClearSelection2 True
    
    Set modelDocExt = swModel.Extension
    Set selectionMgr = swModel.SelectionManager

    status = modelDocExt.SelectByID2(nomComposant, "COMPONENT", 0, 0, 0, True, 0, Nothing, 0)
    Set selObj = selectionMgr.GetSelectedObject6(Nbr, -1)
    count = selectionMgr.GetSelectedObjectCount2(0)
    ReDim componentsToMove(count - 1)
    For i = 0 To count - 1
        Set componentToMove = selectionMgr.GetSelectedObjectsComponent4(i + 1, 0)
        Set componentsToMove(i) = componentToMove
    Next

    Dim erreur As String
    erreur = "Oui"
    Set swAssy = swModel
    Set featureMgr = swAssy.FeatureManager
    Set feature = swModel.FirstFeature
    Do While Not feature Is Nothing
        If feature.Name = nomDossier Then
            erreur = "Non"
        End If
        Set feature = feature.GetNextFeature
    Loop
    If erreur = "Oui" Then
        Set feature = featureMgr.InsertFeatureTreeFolder2(swFeatureTreeFolder_EmptyBefore)
        feature.Name = nomDossier
    End If
    
    Set feature = swAssy.FeatureByName(nomDossier)
    retVal = swAssy.ReorderComponents(componentsToMove, feature, swReorderComponents_LastInFolder)
    
    swModel.ClearSelection2 True
End Sub

Kind regards


macroranking3d.swp
2 Likes

Thank you @d.roger, it's more of a track it's a highway that you made for me!

It helps me a lot, I wasn't that far, rather very far from there...

I still have a problem for 1 special case:

Parts created with a part family, where the Category is filled in the configuration (such as Screws or other) are ignored, I would have to add a condition if the "category" property is empty then look at the configuration property.

 

Finally, I also need to add an improvement to delete the Screws and FI folder when starting the macro if they already exist. (in case we restart the macro after adding new coins)

And finally I would like to move the 2 folders to the very bottom of the feature manager if possible (no way to move the folder).

 

 

Hello

Here is a new version that allows you to delete folders at startup if they exist and also to search for the value of the variable in all configurations of 3D elements.

I didn't try to put the folders at the end of the feature manager, we'll see later if I have the time.

A little reminder, this is only an example so the error management is not done...

Kind regards


macroranking3d.swp
2 Likes

Latest version, the one with the positioning of the folders at the end of the feature manager ...

Kind regards


macroranking3d.swp
3 Likes

I test it during the day if I can find 15-20mn, but at first sight seems perfectly functional!

For the dictionary structure I discover something new, in the elaboration of macros. Thank you.

I'll come back at the end of the day if all goes well.

 

And thank you @d.roger for taking the time to look at all this.

After test:

There are at least 2  bugs left to solve:

- if a part is in the deleted state (N°1-Image1)-> impossible to find the default configuration -> error -> I have to find how to ignore it if the part is in the delete state. (for bug 2 put back not deleted)

- the folder move does not work well the well folder is at the very bottom, but all the pieces below the 1st one to move in the folder, are also in the folder.

And in addition, the folder cannot be "extended" with the arrow to see its contents.

Whereas without the displacement, the arrow is there.

I think it moves all the items below the folder in there, including the other folders that are created next.

Example before macro (Image 1)

In N°1 assembly removed for bug 1

in N°2 (Screws)

In N°3 and 4 (FI)

 

Attached, my test assembly, and the macro with the properties with the correct case (error on my part during the 1st post).


test_dossiers.zip

Hello

Here is a new version that allows you to avoid elements that are in the deleted state, I removed the lines that move the folders because indeed it bugs in some cases (to think about how to do it but not too much time for the moment).

Kind regards


macroclassement3d_1.swp
2 Likes

Hello

Thanks for the latest version which effectively solves the problem on deleted parts.

I'm going to close the topic despite the bug on the folder move but which was not requested in the basic question.

For the folder move I have some ideas:

- move the parts first rather than the folder and then create the folder

- find out why this bug (by asking the question on the dedicated Solidworks macro forum)

For the rest the macro is perfectly functional and I thank you @ d.roger for the perfect work done, it saved me a more than precious time while having a much cleaner code than what I would have done with my beginner level.
 

 

Hello

Thanks for the latest version which effectively solves the problem on deleted parts.

I'm going to close the topic despite the bug on the folder move but which was not requested in the basic question.

For the folder move I have some ideas:

- move the parts first rather than the folder and then create the folder

- find out why this bug (by asking the question on the dedicated Solidworks macro forum)

For the rest the macro is perfectly functional and I thank you @d.roger for the perfect work done, it saved me a more than precious time while having a much cleaner code than what I would have done with my beginner level.

 

1 Like

Hello

You're welcome for the thank you, mutual aid is the principle of the forum...

For moving the folders, the first idea you consider is something I've also thought about but no time to test it for the moment. If you have a functional solution I'm all for it, it will be good for my general culture ...

Don't forget to rework the code to add error handling.

Kind regards

1 Like

No worries, for the error management I actually have to add a little code but nothing to invent just to transplant right and left which should suit me!

If I find a solution I will post the solution here.