2 Replies Latest reply on Mar 8, 2018 4:01 AM by Botg&225 L. Gyula

    Change current sheet name to selected note's text.

    Botg&225 L. Gyula

      Hi!

      I have some drawings with a note (Revision: A, B, C, etc.) This note always placed to same coordinate to sheet.

      I can select this note with SELECTBYID via X and Y coordinates.

      How can I copy the selected text and replace the current sheet name with it with macro?

       

      Thanks, Imre

       

      Sheet_rename.jpg

        • Re: Change current sheet name to selected note's text.
          Artem Taturevych

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swDraw As SldWorks.DrawingDoc

          Dim swSelMgr As SldWorks.SelectionMgr

           

          Sub main()

           

              Set swApp = Application.SldWorks

             

              Set swModel = swApp.ActiveDoc

             

              Set swDraw = swModel

             

              Set swSelMgr = swModel.SelectionManager

             

              Dim swNote As SldWorks.Note

             

              Set swNote = swSelMgr.GetSelectedObject6(1, -1)

             

              Dim swSheet As SldWorks.Sheet

              Set swSheet = swDraw.GetCurrentSheet()

             

              swSheet.SetName swNote.GetText

             

          End Sub

          • Re: Change current sheet name to selected note's text.
            Botg&225 L. Gyula

            Hi Artem Taturevych!

             

            Thanks for the quick reply! This code works fine!

            If I select a face in a multibody part in drawing, I run the macro.

            This lines puts the Item ID and Revision of the selected component (cut list properties) to the right side of drawing sheet.

            '...

            Set swApp = _

            Application.SldWorks

            Set Part = swApp.ActiveDoc

            Set myNote = Part.InsertNote("$PRPSWLDMODEL:""Item ID"" $COMP:""Part2-17@Drawing View8""" & " $PRPSWLDMODEL:""Revision"" $COMP:""Part2-17@Drawing View8""")

                If Not myNote Is Nothing Then

                   myNote.LockPosition = False

                   myNote.Angle = 0

                   boolstatus = myNote.SetBalloon(0, 0)

                   Set myAnnotation = myNote.GetAnnotation()

                   If Not myAnnotation Is Nothing Then

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

                      boolstatus = myAnnotation.SetPosition(0.251149284009547, 5.7613365155132E-03, 0.009999999999999)

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

                   End If

                End If

            Part.ClearSelection2 True

             

             

            '....

            'After that, it's find this text, select by coordinates. Copy and paste to the sheet name.

             

            Dim swModel As SldWorks.ModelDoc2

            Dim swDraw As SldWorks.DrawingDoc

            Dim swSelMgr As SldWorks.SelectionMgr

                Set swModel = swApp.ActiveDoc

                Set swDraw = swModel

                Set swSelMgr = swModel.SelectionManager

                Dim swNote As SldWorks.Note

               

                boolstatus = Part.ActivateView("Drawing View70")

                boolstatus = Part.Extension.SelectByID2("", "NOTE", 0.251149284009547, 5.7613365155132E-03, 0.009999999999999, False, 0, Nothing, 0)

               

                Set swNote = swSelMgr.GetSelectedObject6(1, -1)

                Dim swSheet As SldWorks.Sheet

                Set swSheet = swDraw.GetCurrentSheet()

                swSheet.SetName swNote.GetText

                Part.Extension.DeleteSelection2 1

             

            Part.ClearSelection2 True

            Part.WindowRedraw