Makroverbesserung Änderung der abgewickelten Seite am Blech

Macro
1

Hallo
Ich versuche, ein Makro zu perfektionieren, das sehr regelmäßig verwendet wird.
Dieses Makro ist bei allen neueren Blechteilen sehr funktional, funktioniert jedoch nicht bei älteren Teilen (ohne Blechrückenlehne)
Wenn jemand eine Idee hat, es für die 2 beigefügten Blätter funktionsfähig zu machen.

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

Das ursprüngliche Subjekt oder @Lynkoa15 hatte mich gefunden , die aktuelle Lösung funktioniert bei 92% bleibt die 8% des älteren Teils.
Neu.SLDPRT (245.2 KB)
Alt.SLDPRT (578.4 KB)
In den Dokumenten, die nicht über die entfaltete Statusdatei verfügen:
image
Egal wie sehr ich hinschaue, ich kann nicht meine Auswahl an Talenten treffen, um ihm dann das Gesicht aufzutragen.

2

Keine Ahnung, ob es hilft, aber es ist unmöglich, es zu Hause (SW 2024 SP01) von Hand zu entfalten, ohne die Funktion " Entfalten " zu durchlaufen, normalerweise bevorzugen wir die Funktion " Flatten ", aber in diesem Fall nicht funktionsfähig. Sogar die Konvertierung Ihrer Datei in meine aktuelle Version.

image
Bild942×321 23,6 KB

image
Bild873×362 33,1 KB

1 „Gefällt mir“
3

Hallo @sbadenis
In der Tat zielt die Funktion get_flat_feature() direkt auf den aufgeklappten Funktionsordner ab (um die Leistung zu optimieren), aber dieser Ordner scheint für diese alten Teile nicht zu existieren, ich schlage Ihnen vor, alle Funktionen mit dieser Funktion durchzugehen,

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, versuche, das Löschen der Falten rückgängig zu machen (manchmal macht sw es nicht automatisch, indem es den ungefalteten Zustand auswählt)
Capture (SW22 getestet)

2 „Gefällt mir“
5

Es funktioniert, Hut ab!

image
Bild1045×669 83.1 KB

2 „Gefällt mir“
6

Ja, mein Makro im Debug-Modus hatte diese Funktionen entfernt. Nichts allzu Ernstes.

7

Vielen Dank @Lynkoa15 ich hatte etwas Ähnliches versucht, aber ohne Erfolg, dass es funktionierte.
Vorerst ist es nun einwandfrei funktionsfähig.
Meine automatische Zeichnung für Blechteile hat jetzt eine weitere Saite am Bogen.
Vielen Dank!

1 „Gefällt mir“