ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
TWTrevor Wunn11/10/2012

Hey All,

I would like to have a macro that will delete an old rev table, create a new one with my information, and then attach it to the anchor point i have set in the upper right corner. I was looking over the Get and Set Table Anchor of Hole Table section of the solidworks help and was able to decipher some of but I don't understand enough of it to get the anchor part of it to work. The rest of it, however is working quite well. Any help would be greatly appreciated.

Thanks,

Trevor

Here is the code I have, anything related to the anchor is just thoughts and may not be correct.

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

'Delete Old Custom Properties
Dim modelDoc As SldWorks.ModelDoc2
Dim CustomPropertyMgr As SldWorks.CustomPropertyManager
Dim current_Date As Date
Dim user_Name As Boolean
Dim Todays_Date As Boolean

Dim temp    As String
    Set swApp = Application.SldWorks
    Set modelDoc = swApp.ActiveDoc
    Set CustomPropertyMgr = modelDoc.Extension.CustomPropertyManager("")

    current_Date = DateValue(Now)
    CustomPropertyMgr.Delete "DrawnBy"
    CustomPropertyMgr.Delete "DrawnDate"
    CustomPropertyMgr.Delete "CheckedBy"
    CustomPropertyMgr.Delete "CheckedDate"
    Todays_Date = modelDoc.AddCustomInfo3("", "DRAWNDATE", swCustomInfoDate, current_Date)
    user_Name = modelDoc.AddCustomInfo3("", "DRAWNBY", swCustomInfoText, "TREVOR W")

   

'Delete Old Rev Table
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("DetailItem413@Sheet1", "ANNOTATIONTABLES", 0.1376164711627, 0.2081344372716, 0, False, 0, Nothing, 0)
Part.EditDelete

'Insert New Rev Table
Set Part = swApp.ActiveDoc
Dim currentSheet As Object
Dim myRevisionTable As Object
Set currentSheet = Part.GetCurrentSheet()
Set myRevisionTable = currentSheet.InsertRevisionTable(False, 0.2699418663596, 0.2060257654404, 2, "C:\KMI-Vault\Admin Files\SW - Templates\TABLES\KRAUSE REV TABLE.sldrevtbt")

'Add Rev A and Description
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

Dim myTable As Object
Dim nrows As Integer
Dim msgResult As Boolean

Set currentSheet = Part.GetCurrentSheet()
Set myRevisionTable = currentSheet.RevisionTable
Set myTable = myRevisionTable

If myTable Is Nothing Then

msgResult = MsgBox("No Revision Table on Drawing", vbCritical)

Else

    nrows = myTable.RowCount
    If nrows = 3 Then
        'end
    Else
        longstatus = myRevisionTable.AddRevision("A")
        myTable.Text(nrows, 2) = "TREVOR W"
        myTable.Text(nrows, 3) = current_Date
        myTable.Text(nrows, 1) = "INITIAL RELEASE"
    End If
End If

Dim swRevTable As SldWorks.RevisionTableAnnotation


Dim rev_Anchor As TableAnchor
Set rev_Anchor = drwView.Sheet.TableAnchor(swTableAnnotation_RevisionTable)

Dim anchorPosition
anchorPosition = rev_Anchor.Position


'myTable.Postition = swBOMConfigurationAnchor_TopRight


End Sub