AnsweredAssumed Answered

Set the foreshortened Radius  with API

Question asked by Yong Ning on May 29, 2015

0.jpg

 

 

1.jpg

 

How to foreshortened (broken)  dimension. and  move centerpoint of a radius

 

 

How to set the Radial Dimension Text Position? | SOLIDWORKS Forums

https://forum.solidworks.com/message/429020#429020

 

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

 

 

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

      Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

  

      Debug.Print SwDispDim.ShortenedRadius

      With SwDispDim

         .ShortenedRadius = False

         .ShortenedRadius = True

         Debug.Print .GetBrokenLeader2

         .SetBrokenLeader2 False, swBrokenLeaderHorizontalText

         '.SetBrokenLeader2 False, swSolidLeaderAlignedText

         '.SetBrokenLeader2 False, swBrokenLeaderAlignedText

         Debug.Print .GetPrimaryPrecision2

         .SetPrecision2 0, 0, 0, 0

         Debug.Print .Type2

     

      End With

  

      Stop

End Sub

 

type2

 

swDimensionType_e

swDimensionTypeUnknown - Dimension type could not be determined

swOrdinateDimension - Base ordinate and its subordinates are of this type

swLinearDimension - Linear dimension type

swAngularDimension - Angular dimension type

swArcLengthDimension - Arc length dimension type

swRadialDimension - Radial and diametric dimensions are of this type

swDiameterDimension

swHorOrdinateDimension - Horizontal ordinate dimension

swVertOrdinateDimension - Vertical ordinate dimension

swZAxisDimension

swChamferDimension

swHorLinearDimension - Horizontal linear dimension

swVertLinearDimension - Vertical linear dimension

swScalarDimension

 

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

 

 

 

Private Sub ll1()

   Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

      Set SwApp = Application.SldWorks

      Set SwModel = SwApp.ActiveDoc

   Dim SwDraw As DrawingDoc, SwSheet As Sheet, vSheet

      Set SwDraw = SwModel

   Dim SwView As View

   Dim SwDispDim As DisplayDimension

      vSheet = SwDraw.GetSheetNames

      For ii = 0 To UBound(vSheet)

         With SwDraw

            .ActivateSheet vSheet(ii)

            Set SwSheet = .GetCurrentSheet

            Set SwView = SwDraw.GetFirstView

            Set SwView = SwView.GetNextView

            Set SwDispDim = SwView.GetFirstDisplayDimension

            Do While Not SwDispDim Is Nothing

               If SwDispDim.Type2 = swRadialDimension Then

                  With SwDispDim

                     Debug.Print .Type2

                     .SetBrokenLeader2 False, swBrokenLeaderHorizontalText

                     .ShortenedRadius = True

                   

                  End With

               End If

               SwDispDim.SetPrecision2 0, 0, 0, 0

               Set SwDispDim = SwDispDim.GetNext

            Loop

         End With

      Next ii

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''

Function AlignDimCen(SwView As View)

    Dim SwDispDim As DisplayDimension

    Dim SwDim As Dimension

    Dim SwAnn As Annotation

      

       'Debug.Print SwView.GetName2

       If SwView Is Nothing Then

          Exit Function

       End If

       ''

       Set SwDispDim = SwView.GetFirstDisplayDimension

       ''

       Do While Not SwDispDim Is Nothing

          With SwDispDim

             Set SwDim = .GetDimension

             If .GetType = 5 Then

                .CenterText = True

                .BrokenLeader = False

                .ShortenedRadius = True

                ''

                If SwDim.FullName Like "*Dn*" Then

                   .SetBrokenLeader2 False, swDisplayDimensionLeaderText_e.swBrokenLeaderAlignedText

                Else

                   .SetBrokenLeader2 False, swDisplayDimensionLeaderText_e.swBrokenLeaderHorizontalText

                End If

                ''

             ElseIf .GetType = 2 Then

                Set SwDim = .GetDimension

                .CenterText = True

                .BrokenLeader = True

                .SetBrokenLeader2 False, swDisplayDimensionLeaderText_e.swBrokenLeaderAlignedText

             Else

                .CenterText = False

                .BrokenLeader = False

                .SetBrokenLeader2 False, swDisplayDimensionLeaderText_e.swSolidLeaderAlignedText

             End If

             Set SwDim = .GetDimension

             .SetDual True

             .ShowParenthesis = False

             Set SwAnn = .GetAnnotation

             SwAnn.Layer = "尺寸线"

             Set SwDispDim = .GetNext

          End With

       Loop

End Function

''

Private Sub ll3()

   Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

      Set SwApp = Application.SldWorks

      Set SwModel = SwApp.ActiveDoc

   Dim SwDraw As DrawingDoc

      Set SwDraw = SwModel

   Dim vSheets, SwSheet As Sheet, SwView As View

      vSheets = SwDraw.GetSheetNames

      For ii = 0 To UBound(vSheets)

         SwDraw.ActivateSheet vSheets(ii)

         Set SwSheet = SwDraw.GetCurrentSheet

         Set SwView = SwDraw.GetFirstView

         Do While Not SwView Is Nothing

            AlignDimCen SwView

            Set SwView = SwView.GetNextView

         Loop

      Next ii

End Sub

Attachments

Outcomes