Revisionstabelle für Makroeinfügung + Solidworks Revision

Out of category
1

Hallo ihr alle

Ich bin auf der Suche nach einem Makro, um die Revisionstabelle in der SOLIDWORKS-Zeichnung hinzuzufügen.

Das Array, das hinzugefügt werden soll, ist nicht das Basisarray, es befindet sich in einem bestimmten Pfad. 

Außerdem möchte ich, sobald die Tabelle erstellt ist, eine automatische Revision einfügen (immer gleich).

 

 

Vielen Dank im Voraus für Ihre Hilfe

2

Hallo Mcjones,

Zunächst einmal die besten Wünsche, ...

Wenn Sie Mycadtool haben , gibt es in dieser Anwendung ein Makro, das all dies tut, gekoppelt mit dem Integrationsmodul, ich beherrsche keine Makros, aber es funktioniert sehr gut.

Sobald ich meine Hand an meinem PC habe, mache ich einen Screenshot.

@+.

AR.

1 „Gefällt mir“
3

Hallo A.R,

 

Vielen Dank auch an Sie!

Okay, ich werde mir das ansehen.

Vielen Dank für Ihre Antwort!

4

Hallo;

Hier ist ein Beispiel für das Einfügen einer "persönlichen" Revisionstabelle mit einer Auswahl an Einfügeschichten: (Hier "Annotation")

-> Zeile "Set mytablerev": Geben Sie den vollständigen Pfad des Speicherorts der Revisionstabelle (*.sldrevtbt) ein.

Public swApp As SldWorks.SldWorks
Public swDoc As SldWorks.ModelDoc2
Public SwSheet As SldWorks.DrawingDoc
Public swview As SldWorks.View
Public SwTableRev As TableAnnotation
Public swAnn As SldWorks.Annotation

Public currentsheet As Object
Public mytablerev As Object


Dim LayerMgr As SldWorks.LayerMgr
Dim draw As SldWorks.ModelDoc2


Sub Ajout_table_rev()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set SwSheet = swDoc

'insertion table
'attention changer le chemin pour la table de revision
' si "mytablerev" 'true' alors la table se met sur le point d'ancrage sinon sur coordonné 0,0

Set currentsheet = SwSheet.GetCurrentSheet
Set mytablerev = currentsheet.InsertRevisionTable(True, 0, 0, 3, "W:\Modeles_solidworks\table_de_revision\revision.sldrevtbt")
Set myRevisionTable = currentsheet.RevisionTable
longstatus = myRevisionTable.AddRevision("")

'Deplace la table sur le calque "Annotation"
myRevisionTable.GetAnnotation.Layer = "Annotation"

Dim Revis As String
Revis = myRevisionTable.CurrentRevision

'Ajoute la valeur de "revision" sur la table
Dim Valeur As String
Set swModel = swApp.ActiveDoc
Valeur = swModel.DeleteCustomInfo("Revision")
Valeur = swModel.AddCustomInfo3("", "Revision", swCustomInfoText, Revis)

'force la reconstruction
Dim bRet As String
bRet = swModel.Rebuild(swRebuildOptions_e.swForceRebuildAll)

End Sub

 

Grüße.

2 „Gefällt mir“
5

Oder schauen Sie sich dieses Makro an, um es nach Ihren Bedürfnissen und Ihrem Wissen zu ändern:

Sub tableRevision()
Const TABLE_TEMPLATE As String = "U:\Entreprise\Service BE\1-Commun service\Solidworks\SOLIDWORKS Data 2018\lang\french\standard revision block.sldrevtbt"
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc
Dim swSheet             As SldWorks.Sheet
Dim vViews              As Variant
Dim swView              As SldWorks.View
Dim swAnn               As SldWorks.Annotation
Dim swRevTable          As SldWorks.RevisionTableAnnotation
Dim i                   As Integer
Dim UserName            As String
Dim DescriptionRev      As String
Dim fileerror           As Long
Dim filewarning         As Long
Dim sName               As String
Dim longstatus          As Long, longwarnings As Long
Dim swDocSpecification  As SldWorks.DocumentSpecification

Debug.Print "Indice:" & Indice


Set swApp = Application.SldWorks
Debug.Print "Chemin MEP:" & PathMep & Indice & ".slddrw"
Set swDocSpecification = swApp.GetOpenDocSpec(PathMep & Indice & ".slddrw")
sName = swDocSpecification.Filename
swDocSpecification.DocumentType = swDocDRAWING
swDocSpecification.ReadOnly = False
swDocSpecification.Silent = False
Set swModel = swApp.OpenDoc7(swDocSpecification)
longstatus = swDocSpecification.Error
longwarnings = swDocSpecification.Warning
    
    
    
'Set swModel = swApp.ActiveDoc
Set swDraw = swModel

    If Not swDraw Is Nothing Then
    
        Set swSheet = swDraw.GetCurrentSheet
        
        Set swRevTable = swSheet.RevisionTable
        
        If swRevTable Is Nothing Then
            
            'On ajoute une table de révision
            Debug.Print "Pas de table de révision existante-> création"
            Set swRevTable = swSheet.InsertRevisionTable(True, Empty, Empty, swBOMConfigurationAnchor_TopRight, TABLE_TEMPLATE)
        
            If swRevTable Is Nothing Then
                swApp.SendMsgToUser "L'insertion de la table à échoué."
            End
            End If

        End If
        'On récupère les infos sur le nom de session windows
        UserName = Environ("USERNAME")
        UserName = Replace(UserName, ".", " ")
        UserName = StrConv(UserName, vbProperCase)
        Debug.Print "Nom de session windows:" & UserName
        
        'On demande la valeur de la description du nouveau indice
        DescriptionRev = InputBox("Taper la description de la révision:", "Ajout de Révision")
        If DescriptionRev = "" Then
        DescriptionRev = " A définir"
        End If

        'On ajoute la ligne de révision
        Debug.Print "On ajoute une ligne à la table de révision"
        AddRevision swRevTable, Indice, Array("A définir", "", DescriptionRev, "", UserName)
    
    Else
        MsgBox "Merci d'ouvrir un plan"
    End If



End Sub


Sub AddRevision(swRevTable As SldWorks.RevisionTableAnnotation, revName As String, rowData As Variant)
    
    Dim i As Integer
    Dim swTableAnn As SldWorks.TableAnnotation
    
    Set swTableAnn = swRevTable
    
    swRevTable.AddRevision revName
            
    For i = 0 To UBound(rowData)
                
        If rowData(i) <> "" Then
            
            swTableAnn.Text(swTableAnn.RowCount - 1, i) = rowData(i)
        
        End If
                
    Next
    
End Sub

 

2 „Gefällt mir“
6

Vielen Dank an alle für Ihre schnelle Antwort! Ich schaue, was ich besser machen kann! Vielen Dank an alle!