ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
CTChristopher Torres17/04/2020

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