Abrufen von Ebeneninformationen aus einer Notiz oder Sprechblase

Macro
1

Hallo, ich habe herausgefunden, wie man in einem VBA-Makro einige Informationen über die Notizen oder Blasen in einer Solidworks-Zeichnung abruft, ihren Text, um sie zu bearbeiten, ihre Form (Feld, Dreieck usw.) und ich möchte auch in der Lage sein, die Ebene zu erkennen, zu der sie gehört, und sie möglicherweise zu ändern, um die Farbe usw. zu ändern.

Vielen Dank im Voraus

2

Hallo
Dies geschieht mit Hilfe der Layer-Verwaltung.
Schauen Sie sich diesen Code an, der es mir ermöglichte, eine rote Notiz einzufügen:

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 „Gefällt mir“
3

Danke für Ihre Hilfe. Ich habe den Teil entdeckt, der mich in Ihrem Code interessiert:
myAnnotation.Layer = " Rote Notizen "
Ich konnte die Methode nicht direkt auf meine Notiz anwenden, fügte ich hinzu
Legen Sie myAnnotation = myNote.GetAnnotation() fest
Und es funktioniert perfekt! Vielen Dank.

2 „Gefällt mir“
4

Hallo
Was uns betrifft, so verwenden wir eine Bibliothek von Anmerkungen.
Es ist eine Wahl