Solidworks vba wszystkie widoki skali arkusza

Witam

Importuję wszystkie części zespołu do MEP, płaski

Zmieniam skalę arkuszy ręcznie i chcę, aby wszystkie widoki przyjmowały skalę bieżącego arkusza (zaznaczony przycisk radiowy: "Użyj skali arkusza"), tak aby jeśli zmienię skalę arkusza, wszystkie widoki zmienią skalę

 

Czy masz pomysł na makra, które przetwarzają wszystkie karty instalacji w celu skalowania wszystkich widoków karty?

Dziękuję

Witam;

Uważam, że dziwne jest przechodzenie przez makro w tym celu... Ale oto przykład, nad którym warto popracować:

'This example shows how to set the scale of a selected drawing view.

'---------------------------------------------
' Preconditions:
' 1. Open public_documents\introsw\bolt-assembly.slddrw.
' 2. Select a drawing view.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Increases the selected drawing view's scale.
' 2. Examine the drawing and Immediate window.
'
' NOTE: Because the drawing is used elsewhere, do not
' save changes.
'---------------------------------------------

Option Explicit

Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swView As SldWorks.View
    Dim vScaleRatio As Variant
    Dim bRet As Boolean

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSelMgr = swModel.SelectionManager
    Set swView = swSelMgr.GetSelectedObject6(1, -1)

    vScaleRatio = swView.ScaleRatio

    Debug.Print "File = " & swModel.GetPathName
    Debug.Print "  View = " & swView.Name
    Debug.Print "    Use sheet scale = " & CBool(swView.UseSheetScale)
    Debug.Print "    Original scale ratio = " & vScaleRatio(0) & ":" & vScaleRatio(1)
    Debug.Print "    Original decimal scale value = " & swView.ScaleDecimal

    ' Increase scale values
    ' Changing scale sets IView::UseSheetScale to false
    vScaleRatio = swView.ScaleRatio
    swView.ScaleDecimal = swView.ScaleDecimal * 2#
    vScaleRatio = swView.ScaleRatio
    Debug.Print ""
    Debug.Print "    Use sheet scale = " & CBool(swView.UseSheetScale)
    Debug.Print "    New scale ratio = " & vScaleRatio(0) & ":" & vScaleRatio(1)
    Debug.Print "    New decimal scale value = " & swView.ScaleDecimal

    ' Rebuild to see the scaled drawing view
    bRet = swModel.EditRebuild3: Debug.Assert bRet

End Sub

Źródło: https://help.solidworks.com/2017/english/api/sldworksapi/Set_View_Scale_Example_VB.htm

Pozdrowienia.

1 polubienie

Dzięki za odpowiedź, ale nie wiem, jak zapętlić wszystkie widoki i zastosować skalę tabulatora za pomocą opcji przycisku radiowego "użyj skali arkusza"

Dim swApp As Object
Dim Part As DrawingDoc
Dim currentSheet As Sheet
Dim boolstatus As Boolean
Dim SwModel As SldWorks.ModelDoc2
Dim swDraw  As SldWorks.DrawingDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swView  As SldWorks.View
Dim vScaleRatio As Variant


Sub Echelle_Feuille_Vues()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

'Feuille
Set currentSheet = Part.GetCurrentSheet
vScaleRatio = currentSheet.GetProperties
Debug.Print ("Échelle Feuille = " & vScaleRatio(2) & " : " & vScaleRatio(3))
a = vScaleRatio(2)
b = vScaleRatio(3)

'Vue
Set swDraw = SwModel
Set SwModel = swApp.ActiveDoc
Set swSelMgr = SwModel.SelectionManager
Set swView = swSelMgr.GetSelectedObject5(1)
vScaleRatio = swView.ScaleRatio
Debug.Print ("Échelle vue = " & vScaleRatio(0) & " : " & vScaleRatio(1))
swView.ScaleDecimal = a / b


boolstatus = SwModel.EditRebuild

End Sub

Napisałem fragment kodu, ale nie jest on zadowalający

Nie znalazłem, jak zapętlić wszystkie widoki arkusza (karty) i sprawdzić przycisk radiowy

jeśli ktoś ma pomysł

 

Oto przykładowy kod do zapętlania wszystkich widoków w arkuszu:

'This example shows how to get the display state for each drawing view.

'------------------------------------------------------
' Preconditions:
' 1. Open a drawing.
' 2. Open the Immediate window.
'
' Postconditions:
' 1. Traverses the drawing views on the current sheet and 
'    gets each drawing view's display state.
' 2. Examine the Immediate window.
'
' NOTE: Because the drawing is used elsewhere, do not
' save changes.
'------------------------------------------------------
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

    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    Set swView = swDraw.GetFirstView

    Debug.Print "File = " & swModel.GetPathName
    Debug.Print "  " & swSheet.GetName

    While Not swView Is Nothing
        Debug.Print "    " & swView.GetName2 & " [" & swView.DisplayState & "]"
        Set swView = swView.GetNextView
    Wend

End Sub

Źródło: https://help.solidworks.com/2022/english/api/sldworksapi/Get_Display_State_for_Each_Drawing_View_Example_VB.htm

Dziękuję za odpowiedzi, jeśli ktoś ma pomysł na przycisk radiowy, jestem zainteresowany

Oto makro, które zajmuje się kartą/arkuszem

Sub Echelle_Feuille_Vues()
'MEP changer l'échelle des vues
'1 : Bouton radio "échelle de la feuille"
'2 : Échelle personnalisée


Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Part As DrawingDoc
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swView As SldWorks.View
Dim swSelMgr As SldWorks.SelectionMgr
Dim bRet As Boolean
Dim currentSheet As Sheet
Dim vScaleRatio As Variant
Dim boolstatus As Boolean

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
Set swView = swDraw.GetFirstView
Set swSelMgr = swModel.SelectionManager

'Feuille
Set currentSheet = Part.GetCurrentSheet
'vScaleRatio = currentSheet.GetProperties '2-Éch. perso.
'Debug.Print ("Échelle Feuille = " & vScaleRatio(2) & " : " & vScaleRatio(3))
'a = vScaleRatio(2) '2-Éch. perso.
'b = vScaleRatio(3) '2-Éch. perso.

'Vue
While Not swView Is Nothing
    vScaleRatio = swView.ScaleRatio
    'Debug.Print ("Échelle vue = " & vScaleRatio(0) & " : " & vScaleRatio(1))
    'swView.ScaleDecimal = a / b '2-Éch. perso.
    'Bouton radio "utiliser l'échelle de la feuille"
    swView.UseSheetScale = True '1-BT radio
    swView.UpdateViewDisplayGeometry '1-BT radio
Set swView = swView.GetNextView
Wend

boolstatus = swModel.EditRebuild
End Sub

 

Witam;

Jeśli używasz proporcji:

'Debug.Print ("Échelle vue = " & vScaleRatio(0" : " & vScaleRatio(1))

W miejsce wartości podanej w:

Debug.Print "    Use sheet scale = " & CBool(swView.UseSheetScale)


Przycisk radiowy nigdy nie może być aktywny....
Pozdrowienia.

Witam

Dlatego umieszczam 2 w makrze, albo (1-) przycisk radiowy, albo (2-) niestandardową skalę