Bonjour Cyril,
Je reprends le sujet très longtemps après faute de temps et de fichiers à tester.
J’ai essayé d’améliorer ton code après un test sur un très gros assemblage et quelques écueils :
- passer tous les composants en résolu → ajout de l’instruction sous le commentaire « 'passer tout en résolu »
- re-créer les propriétés « Référence » et 'Code pré-étyde" qui étaient en conflit, avec un contenu vide (les supprimer ne suffit pas, PDM garde en mémoire l’ancienne valeur) → ajout des instructions sous le commentaire « ajout propriétés Reference et Code-preetude vide »
- forcer le rebuild et l’enregistrement pour appliquer les changements des propriétés (j’ai remarqué que ça ne les gardait pas sinon) → ajout des instructions sous le commentaire « 'on force un rebuild pour appliquer l’enregistrement sur chaque enfant »
- forcer le rebuild du fichier de tête -->ajout de la dernière instruction
La bonne nouvelle c’est que j’ai l’impression que ça traite bien les asm enfants virtuels aussi, ou alors je me suis perdu dans tous mes essais…
Mais j’ai aussi l’impression que c’est très lent, probablement à cause du rebuild que je force sur chaque enfant, une idée pour optimiser ça ?
Et enfin, mon dernier obstacle : dans l’asm que j’ai testé il y avait des fichiers tellement vieux qu’il me demandait de les « Enregistrer sous » pour les convertir, du coup la modif des propriétés ne fonctionne pas puisque le rebuild+save n’est pas appliqué. Est-ce que y a un moyen de contourner ça ? J’ai du les traiter à la main…
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
.
!