3 Replies Latest reply on May 21, 2014 10:09 AM by Yong Ning

    Have dimension → how to set DisplayDimension

    Yong Ning

      Known Dim swDispDim  As SldWorks.DisplayDimension

         Set swAnn = swDispDim.GetAnnotation

         Set swDim = swDispDim.GetDimension

       

       

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

          Dim swDispDim                   As SldWorks.DisplayDimension

          Dim swDim                       As SldWorks.Dimension

          Dim swAnn                       As SldWorks.Annotation

       

      Set swDispDim = swView.GetFirstDisplayDimension5

         Set swAnn = swDispDim.GetAnnotation

         Set swDim = swDispDim.GetDimension

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

       

       

      My question

          Dim swDim As SldWorks.Dimension

          Set swDim = swModel.Parameter("D1@Extrude1")

      How to set SldWorks.Dimension→SldWorks.DisplayDimension


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

       


        • Re: Have dimension → how to set DisplayDimension
          Yong Ning

          For example code.

           

          Set swDim = swModel.Parameter("D1@Extrude1")

          Have Dimension → How to set Displaydimension


          '

          '---------------------------------------------

          Option Explicit

          Sub main()

              Dim swApp                       As SldWorks.SldWorks

              Dim swModel                     As SldWorks.ModelDoc2

              Dim swDim                       As SldWorks.Dimension

              Dim vConfigNames                As Variant

              Dim vValue                      As Variant

              Set swApp = Application.SldWorks

              Set swModel = swApp.ActiveDoc

              Set swDim = swModel.Parameter("D1@Extrude1")

           

              Debug.Assert Not swDim Is Nothing

           

              Debug.Print "File = " & swModel.GetPathName

              Debug.Print "  FullName = " & swDim.FullName

              Debug.Print "  Name = " & swDim.Name

           

              vConfigNames = swModel.GetConfigurationNames

              vValue = swDim.GetSystemValue3(swThisConfiguration, (vConfigNames))

              Debug.Print "  SystemValue = " & vValue(0) * 1000#; "" & " mm"

           

          End Sub

            • Re: Have dimension → how to set DisplayDimension
              Artem Taturevych

              Despite it is not ideal solution but I do not see any other possible ways to do this (apart traversing):

               

              Dim swApp As SldWorks.SldWorks

              Dim swModel As SldWorks.ModelDoc2

              Dim swSelMgr As SldWorks.SelectionMgr

               

              Sub main()

               

                  Set swApp = Application.SldWorks

               

                  Set swModel = swApp.ActiveDoc

                 

                  Set swSelMgr = swModel.SelectionManager

                 

                  Dim swDim As SldWorks.Dimension

                 

                  Set swDim = swModel.Parameter("D1@Extrude1")

                 

                  If swModel.Extension.SelectByID2(swDim.GetNameForSelection(), "DIMENSION", 0, 0, 0, False, 0, Nothing, 0) Then

                     

                      Dim swDispDim As SldWorks.DisplayDimension

                      Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

               

                  End If

                 

              End Sub

              ____________________________________________________

              Regards,

              Artem Taturevych, Application Engineer at Intercad (Australia)

               

              translationXpert – add-in to translate SolidWorks models

              myIntercad an integrated tool for SolidWorks Professionals

              LinkedIn SolidWorks API Education Group

                • Re: Have dimension → how to set DisplayDimension
                  Yong Ning

                  Thank your tip.

                   

                  2013 SolidWorks API Help - Get Feature Type and Name Example (VBA)

                  http://help.solidworks.com/2013/English/api/sldworksapi/get_feature_type_and_name_example_vb.htm

                   

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

                   

                  ' Get the feature's type and name

                  featName = swFeat.GetNameForSelection(featType)

                  swModelDocExt.SelectByID2 featName, featType, 0, 0, 0, True, 0, Nothing, 0

                   

                  Sub ll()

                    Dim SwDraw As DrawingDoc

                    Set SwDraw = Application.SldWorks.ActiveDoc

                    Dim SwDisp As DisplayDimension, SwDim As Dimension

                      Set SwDim = SwDraw.Parameter("D1@草图1")

                  Debug.Print Not SwDim Is Nothing

                  Debug.Print

                      If Not SwDim Is Nothing Then

                      tmp = SwDraw.Extension.SelectByID2(SwDim.FullName, "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

                      Debug.Print tmp

                      SwDraw.EditDelete

                      End If

                   

                  End Sub

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

                  Sub main()
                    Dim swApp As SldWorks.SldWorks, SwModel As ModelDoc2, SwDraw As DrawingDoc
                    Dim vModel As ModelDoc2
                    ''
                    Dim Arr, Arr1, oArr, oArr1, Rng As Range, Sht As Worksheet
                   
                    Dim FileName, Str, Path
                    Set swApp = Application.SldWorks  ''
                    swApp.SetUserPreferenceToggle 249, False
                    Set SwDraw = swApp.ActiveDoc
                    FileName = Left(SwDraw.GetPathName, InStr(FileName, "卧式储罐") + 4) & "Horizontal Tank.xls"
                    Set Sht = OpenXls(FileName).Sheets("材料表")
                   
                    ''
                    Str = SwDraw.GetPathName
                    'Debug.Print Str, Sht.name
                    ''
                    savePath = Left(Str, InStrRev(Str, "\"))
                    ''
                    Set Rng = Sht.Range("A5:A" & Sht.Range("A65536").End(3).Row)
                    ''
                    For ii = 1 To Rng.Rows.Count
                      ''
                      If Rng(ii, 1) <> "" Then
                       
                        Set SwModel = swApp.GetOpenDocumentByName(savePath & Rng(ii, 21))
                        'Debug.Print SwModel.GetTitle
                        SwDwg swApp, SwModel, Sht, Rng(ii, 1)
                       
                        SwModel.ForceRebuild3 False
                      End If
                    Next ii
                    ''
                    Dim SwDim As Dimension, SwDim1 As Dimension, SwView As View
                    With SwDraw
                      
                       Set SwView = .GetFirstView
                       Set SwView = SwView.GetNextView
                       .ForceRebuild3 False
                       Str = "RD5@" & SwView.name
                       .ForceRebuild3 False
                       Set SwDim1 = SwDraw.Parameter(Str)
                      
                       Str = "D7@草图1"
                       Set SwDim = SwDraw.Parameter(Str)
                       'Debug.Print SwDim.FullName, SwDim.Value, SwDim1.FullName, SwDim1.Value
                      
                       SwDim.Value = SwDim1.Value
                       ''
                       Set SwView = SwView.GetNextView
                       Str = "RD3@" & SwView.name
                       Set SwDim1 = SwDraw.Parameter(Str)
                       Str = "D5@草图1"
                       Set SwDim = SwDraw.Parameter(Str)
                       SwDim.Value = SwDim1.Value - 150
                       ''
                       SwDraw.ForceRebuild3 False
                   
                       For ii = 1 To 10
                         Set SwDim = SwDraw.Parameter("D" & ii & "@草图1")

                         If Not SwDim Is Nothing Then
                            tmp = SwDraw.Extension.SelectByID2(SwDim.FullName, "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
                            Debug.Print tmp
                            SwDraw.EditDelete
                         End If
                      Next ii
                       '.Save2 False
                      
                    End With

                    ''
                    swApp.SetUserPreferenceToggle 249, True
                  End Sub

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

                   

                  Sub ll()

                     Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2, Str

                      Set SwApp = Application.SldWorks

                      Set SwModel = SwApp.ActiveDoc

                      Set SwSelMgr = SwModel.SelectionManager

                   

                      Dim DispDim As DisplayDimension, SwDim As SldWorks.Dimension, SwDim1 As Dimension

                      Set SwDim = SwModel.Parameter("TH_d@CutHoleSketch")

                      If SwModel.Extension.SelectByID2(SwDim.FullName, "DIMENSION", 0, 0, 0, False, 0, Nothing, 0) Then

                          Dim swDispDim As SldWorks.DisplayDimension

                          Set swDispDim = SwSelMgr.GetSelectedObject6(1, -1)

                           Str = 64 & "-<MOD-DIAM>"

                           swDispDim.SetText 1, Str

                           swDispDim.SetText 4, "配M螺柱"

                           Debug.Print swDispDim.GetText(1), swDispDim.GetText(4)

                      End If

                  End Sub

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

                  Sub lll()

                    Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2, SwDraw As DrawingDoc

                      Set SwApp = GetObject(, "SldWorks.Application")

                      Set SwModel = SwApp.ActiveDoc

                      Set SwDraw = SwModel

                    Dim SwSelMgr As SelectionMgr

                      Set SwSelMgr = SwModel.SelectionManager

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

                   

                      Set DispDim = SwSelMgr.GetSelectedObject6(1, -1)

                      With DispDim

                        'Debug.Print .HorizontalJustification

                        Debug.Print .GetUseDocBrokenLeader

                        .SetBrokenLeader2 False, swBrokenLeaderHorizontalText

                      End With

                  End Sub