I am currently working on an assembly that was initially made in china and I found this code that translates individual parts to English. I was hoping somebody could modify it to make it work on an assembly or give me some ideas on how I should proceed about translate all the parts inside the assembly and this assembly also has multiple sub-assemblies.
thank you.
by the way, I am currently using SolidWorks 2019.
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc
Dim swFeat As SldWorks.Feature
Dim newName As String
Dim dicFeatsCount As Object
Dim collFeatsNonIncr As Collection
Dim dicBaseNames As Object
Const FrontPlane = "Front Plane"
Const TopPlane = "Top Plane"
Const RigthPlane = "Rigth Plane"
Const Origin = "Origin"
Dim isRefGeom As Boolean
Sub main()
Set dicFeatsCount = CreateObject("Scripting.Dictionary")
Set collFeatsNonIncr = New Collection
Set dicBaseNames = CreateObject("Scripting.Dictionary")
isRefGeom = False
'Add the list of features which shouldn't be incremented
'- - - - - - - - - - - - - - - - - - - -
collFeatsNonIncr.Add "SensorFolder"
collFeatsNonIncr.Add "DocsFolder"
collFeatsNonIncr.Add "DetailCabinet"
collFeatsNonIncr.Add "MaterialFolder"
collFeatsNonIncr.Add "OriginProfileFeature"
'- - - - - - - - - - - - - - - - - - - -
'Add the list of predefined base names
'- - - - - - - - - - - - - - - - - - - -
dicBaseNames.Add "MaterialFolder", "Material <not specified>"
dicBaseNames.Add "OriginProfileFeature", "Origin"
dicBaseNames.Add "ProfileFeature", "Sketch"
dicBaseNames.Add "Extrusion", "Extrude"
dicBaseNames.Add "RefPlane", "Plane"
'- - - - - - - - - - - - - - - - - - - -
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FirstFeature
While Not swFeat Is Nothing
If dicFeatsCount.exists(swFeat.GetTypeName2()) Then
dicFeatsCount.Item(swFeat.GetTypeName2()) = dicFeatsCount.Item(swFeat.GetTypeName2()) + 1
Else
dicFeatsCount.Add swFeat.GetTypeName2(), 1
End If
If dicBaseNames.exists(swFeat.GetTypeName2()) Then
newName = dicBaseNames.Item(swFeat.GetTypeName2())
Else
newName = swFeat.GetTypeName2()
End If
Dim i As Integer
Dim isIncremented As Boolean
isIncremented = True
For i = 1 To collFeatsNonIncr.Count
If collFeatsNonIncr(i) = swFeat.GetTypeName2() Then
isIncremented = False
Exit For
End If
Next
If isIncremented Then
newName = newName & dicFeatsCount.Item(swFeat.GetTypeName2())
End If
If swFeat.GetTypeName2 = "MaterialFolder" Then
isRefGeom = True
Dim sMatName As String
sMatName = swPart.GetMaterialPropertyName2("", "")
If sMatName <> "" Then
newName = sMatName
End If
End If
swFeat.Name = newName
Set swFeat = swFeat.GetNextFeature
If isRefGeom Then
swFeat.Name = FrontPlane
Set swFeat = swFeat.GetNextFeature
swFeat.Name = TopPlane
Set swFeat = swFeat.GetNextFeature
swFeat.Name = RigthPlane
Set swFeat = swFeat.GetNextFeature
swFeat.Name = Origin
Set swFeat = swFeat.GetNextFeature
isRefGeom = False
End If
Wend
End Sub