Automatisches Inkrementieren von Blöcken (oder Makros)

Macro
1

Hallo

In meinen Zeichnungen auf SolidWorks habe ich einen Block "Verifizierung: 1". Ich möchte die 1 beim Einfügen automatisch erhöhen. Gibt es eine Möglichkeit? Ich kann ein Makro verwenden, wenn es sein muss, aber ich kenne den Code zum Abrufen meines Attributs nicht.

Vielen Dank und einen schönen Tag

2

Hallo, haben Sie eine Variable im $prpsheet.......-Block?

Ich für meinen Teil bevorzuge es, eine Anmerkung zu verwenden

Verifizierung: "$PRPSHEET xxxxxx:"

 

3

Hallo

Im Moment habe ich eine interne Variable im Block, um die benutzerdefinierten Eigenschaften meiner Pläne nicht zu überladen. Ich ändere es manuell, aber es würde mir Zeit sparen, wenn sich die Zahl mit jedem Klick ändert (ich habe im Durchschnitt etwa 60 Blöcke zum Einfügen)

4

Hallo, ich erlaube mir, diesen Beitrag zu erwähnen, den ich während der Serverbrände gestartet hatte. Wenn es keine Lösung gibt, werde ich schließen, aber im Zweifel... :)

5

Hallo

Dadurch wird eine Notiz mit Schritten hinzugefügt:

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

Danke, ich werde es damit versuchen! Vielen Dank für die Zeit.