1 Reply Latest reply on Jun 29, 2017 7:27 AM by Peter Brinkhuis

    EditDimensionProperties3,use chr(13) result  is error.

    Yong Ning

      using the following code to create text below a dimension in a drawing. multiple lines. If anyone can point me to how to add a carriage return to this I would appreciate it!

      Follow code, chr(13) result  is error.

      SetText.jpg

      Artificial press enter, dimensioning results correctly.

       

       

       

       

      SetText1.jpg

       

       

       

       

      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

             Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

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

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

       

       

      Dim SwDim As Dimension

          SwDim.Value

       

       

      End Sub

       

       

      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)

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

              SwDispDim.SetText SwConst.swDimensionTextParts_e.swDimensionTextAll, Str

          

      End Sub

       

       

      '''

      How to enter multiline text below dimension via... | SOLIDWORKS Forums  https://forum.solidworks.com/thread/201334

       

      *************************************************

       

       

      Function GetOrientation(swDisplayDimension As DisplayDimension) As String

          Dim SwDim As SldWorks.Dimension

          Set SwDim = swDisplayDimension.GetDimension '2(0)

          Dim swMathVec As SldWorks.MathVector

          Dim vDir As Variant

          GetOrientation = ""

          Set swMathVec = SwDim.DimensionLineDirection

          vDir = swMathVec.ArrayData

          If IsCollinear(vDir(0), 1) And IsCollinear(vDir(1), 0) Then

              GetOrientation = "HOR"

          ElseIf IsCollinear(vDir(1), 1) And IsCollinear(vDir(0), 0) Then

              GetOrientation = "VER"

          End If

      End Function

      Function IsCollinear(val As Variant, vector As Double) As Boolean

          Const TOL = 0.00000001

          IsCollinear = Abs(Abs(val) - Abs(vector)) < TOL

      End Function

      Function RefPtArr(SwModel As ModelDoc2, SwMathUtil As MathUtility, SwView As View, SwDispDim As DisplayDimension)

         Dim SwXForm As MathTransform

             Set SwXForm = SwView.ModelToViewTransform

         Dim SwDim As Dimension

         Dim SwAnn As Annotation, SwAnn1 As Annotation

         Dim Ss, oScale, ii, Str

         Dim MathPt As MathPoint

         Dim SwNote As Note

             With SwDispDim

                 Set SwDim = .GetDimension

                 'Debug.Print SwDim.FullName

                 Set SwAnn = .GetAnnotation

                 Ss = SwDim.ReferencePoints

                 oScale = 1

                 For ii = 0 To 2

                     Set MathPt = Ss(ii)

                     Set MathPt = MathPt.MultiplyTransform(SwXForm)

                     With MathPt

                              Debug.Print "   xy(" & ii & "," & 0 & ")=" & Round(.ArrayData(0), 6) & ":",

                              Debug.Print "   xy(" & ii & "," & 1 & ")=" & Round(.ArrayData(1), 6)

                              tmp = SwModel.Extension.SelectByID2("", "VERTEX", .ArrayData(0), .ArrayData(1), .ArrayData(2), False, 0, Nothing, 0)

                              Str = GetOrientation(SwDispDim) & "-" & SwDim.Name & "-" & ii

                              Str = Str & vbCr & " (" & Round(.ArrayData(0), 4) & "," & Round(.ArrayData(1), 4) & ",0)"

                     End With

                     ''

                     Set SwNote = SwModel.InsertNote(Str)

                     Set SwAnn1 = SwNote.GetAnnotation

                 Next ii

             End With

         Dim MathVext As MathVector, Pt(2) As Double

             Set MathVect = SwDim.DimensionLineDirection

             vDir = MathVect.ArrayData

             'Str = "<STACK><DIM><OVER>DimensionLineDirection is Direction ("               ''

             Str = SwDispDim.GetText(swDimensionTextAll)

             'Stop

             'Str = SwDispDim.GetText(swDimensionTextAll) & vbCrLf & "("

             'Str = vbCrLf & "("

             'Str = "<DIM>" & vbCrLf & "("                ''

             'Str = vbCrLf & "("

             Str = "("

             For jj = 0 To 2

                  Str = Str & Round(vDir(jj), 5) & ","

             Next jj               ''

             Str = Left(Str, Len(Str) - 1) & ")" '& vbCrLf

             Ss = SwAnn.GetPosition

             SwAnn.Select True

             'SwDispDim.SetText SwConst.swDimensionTextParts_e.swDimensionTextAll, Str

             SwModel.EditDimensionProperties2 0, 0, 0, "", "", 1, 9, 2, 1, 11, 11, "", "", 1, "", Str, 1

             'SwDispDim.SetText swDimensionTextCalloutBelow, Str

             SwModel.GraphicsRedraw2

             'SwDispDim.SetText swDimensionTextCalloutAbove, Str

             'For ii = 0 To 2

                 'Pt(ii) = Ss(ii)

             'Next ii

             ''

             'tmp = SwModel.Extension.SelectByID2("", "DRAWINGVIEW", Ss(0), Ss(1), 0, False, 0, Nothing, 0)

             'Set SwNote = SwModel.InsertNote(Str)            

      End Function

      Private Sub del20170625()

          Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

               Set SwApp = Application.SldWorks

               Set SwModel = SwApp.ActiveDoc

          Dim SwMathUtil As MathUtility

               Set SwMathUtil = SwApp.GetMathUtility

          Dim SwDraw As DrawingDoc

               Set SwDraw = SwModel

          Dim SwView As View

               Set SwView = SwDraw.GetFirstView

          Dim SkSketch As Sketch, SkPtArr

               Set SkSketch = SwView.GetSketch

               SkPtArr = SkSketch.GetSketchPoints

               ''

               If Not IsEmpty(SkPtArr) Then

                  For ii = 0 To UBound(SkPtArr)

                      Set SkPt = SkPtArr(ii)

                      SkPt.Select True

                  Next ii

                  SwModel.EditDelete

               End If

               ''

          Dim SwDispDim As DisplayDimension

         

          Dim SwNote As Note, SwAnn As Annotation, Anns

              

               Set SwView = SwView.GetNextView

          ''

               Do While Not SwView Is Nothing

                   SwModel.ClearSelection2 True

                   Set SwNote = SwView.GetFirstNote

                   Do While Not SwNote Is Nothing

                      'Debug.Print SwNote.GetText

                      Set SwAnn = SwNote.GetAnnotation

                      SwAnn.Select True

                     

                      Set SwNote = SwNote.GetNext

                   Loop

                   ''

                   SwModel.EditDelete

                   SwModel.ClearSelection2 True

                   ''

                   Set SwDispDim = SwView.GetFirstDisplayDimension

                   Do While Not SwDispDim Is Nothing

                        With SwDispDim

                             If .Type2 = 2 Or .Type2 = 11 Or .Type2 = 12 Then

                                 Debug.Print "'******** Êý×é" & SwDispDim.GetDimension.Name

                                 Arr = RefPtArr(SwModel, SwMathUtil, SwView, SwDispDim)

                             End If

                        End With

                        Set SwDispDim = SwDispDim.GetNext

                   Loop

                   Set SwView = SwView.GetNextView

               Loop

      End Sub

        • Re: EditDimensionProperties3,use chr(13) result  is error.
          Peter Brinkhuis

          Well you are trying to add a suffix, which means some text after the main object. I though it might be the fact that you define your string as a variant, but that wasn't the issue. I changed the text to this:

           

          Str = Chr(13) & "(0,0,1)"

           

          It now adds a carriage return to the existing text <DIM>. This is the code that I used, the dimension still has to be preselected.

           

          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

              Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

              Str = Chr(13) & "(0,0,1)"

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

          End Sub

           

          According to the help, the best way to edit a dimension is via EditDimensionProperties that used the ModelDocExtension.