Renaming a Mate with VBA

[timied07]

I have been working on some mate macros and at the point that I think we need to rename some of the mates so they can still be easily located / alignment flipped with the macros after the assemblies are being built up.

I have access the mates and pull their paramteres, but I have not found a way to change the name. I have tried several things, but also feel I have exhausted the help files and google searches.

Thanks in advance!

[gupta9665]

Use swFeature.GetTypeName2 to get if the type is Mate, and then use swFeature.Name to rename the mates.

[timied07]

Thanks, I'm definitely getting closer!

The Immediate Window shows the new name after running the macro:

image.png (3.12 KiB) Viewed 1173 times

However the feature tree in SolidWorks still shows the original name:

image.png (8.1 KiB) Viewed 1173 times

How do I push the name update back to SolidWorks?

[RonE]

Try UpdateFeatureTree Method (IFeatureManager) -> https://help.solidworks.com/2022/englis ... eTree.html

[gupta9665]

How do I push the name update back to SolidWorks?

Try force rebuild to reflect the new names.

[timied07]

I tried force rebuild and update feature tree, see attached screenshot of code:

Here is the relevant snippet from the Immediate Window

There is still no change in the Feature Tree in SolidWorks UI

Unsure if it makes a difference, but I'm running SW Student Edition 2023 SP 2.1

[gupta9665]

Can you please share the complete macro to debug?

[timied07]

Yes, I'll post it a bit later on. Thanks

[AlexB]

This macro I wrote to test this works. It renames every mate in the mates folder by adding "_NEW" to the end of the name. No need to update the feature tree via rebuild or anything (2024 SP5)

image.png (5.25 KiB) Viewed 980 times

Code: Select all

Option Explicit

Sub main()
    
    Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    Dim swFeature As Feature
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then Exit Sub
    If swModel.GetType <> swDocumentTypes_e.swDocASSEMBLY Then Exit Sub
    
    Debug.Print swModel.GetTitle
    
    Set swFeature = swModel.FirstFeature
    
    While Not swFeature Is Nothing
        Dim typeName As String
        typeName = swFeature.GetTypeName2
        Debug.Print typeName
        If typeName = "MateGroup" Then
            
            Dim swSubFeat As Feature
            Set swSubFeat = swFeature.GetFirstSubFeature
            While Not swSubFeat Is Nothing
                typeName = swSubFeat.GetTypeName2
                Debug.Print "  " + typeName
                
                swSubFeat.Name = swSubFeat.Name + "_NEW"
                Debug.Print "  New Name: " + swSubFeat.Name
                
                Set swSubFeat = swSubFeat.GetNextSubFeature
            Wend
            
        End If
        
        Set swFeature = swFeature.GetNextFeature
        
    Wend
    
End Sub

[timied07]

Here is my macro, it is quite ugly at the moment after trying a lot of things...sorry in advance

Code: Select all

Option Explicit

Function SelectMateEntity(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swMateEnt As SldWorks.MateEntity2, nMark As Long) As Boolean

    Dim swEnt As SldWorks.Entity
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swSelData As SldWorks.SelectData
    Dim bRet As Boolean

    Select Case swMateEnt.ReferenceType

        Case swMateEntity2ReferenceType_Point, _
                swMateEntity2ReferenceType_Line, _
                swMateEntity2ReferenceType_Circle, _
                swMateEntity2ReferenceType_Plane, _
                swMateEntity2ReferenceType_Cylinder, _
                swMateEntity2ReferenceType_Sphere, _
                swMateEntity2ReferenceType_Cone, _
                swMateEntity2ReferenceType_SweptSurface

            Set swSelMgr = swModel.SelectionManager
            Set swSelData = swSelMgr.CreateSelectData
            Set swEnt = swMateEnt.Reference

            swSelData.Mark = nMark

            bRet = swEnt.Select4(True, swSelData)

            SelectMateEntity = bRet

            Exit Function

        Case swMateEntity2ReferenceType_Set, _
                swMateEntity2ReferenceType_MultipleSurface, _
                swMateEntity2ReferenceType_GenSurface, _
                swMateEntity2ReferenceType_Ellipse, _
                swMateEntity2ReferenceType_GeneralCurve, _
                swMateEntity2ReferenceType_UNKNOWN

        Case Else

    End Select

    SelectMateEntity = False

End Function


