Witaj Cyrylu,
Wracam do tematu jeszcze długo później ze względu na brak czasu i plików do testowania.
Próbowałem poprawić Twój kod po teście na bardzo dużym asemblerze i kilku pułapkach:
- Przenieś wszystkie komponenty do rozwiązanego → dodał oświadczenie pod komentarzem " 'Wydaj wszystko do rozwiązania '
- odtworzyć właściwości " Reference " i "Pre-etyde Code", które były w konflikcie, z pustą treścią (usunięcie ich nie wystarczy, PDM zachowuje starą wartość w pamięci) → dodał instrukcje pod komentarzem " dodawanie pustych właściwości Reference i Code-preetude "
- wymuś przebudowanie i zapisz, aby zastosować zmiany właściwości (zauważyłem, że nie zachowało ich w inny sposób) → dodałem instrukcje pod komentarzem " 'Wymuszamy przebudowę, aby zastosować zapis na każdym potomku "
- Wymuś odbudowanie pliku head --> dodano ostatnią instrukcję
Dobra wiadomość jest taka, że mam wrażenie, że traktuje też wirtualne dzieci jak najgorzej, albo pogubiłam się we wszystkich swoich próbach...
Ale mam też wrażenie, że jest to bardzo powolne, pewnie ze względu na przebudowę, którą wymuszam na każdym dziecku, jakiś pomysł, żeby to zoptymalizować?
I wreszcie moja ostatnia przeszkoda: w testowanym przeze mnie asm znajdowały się pliki tak stare, że poprosiło mnie o " Zapisz jako " je w celu ich konwersji, więc modyfikacja właściwości nie działa, ponieważ nie jest stosowany rebuild+save. Czy jest na to sposób? Musiałem je przetworzyć ręcznie...
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
tego nie uruchomili.
mną w porządku!