Obrót widoku makr

Witam

W makrze otrzymuję szerokość widoku, a także jego wysokość, a jeśli szerokość jest większa niż wysokość, chcę obrócić widok o 90°

Makro jest prawie funkcjonalne, ale musisz wybrać widok ręcznie, podczas gdy ja chciałbym, aby ten wybór widoku był automatyczny.

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

Próbowałem kilku rzeczy za pomocą menedżera wyboru, a także aby uaktywnić widok, ale na razie nie ma działającego rozwiązania.

Witam

Spróbuj postawić linię:

bRet = swModel.Extension.SelectByID2(swView.Name, "DRAWINGVIEW", 0, 0, 0, Fałsz, 0, Nic, 0)

Tuż przed linią:

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

Bądź ostrożny, zmiana kąta jednego widoku wpłynie na inne widoki w zależności od ich położenia (na przykład prawy widok zostanie całkowicie przeliczony, jeśli widok z przodu zostanie obrócony).

Pozdrowienia

1 polubienie

Lub inne rozwiązanie, postaw linię:

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

W miejsce linii:

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

Pozdrowienia

1 polubienie

Nie, nadal nic, widok nadal obraca się tylko wtedy, gdy wybierzesz widok ręcznie...

Myślę, że już wypróbowałem to rozwiązanie lub coś bardzo zbliżonego.

FYI, nie ma obaw o ponowne obliczanie innych widoków, ponieważ w moim arkuszu wstawiany jest tylko jeden widok (widok  płaskiego wzoru arkusza)

Celem jest dla nas automatyzacja rysowania blach.

Dziwne, te 2 rozwiązania działają dla mnie, czy to standardowy widok z 3D? Czy możesz wysłać mi jednoosobową kompozycję na wynos do domu wraz z planem, na którym nie działa?

Pozdrowienia

Czy wczytywanie nowej płaszczyzny, po której widok musi zostać obrócony, to działa?

Twój widok, po obróceniu, jest pod kątem 90°, ale ten parametr nie jest przyrostowy (rozumiem przez to, że funkcja nie odpowiada "Obracam widok o 90°", ale odpowiada "Ustawiam widok pod kątem 90°"), więc jeśli Twój widok został już obrócony, nie zmieni się po raz drugi. Jeśli chcesz, możesz umieścić linię "swView.Angle = 0" w bloku "Else", aby przetestować ją tak, aby obracała się za każdym razem.

Pozdrowienia

 

1 polubienie

Witam

Oto przykład załączonego pliku.

Dla kąta, który wcześniej systematycznie ustawiałem na 0°. ale nic się nie zmienia (ani z dodatkiem w innym)

Próbowałem również umieścić wiersze "Rób, gdy nie" i "Ustaw swView = swView.GetNextView" w komentarzach, ponieważ nie mam następnego widoku, ale nie lepszego.

 


test_decoupe.zip

Witam

Dla mnie działa idealnie z Twoim rysunkiem i z następującym makrem:

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

Aby sprawdzić w opcjach oprogramowania, czy nie masz ustawienia, które blokuje widoki lub MeP, korzystam z oprogramowania SW 2019.

Pozdrowienia

1 polubienie

Dziękuję, zgadza się, właśnie zobaczyłem, że mój stan nie jest dobry:

'If width > height Then

I cały problem tkwił od tego momentu.