Hello
Is it possible to add a VBA view label?
https://help.solidworks.com/2019/French/SolidWorks/sldworks/c_view_labels.htm
I did find a code to read them but nothing on how to create one on a view.
Currently I add a note that I center in relation to the view but when you change the scale of the sheet or the view the annotation is no longer centered (unlike a view label created manually.)
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
Hello sbadenis,
I haven't found any VBA information to do what you want ... However, it is possible to get around this problem by setting the view label at the time of inserting your isometric view by changing the document options. This can be done using vba by first raising the value in the options and then modifying it as desired before returning it to its initial value after inserting the view.
Small example:
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
For other settings to change, see HERE.
Kind regards
1 Like
The code looks functional, but for now it doesn't add anything, I'm looking at how to modify the name option to put "Symmetrical" and how to modify the layer to put "Dimensioning" and then restore the original settings.
When you modify the 2 options manually and insert a view manually, it works, so once the 2 options are modified in vba, it should work.
After several tries it still doesn't work, I tried to add this before the creation of the view, without it changing anything:
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")
I also tried to remove the line to uncheck the option and if I return the option (Other/Add View Label...) in the menu is not ticked which I find surprising. (especially since the debug.print tells me that the option is true)
A little more complete code that works perfectly for me, provided you put a valid filename for the sldprt and have the slddrw started and open in 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
Kind regards
1 Like
I just tried and the view is well inserted but no Label.
Debug.Print Result:
1 - False
1 - True
2 - 0
2 - 0
3 -
3 -
4 -
4 -
1 - False
Maybe something in my general options that is blocking.
Can you give me the result of your Debug.Print when it works? Maybe this will help me identify the problem.
For Debug.print:
1 - False
1 - True
2 - 1
2 - 1
3 -
3 - Symmetrical
4 -
4 - Quotes
1 - False
So it's the value 2 that is probably blocking you. You may have the value "According to the standard" checked, which I don't. If so, try unchecking it...
If it comes from there, then it will also have to be managed by code.
Kind regards
1 Like
Hello
I just added this (option according to the standard is checked):
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)
The result:
1 - False
1 - True
1.5 - False
1.5 - True
2 - 0
2 - 0
3 - Symmetrical
3 - Symmetrical
4 -
4 -
1 - False
But no Symmetrical text on the view...
There must be one option that blocks me.
Hello
There's some mixing in the air, replace your lines with these:
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)
Kind regards
1 Like
Problem solved by adding the 2 lines below
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
My macro creates an unfolded view on sheet 1 then I added a sheet 2 but swModel and SwDraw stayed on the 1st sheet...
Now it works perfectly.
Thank you very much for the help @d.roger, I learned a lot more!
1 Like