8 Replies Latest reply on Aug 22, 2018 11:11 AM by Alex Burnett

    Why is this macro missing certain annotations?

    Steve Soeder

      I wrote a Macro to update existing drawings to our new drawing standard.  It's supposed to load the drawing standard and then go in and set all the notes, dimensions, etc. to use the default font, but it always seems to miss a few.  I would say it typically works on about 90% of annotations (including dimensions, notes, tables, title block, etc. - and it does work on all pages in multi-page documents) but there are always a handful that it seems to "miss" - i.e. there are always a few notes or tables that don't get set to use the default font.

       

      I'm not really sure why this would be - can anyone help me figure out what I'm missing?

       

      Thanks!

       

      Option Explicit
          Dim swApp As SldWorks.SldWorks
          Dim swModel As SldWorks.ModelDoc2
          Const drawStd As String = "C:\MyFolder\MyStandard.sldstd"
      
      
      
      
      Sub main()
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          Dim theReturn As Boolean
          
          If swModel.GetType <> 3 Then MsgBox "active document is not a solidworks drawing": Exit Sub
          
          theReturn = swModel.Extension.LoadDraftingStandard(drawStd)
          
          Dim theFeat As SldWorks.Feature
          Set theFeat = swModel.FirstFeature
          
          Do While Not theFeat Is Nothing
          
              If "DrSheet" = theFeat.GetTypeName Then
              
                  swModel.ActivateSheet theFeat.Name
                  Call getnote
                  
              End If
              
              Set theFeat = theFeat.GetNextFeature
          
          Loop
      
      
      End Sub
      
      
      Sub getnote()
          Dim theFormat As SldWorks.TextFormat
          Dim theDraw As SldWorks.DrawingDoc
          Dim theView As SldWorks.View
          Dim theNote As SldWorks.Note
          Dim theAnn As SldWorks.Annotation
          Dim theReturn As Boolean
          Dim i As Long
              
          
          Set theDraw = swModel
          Set theView = theDraw.GetFirstView
          Set theNote = theView.GetFirstNote
          swModel.ClearSelection2 (True)
          
          Do While Not theNote Is Nothing
          
              Set theAnn = theNote.GetAnnotation
              theReturn = theAnn.Select2(True, 0)
              Debug.Assert theReturn
              'theReturn = theAnn.ApplyDefaultStyleAttributes()
              For i = 0 To theAnn.GetTextFormatCount - 1
                  Set theFormat = theAnn.GetTextFormat(i)
                  theReturn = theAnn.SetTextFormat(i, True, theFormat)
              Next
              Set theNote = theNote.GetNext
          Loop
         
      End Sub
      
        • Re: Why is this macro missing certain annotations?
          Alex Burnett

          This should get your pretty close on all your pages to the document font. However, this doesn't do anything within text blocks on the sheet format but it does update my items on the sheet format that are outside of blocks.

           

          Dim swApp As SldWorks.SldWorks
          Dim swModel As SldWorks.ModelDoc2
          Dim swDraw As DrawingDoc
          Dim swView As SldWorks.View
          Dim lerr As Long
          Dim bstatus As Boolean
          Dim allSheetViewArrays As Variant
          Dim sheetViews As Variant
          Dim swAnno As Annotation
          Dim textFormat As textFormat
          
          
          Sub main()
          
          
              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              
              If swModel.GetType <> swDocDRAWING Then
                  Msg = "Only Allowed on Drawings" ' Define message
                  Style = vbOKOnly ' OK Button only
                  Title = "Error" ' Define title
                  Call MsgBox(Msg, Style, Title) ' Display error message
                  Exit Sub ' Exit this program
              End If
                  
              Set swDraw = swModel
              allSheetViewArrays = swDraw.GetViews
              For i = 0 To UBound(allSheetViewArrays)
                  sheetViews = allSheetViewArrays(i)
                  For j = 0 To UBound(sheetViews)
                      Set swView = sheetViews(j)
                      
                          Set swAnno = swView.GetFirstAnnotation2
                          
                          Do While Not swAnno Is Nothing
                              If swAnno.GetType = swNote _
                              Or swAnno.GetType = swDisplayDimension _
                              Or swAnno.GetType = swTableAnnotation Then
                                  Dim formatIndex As Integer
                                  For formatIndex = 0 To swAnno.GetTextFormatCount - 1
                                      Set textFormat = swAnno.GetTextFormat(i)
                                      swAnno.SetTextFormat i, True, textFormat
                                  Next
                              End If
                              Set swAnno = swAnno.GetNext
                          Loop
                          
                      Set swView = swView.GetNextView
                  Next j
              Next i
          End Sub
          

           

          Edit: to apply to tables, dims and notes

           

          To answer your question, I believe it is missing annotations because you are looking only for notes. A dimension is not a note, however it is an annotation. You need to loop through your annotations and then determine which types you want to update.

            • Re: Why is this macro missing certain annotations?
              Steve Soeder

              Alex,

               

              Your code gives me the same results with the pages in question.

              To clarify, I'm not having trouble with missing an entire class of annotation objects - i.e. missing all dimensions or something like that.  The code I posted updates dimensions, notes, tables, balloons, etc.   It just "misses" some, and I can't figure out why.


              For example, I have one drawing which has 7 pages.  Each page has multiple views with dimensions, notes (some notes are placed in a view, some are not - they are just placed on the sheet), tables, flag notes, balloons, etc.  On the first 2 pages, my macro updates 100% of all these objects to use the document font.  Great.  On page 3, it gets the table, the dimensions, and about 75% of the notes, leaving three random notes on one view (they are the same 3 every time) which are left using a non-document font.  On pages 4 and 5, it gets 100% of everything, and then on page 6 it leaves one table with a non-document font, and page 7 it leaves half of one table with non-document font.

               

               


              So it's kind of weird.  It's not entirely random, as it's "missing" the same things every time I run yours or my macro, but I can't figure out why it's missing those objects.

               

               

              Does that make sense?

                • Re: Why is this macro missing certain annotations?
                  Steve Soeder

                  Also, based on your reply I did try a version of my macro where I move out a level to the annotation interface, and tried cycling through that collection, but it was the same results.

                   

                      Set theDraw = swModel
                      Set theView = theDraw.GetFirstView
                      Set theNote = theView.GetFirstNote
                      swModel.ClearSelection2 (True)
                      Set theAnn = theNote.GetAnnotation
                     
                      Do While Not theAnn Is Nothing
                          theReturn = theAnn.Select2(True, 0)
                          Debug.Assert theReturn
                          'theReturn = theAnn.ApplyDefaultStyleAttributes()
                              Dim formatIndex As Integer
                              For formatIndex = 0 To theAnn.GetTextFormatCount - 1
                                  Set theFormat = theAnn.GetTextFormat(i)
                                  theAnn.SetTextFormat i, True, theFormat
                              Next
                              Set theAnn = theAnn.GetNext
                          Set theAnn = theAnn.GetNext3
                      Loop
                  
                  • Re: Why is this macro missing certain annotations?
                    Deepak Gupta

                    Can you share that file to find out the reason as why macro skips them?

                    • Re: Why is this macro missing certain annotations?
                      Jim Sculley

                      Steve Soeder wrote:

                       

                       

                      So it's kind of weird. It's not entirely random, as it's "missing" the same things every time I run yours or my macro, but I can't figure out why it's missing those objects.

                       

                       

                      Does that make sense?

                      What does running it in the debugger reveal?  If the  format isn't changing, either the annotation type isn't one of the three that Alex's code is testing for, or the call to SetTextFormat is failing, in  which case it should return 'False'.  As written, the code isn't checking the return value at all.  The 'Remarks' section of the API  docs for SetTextFormat also lists a variety of caveats and restrictions based on the type of annotation.  Are you violating the guidelines?  Also, the API docs state:

                       

                      "To see the effects of changing the text format information for this annotation, use ModelDoc2::GraphicsRedraw2"

                       

                      What happens if you delete all the annotations except the ones that repeatedly fail?  Do they still fail?  What happens if you paste them into a different view/sheet/document?

                        • Re: Why is this macro missing certain annotations?
                          Alex Burnett

                          Thanks Jim, I agree that it should be checking the return value. I threw this together too quickly. Here's an updated one that applies your suggestions. Now, I don't know if there is something that I have to do specific to a compound note if there is one but I added a check for that too.

                           

                          Option Explicit
                          
                          
                          Dim swApp As SldWorks.SldWorks
                          Dim swModel As SldWorks.ModelDoc2
                          Dim swDraw As DrawingDoc
                          Dim swView As SldWorks.View
                          Dim Msg As String
                          Dim Style As Variant
                          Dim Title As String
                          Dim lerr As Long
                          Dim bstatus As Boolean
                          Dim allSheetViewArrays As Variant
                          Dim sheetViews As Variant
                          Dim swAnno As Annotation
                          Dim swNote As Note
                          Dim textFormat As textFormat
                          
                          
                          Sub main()
                          
                          
                              Set swApp = Application.SldWorks
                              Set swModel = swApp.ActiveDoc
                              
                              If swModel.GetType <> swDocDRAWING Then
                                  Msg = "Only Allowed on Drawings" ' Define message
                                  Style = vbOKOnly ' OK Button only
                                  Title = "Error" ' Define title
                                  Call MsgBox(Msg, Style, Title) ' Display error message
                                  Exit Sub ' Exit this program
                              End If
                                  
                              Set swDraw = swModel
                              allSheetViewArrays = swDraw.GetViews
                              
                              Dim i As Integer
                              Dim j As Integer
                              For i = 0 To UBound(allSheetViewArrays)
                                  sheetViews = allSheetViewArrays(i)
                                  For j = 0 To UBound(sheetViews)
                                      Set swView = sheetViews(j)
                                      Set swAnno = swView.GetFirstAnnotation2
                                      
                                      Do While Not swAnno Is Nothing
                                          If swAnno.GetType = SwConst.swNote _
                                          Or swAnno.GetType = SwConst.swDisplayDimension _
                                          Or swAnno.GetType = SwConst.swTableAnnotation Then
                                              Dim formatIndex As Integer
                                              For formatIndex = 0 To swAnno.GetTextFormatCount - 1
                                                  If swAnno.GetType = SwConst.swNote Then
                                                      Set swNote = swAnno.GetSpecificAnnotation
                                                      If swNote.IsCompoundNote Then
                                                          Debug.Print swNote.GetName & " is compound note"
                                                      End If
                                                  End If
                                                  
                                                  Set textFormat = swAnno.GetTextFormat(i)
                                                  bstatus = swAnno.SetTextFormat(i, True, textFormat)
                                                  Debug.Print "Set TF" & ": " & bstatus & " for " & swAnno.GetName
                                              Next
                                          End If
                                          Set swAnno = swAnno.GetNext
                                      Loop
                                      Set swView = swView.GetNextView
                                  Next j
                              Next i
                              swModel.GraphicsRedraw2
                              
                          End Sub