Perte de bulles automatiques

Bonjour @ tous,

j ai un plan d 'une configuration
Et une macro qui change les configs des vues et de la table de nomenclature pour exporté un plan PDF pour chaque configuration.

Malheureusement chaque configs a plus ou moins de pièces et le les bulles automatique disparais et ne réapparaisse pas.

Avez vous une piste pour m aider SVP

Merci d avance

Bonjour

Pouvez vous fournir la macro?

Cdlt

Voici ma macro,
je suis pas un pro dans ce domaine c'est ma deuxième. Et la base de la macro vient de ce forum.
je tache de faire une macro qui efface les bulles pour les reposer mais je bloc.

Cordialement


macro_pdf_enregistrer_sous-2.swp

Bonjour Yannik, une idée?

Bonjour,

Tu peux utiliser la fonction AutoBalloon5 

Note: avant de commencer à coder, vérifier que ca fonctionne manuellement avec la fonction Auto_Balloons

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 « J'aime »

Merci JeromeP,

je voulais faire cela, mais je dois commencé par effacé les bulle en place,car j ai une boucle qui me fait toute les configurations.

et pour cela je contais utiliser "Part.Extension.SketchBoxSelect" mais je suis novice en macro dans SW et je bloc vite.

Cordialement

Pour effacer tous les ballons d'une feuille:

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