1 Reply Latest reply on Jul 15, 2017 1:37 PM by Deepak Gupta

    Drawing update macro: sheet format - ok, colors (dimensions, centerlines, center marks, datum tags) - ok, drawing template - missing, colors (balloons, cut list properties note, tolerance boxes) - missing. Could anyone help?

    Wojciech Pogorzelski

      Hello everybody,

      I spend hours searching forums and API help for a solution and here is where I got so far.

      I have a macro, combined from a few different ones, that updates drawings sheets on an open drawing. So far the macro does:

      - checks if SW file is open with message box if not

      - checks if SW drawing is open with message box if not

      - updates a sheet format on all sheets by removing an old one and loading a new one (a3 - iso.slddrt)

      - updates colors for: dimensions, centerlines, center marks, datum tags

      - saves the file

      *macro works only on an active drawing.

       

      Next thing I would like to add is an drawing template change/update based on whether the drawing was created from a part model nor assembly.

      Generally I use one sheet format for all the drawings except I have two different templates: one for assemblies and one for parts.

      I wasn't able to get even close to what I need with this problem.

      Could anyone help me with that?

       

      I'm also having trouble with a color change of some other features on a drawing like:

      - balloons (Balloon - not working)

      - annotations=>cut list properties note only (Note - works for all the notes)

      - tolerance boxes (Gtol - not working).

       

      =======================================================================================

      'Colors in RGB:

      '------------------------------

      'Black (0, 0, 0)

      'Blue (0, 0, 255)

      'Green (0, 255, 0)

      'Cyan (0, 255, 255)

      'Red (255, 0, 0)

      'Magenta (255, 0, 255)

      'Yellow (255, 255, 0)

      '------------------------------

      Option Explicit

       

      Dim swApp                       As SldWorks.SldWorks

      Dim swModel                     As SldWorks.ModelDoc2

      Dim swDraw                      As SldWorks.DrawingDoc

      'Sheet format update:

      Dim swSheet                     As SldWorks.Sheet

      Dim vSheetProps                 As Variant

      Dim vSheetName                  As Variant

      Dim vTemplateName               As Variant

      Dim longstatus                  As Long

      Dim longwarnings                As Long

      Dim nErrors                     As Long

      Dim nWarnings                   As Long

      Dim i                           As Long

      'Colors update:

      Dim swView                      As SldWorks.View

      Dim swCenterLine                As SldWorks.Centerline

      Dim swCenterMark                As SldWorks.CenterMark

      Dim swDispDim                   As SldWorks.DisplayDimension

      Dim swDispGtol                  As SldWorks.Gtol

      Dim swDatumTag                  As SldWorks.DatumTag

      Dim swNote                      As SldWorks.Note

      Dim swBalloon                   As SldWorks.BalloonStack

      Dim swAnn                       As SldWorks.Annotation

       

      Sub main()

       

      On Error Resume Next

       

      Set swApp = Application.SldWorks

      Set swModel = swApp.ActiveDoc

       

      '-----------------------------------------------------------------

      'Is SW file open?

      If swModel Is Nothing Then

          swApp.SendMsgToUser2 "                     SheetFormat Update" & vbNewLine & "" & vbNewLine & "                            Otwórz plik!", swMbWarning, swMbOk

          Exit Sub

      End If

       

      '-----------------------------------------------------------------

      'Is SW drawing open?

      If swModel.GetType <> swDocDRAWING Then

          swApp.SendMsgToUser2 "                     SheetFormat Update" & vbNewLine & "" & vbNewLine & "                         Otwórz rysunek!", swMbWarning, swMbOk

          Exit Sub

      End If

       

      Set swDraw = swModel

       

      '-----------------------------------------------------------------

      'Sheet format update (a3 - iso.slddrt)

         

          vSheetName = swDraw.GetSheetNames

       

          For i = 0 To UBound(vSheetName)

       

              swDraw.ActivateSheet vSheetName(i)

              Set swSheet = swDraw.GetCurrentSheet

             

              'Get the current drawing sheet format from this sheet

              vTemplateName = swSheet.GetTemplateName

             

              vSheetProps = swSheet.GetProperties

         

          'Sheet format delete:

          swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateNone, vSheetProps(2), vSheetProps(3), True, "", vSheetProps(5), vSheetProps(6), "Default", True

         

          'Sheet format load:

          swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), True, "a3 - iso.slddrt", vSheetProps(5), vSheetProps(6), "Default", True

       

          swDraw.ViewZoomtofit2

         

      '-----------------------------------------------------------------

      'Colors update

         

      Set swView = swDraw.GetFirstView

                 

          Do While Not swView Is Nothing

                     

              '(DisplayDimension) - color replacement

              Set swDispDim = swView.GetFirstDisplayDimension

              Do While Not swDispDim Is Nothing

                  Set swAnn = swDispDim.GetAnnotation

                  swAnn.Color = RGB(0, 0, 255) 'color in RGB or...

                  'swAnn.Color = 16711680 'color in decimal

                  Set swDispDim = swDispDim.GetNext

              Loop

             

              '(CenterLine) - color replacement

              Set swCenterLine = swView.GetFirstCenterLine

              Do While Not swCenterLine Is Nothing

                  Set swAnn = swCenterLine.GetAnnotation

                  swAnn.Color = RGB(128, 0, 0) 'color in RGB or...

                  Set swCenterLine = swCenterLine.GetNext

              Loop

             

              '(CenterMark) - color replacement

              Set swCenterMark = swView.GetFirstCenterMark

              Do While Not swCenterMark Is Nothing

                  Set swAnn = swCenterMark.GetAnnotation

                  swAnn.Color = RGB(128, 0, 0) 'color in RGB or...

                  Set swCenterMark = swCenterMark.GetNext

              Loop

                             

              '(DatumTag) - color replacement

              Set swDatumTag = swView.GetFirstDatumTag

              Do While Not swDatumTag Is Nothing

                  Set swAnn = swDatumTag.GetAnnotation

                  swAnn.Color = RGB(128, 0, 0) 'color in RGB or...

                  Set swDatumTag = swDatumTag.GetNext

              Loop

                                 

              '(Balloon) - color replacement - NOT WORKING

              'Set swBalloon = swView.GetFirstBalloonStack

              'Do While Not swBalloon Is Nothing

                  'Set swAnn = swBalloon.GetAnnotation

                  'swAnn.Color = RGB(0, 0, 255) 'color in RGB or...

                  'Set swBalloon = swBalloon.GetNext

              'Loop

             

              '(Note) - color replacement - NOT WORKING (works for all the notes, need only for annotations=>cut list properties note)

              'Set swNote = swView.GetFirstNote

              'Do While Not swNote Is Nothing

                  'Set swAnn = swNote.GetAnnotation

                  'swAnn.Color = RGB(128, 0, 0) 'color in RGB or...

                  'Set swNote = swNote.GetNext

              'Loop

                                 

              '(Gtol) - color replacement - NOT WORKING

              'Set swDispGtol = swView.GetFirstGTOL

              'Do While Not swDispGtol Is Nothing

                  'Set swAnn = swDispGtol.GetAnnotation

                  'swAnn.Color = RGB(128, 0, 0) 'color in RGB or...

                  'Set swDispGtol = swDispGtol.GetNext

              'Loop

             

              Set swView = swView.GetNextView

          Loop

      '-----------------------------------------------------------------

      Next i

       

          swDraw.ActivateSheet vSheetName(0)

          swDraw.ForceRebuild3 False

             

      Set swDraw = Nothing

       

      End Sub

       

      =======================================================================================