Re: Witam wszystkich!
Tak więc najlepszą odpowiedź przypisze się @Konti : nawet jeśli w wielu innych odpowiedziach znalazłem elementy, które mnie odblokowały, to właśnie jego pozwoliły mi najbardziej ruszyć do przodu (i to pomimo tego, że jego kod jest napisany w C#).
Dziękujemy @Konti !
Oto szczegółowe rozwiązanie:
Rzeczywiście, jak pokazuje kod @Konti, należy użyć kodu błędu 51 swSketchErrorExtRefFail .
Gdy składnik jest usuwany bez usuwania skojarzonych z nim wiązań, odwołania do ograniczeń przyjmują flagę **External**
Z jakiegoś powodu pierwszym pomysłem, jaki przyszedł mi do głowy, było sprawdzenie, czy komponent powiązany z jednostką odniesienia do chwiejnego ograniczenia nie działa: nadal była z nim powiązana nazwa pliku, ale nie miała ona nic wspólnego z oryginalną. Krótki! Niezrozumiały.
Warunkiem, aby to zadziałało, jest to, że opcja systemowa Traktuj brakujące odwołania do ograniczeń jako błędy musi być sprawdzona (właśnie po to, aby kod 51 został skojarzony z ograniczeniem).
OSTROŻNY!! Jeśli brakuje pliku (np. oprogramowanie nie może go znaleźć), pojawia się on jako usunięty w drzewie i dla wszystkich konfiguracji, jeśli takie istnieją, a ograniczenia z nim związane również wracają do kodu błędu 51; Dlatego konieczne jest zastanowienie się nad rozwiązaniem/znalezieniem tych komponentów przed wykorzystaniem makra.
Inny problem, na który się natknąłem, jest związany z funkcją grupowania ograniczeń według statusu (*Podziękowania dla @Sylk za udostępnienie tej opcji wyświetlania w jednym z jego postów):
Jeśli wiązanie jest podfunkcją funkcji Ograniczenia domyślne w drzewie zestawu, foldery użytkownika lub foldery automatycznego grupowania znajdują się na tym samym poziomie i muszą zostać odrzucone przed analizą wiązania.
Proszę bardzo! Jeszcze raz wszystkim dziękuję.
Poniżej mój kod:
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
