Makro zum Hinzufügen von Notizen entsprechend dem Format der Gliederung

sbadenis · 25. Oktober 2019 um 11:38

Hallo

Nachdem ich einen Plan eröffnet habe, möchte ich einige der folgenden Schritte durchführen:

1- Überprüfen Sie das Format des Plans (A4H, A3H...)

2-Fügen Sie je nach Format des Blattes eine Anmerkung hinzu (mit rotem Text und rechteckigem Feld drumherum) mit unterschiedlichen Koordinaten je nach Format

3-Schlaufe auf das nächste Blatt.

Im Moment schaffe ich es, die Notiz in einem Blatt zu erstellen, aber in schwarz, ohne Kasten und ohne einen rechteckigen Rahmen drumherum, und ich hätte daher gerne Hilfe bei dieser 1. Änderung:

A-) Ändern Sie den Text in einen roten und rechteckigen Rahmen um ihn herum

B) Ein Beispiel oder die Funktionen, die verwendet werden sollen, um meinen Code entsprechend dem Format des Blatts zu starten

C-) ein Beispiel, das sich über mehrere Blätter erstreckt

Mit seinen verschiedenen Elementen hoffe ich, dass ich dieses Makro trotz meines Anfängerniveaus in VBA endlich erreichen kann.

Mein bisher sehr einfacher Code:

Option Explicit

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim str As String

    ' Constant enumerators
    Const swDocPART = 1
    Const swDocASSEMBLY = 2
    Const swDocDRAWING = 3

    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        ' If no model currently loaded, then exit
        Exit Sub
    End If

    ' Determine the document type
    ' If the document is not a drawing, then send a message to the user
    If (swModel.GetType <> swDocDRAWING) Then
        swApp.SendMsgToUser ("Macro only used for drawings")
        Exit Sub
    End If

    ' Compose text string with carriage return
    str = "Traçabilité" + Chr(10) + "Matière"

    ' Insert note at (x=0.138m,y=0.285m) on the sheet
    swModel.CreateText str, 0.138, 0.285, 0.5, 0.005, 0

End Sub

Vielen Dank im Voraus für all die Beiträge, die mir helfen werden, bei diesem Thema voranzukommen.

sbadenis · 25. Oktober 2019 um 13:16

Ich antworte mir selbst für die Schleife:

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim str As String
    'i = 0

    
    
    ' Constant enumerators
    Const swDocPART = 1
    Const swDocASSEMBLY = 2
    Const swDocDRAWING = 3

    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        ' If no model currently loaded, then exit
        Exit Sub
    End If

    ' Determine the document type
    ' If the document is not a drawing, then send a message to the user
    If (swModel.GetType <> swDocDRAWING) Then
        'swApp.SendMsgToUser ("Utiliser cette macro uniquement pour une MEP")
        MsgBox "Utiliser cette macro uniquement pour une MEP.", vbCritical, "Mauvais type de document ouverth"
        Exit Sub
    End If

    ' Compose text string with carriage return
    str = "Traçabilité" + Chr(10) + "Matière"

 

    'SD modif on boucle sur chaque feuille
        Set Document = swApp.ActiveDoc        ' On récupère le document d'ouvert
        Set swSht = Document.GetCurrentSheet
    sThisSheet = swSht.GetName

    iSheets = Document.GetSheetCount
    sSheetNames = Document.GetSheetNames
        
                For i = 0 To iSheets - 1
                
                            MsgBox i
                            If sSheetNames(i) <> sThisSheet Then
                            Document.ActivateSheet sSheetNames(i)
                            End If
                            ' Insert note at (x=0.138m,y=0.285m) on the sheet
                            swModel.CreateText str, 0.138, 0.285, 0.5, 0.005, 0
                Next i


End Sub

Es gibt noch das zu überprüfende Format und die Formatierung der Notiz (Farbe + Kästchen)

stefbeno · 25. Oktober 2019 um 12:24

Für die Farbe scheint es mir, dass man das Objekt in eine bestimmte Ebene legen muss (zumindest habe ich das getan, als ich es brauchte).

