Bonjour,
Est-il possible d'ajouter un label de vue en vba?
https://help.solidworks.com/2019/French/SolidWorks/sldworks/c_view_labels.htm
J'ai bien trouvé un code pour les lire mais rien sur la façon d'en créer un sur une vue.
Actuellement j'ajoute une note que je centre par rapport a la vue mais quand on change l'échelle de la feuille ou de la vue l'annotation n'est plus centré (contrairement a un label de vue crée de façon manuel.)
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
Bonjour sbadenis,
Je n'ai pas trouvé d'information VBA pour faire ce que tu souhaite ... Il est cependant possible de contourner ce problème en mettant le label de vue au moment de l'insertion de ta vue isométrique en modifiant les options du document. Cela est faisable à l'aide de vba en commençant par relever la valeur dans les options puis en la modifiant tel que souhaité avant de la remettre à sa valeur initiale après insertion de la vue.
Petit exemple :
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
Pour d'autres paramètres à modifier, Voir ICI.
Cordialement,
1 « J'aime »
Le code a l'air fonctionnel, mais pour l'instant cela n'ajoute rien, je regarde comment modifier l'option name pour y mettre "Symétrique" et comment modifier le calque pour mettre "Cotation" puis restaurer les paramètres d'origines.
Quand on modifie les 2 option manuellement et que l'on insère une vue manuellement cela fonctionne donc une fois les 2 options modifié en vba cela devrait marcher.
Après plusieurs essai cela ne fonctionne toujours pas j'ai essayé d'ajouter ça avant la création de la vue, sans que cela ne change quoi que ce soit:
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")
J'ai également essayé d'enlever la ligne pour décoché l'option et si je retourne dans le menu l'option (Autre/Ajouter un label de vue...)n'est pas coché ce que je trouve étonnant. (surtout que le debug.print me dit que l'option est true)
Code un peu plus complet qui fonctionne parfaitement pour moi, sous réserve de mettre un nom de fichier valide pour le sldprt et d'avoir le slddrw de commencé et d'ouvert dans 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
Cordialement,
1 « J'aime »
Je viens d'essayer et la vue est bien insérée mais pas de Label.
Résultat du Debug.Print:
1 - Faux
1 - Vrai
2 - 0
2 - 0
3 -
3 -
4 -
4 -
1 - Faux
Peux être quelque chose dans mes options générales qui bloque.
Peut tu me donner le résultat de ton de ton Debug.Print quand cela fonctionne? Cela m'aidera peut-être a identifier le problème.
Pour les Debug.print :
1 - Faux
1 - Vrai
2 - 1
2 - 1
3 -
3 - Symétrique
4 -
4 - Cotations
1 - Faux
C'est donc la valeur 2 qui te bloque sûrement. Tu as peut-être la valeur "Selon la norme" de cochée, ce que je n'ai pas. Si c'est le cas, essaye en la décochant ...
Si ça vient de là alors il faudra aussi la gérer par le code.
Cordialement,
1 « J'aime »
Bonjour,
Je viens d'ajouter ça (option selon la norme est bien coché):
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)
Le résultat:
1 - Faux
1 - Vrai
1.5 - Faux
1.5 - Vrai
2 - 0
2 - 0
3 - Symétrique
3 - Symétrique
4 -
4 -
1 - Faux
Mais pas de texte Symétrique sur la vue...
Il doit rester une option qui me bloque.
Bonjour,
Il y a du mélange dans l'air, remplace tes lignes par celles-ci :
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)
Cordialement,
1 « J'aime »
Problème résolu en ajoutant les 2 lignes ci-dessous
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Ma macro crée une vue déplié sur la feuille 1 ensuite j'ajoutais une feuille 2 mais swModel etSwDraw restait sur la 1ère feuille...
Maintenant ça fonctionne parfaitement.
Merci beaucoup pour l'aide @d.roger , j'ai encore appris plein de chose!
1 « J'aime »