Poprawa makro zmiana strony rozłożonej na blasze

Macro
1

Witam
Chcę udoskonalić makro, które jest używane bardzo regularnie.
To makro jest bardzo funkcjonalne na wszystkich najnowszych częściach arkusza blachy, ale nie działa na starszych częściach (bez oparcia z blachy)
Jeśli ktoś ma pomysł, aby był funkcjonalny dla 2 dołączonych arkuszy.

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim selManager As SldWorks.SelectionMgr


Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set selManager = swModel.SelectionManager
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'code
    
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim swFace1 As Face2
    Do While swFace1 Is Nothing
        Set swFace1 = selManager.GetSelectedObject6(1, -1)
        DoEvents
    Loop
    
    set_fixed_face get_flat_feature(swFace1.GetBody), swFace1
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'code

    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub
Public Function get_flat_feature(bod As Body2) As Feature
    Dim featurmgr As FeatureManager
    Set featurmgr = swModel.FeatureManager
    Dim flatpaternfolder As FlatPatternFolder
    Set flatpaternfolder = featurmgr.GetFlatPatternFolder()
    Dim flatfeatures As Variant
    flatfeatures = flatpaternfolder.GetFlatPatterns()
    Dim sFlatPatternFeatureData As FlatPatternFeatureData
    Dim face As Face2
    Dim feat As Variant
    For Each feat In flatfeatures
        Set sFlatPatternFeatureData = feat.GetDefinition()
        Set face = sFlatPatternFeatureData.FixedFace2
        If face.GetBody.Name = bod.Name Then
            Set get_flat_feature = feat
            Exit Function
        End If
    Next
End Function

Public Sub set_fixed_face(feat As Feature, face As Face2)
    Dim sFlatPatternFeatureData As FlatPatternFeatureData
    Set sFlatPatternFeatureData = feat.GetDefinition()
    sFlatPatternFeatureData.AccessSelections swModel, Nothing
    sFlatPatternFeatureData.FixedFace2 = face
    feat.ModifyDefinition sFlatPatternFeatureData, swModel, Nothing
End Sub

Pierwotny temat lub @Lynkoa15 znalazł mnie, że obecne rozwiązanie działa w 92%, pozostaje 8% starszej części.
Nowy.SLDPRT (245,2 KB)
Stary.SLDPRT (578,4 KB)
W dokumentach, które nie mają rozwiniętego pliku stanu:
image
Bez względu na to, jak bardzo na to wyglądam, nie mogę dokonać wyboru wyczynu, aby następnie nałożyć na niego twarz.

2

Nie mam pojęcia, czy to pomaga, ale nie da się rozłożyć ręcznie w domu (SW 2024 SP01) bez przejścia przez funkcję " Rozłóż ", zwykle wolimy funkcję " Spłaszcz ", ale w tym przypadku nie działa. Nawet konwertując plik do mojej obecnej wersji.

image
obraz942×321 23.6 KB

image
obraz873×362 33.1 KB

1 polubienie
3

Witam @sbadenis
Rzeczywiście, funkcja get_flat_feature() jest bezpośrednio ukierunkowana na rozwinięty folder funkcji (w celu optymalizacji wydajności), jednak ten folder wydaje się nie istnieć dla tych starych części, sugeruję przejrzenie wszystkich funkcji za pomocą tej funkcji,

Public Function get_flat_feature2(bod As Body2) As Feature
    Dim featurmgr As FeatureManager
    Set featurmgr = swModel.FeatureManager
    
    Dim sFlatPatternFeatureData As FlatPatternFeatureData
    Dim face As Face2
    
    Dim feat As Feature
    Set feat = swModel.FirstFeature
    While Not feat Is Nothing
        If feat.GetTypeName2() = "FlatPattern" Then
            Set sFlatPatternFeatureData = feat.GetDefinition()
            Set face = sFlatPatternFeatureData.FixedFace2
            If face.GetBody.Name = bod.Name Then
                Set get_flat_feature2 = feat
                Exit Function
            End If
        End If
        
        Set feat = feat.GetNextFeature
    Wend
End Function
4

Roman, spróbuj cofnąć usunięcie zagięć (czasami sw nie robi tego automatycznie, wybierając stan rozłożony)
Capture (testowany przez SW22)

2 polubienia
5

To działa, czapki z głów!

image
obraz1045×669 83.1 KB

2 polubienia
6

Tak, moje makro w trybie debugowania usunęło te funkcje. Nic poważnego.

7

Dziękuję , @Lynkoa15 próbowałem czegoś podobnego, ale nie udało mi się sprawić, by to zadziałało.
Na razie jest teraz doskonale funkcjonalny.
Mój automatyczny rysunek części blaszanych zawiera teraz jeszcze jedną cięciwę do łuku.
Dziękuję!

1 polubienie