Automatyczne zwiększanie bloku (lub makro)

Witam

W moich rysunkach na SolidWorks mam blok "weryfikacja: 1". Chcę automatycznie zwiększyć liczbę 1 podczas wstawiania. Czy jest taka możliwość? Mogę użyć makra, jeśli zajdzie taka potrzeba, ale nie znam kodu, aby pobrać mój atrybut.

Dziękuję i życzę miłego dnia

Witam, czy masz zmienną w bloku $prpsheet.......?

Ze swojej strony wolę używać adnotacji 

Weryfikacja: "$PRPSHEET xxxxxx:"

 

Witam

Na razie mam w bloku zmienną wewnętrzną, aby nie przeciążać niestandardowych właściwości moich planów. Zmieniam go ręcznie, ale zaoszczędziłoby mi to czasu, gdyby numer zmieniał się sam z każdym kliknięciem (mam średnio około 60 klocków do wstawienia)

Witam, pozwolę sobie przywołać ten post, który uruchomiłem podczas odpalania serwerów. Jeśli nie będzie rozwiązania, zamknę, ale mam wątpliwości... :)

Witam

Spowoduje to dodanie notatki z przyrostami:

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 polubienie

Dziękuję, spróbuję z tym! Dziękuję za poświęcony czas.