Retrieve layer information from a note or speech bubble

Macro
1

Hello, I found how to retrieve in a VBA macro some information about the notes or bubbles in a solidworks drawing, its text to edit it, its shape (box, triangle etc) and I would also like to be able to detect the layer to which it belongs and possibly change it to change the color etc.

Thanks in advance

2

Hello
This is done with the help of layer management.
Look at this code, which allowed me to insert a note in red:

Option Explicit

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swDraw                      As SldWorks.DrawingDoc
Dim swSketchBlockDef            As SldWorks.SketchBlockDefinition
Dim swBlockInst                 As SldWorks.SketchBlockInstance
Dim swSketchMgr                 As SldWorks.SketchManager
Dim swModelDocExt               As SldWorks.ModelDocExtension
Dim swSheet                     As SldWorks.Sheet
Dim mySheet                     As SldWorks.Sheet
Dim paperSize                   As swDwgPaperSizes_e
Dim myBlockDefinition           As Object
Dim vSheetNames                 As Variant
Dim bRet                        As Boolean
Dim i                           As Long
Dim swMathUtil                  As SldWorks.MathUtility
Dim swMathPoint                 As SldWorks.MathPoint
Dim width                       As Double
Dim height                      As Double
Dim nPt(2)                      As Double
Dim vPt                         As Variant
Dim posX                        As Double
Dim posY                        As Double
Dim nomDuBloc                   As String
Dim swTextFormat                As SldWorks.TextFormat
Public X                        As Double
Public Y                        As Double
Public str                      As String


Sub origineAcier()
'On appelle la procédure et on place le texte comme argument
coordonnéeXY "Origine Acier : " + Chr(10) + "Aciéries de l'europe" + Chr(10) + "de l'ouest"
End Sub
 
Sub contactAlimentaire()
'On appelle la procédure et on place le texte comme argument
coordonnéeXY "Contact Alimentaire"
End Sub

Sub traçabilitéNuance()
'On appelle la procédure et on place le texte comme argument
coordonnéeXY "Traçabilité Nuance"
End Sub
Sub traçabilitéNuanceEtContactAlimentaire()
'On appelle la procédure et on place le texte comme argument
coordonnéeXY "Traçabilité Nuance" + Chr(10) + "Contact Alimentaire"
End Sub
Sub traçabilitéGravureNumPlan()
'On appelle la procédure et on place le texte comme argument
coordonnéeXY "Graver le N° de" + Chr(10) + "plan sur la pièce"
End Sub

Sub coordonnéeXY(str As String)
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    vSheetNames = swDraw.GetSheetNames

    
    For i = 0 To UBound(vSheetNames)

        posX = 0.065       'modifier ici le décalage en X par rapport à l'angle en haut à gauche
        posY = 0.015      'modifier ici le décalage en Y par rapport à l'angle en haut à gauche
        swDraw.ActivateSheet (vSheetNames(i))
        Set mySheet = swDraw.GetCurrentSheet
        paperSize = mySheet.GetSize(width, height)
        posX = width - posX
        posY = height - posY
        insertionNote swModel, posX, posY, str
        swDraw.GraphicsRedraw2
        
    Next i
    swDraw.ActivateSheet (swSheet.GetName)
End Sub

Sub insertionNote(swModel As ModelDoc2, X As Double, Y As Double, monBloc As String)
    Dim myNote As Note
    Dim myAnnotation As Annotation
    Dim swTextFormat As SldWorks.TextFormat
    Dim boolstatus As Boolean
    Set myNote = swModel.InsertNote(monBloc)
    If Not myNote Is Nothing Then
        boolstatus = myNote.SetBalloon(4, 0)
        Set myAnnotation = myNote.GetAnnotation()
        If Not myAnnotation Is Nothing Then
            boolstatus = myAnnotation.SetPosition(X, Y, 0)
            Set swTextFormat = myAnnotation.GetTextFormat(1)
            swTextFormat.CharHeight = 0.004
            swTextFormat.Bold = True
            swTextFormat.Italic = True
            boolstatus = myAnnotation.SetTextFormat(1, False, swTextFormat)
        End If
    End If
    ListeCalque swDraw, myAnnotation
End Sub

Sub ListeCalque(swModel As DrawingDoc, myAnnotation As Annotation)
    Dim swLayerMgr As SldWorks.LayerMgr
    Dim vLayerArr As Variant
    Dim vLayer As Variant
    Dim swLayer As SldWorks.Layer
    Dim noteLayer As Integer
    Dim layerExist As Boolean
    Set swLayerMgr = swModel.GetLayerManager
    vLayerArr = swLayerMgr.GetLayerList
    For Each vLayer In vLayerArr
        Set swLayer = swLayerMgr.GetLayer(vLayer)
        If swLayer.Name = "NotesRouge" Then
            layerExist = True
        Else
            layerExist = False
        End If
    Next
    If layerExist = True Then
        myAnnotation.Layer = "NotesRouge"
    Else
        noteLayer = swLayerMgr.AddLayer("NotesRouge", "Calque pour les notes rouge", RGB(255, 0, 0), 0, 0)
        myAnnotation.Layer = "NotesRouge"
    End If
End Sub
4 Likes
3

Thank you for your help. I spotted the part that interests me in your code:
myAnnotation.Layer = " RedNotes "
I couldn't apply the method directly to my note, I added
Set myAnnotation = myNote.GetAnnotation()
And it works perfectly! Thank you very much.

2 Likes
4

Hello
As far as we are concerned, we use a library of annotations.
It's a choice