Automatischer Blasenverlust

Hallo @ zusammen,

Ich habe einen Plan für eine Konfiguration
Und ein Makro, das die Konfigurationen der Ansichten und der Stücklistentabelle ändert, um für jede Konfiguration einen PDF-Plan zu exportieren .

Leider hat jede Konfiguration mehr oder weniger Teile und die automatischen Blasen verschwinden und tauchen nicht wieder auf.

Hast du bitte einen Hinweis, der mir helfen kann

Vielen Dank im Voraus

Hallo

Können Sie das Makro bereitstellen?

Cdlt

Hier ist mein Makro,
Ich bin kein Profi auf diesem Gebiet, es ist mein zweiter. Und die Basis des Makros stammt aus diesem Forum.
Ich versuche, ein Makro zu erstellen, das die Blasen löscht, um sie auszuruhen , aber ich blockiere.

Herzliche Grüße


macro_pdf_enregistrer_sous-2.swp

Hallo Yannik, irgendeine Idee?

Hallo

Sie können die AutoBalloon5-Funktion  verwenden

Hinweis: Bevor Sie mit dem Programmieren beginnen , überprüfen Sie, ob es manuell mit der Funktion Auto_Balloons funktioniert

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim vNotes As Variant
Dim autoballoonParams As SldWorks.AutoBalloonOptions
Dim boolstatus As Boolean
Option Explicit
Sub main()
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
    boolstatus = Part.ActivateView("Drawing View1")
    boolstatus = Part.Extension.SelectByID2("Drawing View1", "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
    Set autoballoonParams = Part.CreateAutoBalloonOptions()
    autoballoonParams.Layout = swBalloonLayoutType_e.swDetailingBalloonLayout_Top
    autoballoonParams.ReverseDirection = False
    autoballoonParams.IgnoreMultiple = True
    autoballoonParams.InsertMagneticLine = True
    autoballoonParams.LeaderAttachmentToFaces = True
    autoballoonParams.Style = swBS_Circular
    autoballoonParams.Size = swBF_5Chars
    autoballoonParams.UpperTextContent = swBalloonTextItemNumber
    autoballoonParams.Layername = "-None-"
    autoballoonParams.ItemNumberStart = 1
    autoballoonParams.ItemNumberIncrement = 1
    autoballoonParams.ItemOrder = swBalloonItemNumbers_DoNotChangeItemNumbers
    autoballoonParams.EditBalloons = True
    autoballoonParams.EditBalloonOption = swEditBalloonOption_Resequence
    vNotes = Part.AutoBalloon5(autoballoonParams)
End Sub

 

1 „Gefällt mir“

Danke JeromeP,

Ich wollte das tun, aber ich muss damit beginnen, die Blasen an Ort und Stelle zu löschen, da ich eine Schleife habe, die alle Konfigurationen vornimmt.

und dafür wollte ich "Part.Extension.SketchBoxSelect" verwenden, aber ich bin neu im Makro in SW und blockiere schnell.

Herzliche Grüße

So löschen Sie alle Positionsnummern aus einem Blatt:

Option Explicit
Sub Main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swView As SldWorks.View
    Dim swNote As SldWorks.Note
    Dim swAnn As SldWorks.Annotation
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
        MsgBox "Ouvrir un dessin", vbOKOnly + vbInformation
        Exit Sub
    End If
    Set swDraw = swModel
    Set swView = swDraw.GetFirstView
    swModel.ClearSelection2 True
    While Not swView Is Nothing
        Set swNote = swView.GetFirstNote
        While Not swNote Is Nothing
            If swNote.IsBomBalloon Then
                Set swAnn = swNote.GetAnnotation
                swAnn.Select3 True, Nothing
            End If
            Set swNote = swNote.GetNext
        Wend
        Set swView = swView.GetNextView
    Wend
    swModel.EditDelete
End Sub