Save as step with renamed parts

Hi !

I want to save an assembly in step format with new names for parts and sub assemblies .

I wrote a macro :

it creates a new assembly with description+revision and then rename temporarily all parts and sub assemblies with description+revision.

it saves it in step format and close everything. It works but some parts in the original assembly are renamed why ?

(left: original assemblie, right: step file)

Does anyone can tell me what i am doing wrong ?

Option Explicit

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

Dim vChildComp As Variant

Dim swChildComp As SldWorks.Component2

Dim swCompConfig As SldWorks.Configuration

Dim swCustProp As SldWorks.CustomPropertyManager

Dim swChildModel As SldWorks.ModelDoc2

'Dim sPadStr As String

Dim i As Long

Dim Reference As String

Dim Revision As String

Dim Description As String

Dim Ver As String

Dim ValOut As String

Dim wasResolved As Boolean

Dim NewName As String

Dim PathName As String

Dim errorsRename As Long

Dim swSelData As SldWorks.SelectData

Dim swSelMgr As SldWorks.SelectionMgr

vChildComp = swComp.GetChildren

For i = 0 To UBound(vChildComp)

Set swChildComp = vChildComp(i)

TraverseComponent swChildComp, nLevel + 1

'Debug.Print sPadStr & swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"

Set swChildModel = swChildComp.GetModelDoc

PathName = swChildModel.GetPathName

If _

InStrRev(PathName, "ElementsArchives") <> 0 _

Or _

InStrRev(PathName, "ElementsStandards") <> 0 _

Or _

InStrRev(PathName, "Modèles SolidWorks") <> 0 _

Or _

InStrRev(PathName, "template") <> 0 _

Or _

InStrRev(PathName, "3D COMPOSER") <> 0 _

Then

Debug.Print "composant bibliotheque"

Else

Set swSelMgr = swChildModel.SelectionManager

Set swSelData = swSelMgr.CreateSelectData

Set swCustProp = swChildModel.Extension.CustomPropertyManager("")

swCustProp.Get5 "REFERENCE", False, ValOut, Reference, wasResolved

swCustProp.Get5 "INDICE", False, ValOut, Revision, wasResolved

swCustProp.Get5 "DESCRIPTION", False, ValOut, Description, wasResolved

swCustProp.Get5 "VERSION", False, ValOut, Ver, wasResolved

If Ver = "" Then

NewName = Reference + " " + Revision + "_" + Description

Else

NewName = Reference + " " + Revision + "_" + Ver + "_" + Description

End If

swChildComp.Select4 False, swSelData, False

swChildComp.Name2 = NewName

End If

Next i

End Sub

Sub main()

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swAssy As SldWorks.AssemblyDoc

Dim swCustProp As SldWorks.CustomPropertyManager

Dim swConf As SldWorks.Configuration

Dim swRootComp As SldWorks.Component2

Dim swExportPDFData As SldWorks.ExportPdfData

Dim Revision As String

Dim Description As String

Dim Ver As String

Dim ValOut As String

Dim Path As String

Dim wasResolved As Boolean

Dim status As Boolean

Dim errors As Long

Dim warnings As Long

Dim dFileName As String

Dim pFileName As String

Dim bOldSetting As Boolean

Set swApp = Application.SldWorks

bOldSetting = swApp.GetUserPreferenceToggle(swExtRefUpdateCompNames)

swApp.SetUserPreferenceToggle swExtRefUpdateCompNames, False

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set swCustProp = swModel.Extension.CustomPropertyManager("")

swCustProp.Get5 "INDICE", False, ValOut, Revision, wasResolved

swCustProp.Get5 "DESCRIPTION", False, ValOut, Description, wasResolved

swCustProp.Get5 "VERSION", False, ValOut, Ver, wasResolved

pFileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)

pFileName = Left(pFileName, InStrRev(pFileName, ".") - 1)

'Path = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))

'pFileName = "c:\temp\" + pFileName + " " + Revision + "_" + Ver

status = swModelDocExt.SaveAs("c:\temp\" + pFileName + " " + Revision + "_" + Ver + ".sldasm", 0, 2, swExportPDFData, errors, warnings)

'Open assembly

Set swModel = swApp.OpenDoc6("c:\temp\" + pFileName + " " + Revision + "_" + Ver + ".sldasm", swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)

Set swConf = swModel.GetActiveConfiguration

Set swRootComp = swConf.GetRootComponent3(True)

'Debug.Print "File = " & swModel.GetPathName

'Traverse Components

TraverseComponent swRootComp, 1

status = swModel.Extension.SaveAs("c:\temp\" + pFileName + " " + Revision + "_" + Ver + ".step", 0, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings)

'swApp.SetUserPreferenceToggle swExtRefUpdateCompNames, bOldSetting

swApp.CloseDoc pFileName + " " + Revision + "_" + Ver + ".sldasm"

Set swModel = swApp.ActiveDoc

status = swModel.ForceRebuild3(False)

swApp.SetUserPreferenceToggle swExtRefUpdateCompNames, True

End Sub

SolidworksApi/macros