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..