Wenn ich ein Makro erstellen muss, gehe ich oft durch den Rekorder, er ermöglicht es mir, einfach Code-Bits für die grundlegenden Operationen abzurufen. Zum Beispiel, um das Feld um den Text herum zu erstellen, wenn das Feld Teil der Anmerkung ist (Gliederungsabschnitt).

sbadenis · 25. Oktober 2019 um 13:25

stefbeno Ich habe den Recorder ausprobiert, um eine Note mit Text + Farbe + Rahmen zu erstellen und das Ergebnis: ein leeres Makro...

Es sei denn, meine Blockflöte hat Mist gebaut, war sie leider nicht sehr überzeugend...

Aber ich danke Ihnen trotzdem für den Rat.

d.roger · 25. Oktober 2019 um 17:49

Hallo

Sie sollten in der Lage sein, den folgenden Code zu verwenden, um zu tun, was Sie wollen (seien Sie vorsichtig, ich habe mich nicht um die Fehlerbehandlung gekümmert), ich ändere nur die Position des Textes entsprechend dem Format, aber Sie können auch den Text ändern, dafür definieren Sie eine String-Variable, die Sie mit dem gewünschten Text in jedem "Fall" füllen, dann übertragen Sie diese Variable an die Funktion "insertionNote" anstelle von hartcodiertem Text. Ich habe den Code nicht kommentiert, aber ich weiß, dass Sie wissen, wie man ihn liest.

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
 
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    vSheetNames = swDraw.GetSheetNames
    For i = 0 To UBound(vSheetNames)
        swDraw.ActivateSheet (vSheetNames(i))
        Set mySheet = swDraw.GetCurrentSheet
        paperSize = mySheet.GetSize(width, height)
        Select Case paperSize
            Case 0
                posX = 0.038
                posY = 0.285
            Case 1
                posX = 0.138
                posY = 0.285
            Case 2
                posX = 0.038
                posY = 0.185
            Case 3
                posX = 0.038
                posY = 0.105
            Case 4
                posX = 0.008
                posY = 0.2
            Case 5
                posX = 0.008
                posY = 0.15
            Case 6
                posX = 0.008
                posY = 0.007
            Case 7
                posX = 0.06
                posY = 0.18
            Case 8
                posX = 0.23
                posY = 0.03
            'Ainsi de suite jusqu'à Case 12
            '...
            Case Else
                Exit Sub
        End Select
        insertionNote swModel, posX, posY, "Mon test d'insertion d'une note"
        swDraw.GraphicsRedraw2
    Next i
    swDraw.ActivateSheet (swSheet.GetName)
End Sub

Sub insertionNote(swModel As ModelDoc2, X As Double, Y As Double, monTexte As String)
    Dim myNote As Note
    Dim myAnnotation As Annotation
    Dim boolstatus As Boolean
    Set myNote = swModel.insertNote(monTexte)
    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)
        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

Herzliche Grüße

sbadenis · 28. Oktober 2019 um 12:48

Nochmals vielen Dank , d.roger !

Ich komme zum Ende dieses Makros, aber es gibt noch 2 kleine Probleme zu beheben:

- Ich möchte die Schriftart des Textes der Notiz vergrößern, und ich kann in der Hilfe zur Vergrößerung dieser Notiz (http://help.solidworks.com/2018/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.inote_members.html) nichts finden.

Es sei denn, ich verpasse es...

- Endlich für die Farbe funktioniert es nicht. Er erstellt die Ebene mit der Farbe, aber die Anmerkung nimmt die grauen Farben an...

Und im manuellen Modus zur Erstellung von Anmerkungen ist die Anmerkung auf der richtigen Ebene (rot) rot, ändert sich aber bei der Validierung in Grau. Ich denke, es kommt eher von einer SW-Option, aber ich kann nicht finden, welche.

Ansonsten funktioniert das Makro perfekt und ich habe es geschafft, den überwiegenden Teil davon zu verstehen und sogar mit dem Entfernen der "Kästchen" zu ändern, ich habe einfach eine Subtraktion der X- und Y-Position in Bezug auf die Größe des Blattes angewendet, wodurch die Anmerkung oben links auf jedem Blatt platziert wird, wie ich es wollte und einfacher.

d.roger · 28. Oktober 2019 um 13:04

Hallo

Für die Schriftgröße der Notiz können Sie die Sub insertionNote durch diese ersetzen:

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.02
            swTextFormat.Bold = True
            swTextFormat.Italic = True
            boolstatus = myAnnotation.SetTextFormat(1, False, swTextFormat)
        End If
    End If
    ListeCalque swDraw, myAnnotation
End Sub

Dies ermöglicht es Ihnen, eine Textgröße (hier 0,02 m) zu setzen und auch kursiv und fett zu setzen, wenn Sie möchten, andere Optionen HIER.

Was die Farbe betrifft, so kommt es wahrscheinlich von einer SW-Option, aber ich konnte im Moment nicht finden, welche, auf meinem PC bleibt die Farbe in Rot...

Herzliche Grüße

sbadenis · 28. Oktober 2019 um 14:08

Vielen Dank d.roger für Ihre wertvolle Hilfe zu diesem Thema.

Am Ende hatte ich den Text auf meiner Seite mit den gewünschten Koordinaten eingefügt, aber ohne das Feld, die Farbe und die Schriftgröße.

Und außerdem war mein Code viel weniger optimiert.

Für die Farbe, die nicht gut ist, stelle ich eine Anfrage an die Hotline und ich werde sehen, warum es nicht funktioniert, weil es eindeutig irgendwo eine Option ist, da es manuell ohne das Makro nicht besser funktioniert.

Hier ist der endgültige Code ohne die Fehlerbehandlung, die nicht unbedingt nützlich ist, da er aus der Integration gestartet wurde (nur auf einem MEP)

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



 
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    vSheetNames = swDraw.GetSheetNames

    
    For i = 0 To UBound(vSheetNames)
        'modifier ici le décalage en X et Y par rapport à l'angle en haut à gauche
        posX = 0.11
        posY = 0.013
        swDraw.ActivateSheet (vSheetNames(i))
        Set mySheet = swDraw.GetCurrentSheet
        paperSize = mySheet.GetSize(width, height)
        posX = width - posX
        posY = height - posY
        insertionNote swModel, posX, posY, "Traçabilité matière"
        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.008
            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

Vielen Dank

d.roger · 28. Oktober 2019 um 21:40

Hallo

Für die Farbe stellen Sie sicher, dass Sie die Kontrollkästchen-Schaltfläche nicht in der Symbolleiste "Linienformat" haben, siehe HIER.

Herzliche Grüße

sbadenis · 29. Oktober 2019 um 06:52

Nein, es ist nicht aktiviert, anscheinend würde es eher von der Einstellung der Farbe der Linie kommen, die nicht auf Standard gesetzt ist (Kontrollkästchen nicht aktiviert) und plötzlich wird es grau.

Um bestätigt zu werden, denn ich hatte keine Zeit, tiefer zu graben.

Wie auch immer, die Farbe ist weniger wichtig als der Rest, daher bestätige ich Ihre relevanteste Antwort.

tesniere53120 · 20. Februar 2020 um 11:04

Hallo

Ich habe das gleiche Problem mit Farben wie sbadenis, haben Sie das Problem gelöst?

sbadenis · 20. Februar 2020 um 12:47

Dieses Problem wurde nicht gelöst.

Ich musste das Geschäft aus Zeitmangel ohne die Farbe starten und konnte mich seitdem nicht mehr mit dem Problem auseinandersetzen.

Das Problem kommt nicht vom Makro, da ich es mit dem Mano reproduzieren kann.

Wenn ich meine Anmerkung eingebe, ist die rote Ebene rot und sobald ich sie bestätige, wird sie grau ...

Auf der anderen Seite, wenn Sie die Lösung finden, bin ich interessiert.