Sub main2()
    
    'On Error Resume Next
    
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swComp As SldWorks.Component2
    Dim swAssy As AssemblyDoc

    Dim swMates() As SldWorks.Feature
    Dim isInit As Boolean
    'inInit = False
    Dim X As Integer
    Dim i As Integer
    
    Dim swMateGroupFeat As SldWorks.Feature
    
    Dim featIndex As Integer
    featIndex = 0
    
    Dim arrayMates As Variant
    Dim swMate2 As SldWorks.Mate2
    Dim swMateEntity As SldWorks.MateEntity2
    Dim testComp As SldWorks.Component2
    
    Dim nNewMateAlign As swMateAlign_e
    Dim ErrorLong As Long
    Dim swMateEdit As Mate2
    Dim instance As IAssemblyDoc

    Set swApp = Application.SldWorks
    Set swAssy = swApp.ActiveDoc
    Set swModel = swApp.ActiveDoc
    Set instance = swApp.IActiveDoc
    
    Dim nNumMateEnt As Long
    Dim swMateEnt() As SldWorks.MateEntity2
    Dim vMateEntPar As Variant
    Dim bRet As Variant
    Dim swFeat As SldWorks.Feature
    
    Dim mateCount As Integer
    Dim instance2 As IFeatureManager
    Dim swFeatMgr As SldWorks.FeatureManager
        
    
    
    If Not swAssy Is Nothing Then
        Set swSelMgr = swAssy.SelectionManager
        Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
        
        If Not swComp Is Nothing Then
            Debug.Print swComp.GetPathName
            Debug.Print swComp.Name2
            swComp.Select4 False, Nothing, False
            
            arrayMates = swComp.GetMates
            mateCount = UBound(arrayMates) - LBound(arrayMates)
            
            If mateCount = 1 Then
                For X = LBound(arrayMates) To UBound(arrayMates)
                    'If arrayMates(X).Type = 0 Then
                        Set swMate2 = arrayMates(X)
                        nNumMateEnt = swMate2.GetMateEntityCount
                        Debug.Print "Type::    " & swMate2.Type
                        Debug.Print "Mate Name::   " & arrayMates(X).Name
                        Debug.Print "Alignment::   " & swMate2.Alignment
                        Debug.Print "Entity Count::    " & nNumMateEnt
                        Debug.Print "Test::     " & Left(swComp.Name, InStr(swComp.Name, "-") - 1) & "+" & arrayMates(X).Name
                        
                        ReDim swMateEnt(nNumMateEnt)
                        For i = 0 To nNumMateEnt - 1
                            Set swMateEnt(i) = swMate2.MateEntity(i)
                            Set swComp = swMateEnt(i).ReferenceComponent
                            vMateEntPar = swMateEnt(i).EntityParams
                            
                            Debug.Print "      RefType(" & i & ")   = " & swMateEnt(i).ReferenceType
                            Debug.Print "        Component          = " & swComp.Name2 & " (" & swComp.ReferencedConfiguration & ") --> " & swComp.GetPathName
                            Debug.Print "        Point              = (" & vMateEntPar(0) * 1000# & ", " & vMateEntPar(1) * 1000# & ", " & vMateEntPar(2) * 1000# & ") mm"
                            Debug.Print "        Vector             = (" & vMateEntPar(3) & ", " & vMateEntPar(4) & ", " & vMateEntPar(5) & ")"
                            Debug.Print "        Radius 1           = " & vMateEntPar(6) * 1000# & " mm"
                            Debug.Print "        Radius 2           = " & vMateEntPar(7) * 1000# & " mm"
                        Next i
                        
                        'boolstatus = swAssy.Extension.SelectByID2(arrayMates(X).Name, "MATE", 0, 0, 0, False, 0, Nothing, 0)
                        
                        If swMateAlignALIGNED = swMate2.Alignment Then
                            nNewMateAlign = swMateAlignANTI_ALIGNED
                            Debug.Print "Was Aligned"
                        Else
                            If swMateAlignANTI_ALIGNED = swMate2.Alignment Then
                                nNewMateAlign = swMateAlignALIGNED
                                Debug.Print "Was Anti-Aligned"
                            Else
                                ' closest alignment, so changing alignment does not make sense
                                Debug.Assert swMateAlignCLOSEST = swMate2.Alignment
                                Exit Sub
                            End If
                        End If
                        
                        swAssy.ClearSelection2 True
                        
                        For i = 0 To nNumMateEnt - 1
                            bRet = SelectMateEntity(swApp, swAssy, swMateEnt(i), 1)
                        Next i
                        
                        'bRet = swFeat.Select2(True, 0)
                        bRet = swMate2.Select2(True, 0)
                
                        swAssy.EditMate3 swMate2.Type, nNewMateAlign, True, 0, 0, 0, 0, 0, 0, 0, 0, False, True, 0, ErrorLong
                        
                        'Trying to rename mate
                        
                        Debug.Print "swMate2.GetTypeName2 :   " & swMate2.GetTypeName2
                        Debug.Print "Read name swMate2.Name :   " & swMate2.Name
                        arrayMates(X).Name Left(swComp.Name, InStr(swComp.Name, "-") - 1) & "+" & arrayMates(X).Name
                        Debug.Print "After changing name swMate2.Name :   " & swMate2.Name
                        
                        
                    'End If
                    
                Next
                
            Else                          'If more than 2 mates
                swAssy.ClearSelection2 True
                Exit Sub
            End If
            
        End If
        
    End If
    
    'trying to rename outside of if statement just to simplify
    Debug.Print "Before Pause aka stop command"
    Stop
    Set swFeatMgr = swModel.FeatureManager
    swFeatMgr.UpdateFeatureTree
    Debug.Print "After Resuming the stop and running swFeatMgr.UpdateFeatureTree"
    Debug.Print "Mate name should show as:    " & swMate2.Name
    'end of rename attempts
    
    bRet = swAssy.EditRebuild3
    swAssy.ClearSelection2 True
    
    bRet = swModel.ForceRebuild3(True)
    
    
