Hallo Cyril,
Ik pak het onderwerp lange tijd later weer op vanwege gebrek aan tijd en bestanden om te testen.
Ik heb geprobeerd je code te verbeteren na een test op een zeer grote assembly en een paar valkuilen:
- Verplaats alle componenten naar opgelost → heeft de instructie toegevoegd onder de opmerking " 'Besteed alles aan opgelost '
- de eigenschappen " Referentie " en "Pre-etyde Code" die in conflict waren, opnieuw maken met lege inhoud (ze verwijderen is niet genoeg, PDM behoudt de oude waarde in het geheugen) → de instructies toegevoegd onder de opmerking " lege referentie- en code-preetude eigenschappen toevoegen"
- geforceerd opnieuw opbouwen en opslaan om eigenschapswijzigingen toe te passen (ik merkte dat het ze anders niet behield) → instructies toegevoegd onder de opmerking " 'we forceren een herbouw om de opslag op elk kind toe te passen "
- Forceer de herbouw van het hoofdbestand --> de laatste instructie toegevoegd
Het goede nieuws is dat ik de indruk heb dat het virtuele kinderen ook goed behandelt, anders ben ik verdwaald in al mijn pogingen...
Maar ik heb ook de indruk dat het erg traag gaat, waarschijnlijk vanwege de wederopbouw die ik elk kind opdring, enig idee om dat te optimaliseren?
En tot slot, mijn laatste obstakel: in de asm die ik heb getest, waren er bestanden die zo oud waren dat het me vroeg om ze op te slaan als om ze te converteren, dus de wijziging van de eigenschappen werkt niet omdat de rebuild+save niet wordt toegepast. Is er een manier om dit te omzeilen? Ik moest ze met de hand verwerken...
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
lanceren.
mij!