Macroverbeteringsverandering uitgeklapte zijde op plaatwerk

Macro
1

Hallo
Ik ben op zoek naar een macro die zeer regelmatig wordt gebruikt.
Deze macro is zeer functioneel op alle recente plaatwerk onderdelen maar werkt niet op oudere onderdelen (zonder plaatwerk rugleuning)
Als iemand een idee heeft om het functioneel te maken voor de 2 bijgevoegde vellen.

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

Het oorspronkelijke onderwerp of @Lynkoa15 had me gevonden, de huidige oplossing functioneel op 92% blijft de 8% van het oudere deel.
Nieuw.SLDPRT (245.2 KB)
Oud.SLDPRT (578.4 KB)
In de documenten die niet het uitgeklapte staatsdossier hebben:
image
Hoe hard ik ook kijk, ik kan mijn keuze niet maken om vervolgens het gezicht op hem toe te passen.

2

Geen idee of het helpt, maar onmogelijk om thuis met de hand uit te vouwen (SW 2024 SP01) zonder de functie " Uitvouwen " te doorlopen, meestal geven we de voorkeur aan de functie " Afvlakken ", maar in dit geval niet functioneel. Zelfs het converteren van uw bestand naar mijn huidige versie.

image
afbeelding942×321 23.6 KB

image
Afbeelding873×362 33.1 KB

1 like
3

Hallo @sbadenis
Inderdaad, de functie get_flat_feature() richt zich rechtstreeks op de map met uitgeklapte functies (om de prestaties te optimaliseren), maar deze map lijkt niet te bestaan voor deze oude onderdelen, ik raad u aan om alle functies met deze functie te doorlopen,

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, probeer het verwijderen van de vouwen ongedaan te maken (soms doet sw dit niet automatisch door uitgevouwen toestand te selecteren)
Capture (SW22 getest)

2 likes
5

Het werkt, petje af!

image
afbeelding1045×669 83.1 KB

2 likes
6

Ja, mijn macro in de foutopsporingsmodus had deze functies verwijderd. Niets ernstigs.

7

Bedankt @Lynkoa15 ik iets soortgelijks had geprobeerd, maar zonder erin te slagen het te laten werken.
Voorlopig is het nu perfect functioneel.
Mijn automatische tekening voor plaatwerkonderdelen bevat nu nog een snaar op de boog.
Bedankt!

1 like