Hallo
Is het mogelijk om een VBA-weergavelabel toe te voegen?
https://help.solidworks.com/2019/French/SolidWorks/sldworks/c_view_labels.htm
Ik heb wel een code gevonden om ze te lezen, maar niets over hoe je er een kunt maken op een weergave.
Momenteel voeg ik een notitie toe die ik centreer ten opzichte van de weergave, maar wanneer u de schaal van het blad of de weergave wijzigt, wordt de annotatie niet langer gecentreerd (in tegenstelling tot een weergavelabel dat handmatig is gemaakt).
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
Hallo sbadenis,
Ik heb geen VBA-informatie gevonden om te doen wat je wilt ... Het is echter mogelijk om dit probleem te omzeilen door het weergavelabel in te stellen op het moment dat uw isometrische weergave wordt ingevoegd door de documentopties te wijzigen. Dit kan worden gedaan met behulp van vba door eerst de waarde in de opties te verhogen en deze vervolgens naar wens aan te passen voordat deze na het invoegen van de weergave weer naar de oorspronkelijke waarde wordt teruggebracht.
Klein voorbeeld:
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
Voor andere instellingen die kunnen worden gewijzigd, zie HIER.
Vriendelijke groeten
1 like
De code ziet er functioneel uit, maar voorlopig voegt het niets toe, ik ben aan het kijken hoe ik de naamoptie kan wijzigen om "Symmetrisch" te zetten en hoe ik de laag kan wijzigen om "Dimensionering" te zetten en vervolgens de originele instellingen te herstellen.
Wanneer u de 2 opties handmatig wijzigt en handmatig een weergave invoegt, werkt het, dus zodra de 2 opties in vba zijn gewijzigd, zou het moeten werken.
Na verschillende pogingen werkt het nog steeds niet, ik heb geprobeerd dit toe te voegen voor het maken van de weergave, zonder dat het iets veranderde:
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")
Ik heb ook geprobeerd de regel te verwijderen om de optie uit te vinken en als ik de optie (Andere/Weergavelabel toevoegen...) in het menu terugzetis niet aangevinkt, wat ik verrassend vind. (vooral omdat de debug.print me vertelt dat de optie waar is)
Een iets completere code die perfect werkt voor mij, op voorwaarde dat je een geldige bestandsnaam voor de sldprt en de slddrw start en opent 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
Vriendelijke groeten
1 like
Ik heb het net geprobeerd en de weergave is goed ingevoegd, maar geen label.
Debug.Print Resultaat:
1 - Onwaar
1 - Waar
2 - 0
2 - 0
3 -
3 -
4 -
4 -
1 - Onwaar
Misschien iets in mijn algemene opties dat blokkeert.
Kunt u mij het resultaat van uw Debug.Print geven wanneer het werkt? Misschien helpt dit me om het probleem te identificeren.
Voor Debug.print:
1 - Onwaar
1 - Waar
2 - 1
2 - 1
3 -
3 - Symmetrisch
4 -
4 - Aanhalingstekens
1 - Onwaar
Het is dus de waarde 2 die je waarschijnlijk blokkeert. Het kan zijn dat je de waarde "Volgens de norm" hebt aangevinkt, wat ik niet doe. Als dit het geval is, probeer het dan uit te vinken...
Als het daar vandaan komt, dan zal het ook door code moeten worden beheerd.
Vriendelijke groeten
1 like
Hallo
Ik heb zojuist dit toegevoegd (optie volgens de norm is aangevinkt):
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)
Het resultaat:
1 - Onwaar
1 - Waar
1.5 - Niet waar
1.5 - Waar
2 - 0
2 - 0
3 - Symmetrisch
3 - Symmetrisch
4 -
4 -
1 - Onwaar
Maar geen symmetrische tekst op het uitzicht...
Er moet één optie zijn die me blokkeert.
Hallo
Er is wat vermenging in de lucht, vervang je lijnen door deze:
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)
Vriendelijke groeten
1 like
Probleem opgelost door de 2 onderstaande regels toe te voegen
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Mijn macro maakt een uitgevouwen weergave op blad 1, daarna heb ik een blad 2 toegevoegd, maar swModel en SwDraw bleven op het 1e blad ...
Nu werkt het perfect.
Heel erg bedankt voor de hulp @d.roger, ik heb nog veel meer geleerd!
1 like