Macro rotation de la vue

Bonjour,

Dans une macro je récupère la largeur de la vue ainsi que sa hauteur et si la largeur est plus importante que la hauteur je souhaite tourner la vue de 90°

La macro est presque fonctionnelle mais il faut sélectionner la vue manuellement alors que je voudrais que cette sélection de vue soit automatique.

Option Explicit

Sub main()

    Dim swApp           As SldWorks.SldWorks
    Dim swModel         As SldWorks.ModelDoc2
    Dim swDraw          As SldWorks.DrawingDoc
    Dim swSheet         As SldWorks.sheet
    Dim swView          As SldWorks.View
    Dim swActiveView    As SldWorks.View
    Dim bRet            As Boolean
    Dim outline()       As Double
    Dim pos()           As Double
    Dim fileName        As String
    Dim errors          As Long
    Dim warnings        As Long
    Dim vSheetProps     As Variant
    Dim width           As Long
    Dim height          As Long
    Dim Pi              As Double
    
  
    'On récupère la MEP active
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    


    

    ' Set PI
    Pi = 4 * Atn(1)
    
    'Debug.Print "File = " & swModel.GetPathName
    'Debug.Print "  Sheet = " & swSheet.GetName
    'Debug.Print "    Template = " & swSheet.GetTemplateName



    
    
    

    Set swApp = CreateObject("SldWorks.Application")
    
    fileName = swModel.GetPathName
    Set swDraw = swApp.OpenDoc6(fileName, swDocumentTypes_e.swDocDRAWING, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
    Set swView = swDraw.GetFirstView


    Do While Not swView Is Nothing
        outline = swView.GetOutline
        pos = swView.Position

        width = (outline(2) * 1000) - outline(0) * 1000
        Debug.Print "width" & width
        height = (outline(3) * 1000) - outline(1) * 1000
        Debug.Print "height" & height
        
        'On vérifie si la pièce est plus large que haute
        If width < height Then
            Debug.Print "Pièce plus large que haute"

            ' Rotation de la vue suivant angle indiqué

            bRet = swDraw.DrawingViewRotate(90 / (180 / Pi))    'Angle de rotation/(180/Pi) pour passer de radian en °

            

            
        Else
            Debug.Print "Pièce plus haute que large"

            
        End If
        
        
        ' On récupère l'échelle
        'vSheetProps = swSheet.GetProperties
        'Debug.Print "      Scale1         = " & vSheetProps(2)
        'Debug.Print "      scale2         = " & vSheetProps(3)
        'On redimensionne la vue

        Set swView = swView.GetNextView
    Loop




End Sub

J'ai essayé plusieur chose avec selection manager et aussi de rendre la vue active mais pour l'instant pas de solution fonctionnel.

Bonjour,

Essaye en mettant la ligne :

bRet = swModel.Extension.SelectByID2(swView.Name, "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)

juste avant la ligne :

bRet = swDraw.DrawingViewRotate(90 / (180 / Pi))

Attention, le fait de changer l'angle d'une vue va jouer sur les autres vues suivant leurs positions (par exemple, la vue de droite va être complètement recalculée si la vue de face est pivotée).

Cordialement,

1 « J'aime »

Ou autre solution, mettre la ligne :

swView.Angle = (90 / (180 / Pi))

En lieu et place de la ligne :

bRet = swDraw.DrawingViewRotate(90 / (180 / Pi))

Cordialement,

1 « J'aime »

Non, toujours rien la vue ne pivote toujours que si on selectionne la vue manuellement...

Je crois d'ailleure que j'avais déjà essayé cette solution ou quelque chose de très proche.

Pour info pas de soucis de recalcul des autres vues puisque une seule vues est inséré sur ma feuille (la vue de  flat-pattern d'une tôle)

Le but est jute d'automatisé les mises en plan de tôlerie pour nous.

Bizarre, les 2 solutions fonctionnent pour moi, c'est bien une vue standard issue d'un 3D ? Peux-tu me transmettre une compo à emporter d'une pièce plus son plan sur lequel ça ne fonctionne pas ?

Cordialement,

Si tu charge un nouveau plan sur lequel la vue doit pivoter est-ce que cela fonctionne ?

Ta vue, une fois pivotée, est à un angle de 90° hors ce paramètre n'est pas incrémental (j'entends par là que la fonction ne correspond pas à "je tourne la vue de 90°" mais correspond à "je met la vue à 90°") donc si ta vue à déjà subie une rotation elle ne changera pas une deuxième fois. Si tu veux tu peux mettre la ligne "swView.Angle = 0" dans le bloc "Else" pour la faire test tests comme ça elle devrait pivoter à chaque fois.

Cordialement,

 

1 « J'aime »

Bonjour,

Voici ci-joint un exemple de fichier joint.

Pour l'angle je remet à 0° systématiquement avant. mais rien ne change (ni avec l'ajout dans le else)

J'ai aussi tenté te mettre les lignes "Do while Not" et "Set swView = swView.GetNextView" en commentaire puisque je n'ai pas de vue suivante mais pas mieux.

 


test_decoupe.zip

Bonjour,

Pour moi ça marche parfaitement avec ta mise en plan et avec la macro suivante :

Option Explicit

Sub main()

    Dim swApp           As SldWorks.SldWorks
    Dim swModel         As SldWorks.ModelDoc2
    Dim swDraw          As SldWorks.DrawingDoc
    Dim swSheet         As SldWorks.Sheet
    Dim swView          As SldWorks.View
    Dim swActiveView    As SldWorks.View
    Dim bRet            As Boolean
    Dim outline()       As Double
    Dim pos()           As Double
    Dim fileName        As String
    Dim errors          As Long
    Dim warnings        As Long
    Dim vSheetProps     As Variant
    Dim width           As Long
    Dim height          As Long
    Dim Pi              As Double

    'On récupère la MEP active
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet

    ' Set PI
    Pi = 4 * Atn(1)
    
    'Debug.Print "File = " & swModel.GetPathName
    'Debug.Print "  Sheet = " & swSheet.GetName
    'Debug.Print "    Template = " & swSheet.GetTemplateName

    Set swApp = CreateObject("SldWorks.Application")
    
    fileName = swModel.GetPathName
    Set swDraw = swApp.OpenDoc6(fileName, swDocumentTypes_e.swDocDRAWING, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
    Set swView = swDraw.GetFirstView

    Do While Not swView Is Nothing
        outline = swView.GetOutline
        pos = swView.Position

        Debug.Print swView.Name
        
        width = (outline(2) * 1000) - outline(0) * 1000
        Debug.Print "width" & width
        height = (outline(3) * 1000) - outline(1) * 1000
        Debug.Print "height" & height
        
        'On vérifie si la pièce est plus large que haute
        'If width > height Then
        If height < width Then
            Debug.Print "Pièce plus large que haute"

            ' Rotation de la vue suivant angle indiqué

            'bRet = swModel.Extension.SelectByID2(swView.Name, "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
            'bRet = swDraw.DrawingViewRotate(90 / (180 / Pi))    'Angle de rotation/(180/Pi) pour passer de radian en °
    
            swView.Angle = (90 / (180 / Pi))
        Else
            swView.Angle = 0
            Debug.Print "Pièce plus haute que large"
        End If

        ' On récupère l'échelle
        'vSheetProps = swSheet.GetProperties
        'Debug.Print "      Scale1         = " & vSheetProps(2)
        'Debug.Print "      scale2         = " & vSheetProps(3)
        'On redimensionne la vue

        Set swView = swView.GetNextView
    Loop

End Sub

A vérifier dans les options de SW si tu n'as pas un paramètre qui bloque les vues ou MeP, je suis sous SW 2019.

Cordialement,

1 « J'aime »

Merci, c'est bien ça, je venais juste de voir aussi que ma condition n'était pas bonne:

'If width > height Then

Et tout le problème venait de là depuis le début..