3 Replies Latest reply on Jun 29, 2017 4:24 AM by Yong Ning

    How to enter multiline text below dimension via macro

    David Dewey

      Hello,

      I'm using the following code to create text below a dimension in a drawing. I would like to be able to break this up into multiple lines. If anyone can point me to how to add a carriage return to this I would appreciate it!

       

      Option Explicit

       

       

      Sub main()

        

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swSelMgr As SldWorks.SelectionMgr

          Dim swDispDim As SldWorks.DisplayDimension

          Dim swDim As SldWorks.Dimension

         

          'Dim sCurrPrefix As String

          'Dim sCurrSuffix As String

          'Dim sCurrCalloutAbove As String

          'Dim sCurrCalloutBelow As String

       

       

          'Dim sNewPrefix As String

          'Dim sNewSuffix As String

          'Dim sNewCalloutAbove As String

          Dim sNewCalloutBelow As String

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

         

          If swModel Is Nothing Then

              MsgBox "Must have a SolidWorks document open." & Chr(13) & "Routine ending.", vbCritical, "Change Dimension Text"

              End

          End If

       

       

          If swModel.GetType <> swDocDRAWING Then

              MsgBox "Macro only works for Drawing files." & Chr(13) & "Routine ending.", vbCritical, "Change Dimension Text"

              End

          End If

         

          Set swSelMgr = swModel.SelectionManager

         

          If (swSelMgr.GetSelectedObjectType3(1, -1) = swSelDIMENSIONS) Then

              Set swDispDim = swSelMgr.GetSelectedObject6(1, 0)

              Set swDim = swDispDim.GetDimension

             

              'Current Dimension Text

              'sCurrPrefix = swDispDim.GetText(swDimensionTextPrefix)

              'sCurrSuffix = swDispDim.GetText(swDimensionTextSuffix)

              'sCurrCalloutAbove = swDispDim.GetText(swDimensionTextCalloutAbove)

              'sCurrCalloutBelow = swDispDim.GetText(swDimensionTextCalloutBelow)

             

              'New Dimension Text

              'sNewPrefix = "My New Prefix "

              'sNewSuffix = " My New Suffix"

              'sNewCalloutAbove = "My New Callout Above"

              sNewCalloutBelow = " THRU INLET & OUTLET FLANGES"

             

              '*Change* Dimension Text

              'swDispDim.SetText swDimensionTextPrefix, sNewPrefix

              'swDispDim.SetText swDimensionTextSuffix, sNewSuffix

              'swDispDim.SetText swDimensionTextCalloutAbove, sNewCalloutAbove

              swDispDim.SetText swDimensionTextCalloutBelow, sNewCalloutBelow

             

              '*Add to Current* Dimension Text

              'swDispDim.SetText swDimensionTextPrefix, sCurrPrefix & sNewPrefix

              'swDispDim.SetText swDimensionTextSuffix, sCurrSuffix & sNewSuffix

              'swDispDim.SetText swDimensionTextCalloutAbove, sCurrCalloutAbove & sNewCalloutAbove

              'swDispDim.SetText swDimensionTextCalloutBelow, sCurrCalloutBelow & sNewCalloutBelow

              'OVERWRITES CALLOUT BELOW

              swDispDim.SetText swDimensionTextCalloutBelow, sNewCalloutBelow

          End If

         

          swModel.GraphicsRedraw2

         

      End Sub

        • Re: How to enter multiline text below dimension via macro
          Simon Turner

          Something like:

          sNewCalloutBelow = " THRU INLET" & vbCrLf & "& OUTLET FLANGES"

          I haven't tested it, but that's the way to put a new line in the middle of a string.

          • Re: How to enter multiline text below dimension via macro
            Yong Ning

            SetText1.jpg

             

            SetText1.jpg

             

             

             

            Private Sub del2()

                Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                    Set SwApp = Application.SldWorks

                    Set SwModel = SwApp.ActiveDoc

                Dim SwSelMgr As SelectionMgr, Str

                    Set SwSelMgr = SwModel.SelectionManager

                Dim SwDispDim As DisplayDimension

                    Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

                    Debug.Print SwDispDim.GetText(swDimensionTextAll)

                    Stop

                    Str = "<DIM>" & vbCrLf & " (0,0,1)" & vbCrLf

                    SwDispDim.SetText swDimensionTextAll, Str

                    SwModel.GraphicsRedraw2

                 

            End Sub

            ''

            Private Sub dell()

               Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                   Set SwApp = Application.SldWorks

                   Set SwModel = SwApp.ActiveDoc

               Dim SwSelMgr As SelectionMgr, Str

                   Set SwSelMgr = SwModel.SelectionManager

               Dim SwDispDim As DisplayDimension, SwDim As Dimension

                   Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

                   Set SwDim = SwDispDim.GetDimension

                   Debug.Print SwDim.Value

                   Debug.Print SwDispDim.GetText(4), SwDispDim.GetType, SwDispDim.Type2

                   Stop

                   Str = "<DIM>" & Chr(13) & "(0,0,1)" & Chr(13)

                   Str = vbCrLf & " (0,0,1)" & vbCrLf

                   SwModel.EditDimensionProperties3 0, 0, 0, "", "", 1, 9, 2, 1, 11, 11, "", Str, 1, "", "", True, locationSelection, ""

            'swAllConfiguration

            End Sub