Re Bonjour Tout le Monde !
Alors la meilleure réponse sera attribuée à @Konti : même si j’ai trouvé des éléments permettant de me débloquer dans beaucoup d’autres réponses, c’est la sienne qui m’a le plus permis d’avancer (et ce malgré que son code soit rédigé en C#).
Merci à toi @Konti !
Voici en détail la solution :
En effet, comme le montre le code de @Konti, c’est le code d’erreur 51 swSketchErrorExtRefFail qu’il faut utilisé.
Quand un composant est supprimé sans supprimer ses contraintes associées, les références de contrainte prennent un flag **External**
Pour une raison que j’ignore, la première idée que j’avais et qui consistait à aller vérifier le composant associé à l’entité de référence de contrainte bancale ne fonctionne pas : il y avait toujours un nom de fichier associé, mais qui n’avait rien à voir avec celui d’origine. Bref ! Incompréhensible.
La condition pour que cela fonctionne est que l’option système Traiter les références de contrainte manquantes comme des erreurs doit être cochés (justement pour que le code 51 soit associé à la contrainte).
ATTENTION !! Si un fichier est manquant (ie SW ne le trouve pas), celui-ci apparait comme supprimé dans l’arbre et pour toutes les configurations s’il y en a, et les contraintes qui lui sont associés remonte également avec le code d’erreur 51 ; il faut donc penser à résoudre/retrouver ces composants avant d’exploiter la macro.
L’autre problème que j’ai rencontré est lié à la fonction de groupement de contraintes par statuts (*Merci à @Sylk d’avoir fait apparaitre cette option d’affichage dans un de ses posts) :
Si la contrainte est une sous-fonction de la fonction Contraintes par défaut dans l’arbre d’un assemblage, les dossiers utilisateur ou les dossiers de regroupement automatique sont au même niveau et il faut les écarter avant d’analyser la contrainte.
Voilà ! Merci à tous encore une fois.
Ci-dessous mon code :
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swMateGroup As SldWorks.Feature
Dim swSubFolder As SldWorks.Feature
Dim swMateFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim swMate As IMate2
Dim swComp As SldWorks.Component2
Dim swMateEnt(2) As SldWorks.MateEntity2
Dim fileName As String
Dim Error As Long
Dim IsWarning As Boolean
Dim i As Long
Dim DeleteOption As Long
Dim status As Boolean
Dim Append As Boolean
Dim Mark As Integer
Dim List As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swModelDocExt = swModel.Extension
'Get the first feature in the assembly
Set swFeat = swModel.FirstFeature
'Iterate over features in FeatureManager design tree
Do While Not swFeat Is Nothing
If "MateGroup" = swFeat.GetTypeName Then
Set swMateGroup = swFeat
Exit Do
End If
Set swFeat = swFeat.GetNextFeature
Loop
Debug.Print " " & swMateGroup.Name
Debug.Print ""
Set swSubFeat = swMateGroup.IGetFirstSubFeature
'iterate over subfeatures (Mate or folders)
Do While Not swSubFeat Is Nothing
If "FtrFolder" = swSubFeat.GetTypeName Then
'--------------------------------------------------------------------
Debug.Print "swSubFeat TypeName: " & swSubFeat.GetTypeName _
& ", Name: " & swSubFeat.Name
'--------------------------------------------------------------------
GoTo Line1
ElseIf "GroupedMatesFolder" = swSubFeat.GetTypeName Then
'--------------------------------------------------------------------
Debug.Print "swSubFeat TypeName: " & swSubFeat.GetTypeName _
& ", Name: " & swSubFeat.Name
'--------------------------------------------------------------------
GoTo Line1
End If
'MsgBox swSubFeat.GetTypeName
Set swMate = swSubFeat.GetSpecificFeature2
If Not swMate Is Nothing Then
Error = swSubFeat.GetErrorCode2(IsWarning)
' Error 51 ?
If Error = 51 Then List = swSubFeat.Select2(True, 0)
End If
Line1:
Set swSubFeat = swSubFeat.IGetNextSubFeature
Loop
'Delete List
' To delete absorbed features, use enum swDeleteSelectionOptions_e.swDelete_Absorbed
' To delete children features, use enum swDeleteSelectionOptions_e.swDelete_Children
' To keep absorbed features and children features, set DeleteOption = 0
DeleteOption = swDeleteSelectionOptions_e.swDelete_Absorbed
'DeleteOption = swDeleteSelectionOptions_e.swDelete_Children
'DeleteOption = 0
'DeleteOption =swDeleteSelectionOptions_e.swDelete_Absorbed + swDeleteSelectionOptions_e.swDelete_Children
status = swModelDocExt.DeleteSelection2(DeleteOption)
End Sub
