AnsweredAssumed Answered

EditDimensionProperties3,use chr(13) result  is error.

Question asked by Yong Ning on Jun 28, 2017
Latest reply on Jun 29, 2017 by Peter Brinkhuis

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

Outcomes