Page 1 of 1
Renaming a Mate with VBA
Posted: Sat Jun 22, 2024 6:18 pm
by 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!
Re: Renaming a Mate with VBA
Posted: Sun Jun 23, 2024 11:57 am
by gupta9665
Use swFeature.GetTypeName2 to get if the type is Mate, and then use swFeature.Name to rename the mates.
Re: Renaming a Mate with VBA
Posted: Sun Jun 23, 2024 3:13 pm
by timied07
Thanks, I'm definitely getting closer!
The Immediate Window shows the new name after running the macro:
- image.png (3.12 KiB) Viewed 1545 times
However the feature tree in SolidWorks still shows the original name:
- image.png (8.1 KiB) Viewed 1545 times
How do I push the name update back to SolidWorks?
Re: Renaming a Mate with VBA
Posted: Mon Jun 24, 2024 4:20 am
by RonE
Re: Renaming a Mate with VBA
Posted: Mon Jun 24, 2024 2:16 pm
by gupta9665
timied07 wrote: ↑Sun Jun 23, 2024 3:13 pm
How do I push the name update back to SolidWorks?
Try force rebuild to reflect the new names.
Re: Renaming a Mate with VBA
Posted: Mon Jun 24, 2024 5:22 pm
by 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
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 1:34 am
by gupta9665
Can you please share the complete macro to debug?
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 5:26 am
by timied07
Yes, I'll post it a bit later on. Thanks
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 8:38 am
by 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 1352 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
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 2:06 pm
by 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...........
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 2:33 pm
by gupta9665
Are you missing "=" in this line
Code: Select all
arrayMates(X).Name = Left(swComp.Name, InStr(swComp.Name, "-") - 1) & "+" & arrayMates(X).Name
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 2:47 pm
by 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 1304 times
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 2:56 pm
by 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
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 3:00 pm
by timied07
Alex,
Thanks. I'm not following what you are saying. What do you mean by cast?
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 3:03 pm
by 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.
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 3:12 pm
by timied07
Didn't seem to make a difference
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 3:16 pm
by 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.
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 3:29 pm
by 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
Re: Renaming a Mate with VBA
Posted: Tue Jun 25, 2024 11:44 pm
by 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?