Witam
Czy można dodać etykietę widoku VBA?
https://help.solidworks.com/2019/French/SolidWorks/sldworks/c_view_labels.htm
Znalazłem kod do ich odczytania, ale nic o tym, jak go utworzyć w widoku.
Obecnie dodaję notatkę, którą wyśrodkowuję w stosunku do widoku, ale po zmianie skali arkusza lub widoku adnotacja nie jest już wyśrodkowana (w przeciwieństwie do etykiety widoku utworzonej ręcznie).
Set swView = swDraw.CreateDrawViewFromModelView3(sOutputFolder + ".sldprt", "*Isométrique", 0.15, 0.17, 0)
swView.UseSheetScale = True
bRet = swView.SetDisplayMode3(False, swSHADED, False, True)
iDisplayIn = swDisplayTangentEdges_e.swTangentEdgesVisible
iDisplayIn = swDisplayTangentEdges_e.swTangentEdgesVisibleAndFonted
swView.SetDisplayTangentEdges2 (iDisplayIn)
swView.ReferencedConfiguration = V(i)
'************************************************************************
'Ci-dessous la partie à modifié pour avoir une note de type Label de vue
'************************************************************************
'On ajoute la note
Dim swNote As SldWorks.Note
Dim swAnnotation As SldWorks.Annotation
Dim ViewCorners As Variant
'get view corner locations
ViewCorners = swView.GetOutline
'lock view focus so note will move if corresponding view moved
swView.FocusLocked = True
'create note
Set swNote = swDraw.InsertNote("Symétrique")
'set note angle
swNote.Angle = 0
'set note to center justification
swNote.SetTextJustification (swTextJustificationCenter)
'set note is balloon to no
swNote.SetBalloon 0, 0
'get note annotation object
Set swAnnotation = swNote.GetAnnotation
'set note leader to none
swAnnotation.SetLeader2 False, 0, True, False, False, False
'locate note center and 5mm below from bottom edge of view bounding box
Dim Viewish As String
Viewish = (ViewCorners(0) + ViewCorners(2)) / 2
swAnnotation.SetPosition Viewish, ViewCorners(1) + 0.001, 0
'unlock view focus
swView.FocusLocked = False
Witaj sbadenis,
Nie znalazłem żadnych informacji VBA, aby zrobić to, co chcesz... Można jednak obejść ten problem, ustawiając etykietę widoku w momencie wstawiania widoku izometrycznego, zmieniając opcje dokumentu. Można to zrobić za pomocą vba, najpierw podnosząc wartość w opcjach, a następnie modyfikując ją zgodnie z potrzebami przed przywróceniem jej do wartości początkowej po wstawieniu widoku.
Mały przykład:
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim bret As Boolean
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Debug.Print "Vues autres - " & swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView)
bret = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView, True)
Set swView = swDraw.CreateDrawViewFromModelView3(sOutputFolder + ".sldprt", "*Isométrique", 0.15, 0.17, 0)
swView.UseSheetScale = True
bret = swView.SetDisplayMode3(False, swSHADED, False, True)
iDisplayIn = swDisplayTangentEdges_e.swTangentEdgesVisible
iDisplayIn = swDisplayTangentEdges_e.swTangentEdgesVisibleAndFonted
swView.SetDisplayTangentEdges2 (iDisplayIn)
bret = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView, False)
Debug.Print "Vues autres - " & swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView)
End Sub
Aby uzyskać informacje o innych ustawieniach, które można zmienić, zobacz TUTAJ.
Pozdrowienia
1 polubienie
Kod wygląda na funkcjonalny, ale na razie nic nie wnosi, zastanawiam się, jak zmodyfikować opcję nazwy, aby umieścić "Symetryczny" i jak zmodyfikować warstwę, aby umieścić "Wymiarowanie", a następnie przywrócić oryginalne ustawienia.
Gdy ręcznie zmodyfikujesz 2 opcje i wstawisz widok ręcznie, to działa, więc po zmodyfikowaniu 2 opcji w vba powinno działać.
Po kilku próbach nadal nie działa, próbowałem dodać to przed utworzeniem widoku, nie zmieniając niczego:
bRet = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingMiscView_Name, swUserPreferenceOption_e.swDetailingMiscView, swDetailingViewLabelsName_e.swDetailingViewLabelsName_custom)
bRet = swModel.Extension.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingMiscView_CustomName, swUserPreferenceOption_e.swDetailingMiscView, "Essai")
Próbowałem również usunąć linię, aby odznaczyć opcję i jeśli zwrócę opcję (Inne/Dodaj etykietę widoku...) w menunie jest zaznaczony, co mnie dziwi. (zwłaszcza, że debug.print mówi mi, że opcja jest prawdziwa)
Trochę bardziej kompletny kod, który działa dla mnie idealnie, pod warunkiem, że umieścisz poprawną nazwę pliku dla sldprt i uruchomisz i otworzysz slddrw w SW:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim DisplayIn As Integer
Dim bret As Boolean
Dim monFichierPrt as string
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
' Voir https://help.solidworks.com/2021/English/api/swconst/DP_ViewLabels-Other.htm
Dim bRetNameView As Boolean
bRetNameView = swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView)
Debug.Print "1 - " & bRetNameView
bret = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView, True)
Debug.Print "1 - " & swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView)
Dim bIntNameViewType As Integer
bIntNameViewType = swModel.Extension.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingMiscView_Name, swUserPreferenceOption_e.swDetailingMiscView)
Debug.Print "2 - " & bIntNameViewType
bret = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingMiscView_Name, swUserPreferenceOption_e.swDetailingMiscView, swDetailingViewLabelsName_custom)
Debug.Print "2 - " & bIntNameViewType
Dim bStringNameView As String
bStringNameView = swModel.Extension.GetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingMiscView_CustomName, swUserPreferenceOption_e.swDetailingSectionView)
Debug.Print "3 - " & bStringNameView
bret = swModel.Extension.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingMiscView_CustomName, swUserPreferenceOption_e.swDetailingMiscView, "Symétrique")
Debug.Print "3 - " & swModel.Extension.GetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingMiscView_CustomName, swUserPreferenceOption_e.swDetailingSectionView)
Dim bStringNameLayer As String
bStringNameLayer = swModel.Extension.GetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingLayer, swUserPreferenceOption_e.swDetailingMiscView)
Debug.Print "4 - " & bStringNameLayer
bret = swModel.Extension.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingLayer, swUserPreferenceOption_e.swDetailingMiscView, "Cotations")
Debug.Print "4 - " & swModel.Extension.GetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingLayer, swUserPreferenceOption_e.swDetailingMiscView)
Set swView = swDraw.CreateDrawViewFromModelView3(sOutputFolder + ".sldprt", "*Isométrique", 0.15, 0.17, 0)
swView.UseSheetScale = True
bret = swView.SetDisplayMode3(False, swSHADED, False, True)
DisplayIn = swDisplayTangentEdges_e.swTangentEdgesVisible
DisplayIn = swDisplayTangentEdges_e.swTangentEdgesVisibleAndFonted
swView.SetDisplayTangentEdges2 (DisplayIn)
bret = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView, bRetNameView)
Debug.Print "1 - " & swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_AddViewLabelOnViewCreation, swUserPreferenceOption_e.swDetailingMiscView)
End Sub
Pozdrowienia
1 polubienie
Właśnie próbowałem i widok jest dobrze wstawiony, ale bez etykiety.
Wynik debugowania.druku:
1 - Fałsz
1 - Prawda
2 - 0
2 - 0
3 -
3 -
4 -
4 -
1 - Fałsz
Może coś w moich ogólnych opcjach, co się blokuje.
Czy możesz podać mi wynik swojego Debug.Print, gdy działa? Może to pomoże mi zidentyfikować problem.
Dla Debug.print:
1 - Fałsz
1 - Prawda
2 - 1
2 - 1
Rozdział 3 -
3 - Symetryczny
Pozycja 4 -
4 - Cytaty
1 - Fałsz
Więc to wartość 2 prawdopodobnie Cię blokuje. Możesz mieć zaznaczoną wartość "Zgodnie z normą", czego ja nie robię. Jeśli tak, spróbuj odznaczyć to...
Jeśli pochodzi stamtąd, to również będzie musiał być zarządzany przez kod.
Pozdrowienia
1 polubienie
Witam
Właśnie dodałem to (opcja według standardu jest zaznaczona):
Dim bRetViewOption As Boolean
bRetViewOption = swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_PerStandard, swUserPreferenceOption_e.swDetailingMiscView)
Debug.Print "1.5 - " & bRetNameView
bRet = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_PerStandard, swUserPreferenceOption_e.swDetailingMiscView, True)
Debug.Print "1.5 - " & swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_PerStandard, swUserPreferenceOption_e.swDetailingMiscView)
Efekt:
1 - Fałsz
1 - Prawda
1.5 - Fałsz
1.5 - Prawda
2 - 0
2 - 0
3 - Symetryczny
3 - Symetryczny
4 -
4 -
1 - Fałsz
Ale w widoku nie ma symetrycznego tekstu...
Musi być jedna opcja, która mnie blokuje.
Witam
W powietrzu unosi się trochę mieszania, zastąp swoje linie tymi:
Dim bRetViewOption As Boolean
bRetViewOption = swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_PerStandard, swUserPreferenceOption_e.swDetailingMiscView)
'Debug.Print "1.5 - " & bRetNameView
Debug.Print "1.5 - " & bRetViewOption
bret = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_PerStandard, swUserPreferenceOption_e.swDetailingMiscView, False)
Debug.Print "1.5 - " & swModel.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingMiscView_PerStandard, swUserPreferenceOption_e.swDetailingMiscView)
Pozdrowienia
1 polubienie
Problem rozwiązany przez dodanie 2 wierszy poniżej
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Moje makro tworzy rozwinięty widok na arkuszu 1, a następnie dodałem arkusz 2, ale swModel i SwDraw pozostały na 1. arkuszu...
Teraz działa idealnie.
Bardzo dziękuję za pomoc @d.roger, dowiedziałem się o wiele więcej!
1 polubienie