2 Replies Latest reply on Jun 19, 2013 6:05 AM by Yong Ning

    How to delete dimension in drawing with AIP ?

    Yong Ning

      Help me.

      Traverse dimension →  delete dimension.

       

      a0.jpg

      Traverse dimension code is:

       

      Sub oDim()

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

        Dim SwView As view, DispDim As DisplayDimension, SwDim As Dimension

        Set SwApp = Application.SldWorks

        Set SwDraw = SwApp.ActiveDoc

        ''

        Set SwView = SwDraw.GetFirstView

        Do While Not SwView Is Nothing

          'If SwView.GetName2 Like "*RF1" Then

            With SwView

              nn = .GetDimensionCount

              Set DispDim = .GetFirstDisplayDimension

              Do While Not DispDim Is Nothing

                Set SwDim = DispDim.GetDimension

                Debug.Print SwDim.FullName

                Set DispDim = DispDim.GetNext2

              Loop

            End With

          'End If

         

          Set SwView = SwView.GetNextView

        Loop

      End Sub

       

      Run Code Result

       

      D1@Sketch2@Part1.Part
      D1@Extrude1@Part1.Part
      D1@Sketch1@Part1.Part
      D2@Sketch1@Part1.Part
      RD1@工程视图3@aa.Drawing

        • Re: How to delete dimension in drawing with AIP ?
          Artem Taturevych

          Check the following macro (lines in red). If you want to delete all dimensions it makes sense to preselect them all with append = True flag and then call delete method at the very end only once.

           

          Sub oDim()

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

            Dim SwView As View, DispDim As DisplayDimension, SwDim As Dimension

            Set SwApp = Application.SldWorks

            Set SwDraw = SwApp.ActiveDoc

            ''

            Set SwView = SwDraw.GetFirstView

            Do While Not SwView Is Nothing

              'If SwView.GetName2 Like "*RF1" Then

                With SwView

                  nn = .GetDimensionCount

                  Set DispDim = .GetFirstDisplayDimension

                  Do While Not DispDim Is Nothing

                    Set SwDim = DispDim.GetDimension

                    Debug.Print SwDim.FullName

                    Dim delDim As SldWorks.Annotation

                    Set delDim = DispDim.GetAnnotation

                    Set DispDim = DispDim.GetNext2 'you should get next dimension before deleting

                    delDim.Select3 False, Nothing

                    SwDraw.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Absorbed

                  Loop

                End With

              'End If

            

              Set SwView = SwView.GetNextView

            Loop

          End Sub

          __________________________

          Regards,

          Artem Taturevych

          Application Engineer at Intercad

          http://intercad.com.au/

          Tel: +61 2 9454 4444

            • Re: How to delete dimension in drawing with AIP ?
              Yong Ning

              Thanks your code

               

              Sub oDim()

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

                Dim SwView As view, DispDim As DisplayDimension, SwDim As Dimension

                Set SwApp = Application.SldWorks

                Set SwDraw = SwApp.ActiveDoc

                ''

                Set SwView = SwDraw.GetFirstView

                Do While Not SwView Is Nothing

                  'If SwView.GetName2 Like "*RF1" Then

                    With SwView

                      nn = .GetDimensionCount

                      Set DispDim = .GetFirstDisplayDimension

                      Do While Not DispDim Is Nothing

                        Set SwDim = DispDim.GetDimension

                        Debug.Print SwDim.FullName

                        Dim delDim As SldWorks.Annotation

                        Set delDim = DispDim.GetAnnotation

                        Set DispDim = DispDim.GetNext2 'you should get next dimension before deleting

                        delDim.Select3 False, Nothing

                        'SwDraw.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Absorbed

                        bRet = SwDraw.DeleteSelection(False)

                        'SwDraw.EditDelete

                      Loop

                    End With

                  'End If

               

                  Set SwView = SwView.GetNextView

                Loop

              End Sub

               

              I use Solidworks version is Solidworks 2006

               

              can't run sentence

              SwDraw.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Absorbed

               

              use sentence

               

              sentence  →    bRet = SwDraw.DeleteSelection(False)

              or

              centence →    'SwDraw.EditDelete

               

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

              ''

              Sub ll2()

                Dim Arr(13, 2)

                  Arr(0, 0) = "H@FlangeSketch": Arr(0, 1) = "XXXX主视图": Arr(0, 2) = False

                  Arr(1, 0) = "D@FlangeSketch": Arr(1, 1) = "XXXX主视图": Arr(1, 2) = False

                  Arr(2, 0) = "A1AB@FlangeSketch": Arr(2, 1) = "XXXX主视图": Arr(2, 2) = False

                  Arr(3, 0) = "f1@FlangeSketch": Arr(3, 1) = "XXXX主视图": Arr(3, 2) = True

                  Arr(4, 0) = "C@FlangeSketch": Arr(4, 1) = "XXXX主视图": Arr(4, 2) = False

                  Arr(5, 0) = "H1@FlangeSketch": Arr(5, 1) = "XXXX主视图": Arr(5, 2) = True

                  Arr(6, 0) = "PipeTHK@FlangeSketch": Arr(6, 1) = "XXXX主视图": Arr(6, 2) = True

                  Arr(7, 0) = "R@FlangeSketch": Arr(7, 1) = "XXXX主视图": Arr(7, 2) = True

                  Arr(8, 0) = "D1@FlangeSketch": Arr(8, 1) = "XXXX主视图": Arr(8, 2) = True

                  Arr(9, 0) = "Fd@FlangeSketch": Arr(9, 1) = "XXXX主视图": Arr(9, 2) = True

                  Arr(10, 0) = "NAB@FlangeSketch": Arr(10, 1) = "XXXX主视图": Arr(10, 2) = True

                  Arr(11, 0) = "L@CutHoleSketch": Arr(11, 1) = "XXXX俯视图": Arr(11, 2) = False

                  Arr(12, 0) = "K@CutHoleSketch": Arr(12, 1) = "XXXX俯视图": Arr(12, 2) = False

                  Arr(13, 0) = "D1@Alfa基准面": Arr(13, 1) = "XXXX俯视图": Arr(13, 2) = True

               

               

                  ''

                Dim ii, jj

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

                Dim DispDim As DisplayDimension, DispDim1 As DisplayDimension

                Set SwApp = Application.SldWorks

                Set SwDraw = SwApp.ActiveDoc

               

                Dim vSheets, SwSheet As Sheet, SwView As View

                Dim Str As String, Str1, ReplStr, ReplStr1, tmp

                Dim FileName, FileName1

                Dim oStr, oStr1

                Dim SwDim As Dimension, SwDim1 As Dimension

                Dim SwSelMgr As SelectionMgr

               

                ''

               

                With SwDraw

                  Set SwSelMgr = .SelectionManager()

                  ''

                  vSheets = .GetSheetNames

                  For ii = 0 To UBound(vSheets)

                    FileName = vSheets(ii)

                    ReplStr = Val(Split(FileName, "-")(1))

                    ReplStr1 = Format(ReplStr / 10, "0.0#")

                    FileName1 = Replace(FileName, "-" & ReplStr, "-" & ReplStr1)

                    FileName1 = Replace(FileName1, "(B)", "")

                    ''

                    .ActivateSheet vSheets(ii)

                    Set SwSheet = .GetCurrentSheet

                    Dim SwAnn As SldWorks.Annotation, SwAnn1 As SldWorks.Annotation

                    ''

                    For jj = 0 To UBound(Arr)

                      Str = Arr(jj, 0) & "@" & .GetTitle & "@" & Arr(jj, 1)

                      Str = Replace(Str, "XXXX", FileName)

                      tmp = .Extension.SelectByID2(Str, "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

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

                      Set SwDim = DispDim.GetDimension

                      ''

                      Str1 = Arr(jj, 0) & "@" & .GetTitle & "@" & Arr(jj, 1)

                      Str1 = Replace(Str1, "XXXX", FileName1)

                      Str1 = Replace(Str1, "(B)", "")

                      tmp = .Extension.SelectByID2(Str1, "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

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

                      Set SwDim1 = DispDim1.GetDimension

                     

                      If Arr(jj, 2) Then

                        Set SwAnn = DispDim.GetAnnotation

                        SwAnn.Select3 False, Nothing

                        .DeleteSelection False

                        Set SwAnn1 = DispDim1.GetAnnotation

                        SwAnn1.Select3 False, Nothing

                        .DeleteSelection False

                      Else

                        If SwDim.Value <> SwDim1.Value Then

                          SwAnn.Select3 False, Nothing

                          DispDim.Inspection = True

                          SwAnn1.Select3 False, Nothing

                          DispDim1.Inspection = True

                        Else

                                   

                        End If

                        'Debug.Print ii, jj, SwDim.FullName, SwDim1.FullName

                      End If

                    Next jj

                  Next ii

                End With

                

              End Sub

              ''