Automatyczna utrata pęcherzyków powietrza

2D plans
1

Witam @ wszystkich,

Mam plan konfiguracji
Makro zmieniające konfiguracje widoków i tabeli zestawienia komponentów w celu wyeksportowania planu PDF dla każdej konfiguracji.

Niestety każda konfiguracja ma mniej lub więcej części, a automatyczne bąbelki znikają i nie pojawiają się ponownie.

Czy masz jakiś trop, który mi pomoże?

Z góry dziękuję

2

Witam

Czy możesz podać makro?

Cdlt powiedział:

3

Oto moje makro,
Nie jestem profesjonalistą w tej dziedzinie, to mój drugi. A podstawa makro pochodzi z tego forum.
Próbuję zrobić makro, które usuwa bąbelki, aby je uspokoić , ale blokuję.

Pozdrowienia


macro_pdf_enregistrer_sous-2.swp
4

Witaj Yannik, masz pomysł?

5

Witam

Można użyć funkcji AutoBalloon5 

Uwaga: zanim zaczniesz kodować, sprawdź, czy działa ręcznie z funkcją 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 polubienie
6

Dziękuję JeromeP,

Chciałem to zrobić, ale muszę zacząć od wymazania bąbelków na miejscu, ponieważ mam pętlę, która tworzy wszystkie konfiguracje.

i do tego miałem zamiar użyć "Part.Extension.SketchBoxSelect", ale jestem nowy w makro w SW i szybko blokuję.

Pozdrowienia

7

Aby usunąć wszystkie numery pozycji z arkusza:

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