Automatische blokverhoging (of macro)

Macro
1

Hallo

In mijn tekeningen op SolidWorks heb ik een blok "verificatie: 1". Ik wil de 1 automatisch verhogen bij het invoegen. Is er een mogelijkheid? Ik kan een macro gebruiken als het moet, maar ik weet niet de code om mijn attribuut op te halen.

Bedankt en een fijne dag verder

2

Hallo, heb je een variabele in het $prpsheet....... blok?

Van mijn kant geef ik de voorkeur aan een annotatie 

Verificatie: "$PRPSHEET xxxxxx:"

 

3

Hallo

Op dit moment heb ik een interne variabele in het blok om de aangepaste eigenschappen van mijn plannen niet te overbelasten. Ik verander het handmatig, maar het zou me tijd besparen als het nummer zichzelf bij elke klik verandert (ik heb gemiddeld ongeveer 60 blokken om in te voegen)

4

Hallo, ik ben zo vrij om dit bericht naar voren te brengen dat ik tijdens de serverbranden had gelanceerd . Als er geen oplossing is, sluit ik af, maar bij twijfel... :)

5

Hallo

Hiermee wordt een notitie met stappen toegevoegd:

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 like
6

Bedankt, ik zal het proberen met dit! Bedankt voor de tijd.