Hello Cyril,
I take up the subject again a long time later due to lack of time and files to test.
I tried to improve your code after a test on a very large assembly and a few pitfalls:
- Move all components to resolved → added the statement under the comment " 'Spend everything to resolved "
- re-create the " Reference " and "Pre-etyde Code" properties that were in conflict, with empty content (deleting them is not enough, PDM keeps the old value in memory) → added the statements under the comment " adding empty Reference and Code-preetude properties"
- force rebuild and save to apply property changes (I noticed it didn't keep them otherwise) → added instructions under the comment " 'we force a rebuild to apply the save on each child "
- force the rebuild of the head file --> added the last statement
The good news is that I have the impression that it treats virtual children asm well too, or I got lost in all my attempts...
But I also have the impression that it's very slow, probably because of the rebuild I force on each child, any idea to optimize that?
And finally, my last obstacle: in the asm I tested there were files so old that it asked me to " Save as " them to convert them, so the modification of the properties doesn't work since the rebuild+save is not applied. Is there a way around this? I had to process them by hand...
Dim swModel As SldWorks.ModelDoc2
Dim compDoc As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim swConfig As SldWorks.Configuration
Dim swConfMgr As SldWorks.ConfigurationManager
Dim comp As SldWorks.Component2
Dim components As Variant
Dim vComp As Variant
Dim pathChain As Variant
Dim titleChain As Variant
Dim vPath As Variant
Dim vConfigNameArr As Variant
Dim vConfigName As Variant
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim linkProp As Variant
Dim nDocType As Long
Dim nErrors As Long
Dim nWarnings As Long
Dim nNbrProps As Long
Dim lRetVal As Long
Dim nRetVal As Long
Dim j As Long
Dim i As Long
Dim bResult3 As Boolean
Dim boolstatus As Boolean
Dim wasResolved As Boolean
Dim linkToProp As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim sCustProp As String
Dim sConfig As String
Sub vider_pptes(vAsm As SldWorks.AssemblyDoc, wDoc As SldWorks.ModelDoc2, vswApp As SldWorks.SldWorks)
components = vAsm.GetComponents(False) ' Get all components
If IsArray(components) Then
For Each vComp In components
Set comp = vComp
Set compDoc = comp.GetModelDoc2
'passer tout en résolu
nRetVal = comp.SetSuppression2(swComponentFullyResolved)
If Not compDoc Is Nothing Then
bResult3 = compDoc.Extension.IsVirtualComponent3(pathChain, titleChain)
If bResult3 <> False Then
For Each vPath In pathChain
If vPath <> wDoc.GetPathName Then
If InStr(LCase(vPath), "sldprt") > 0 Then
nDocType = swDocPART
ElseIf InStr(LCase(vPath), "sldasm") > 0 Then
nDocType = swDocASSEMBLY
ElseIf InStr(LCase(vPath), "slddrw") > 0 Then
nDocType = swDocDRAWING
Else
' Probably not a SOLIDWORKS file
nDocType = swDocNONE
' So cannot open the file
Exit Sub
End If
Set swModel = vswApp.OpenDoc6(vPath, nDocType, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
nNbrProps = swCustProp.Count
lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)
For j = 0 To nNbrProps - 1
For i = 0 To UBound(vPropNames)
sCustProp = vPropNames(i)
boolstatus = swModel.DeleteCustomInfo2("", sCustProp)
Next i
Next j
' ajout propriétés Reference et Code-preetude vide
boolstatus = swCustProp.Add3("Reference", swCustomInfoType_e.swCustomInfoText, "", swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
boolstatus = swCustProp.Add3("Code_pré-étude", swCustomInfoType_e.swCustomInfoText, "", swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Set swConfMgr = swModel.ConfigurationManager
Set swConfig = swConfMgr.ActiveConfiguration
vConfigNameArr = swModel.GetConfigurationNames
For Each vConfigName In vConfigNameArr
Set swCustProp = swModelDocExt.CustomPropertyManager(vConfigName)
nNbrProps = swCustProp.Count
lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)
For j = 0 To nNbrProps - 1
sConfig = vConfigName
For i = 0 To UBound(vPropNames)
sCustProp = vPropNames(i)
boolstatus = swModel.DeleteCustomInfo2(sConfig, sCustProp)
Next i
Next j
Next
End If
Next
End If
'on force un rebuild pour appliquer l'enregistrement sur chaque enfant
boolstatus = compDoc.ForceRebuild3(False)
boolstatus = compDoc.Save3(swSaveAsOptions_Silent, nErrors, nWarnings)
End If
Next
End If
'rebuild du fichier de tête
boolstatus = wDoc.ForceRebuild3(False)
End Sub
launch it.
me!