3 Replies Latest reply on Jun 23, 2017 6:31 AM by Dave Bear

    Dimension Properties

    Yong Ning

      Arrow.jpg

       

      Private Sub ll()

         Dim swApp As SldWorks.SldWorks, swModel As ModelDoc2

             Set swApp = Application.SldWorks

             Set swModel = swApp.ActiveDoc

         Dim SwSelMgr As SelectionMgr

             Set SwSelMgr = swModel.SelectionManager

         Dim swDispDim As DisplayDimension, swDim As Dimension

             Set swDispDim = SwSelMgr.GetSelectedObject5(1)

             With swDispDim

                 .ArrowSide = swDimArrowsInside

                 .SetArrowHeadStyle False, swCLOSED_ARROWHEAD  ' swNO_ARROWHEAD

                 Debug.Print .GetArrowHeadStyle

                 '.SetOverride False, 10 '"<DIM>"

                 .SetBrokenLeader2 False, swBrokenLeaderAlignedText  'swBrokenLeaderHorizontalText  ' swSolidLeaderAlignedText

                 Debug.Print .GetBrokenLeader2

             End With

             swModel.ForceRebuild3 True

      End Sub

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

      swDimensionArrowsSide_e

      swDimArrowsInside - Always positioned on the inside.

      swDimArrowsOutside - Always positioned on the outside.

      swDimArrowsSmart - Positioned on the inside, if there is room; otherwise, positioned on the outside.

      swDimArrowsFollowDoc - As per the document's default setting.

       

      swSolidLeaderAlignedText - The leader is solid (not broken) and the text is aligned with the leader.

      swBrokenLeaderHorizontalText - The leader is broken and the text is horizontal.

      swBrokenLeaderAlignedText - The leader is broken and the text is aligned with the leader.

       

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

      How to Align Dimension with API ? | SOLIDWORKS Forums  https://forum.solidworks.com/message/690260

      How to determine the number of multiple dimensi... | SOLIDWORKS Forums  https://forum.solidworks.com/message/570899#comment-570899

      Have dimension → how to set DisplayDimension | SOLIDWORKS Forums  https://forum.solidworks.com/message/378125#comment-378125

      Rotate the dimension text orientation with API? | SOLIDWORKS Forums  https://forum.solidworks.com/message/473296

      How to set the Radial Dimension Text Position? | SOLIDWORKS Forums  https://forum.solidworks.com/message/429020

      How to display dimension of Horizontal Text wit... | SOLIDWORKS Forums  https://forum.solidworks.com/message/366384

      Vertical Ordinate Dimensions → with API | SOLIDWORKS Forums  https://forum.solidworks.com/message/385093

      How to Get dimension Name in Traverse Assembly | SOLIDWORKS Forums  https://forum.solidworks.com/message/292035#comment-292035

      Get Display Dimension Type - API | SOLIDWORKS Forums  https://forum.solidworks.com/message/317119#comment-317119

        • Re: Dimension Properties
          Yong Ning

          Dim Str

          ''

          Sub MoveDimAnn()

             Dim SkPt As SketchPoint, SkSketch As Sketch

             Dim SkPtArr, SwSegMent As SketchSegment

             Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                 Set SwApp = Application.SldWorks

                 Set SwModel = SwApp.ActiveDoc

                 SwModel.ClearSelection2 False

                 'Set SkPt = SwModel.CreatePoint2(0, 0, 0)

             Dim SwDraw As DrawingDoc

                 Set SwDraw = SwModel

             Dim SwSheet As Sheet, SwView As View

                 Set SwSheet = SwDraw.GetCurrentSheet

                 Set SwView = SwDraw.GetFirstView

             Dim SwMathUtil As MathUtility

                 Set SwMathUtil = SwApp.GetMathUtility

             Dim SwSelMgr As SelectionMgr

                 Set SwSelMgr = SwModel.SelectionManager

             Dim SwDispDim As DisplayDimension, SwDim As Dimension, SwAnn As Annotation

             Dim AnnPos, Ss, SwMathPt(2) As MathPoint

             Dim Xy(2, 1) As Double, Xy1(2, 1), Xy2(2, 1)

             Dim Arr As Variant

                 Do While Not SwView Is Nothing

                     Set SwDispDim = SwView.GetFirstDisplayDimension

                     Do While Not SwDispDim Is Nothing

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

                          MathPtMoveDim SwModel, SwMathUtil, SwView, SwDispDim, Arr(0), Arr(1)

                          Set SwDispDim = SwDispDim.GetNext

                     Loop

                     Set SwView = SwView.GetNextView

                 Loop

          End Sub

           

           

           

           

          ''

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

               Dim Arr(2) As Variant, AnnPos As Variant

               Dim Xy(2, 1) As Double, Xy1(2, 1)

               Dim SwDim As Dimension, SwAnn As Annotation

               Dim SwMathPt(2) As MathPoint

               Dim SwXForm As MathTransform

               Dim RefPt, Dist

                  Set SwXForm = SwView.ModelToViewTransform

                  With SwDispDim

                      Set SwDim = .GetDimension

                      Debug.Print SwDim.FullName, SwDispDim.Type2,

                      DispDimType SwDispDim

           

           

                     

                      Str = SwDim.FullName & "@" & SwView.Name

                      ''Debug.Print Str

                      Ss = SwDim.ReferencePoints

                 

                      For ii = 0 To 2

                          Set SwMathPt(ii) = Ss(ii)

                          Set SwMathPt(ii) = SwMathPt(ii).MultiplyTransform(SwXForm)

                      Next ii

                      Set SwAnn = .GetAnnotation

                      'SwAnn.SetPosition 0#, -0.09, 0

                      'SwAnn.SetPosition 0#, 0.05, 0

                      AnnPos = SwAnn.GetPosition

                   End With

                   For ii = 0 To 2

                       For jj = 0 To 1

                           Xy1(ii, jj) = SwMathPt(ii).ArrayData(jj)

                           Xy(ii, jj) = Round(AnnPos(jj) - Xy1(ii, jj), 6) / SwView.ScaleDecimal

                       Next jj

                   Next ii

               

                      'If SwDim.FullName = "H@Web1@¸¹°å.Part" Then

                      If SwDim.FullName = "W@Web1@¸¹°å.Part" Then

                          'SwAnn.Select False

                          Stop

                      End If

           

           

                   ''

                   If Xy1(0, 1) = Xy1(1, 1) Then

                        Arr(0) = "0,1"

                           If Xy(0, 1) > 0 Then

                               Arr(1) = 10

                           ElseIf Xy(0, 1) < 0 Then

                               Arr(1) = -10

                           End If

                   ElseIf Xy1(0, 0) = Xy1(1, 0) Then

                        Arr(0) = "0,0"

                           If Xy(0, 0) > 0 Then

                               Arr(1) = 10

                           ElseIf Xy(0, 0) < 0 Then

                               Arr(1) = -10

                           End If

                   Else

                        Arr(0) = Empty

                        Arr(1) = Empty

                   End If

                   ''

                   If SwDispDim.Type2 = 2 Then

                       If Xy1(1, 1) = Xy1(2, 1) Then

                          Arr(0) = "0,0"

                          If Xy(1, 0) > 0 Then

                              Arr(1) = 10

                          ElseIf Xy(1, 0) < 0 Then

                              Arr(1) = -10

                          End If

                       End If

                   End If

                   ''''

               DimMathPtArr = Arr

          End Function

          Function MathPtMoveDim(SwModel As ModelDoc2, SwMathUtil As MathUtility, _

                   SwView As View, SwDispDim As DisplayDimension, _

                   RefPt, Dist)

               Dim Arr(2) As Variant, AnnPos As Variant

               Dim Xy(2, 1) As Double, Xy1(2, 1)

               Dim SwDim As Dimension, SwAnn As Annotation

               Dim SwMathPt(2) As MathPoint

               Dim SwXForm As MathTransform

               Dim Xx, Yy

                  Set SwXForm = SwView.ModelToViewTransform

                  With SwDispDim

                      Set SwDim = .GetDimension

                      Ss = SwDim.ReferencePoints

                 

                      For ii = 0 To 2

                          Set SwMathPt(ii) = Ss(ii)

                          Set SwMathPt(ii) = SwMathPt(ii).MultiplyTransform(SwXForm)

                      Next ii

                      Set SwAnn = .GetAnnotation

                      AnnPos = SwAnn.GetPosition

                   End With

                   For ii = 0 To 2

                       For jj = 0 To 1

                           Xy(ii, jj) = SwMathPt(ii).ArrayData(jj) '/ SwView.ScaleDecimal

                       Next jj

                   Next ii

                   Xx = AnnPos(0)

                   Yy = AnnPos(1)

                   '

               Dim Rr, Cc

                   If Not IsEmpty(RefPt) Then

                       Ss = Split(RefPt, ",")

                       Rr = Ss(0)

                       Cc = Ss(1)

                       Select Case RefPt

                            Case "0,0", "1,1"

                                 Xx = Xy(Rr, Cc) + Dist / 1000

                            Case "0,1"

                                 Yy = Xy(Rr, Cc) + Dist / 1000

                       End Select

                       Select Case SwDispDim.Type2

                            Case 2, 12

                                 SwAnn.SetPosition Xx, Yy, 0

                       End Select

                   End If

                   ''

          End Function

          ''

          • Re: Dimension Properties
            Peter Brinkhuis

            Do you have a question for us?