End Sub

What I am trying to do is flip the mates of a component that is selected in the assembly; and rename the mates so I can build off of the mates later if needed (example: need to unflip/reset these mates, or want to skip these mates if flipping other mates that reference this component, etc.)



Alex, I tried your macro as a copy and paste and it renamed flawlessly; however I couldn't figure out why that worked and mine is not. Still need to figure out how to integrate the solutions together. It did rename ALL mates in the assembly, which is not what I'm after, trying to target very specific mates.

Close...........

[gupta9665]

Are you missing "=" in this line

Code: Select all

arrayMates(X).Name =  Left(swComp.Name, InStr(swComp.Name, "-") - 1) & "+" & arrayMates(X).Name

[AlexB]

It looks like AssemblyDoc::EditMate3 is obsolete and no longer supported. I did further testing with the IMate2 interface and it appears you can cast it to a IFeature object and then rename it.

image.png (4.05 KiB) Viewed 932 times

[timied07]

That didn't seem to make a difference.

Here is my setup:
1. Before execution of macro, click a face of the bearing. (You can see the highlighted line in the macro includes the "=" now

2. Here is the result from the execution

[timied07]

Alex,
Thanks. I'm not following what you are saying. What do you mean by cast?

[AlexB]

Would changing your line to set the name to include an explicit cast like this make a difference?

Code: Select all

Dim mateFeature As Feature
Set mateFeature = arrayMates(x)
mateFeature.Name = Left(swComp.Name, InStr(swComp.Name, "-") - 1) & "+" & arrayMates(X).Name

Edit: Casting is essentially telling the code to treat this as a specific type. VBA gets a little odd when trying to do this but hopefully it should work.

[timied07]

Didn't seem to make a difference

[timied07]

I do think I'm on to something by combining my macro with your macro Alex. I need to try to compare the list of mate names that I have identified against all the the mates n the assembly and rename if they match.

[timied07]

I think I have it working. It is likely not the most efficient way to do it, but it seems to work for now.

Here is the code, needs some cleanup for sure...

Code: Select all

Option Explicit

Function SelectMateEntity(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swMateEnt As SldWorks.MateEntity2, nMark As Long) As Boolean

    Dim swEnt As SldWorks.Entity
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swSelData As SldWorks.SelectData
    Dim bRet As Boolean

    Select Case swMateEnt.ReferenceType

        Case swMateEntity2ReferenceType_Point, _
                swMateEntity2ReferenceType_Line, _
                swMateEntity2ReferenceType_Circle, _
                swMateEntity2ReferenceType_Plane, _
                swMateEntity2ReferenceType_Cylinder, _
                swMateEntity2ReferenceType_Sphere, _
                swMateEntity2ReferenceType_Cone, _
                swMateEntity2ReferenceType_SweptSurface

            Set swSelMgr = swModel.SelectionManager
            Set swSelData = swSelMgr.CreateSelectData
            Set swEnt = swMateEnt.Reference

            swSelData.Mark = nMark

            bRet = swEnt.Select4(True, swSelData)

            SelectMateEntity = bRet

            Exit Function

        Case swMateEntity2ReferenceType_Set, _
                swMateEntity2ReferenceType_MultipleSurface, _
                swMateEntity2ReferenceType_GenSurface, _
                swMateEntity2ReferenceType_Ellipse, _
                swMateEntity2ReferenceType_GeneralCurve, _
                swMateEntity2ReferenceType_UNKNOWN

        Case Else

    End Select

    SelectMateEntity = False

End Function


Sub Beta()
    
    'On Error Resume Next
    
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swComp As SldWorks.Component2
    Dim swAssy As AssemblyDoc

    Dim swMates() As SldWorks.Feature
    Dim isInit As Boolean
    'inInit = False
    Dim X As Integer
    Dim i As Integer
    
    Dim swMateGroupFeat As SldWorks.Feature
    
    Dim featIndex As Integer
    featIndex = 0
    
    Dim arrayMates As Variant
    Dim swMate2 As SldWorks.Mate2
    Dim swMateEntity As SldWorks.MateEntity2
    Dim testComp As SldWorks.Component2
    
    Dim nNewMateAlign As swMateAlign_e
    Dim ErrorLong As Long
    Dim swMateEdit As Mate2
    Dim instance As IAssemblyDoc

    Set swApp = Application.SldWorks
    Set swAssy = swApp.ActiveDoc
    Set swModel = swApp.ActiveDoc
    Set instance = swApp.IActiveDoc
    
    Dim nNumMateEnt As Long
    Dim swMateEnt() As SldWorks.MateEntity2
    Dim vMateEntPar As Variant
    Dim bRet As Variant
    Dim swFeat As SldWorks.Feature
    
    Dim mateCount As Integer
    Dim instance2 As IFeatureManager
    Dim swFeatMgr As SldWorks.FeatureManager
        
    
    
    If Not swAssy Is Nothing Then
        Set swSelMgr = swAssy.SelectionManager
        Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
        
        If Not swComp Is Nothing Then
        
            swComp.Select4 False, Nothing, False
            arrayMates = swComp.GetMates
            mateCount = UBound(arrayMates) - LBound(arrayMates)
            
            If mateCount = 1 Then
            
                For X = LBound(arrayMates) To UBound(arrayMates)
                
                    'If arrayMates(X).Type = 0 Then
                    
                        Set swMate2 = arrayMates(X)
                        nNumMateEnt = swMate2.GetMateEntityCount
                        ReDim swMateEnt(nNumMateEnt)
                        
                        For i = 0 To nNumMateEnt - 1
                            Set swMateEnt(i) = swMate2.MateEntity(i)
                            Set swComp = swMateEnt(i).ReferenceComponent
                            vMateEntPar = swMateEnt(i).EntityParams
                            
                        Next i
                        
                        If swMateAlignALIGNED = swMate2.Alignment Then
                            nNewMateAlign = swMateAlignANTI_ALIGNED
                            
                        Else
                            If swMateAlignANTI_ALIGNED = swMate2.Alignment Then
                                nNewMateAlign = swMateAlignALIGNED
                                
                            Else
                                ' closest alignment, so changing alignment does not make sense
                                Debug.Assert swMateAlignCLOSEST = swMate2.Alignment
                                Exit Sub
                            End If
                        End If
                        
                        swAssy.ClearSelection2 True
                        
                        For i = 0 To nNumMateEnt - 1
                            bRet = SelectMateEntity(swApp, swAssy, swMateEnt(i), 1)
                        Next i
                        
                        'bRet = swFeat.Select2(True, 0)
                        bRet = swMate2.Select2(True, 0)
                
                        swAssy.EditMate3 swMate2.Type, nNewMateAlign, True, 0, 0, 0, 0, 0, 0, 0, 0, False, True, 0, ErrorLong
                        
                        'Trying to rename mate

                        'arrayMates(X).Name Left(swComp.Name, InStr(swComp.Name, "-") - 1) & "+" & arrayMates(X).Name
                        Debug.Print arrayMates(X).Name
                        
                    'End If
                    
                Next
                
            Else                          'If more than 2 mates
                swAssy.ClearSelection2 True
                Exit Sub
            End If
            
        End If
        
        'Trying to integrate AlexB
        Dim swFeature As Feature
        Set swFeature = swModel.FirstFeature
        
        While Not swFeature Is Nothing
            Dim typename As String
            typename = swFeature.GetTypeName2
            If typename = "MateGroup" Then
                Dim swSubFeat As Feature
                Set swSubFeat = swFeature.GetFirstSubFeature
                While Not swSubFeat Is Nothing
                    For X = LBound(arrayMates) To UBound(arrayMates)
                        If swSubFeat.Name = arrayMates(X).Name Then
                            swSubFeat.Name = swSubFeat.Name & "+Bearing"
                            
                        End If
                    Next
                    
                    Set swSubFeat = swSubFeat.GetNextSubFeature
                Wend
            End If
            
            Set swFeature = swFeature.GetNextFeature
        
        Wend
        
    End If
    
    bRet = swAssy.EditRebuild3
    swAssy.ClearSelection2 True
    
    bRet = swModel.ForceRebuild3(True)
    
    
End Sub

[timied07]

Huge thanks for helping me troubleshoot this and get a working solution!

I want to run through this macro in use a bit before I mark it solved, but I think I have it working; just want more testing and tested on a different computer to verify.

Should I be marking AlexB's post as correct answer?