Incrément automatique de bloc (ou par macro)

Macro
1

Bonjour,

Dans mes mises en plan sur SolidWorks, j'ai un bloc "vérification : 1". J'aimerais incrémenter le 1 automatiquement à l'insertion. est ce qu'il y a une possibilité? Je peux utiliser une macro s'il faut mais je ne connais pas le code pour récupérer mon attribut.

Merci et bonne journée

2

Bonjour, avez vous une variable dans le bloc $prpsheet.......?

pour ma part je prefere utilisé une annotation 

Vérification : "$PRPSHEET xxxxxx :"

 

3

Bonjour,

Pour le moment j'ai une variable interne au bloc pour ne pas surcharger les propriétés personalisées de mes plans. Je la change manuellement mais ça me ferait économiser du temps que le chiffre se change tout seul à chaque clique (j'ai en moyenne une 60aine de bloc à insérer)

4

Bonjour, Je me permet de faire remonter ce poste que j'avais lancé lors des incendies des serveurs. S'il n'y a pas de solution je clôturerais mais dans le doute ... :)

5

Bonjour,

Ceci ajoutera une note avec incrément:

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swSheet As Sheet
    Dim swPt As Variant
    Dim Txt As String
    Dim Max As Integer
    Dim swNote As SldWorks.Note
    Dim swView As SldWorks.View
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    Set swView = swDraw.ActiveDrawingView
    
    swPt = swDraw.GetInsertionPoint
    If IsEmpty(swPt) Then MsgBox ("Un point doit être sélectionné"): Exit Sub
        
    Txt = "vérification : "
    Max = FindMax(swDraw, Txt)
    
    swDraw.ActivateSheet swSheet.GetName
    
    Set swNote = swDraw.InsertNote("<FONT color=0x000000ff><FONT style=B>" & Txt & Max + 1)
    swNote.SetTextPoint swPt(0), swPt(1), 0
    swNote.Angle = 10 * 3.1416 / 180
    
    If swView Is Nothing Then Exit Sub
    
    Dim swAnn As SldWorks.Annotation
    Dim vEnts As Variant
    Dim swEnt As SldWorks.Entity
    Set swAnn = swNote.GetAnnotation
    swAnn.Select3 False, Nothing
    vEnts = swView.GetVisibleEntities2(Nothing, swViewEntityType_e.swViewEntityType_Face)
    Set swEnt = vEnts(0)
    swDraw.AttachAnnotation swAttachAnnotationOption_e.swAttachAnnotationOption_View
End Sub

Function FindMax(ByVal swDraw As SldWorks.DrawingDoc, ByVal Txt As String)
    Dim Max As Integer
    Dim vSheetName As Variant
    Dim i As Integer
    Dim swView As SldWorks.View
    Dim swNote As SldWorks.Note
    Dim vNotes As Variant
    Dim vNote As Variant
    vSheetName = swDraw.GetSheetNames
    For i = 0 To UBound(vSheetName)
        swDraw.ActivateSheet vSheetName(i)
        Set swView = swDraw.GetFirstView
        While Not swView Is Nothing
            vNotes = swView.GetNotes
            For Each vNote In vNotes
                Set swNote = vNote
                Dim NoteTxt As String
                NoteTxt = swNote.GetText
                If NoteTxt Like Txt & "*" Then
                    'Debug.Print NoteTxt
                    Dim Str() As String
                    Str = Split(NoteTxt, ": ")
                    If Str(1) > Max Then Max = Str(1)
                End If
            Next
            Set swView = swView.GetNextView
        Wend
    Next
    FindMax = Max
End Function

 

1 « J'aime »
6

Merci je vais essayer avec cela! merci du temps passé.