Hallo
Ist es möglich, eine VBA-Ansichtsbeschriftung hinzuzufügen?
https://help.solidworks.com/2019/French/SolidWorks/sldworks/c_view_labels.htm
Ich habe einen Code gefunden, um sie zu lesen, aber nichts darüber, wie man einen in einer Ansicht erstellt.
Derzeit füge ich eine Notiz hinzu, die ich in Bezug auf die Ansicht zentriere, aber wenn Sie den Maßstab des Blattes oder der Ansicht ändern, wird die Anmerkung nicht mehr zentriert (im Gegensatz zu einer manuell erstellten Ansichtsbeschriftung).
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,
Ich habe keine VBA-Informationen gefunden, um das zu tun, was Sie wollen ... Es ist jedoch möglich, dieses Problem zu umgehen, indem Sie die Ansichtsbeschriftung zum Zeitpunkt des Einfügens der isometrischen Ansicht festlegen, indem Sie die Dokumentoptionen ändern. Dies kann mit vba erfolgen, indem Sie zuerst den Wert in den Optionen erhöhen und dann wie gewünscht ändern, bevor Sie ihn nach dem Einfügen der Ansicht auf den ursprünglichen Wert zurücksetzen.
Kleines Beispiel:
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
Weitere zu ändernde Einstellungen finden Sie HIER.
Herzliche Grüße
1 „Gefällt mir“
Der Code sieht funktional aus, aber im Moment fügt er nichts hinzu, ich schaue mir an, wie ich die Namensoption so ändere, dass sie "Symmetrisch" einfügt, und wie ich die Ebene so ändere, dass sie "Bemaßung" einfügt und dann die ursprünglichen Einstellungen wiederherstellt.
Wenn Sie die 2 Optionen manuell ändern und eine Ansicht manuell einfügen, funktioniert es, sodass es funktionieren sollte, sobald die 2 Optionen in VBA geändert werden.
Nach mehreren Versuchen funktioniert es immer noch nicht, ich habe versucht, dies vor der Erstellung der Ansicht hinzuzufügen, ohne dass sich etwas ändert:
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")
Ich habe auch versucht, die Zeile zu entfernen, um die Option zu deaktivieren und wenn ich die Option (Andere/Ansichtsbeschriftung hinzufügen...) im Menü zurückgebe ist nicht angekreuzt, was ich überraschend finde. (zumal die debug.print mir sagt, dass die Option wahr ist)
Ein etwas vollständigerer Code, der für mich perfekt funktioniert, vorausgesetzt, Sie geben einen gültigen Dateinamen für das sldprt ein und haben das slddrw gestartet und in SW geöffnet:
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
Herzliche Grüße
1 „Gefällt mir“
Ich habe es gerade versucht und die Ansicht ist gut eingefügt, aber kein Label.
Debug.Print-Ergebnis:
1 - Falsch
1 - Wahr
2 - 0
2 - 0
3 -
3 -
4 -
4 -
1 - Falsch
Vielleicht etwas in meinen allgemeinen Optionen, das blockiert.
Können Sie mir das Ergebnis Ihres Debug.Print geben, wenn es funktioniert? Vielleicht hilft mir das, das Problem zu identifizieren.
Für Debug.print:
1 - Falsch
1 - Wahr
2 - 1
2 - 1
3 -
3 - Symmetrisch
4-
4 - Zitate
1 - Falsch
Es ist also wahrscheinlich der Wert 2, der Sie blockiert. Möglicherweise haben Sie den Wert "Gemäß der Norm" aktiviert, was ich nicht tue. Wenn ja, versuchen Sie, das Häkchen zu entfernen...
Wenn es von dort kommt, muss es auch per Code verwaltet werden.
Herzliche Grüße
1 „Gefällt mir“
Hallo
Ich habe gerade das hinzugefügt (Option entsprechend der Norm ist aktiviert):
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)
Das Ergebnis:
1 - Falsch
1 - Wahr
1.5 - Falsch
1.5 - Wahr
2 - 0
2 - 0
3 - Symmetrisch
3 - Symmetrisch
4 -
4 -
1 - Falsch
Aber kein symmetrischer Text in der Ansicht...
Es muss eine Option geben, die mich blockiert.
Hallo
Es liegt etwas Vermischung in der Luft, ersetzen Sie Ihre Linien durch diese:
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)
Herzliche Grüße
1 „Gefällt mir“
Problem gelöst, indem die 2 folgenden Zeilen hinzugefügt werden
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Mein Makro erstellt eine abgewickelte Ansicht auf Blatt 1, dann habe ich ein Blatt 2 hinzugefügt, aber swModel und SwDraw blieben auf dem 1. Blatt...
Jetzt funktioniert es perfekt.
Vielen Dank für die Hilfe @d.roger, ich habe viel mehr gelernt!
1 „Gefällt mir“