---

Hallo zusammen,
bei uns sind sehr viele alte Zeichnungen im System und bei kleinen Änderungen ist es nervig, wenn die neuen Stile für Bemaßung, Oberflächenbeschaffenheit oder Geometrische Toleranzen fehlen.
Ein Programm zum Einfügen der neuen Stile wurde bereits erfolgreich erstellt. Mit dem Programm können auch alte Stile gelöscht werden, jedoch muss man wissen, wie diese heißen.
Beim „Benutzen“ einer vorhandenen Bemaßung zum Einfügen der Stile wird die Bemaßung mit dem Stil modifiziert, was nicht gewünscht ist. Deshalb wird eine neue Linie mit Maß eingefügt. Leider muss der User die Maßeingabe bestätigen.
Daraus ergeben sich 2 Fragen:

Gibt es eine Möglichkeit alle auf der Zeichnung befindlichen Stile zu löschen, egal wie diese heißen?
Kann ein Maße ohne Benutzer-Bestätigung eingefügt werden?
Unten ein Auszug aus dem Code.

Ich freue mich auf die Rückmeldungen!

Function delete_BemassungsStile(swApp As SldWorks.SldWorks)

    Dim swDraw                  As SldWorks.ModelDoc2
    Dim swView                  As View
    Dim swDispDim              As SldWorks.DisplayDimension
    Dim myAnnotation            As SldWorks.Annotation
    Dim retval                  As Boolean
    Dim i                      As Integer
   
    Dim Pfad_BemFav            As String
    Dim Endung_BemFav            As String
    Dim zuloeschendeBemStile(10)  As String
    Dim neueBemStile            As Variant

    zuloeschendeBemStile(0) = "H7"
    zuloeschendeBemStile(1) = "F7"
    zuloeschendeBemStile(2) = "K6"
    zuloeschendeBemStile(3) = "h6"
    zuloeschendeBemStile(4) = "f7"
    zuloeschendeBemStile(5) = "g6"
    zuloeschendeBemStile(6) = "0,1"
    zuloeschendeBemStile(7) = "0,2"
    zuloeschendeBemStile(8) = "0,05"
    zuloeschendeBemStile(9) = "+0,05  +0,15"
    zuloeschendeBemStile(10) = "0  -0,05"
   
    Set swDraw = swApp.ActiveDoc

    Pfad_BemFav = swApp.GetUserPreferenceStringValue(swFileLocationsDimensionFavorites) & "\Bemaßung\"
    Endung_BemFav = ".sldstl"

    neueBemStile = fileList(Pfad_BemFav, Endung_BemFav)
   
    'Pfad ergänzen
    For i = 0 To UBound(neueBemStile)
        neueBemStile(i) = Pfad_BemFav & neueBemStile(i)
    Next

    Set swView = swDraw.GetFirstView
   
    Dim swLine As SketchSegment

    ' Linie erstellen
    Set swLine = swDraw.CreateLine2(0, 0, 0, -0.01, 0, 0)

    ' Bemaßung horizontal zur Linie hinzufügen
    swDraw.AddHorizontalDimension2 0, 0, 0

    Set swDispDim = swView.GetFirstDisplayDimension5
    Set myAnnotation = swDispDim.GetAnnotation()
   
    'definierte Bemaßungs-Stile löschen
    For i = 0 To UBound(zuloeschendeBemStile)
        retval = myAnnotation.DeleteStyle(zuloeschendeBemStile(i))
    Next i
     
    'Bemaßungs-Stile einfügen
    For i = 0 To UBound(neueBemStile)
        retval = myAnnotation.LoadStyle(neueBemStile(i))
    Next i
End function

Function fileList(Pfad_Fav As String, FavEndung As String) As Variant
    Dim oFSO                As Object
    Dim oFolder            As Object
    Dim objFile            As Object
    Dim Ordnerinhalt()    As String
   
    ReDim Ordnerinhalt(0)
   
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(Pfad_Fav)

    For Each objFile In oFolder.Files
        If Ordnerinhalt(UBound(Ordnerinhalt)) <> "" Then ReDim Preserve Ordnerinhalt(UBound(Ordnerinhalt) + 1)
        Ordnerinhalt(UBound(Ordnerinhalt)) = objFile.Name
    Next objFile
   
    fileList = Ordnerinhalt
   
End Function

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

du könntest dir doch die Namen der Stile mit der "GetStyleName Method (IAnnotation)" holen und dann löschen, also erst alle Annotations durchgehen und die vorhandenen Namen in einem Arry sammeln und die dann löschen. Oder kann es auch sein das ungenutzte Stile vorhanden sind, weil dann fällt mirnichts ein auf die schnelle.

Zum 2.Punkzt glaube ich musst du die Option "Bemaßungswert einsetzen" aus den Systemoptionen temporär deaktivieren und nach dem ablaufdes Makros natürlich wieder aktivieren.
Mit der Zeile "swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False" kannst du die Option deaktivieren.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Guten Morgen Bernd,

die meisten Stile werden nicht benutzt, somit fällt diese Möglichkeit mit „GetStyleName“ leider weg.

Auf die Idee, dass die erforderliche Maßeingabe eine Systemeinstellung ist, bin ich nicht gekommen. Jetzt lese ich die eingestellte Option aus, setze sie auf „False“ und setzte sie später wieder auf die User-Einstellung.
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False
Klappt super! 

Vielen Dank für die Rückmeldung!

Grüße Daniel

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Daniel,

alternativ könntest du versuchen, die vorhandenen Bemaßungen auf den
Standard zurückzusetzen und dann mit dem neuen Style zu versehen.

Zurücksetzen:
https://help.solidworks.com/2024/english/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IAnnotation~ApplyDefaultStyleAttributes.html

Neu zuweisen:
https://help.solidworks.com/2024/english/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IAnnotation~SetStyleName.html

------------------
==========
Gruß
Andreas
==========

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

vielen Dank für den Vorschlag.
Beim Zurücksetzen auf den Standard werden die ausgewählten Favoriten z.B. bei Maßen Passungsangaben gelöscht. D.h. es müssten alle vorhandenen Angaben, welche mit Favoriten erstellt wurden, erneut geprüft oder zuvor mit VBA eingelesen und wieder übersetzt werden.

Mein aktueller Stand: die zu löschenden Styles werden in einer händisch erstellten Exceltabelle aufgetragen. Das Makro fragt die entsprechenden Zellen ab und löscht dann die aufgelisteten Styles. Der Vorteil ist, man kann einfach in der Excel-Tabelle ergänzen und muss nicht jedes Mal das Makro anpassen.

Grüße Daniel

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP