In een macro krijg ik zowel de breedte van het scherm als de hoogte en als de breedte groter is dan de hoogte, wil ik het beeld 90° draaien
De macro is bijna functioneel, maar je moet de weergave handmatig selecteren, terwijl ik graag zou willen dat deze weergaveselectie automatisch is.
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
Ik heb verschillende dingen geprobeerd met selectiemanager en ook om de weergave actief te maken, maar voor nu geen werkende oplossing.
Wees voorzichtig, het wijzigen van de hoek van de ene weergave heeft invloed op de andere weergaven, afhankelijk van hun posities (de rechterweergave wordt bijvoorbeeld volledig opnieuw berekend als de vooraanzicht wordt gedraaid).
Nee, nog steeds niets, de weergave draait nog steeds alleen als je de weergave handmatig selecteert...
Ik denk dat ik deze oplossing al had geprobeerd of iets heel dichtbij.
Ter info, ik hoef me geen zorgen te maken over het herberekenen van de andere weergaven, aangezien er maar één weergave op mijn blad wordt ingevoegd (de platte patroonweergave van een blad)
Het doel is om plaatwerktekeningen voor ons te automatiseren.
Raar, de 2 oplossingen werken voor mij, is het een standaard weergave van een 3D? Kunt u mij een samenstelling voor één kamer om mee naar huis te nemen plus het plan waarop het niet werkt?
Als u een nieuw vlak laadt waarop de weergave moet draaien, werkt het dan?
Uw weergave staat, eenmaal gedraaid, in een hoek van 90°, maar deze parameter is niet incrementeel (hiermee bedoel ik dat de functie niet overeenkomt met "Ik draai de weergave 90°" maar overeenkomt met "Ik zet de weergave op 90°"), dus als uw weergave al een rotatie heeft ondergaan, zal deze geen tweede keer veranderen. Als je wilt kun je de regel "swView.Angle = 0" in het "Else" blok zetten om het te testen zodat het elke keer zou moeten draaien.
Voor de hoek heb ik systematisch ingesteld op 0° voorheen. maar er verandert niets (ook niet met de toevoeging in de else)
Ik heb ook geprobeerd om de regels "Do while Not" en "Set swView = swView.GetNextView" in opmerkingen te zetten, omdat ik geen volgende weergave heb, maar geen betere.
Voor mij werkt het perfect met je tekening en met de volgende macro:
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
Om de SW-opties in te checken als je geen instelling hebt die weergaven of MeP blokkeert, ben ik op SW 2019.