In einem Makro bekomme ich sowohl die Breite der Ansicht als auch ihre Höhe und wenn die Breite größer als die Höhe ist, möchte ich die Ansicht um 90° drehen
Das Makro ist fast funktionsfähig, aber Sie müssen die Ansicht manuell auswählen, während ich möchte, dass diese Ansichtsauswahl automatisch erfolgt.
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
Ich habe mehrere Dinge mit dem Auswahlmanager ausprobiert und auch die Ansicht aktiv zu machen, aber im Moment keine funktionierende Lösung.
Seien Sie vorsichtig, das Ändern des Winkels einer Ansicht wirkt sich je nach Position auf die anderen Ansichten aus (z. B. wird die rechte Ansicht komplett neu berechnet, wenn die Vorderansicht gedreht wird).
Nein, immer noch nichts, die Ansicht dreht sich immer noch nur, wenn Sie die Ansicht manuell auswählen...
Ich glaube, ich hatte diese Lösung oder etwas sehr Naheliegendes bereits ausprobiert.
Zu Ihrer Information, keine Sorgen über die Neuberechnung der anderen Ansichten, da nur eine Ansicht in mein Blatt eingefügt wird (die flache Ansicht eines Blattes)
Ziel ist es, Blechzeichnungen für uns zu automatisieren.
Seltsam, die 2 Lösungen funktionieren für mich, ist es eine Standardansicht aus einem 3D? Können Sie mir eine Komposition für einen Raum zum Mitnehmen mit dem Plan schicken, bei dem sie nicht funktioniert?
Wenn Sie eine neue Ebene laden, auf der sich die Ansicht drehen muss, funktioniert das?
Ihre Ansicht befindet sich nach dem Drehen in einem 90°-Winkel, aber dieser Parameter ist nicht inkrementell (damit meine ich, dass die Funktion nicht "Ich drehe die Ansicht um 90°", sondern "Ich stelle die Ansicht auf 90°" entspricht), wenn Ihre Ansicht also bereits gedreht wurde, ändert sie sich kein zweites Mal. Wenn Sie möchten, können Sie die Zeile "swView.Angle = 0" in den "Else"-Block einfügen, um ihn so testen zu lassen, dass er sich jedes Mal drehen sollte.
Hier sehen Sie ein Beispiel für eine angehängte Datei.
Für den Winkel habe ich vorher systematisch auf 0° gesetzt. Es ändert sich aber nichts (auch nicht mit dem Zusatz in der else)
Ich habe auch versucht, die Zeilen "Do while Not" und "Set swView = swView.GetNextView" in die Kommentare zu setzen, da ich keine nächste Ansicht habe, aber keine bessere.
Für mich funktioniert es perfekt mit Ihrer Zeichnung und mit folgendem Makro:
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
Um die SW-Optionen einzuchecken, wenn Sie keine Einstellung haben, die Ansichten oder MeP blockiert, befinde ich mich in SW 2019.