11 Replies Latest reply on Sep 17, 2018 12:12 PM by Kenneth Coutinho

    Macro to update revision table

    Kenneth Coutinho

      Hey guys,

      I was trying to create a macro to populate the revision table.

      This is sort of how my revision table looks like:

      REV.
      DESCRIPTION
      DATE WITH INITIALS
      APPROVALS
      AECR 8000029279: RELEASE TO PROD AS PER EAO 60531.29JUN18 KCNJ/VS
      BECR 8000029920: ADDED NOTE 3.221.10SEP18 KCYS/VS
      • The revision are alphabetically incremented but we can't use I, O, Q, S, X & Z (for obvious reasons)
      • The ECR no. strictly has to be 10 digits only
      • If there is an EAO no. (strictly 5 digits) then it has to be preceded by "RELEASE TO PROD AS PER EAO"
      • If there isn't an EAO no. then the description of the change need to be added.
      • The date is followed by the drafter initials
      • Initials of the engineers who will approve the drawing need to be added.
      • The 2nd row is deleted if the number of rows is greater than 5.

       

      I have tried to write the macro but get stuck at the following line:

      myTable.Text(3, 0) = ""

       

      Please help me complete the macro.

       

       

      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

      Set Part = swApp.ActiveDoc

      boolstatus = Part.Extension.SelectByID2("DetailItem317@Sheet1", "REVISIONTABLE", 0.458763552490702, 0.391996361444788, 0, False, 0, Nothing, 0)

      Dim currentSheet As Object

      Dim myRevisionTable As Object

      Set currentSheet = Part.GetCurrentSheet()

      Set myRevisionTable = currentSheet.RevisionTable

      longstatus = myRevisionTable.AddRevision("")

       

      Dim revEcr As String

      Dim revDrafters As String

      Dim revInitials As String

      nowtext = UCase(Format(Now(), "DDMMMYY"))

      revEcr = InputBox("Enter ECR No.:")

      revDrafters = InputBox("Enter your initials:")

      revInitials = InputBox("Enter ME/RF initials:")

       

      Dim myNote As Object

      Dim myAnnotation As Object

      Dim myTextFormat As Object

      Set myNote = Part.InsertRevisionSymbol(0.433624764657207, 0.353991264877615)

      If Not myNote Is Nothing Then

         myNote.LockPosition = False

         myNote.Angle = 0

         boolstatus = myNote.SetBalloon(1, 0)

         Set myAnnotation = myNote.GetAnnotation()

         If Not myAnnotation Is Nothing Then

            longstatus = myAnnotation.SetLeader3(swLeaderStyle_e.swNO_LEADER, 0, True, False, False, False)

       

       

            Set myTextFormat = Part.GetUserPreferenceTextFormat(0)

            myTextFormat.Italic = False

            myTextFormat.Underline = False

            myTextFormat.Strikeout = False

            myTextFormat.Bold = False

            myTextFormat.Escapement = 0

            myTextFormat.LineSpacing = 0.001

            myTextFormat.CharHeight = 0.0035

            myTextFormat.TypeFaceName = "Arial Narrow"

            myTextFormat.WidthFactor = 1

            myTextFormat.ObliqueAngle = 0

            myTextFormat.LineLength = 0

            myTextFormat.Vertical = False

            myTextFormat.BackWards = False

            myTextFormat.UpsideDown = False

            myTextFormat.CharSpacingFactor = 1

            boolstatus = myAnnotation.SetTextFormat(0, False, myTextFormat)

         End If

      End If

      Part.ClearSelection2 True

      Part.WindowRedraw

      boolstatus = Part.Extension.SelectByID2("DetailItem317@Sheet1", "REVISIONTABLE", 0.463316246350311, 0.391006645388351, 0, False, 0, Nothing, 0)

      Part.ClearSelection2 True

      Dim myTable As Object

      Set myTable = Part.SelectionManager.GetSelectedObject5(1)

      myTable.Text(3, 0) = ""

      boolstatus = Part.Extension.SelectByID2("DetailItem317@Sheet1", "REVISIONTABLE", 0.478161987196863, 0.388631326852903, 0, False, 0, Nothing, 0)

      Part.ClearSelection2 True

      Set myTable = Part.SelectionManager.GetSelectedObject5(1)

      myTable.Text(3, 1) = "ECR & revEcr: REL TO PROD AS PER EAO XXXXX"

      boolstatus = Part.Extension.SelectByID2("DetailItem317@Sheet1", "REVISIONTABLE", 0.555557782810221, 0.392986077501225, 0, False, 0, Nothing, 0)

      boolstatus = Part.Extension.SelectByID2("DetailItem317@Sheet1", "REVISIONTABLE", 0.553578350697347, 0.391006645388351, 0, False, 0, Nothing, 0)

      Part.ClearSelection2 True

      Set myTable = Part.SelectionManager.GetSelectedObject5(1)

      myTable.Text(3, 2) = "nowtext & revDrafters"

      boolstatus = Part.Extension.SelectByID2("DetailItem317@Sheet1", "REVISIONTABLE", 0.570997353290635, 0.391006645388351, 0, False, 0, Nothing, 0)

      boolstatus = Part.Extension.SelectByID2("DetailItem317@Sheet1", "REVISIONTABLE", 0.571195296501922, 0.391006645388351, 0, False, 0, Nothing, 0)

      Part.ClearSelection2 True

      Set myTable = Part.SelectionManager.GetSelectedObject5(1)

      myTable.Text(3, 3) = "revInitials"

      End Sub

        • Re: Macro to update revision table
          Fifi Riri

          Hello. Try this:

           

          Option Explicit

          Sub Main()

              Dim swApp As SldWorks.SldWorks

              Dim swModel As SldWorks.ModelDoc2

              Dim swDraw As SldWorks.DrawingDoc

              Dim swSheet As SldWorks.Sheet

              Dim swRevTable As SldWorks.RevisionTableAnnotation

              Dim swTable As SldWorks.TableAnnotation

              Dim boolstatus As Boolean

              Set swApp = Application.SldWorks

              Set swModel = swApp.ActiveDoc

              Set swDraw = swModel

              Set swSheet = swDraw.GetCurrentSheet

              Set swRevTable = swSheet.RevisionTable

              Set swTable = swRevTable

              

              Dim revEcr As String

              Dim revDrafters As String

              Dim revInitials As String

              revEcr = InputBox("Enter ECR No.:")

              revDrafters = InputBox("Enter your initials:")

              revInitials = InputBox("Enter ME/RF initials:")

           

              boolstatus = swTable.AddRevision("")

              Dim RowCount As Long

              RowCount = swTable.RowCount - 1

              swTable.Text(RowCount, 1) = "ECR " & revEcr & ": REL TO PROD AS PER EAO XXXXX"

              swTable.Text(RowCount, 2) = UCase(Format(Now, "DDMMMYY")) & " " & revDrafters

              swTable.Text(RowCount, 3) = revInitials

           

              Dim myNote As SldWorks.Note

              Set myNote = swDraw.InsertRevisionSymbol(0.4, 0.3)

           

          '' shouldn't be necessary if drawing template is correct:

          '    Dim myAnnotation As SldWorks.Annotation

          '    Dim myTextFormat As Object

          '    If Not myNote Is Nothing Then

          '        boolstatus = myNote.SetBalloon(1, 0)

          '        Set myAnnotation = myNote.GetAnnotation()

          '        If Not myAnnotation Is Nothing Then

          '            Set myTextFormat = swDraw.GetUserPreferenceTextFormat(0)

          '            myTextFormat.CharHeight = 0.0035

          '            myTextFormat.TypeFaceName = "Arial Narrow"

          '            boolstatus = myAnnotation.SetTextFormat(0, False, myTextFormat)

          '        End If

          '    End If

           

          End Sub

            • Re: Macro to update revision table
              Kenneth Coutinho

              HI Fifi,

              Thanks for your previous reply. It helped a lot.

              I was trying to edit the macro such that if there are 6 rows in the revision table the second row gets deleted and only five rows remain.

              I added the following lines but failed.

              Could you correct it?

               

              swModel.CustomInfo("Revision") = Rev

               

              If swRevTable.RowCount > 5 Then

                 

                  Rev = Rev - 5

                 

                  Do

                     

                      swRevTable.DeleteRevision Rev, True

                     

                      Rev = Rev - 2

                 

                  Loop Until swRevTable.RowCount = 5

            • Re: Macro to update revision table
              Kenneth Coutinho

              Hey guys,

               

              Could you help me  edit the macro so that the previous revision flags are deleted?

               

              Sub Main()

                  Dim swApp As SldWorks.SldWorks

                  Dim swModel As SldWorks.ModelDoc2

                  Dim swDraw As SldWorks.DrawingDoc

                  Dim swSheet As SldWorks.Sheet

                  Dim swRevTable As SldWorks.RevisionTableAnnotation

                  Dim swTable As SldWorks.TableAnnotation

                  Dim boolstatus As Boolean

                  Set swApp = Application.SldWorks

                  Set swModel = swApp.ActiveDoc

                  Set swDraw = swModel

                  Set swSheet = swDraw.GetCurrentSheet

                  Set swRevTable = swSheet.RevisionTable

                  Set swTable = swRevTable

                  Dim revEcr As Variant

                  Dim revDrafters As String

                  Dim revInitials As String

                  Do

                  revEcr = InputBox("Enter ECR No.:")

                  If StrPtr(revEcr) = 0 Then Exit Sub  

                  If Not IsNumeric(revEcr) Then MsgBox " 10 digits only"

                  Loop Until Val(revEcr) > 8000000000# And Val(revEcr) < 9999999999#

                  revDrafters = InputBox("Enter your initials:")

                  revInitials = InputBox("Enter ME/RF initials:")

                  boolstatus = swTable.AddRevision("")

               

                  Dim RowCount As Long

                  RowCount = swTable.RowCount - 1

                  swTable.Text(RowCount, 1) = "ECR " & revEcr & ": REL TO PROD AS PER EAO XXXXX"

              swTable.Text(RowCount, 2) = UCase(Format(Now, "DDMMMYY")) & " " & UCase(revDrafters)

              swTable.Text(RowCount, 3) = UCase(revInitials)

                  Dim myNote As SldWorks.Note

                  Set myNote = swDraw.InsertRevisionSymbol(0.4, 0.3)

              '' shouldn't be necessary if drawing template is correct:

              '    Dim myAnnotation As SldWorks.Annotation

              '    Dim myTextFormat As Object

              '    If Not myNote Is Nothing Then

              '        boolstatus = myNote.SetBalloon(1, 0)

              '        Set myAnnotation = myNote.GetAnnotation()

              '        If Not myAnnotation Is Nothing Then

              '            Set myTextFormat = swDraw.GetUserPreferenceTextFormat(0)

              ' myTextFormat.CharHeight = 0.0035

              ' myTextFormat.TypeFaceName = "Arial Narrow"

              ' boolstatus = myAnnotation.SetTextFormat(0, False, myTextFormat)

              '        End If

              '    End If

              End Sub

                • Re: Macro to update revision table
                  Kenneth Coutinho

                  I tried adding the following code block to the macro but it failed to delete any flags:

                   

                   

                  Dim SheetName, DelCount, i, View, Annotation, Note  As Variant

                     

                      SheetName = swDraw.GetSheetNames

                     

                      DelCount = 0

                     

                      For i = 0 To swDraw.GetSheetCount - 1

                     

                      swDraw.ActivateSheet (SheetName(i))

                     

                      Set View = swDraw.GetFirstView

                     

                      While Not View Is Nothing

                     

                      Set Annotation = View.GetFirstAnnotation2

                     

                      While Not Annotation Is Nothing

                     

                      If Annotation.GetType = swNote Then

                     

                      Set Note = Annotation.GetSpecificAnnotation

                     

                      If Note.GetBalloonStyle = swBS_Triangle Then

                     

                      If Len(Note) < 3 Then

                     

                      Annotation.Select2 True, 0

                     

                      DelCount = DelCount + 1

                     

                      End If

                     

                      End If

                     

                      End If

                     

                      Set Annotation = Annotation.GetNext2

                     

                      Wend

                     

                      swDraw.DeleteSelection False

                     

                      Set View = View.GetNextView

                     

                      Wend

                     

                      Next i

                     

                      If i > 0 Then

                     

                      swDraw.ActivateSheet (SheetName(0))

                     

                      End If

                     

                      MsgBox Str(DelCount) + " revision triangles deleted"