CACHER ESQUISSE DANS TOUTES LES CONFIGURATIONS

Bonjour tout le monde, j'espère que vous allez bien.

j'ai une question concernant les esquisses.

J'ai une pièce qui comporte beaucoup de configurations de couleur.

Il y a une esquisse de base dans l'arborescence pour la construction des fonctions.

L'esquisse est visible dans toutes les configurations.

Je voudrais savoir si quelqu'un a une solution pour cacher cette esquisse dans toutes les configurations d'un seul coup ?

Car lorsque l'on regarde les propriétés de l'esquisse, on peut cocher "supprimée" et avoir l'option des configurations. Mais il n'y a rien pour cacher ...

Merci d'avance.

1 « J'aime »

Salut, regarde cette macro qui de mémoire fait le job. (cache toutes les esquisses de toutes les config)

Option Explicit

 

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim curFeature As Feature

Dim subFeature As Feature

Dim featureTypeName As String

Dim firstSub As Boolean

Dim Msg As String

Dim Style As Variant

Dim cfgNames As Variant

Dim cfg As Variant

Dim Title As String

Dim originalCfg As String

Dim lastCfg As String

 

Dim modView As ModelView

 

 

 

 

 

Sub main()

 

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

   

    If swModel.GetType <> swDocPART Then

        Msg = "Only Allowed on Part" ' Define message

        Style = vbOKOnly ' OK Button only

        Title = "Error" ' Define title

        Call MsgBox(Msg, Style, Title) ' Display error message

        Exit Sub ' Exit this program

    End If


    cfgNames = swModel.GetConfigurationNames

   

    originalCfg = swModel.GetActiveConfiguration.Name

    Debug.Print "Original Cfg:" & originalCfg

   

    For Each cfg In cfgNames

        swModel.ShowConfiguration2 cfg

        HideGeom swModel

        lastCfg = cfg

        Debug.Print "Last Cfg:" & lastCfg

    Next

   

    If Not lastCfg = originalCfg Then

        swModel.ShowConfiguration2 originalCfg

    End If

   

    Set modView = swModel.ActiveView

    modView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_ShadedWithEdges

    modView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_PerspectiveOff

   

    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDisplayAmbientOcclusionShadows, False

    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDisplayShadowsInShadedMode, False

   

    swModel.Extension.ViewDisplayRealView = False

   

    swModel.ShowNamedView2 "", swStandardViews_e.swIsometricView

    swModel.ViewZoomtofit2

   

    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swPerformanceVerifyOnRebuild, True

   

End Sub

 

Sub HideGeom(m As ModelDoc2)

   

    Set curFeature = m.FirstFeature()

    Do While Not curFeature Is Nothing

        featureTypeName = curFeature.GetTypeName2()

        If curFeature.Visible = swVisibilityState_e.swVisibilityStateShown And Not curFeature.IsSuppressed Then

            Select Case featureTypeName

                Case "RefPlane", "RefAxis", "CoordSys", "RefPoint", "ReferenceCurve"

                    Debug.Print "FeatureTypeName: " & curFeature.Name & " " & featureTypeName

                    curFeature.Select (False)

                    m.BlankRefGeom

                Case "ProfileFeature", "3DProfileFeature"

                    Debug.Print "FeatureTypeName: " & curFeature.Name & " " & featureTypeName

                    curFeature.Select (False)

                    m.BlankSketch

            End Select

        End If

       

        firstSub = True

        Set subFeature = curFeature.GetFirstSubFeature()

        Do While Not subFeature Is Nothing

            featureTypeName = subFeature.GetTypeName2()

            If subFeature.Visible = swVisibilityState_e.swVisibilityStateShown And Not subFeature.IsSuppressed Then

                Select Case featureTypeName

                    Case "RefPlane", "RefAxis", "CoordSys", "RefPoint", "ReferenceCurve"

                        If firstSub Then

                            Debug.Print "FeatureTypeName: " & subFeature.Name & " " & featureTypeName

                            firstSub = False

                        End If

                        Debug.Print vbTab & "FeatureTypeName: " & subFeature.Name & " " & featureTypeName

                        curFeature.Select (False)

                        m.BlankRefGeom

                    Case "ProfileFeature", "3DProfileFeature"

                        If firstSub Then

                            Debug.Print "FeatureTypeName: " & subFeature.Name & " " & featureTypeName

                            firstSub = False

                        End If

                        Debug.Print vbTab & "FeatureTypeName: " & subFeature.Name & " " & featureTypeName

                        curFeature.Select (False)

                        m.BlankSketch

                End Select

            End If

           

        Set subFeature = subFeature.GetNextSubFeature()

        Loop

       

    Set curFeature = curFeature.GetNextFeature()

    Loop

End Sub

 

4 « J'aime »

Voir ce lien entre autre

une macro qui fonctionne sous 2017 correspond à la demande

https://www.lynkoa.com/forum/conception-3d/est-il-possible-de-cacher-automatiquement-les-esquisses-et-%C3%A9l%C3%A9ments-de-construct

@+:-)

3 « J'aime »

Et bien un GRAND MERCI Shadenis, la macro fonctionne parfaitement bien et va me simplifier la vie !!!!

C'est PARFAIT.

Bonne journée

3 « J'aime »

Merci @gt22, la macro fonction sur la config active uniquement j'ai l'impression.

Par contre elle est intéressante pour son mode de fonctionnement avec choix multiples (esquisses, plans ...)

 

 

3 « J'aime »