2 Replies Latest reply on Oct 29, 2018 3:15 PM by Fifi Riri

    delete dangling reference model dimensions

    Mike Flanders

      I was wondering if someone could help me change this macro to work on a part model instead of a drawing. The macro I attached runs through the drawing and deletes any dangling dimensions. I wasn't sure if we could switch a few things to call out the part instead of the drawing and have it work for the model.

       

      dangling model dimensions.JPG

        • Re: delete dangling reference model dimensions
          Deepak Gupta

          Use the codes from this example and add check to find if dimension is dangling or not. If yes then delete else next

           

          Iterate Through Dimensions in Model Example (VBA)

          • Re: delete dangling reference model dimensions
            Fifi Riri

            Hello, Try this:

             

            Option Explicit

            Dim swModel As SldWorks.ModelDoc2

            Sub main()

                Dim swApp As SldWorks.SldWorks

                Dim swFeat As SldWorks.Feature

                Dim swSubFeat As SldWorks.Feature

                Dim swDispDim As SldWorks.DisplayDimension

                Dim swAnn As SldWorks.Annotation

                Dim boolstatus As Boolean

                Set swApp = Application.SldWorks

                Set swModel = swApp.ActiveDoc

                Set swFeat = swModel.FirstFeature

                Do While Not swFeat Is Nothing

                    'Debug.Print "  " + swFeat.Name

                    Set swSubFeat = swFeat.GetFirstSubFeature

                    Do While Not swSubFeat Is Nothing

                       ' Debug.Print "      " + swSubFeat.Name

                        DeleteFeatureDim swSubFeat

                        Set swSubFeat = swSubFeat.GetNextSubFeature

                    Loop

                    DeleteFeatureDim swFeat

                    Set swFeat = swFeat.GetNextFeature

                Loop

            End Sub

             

            Sub DeleteFeatureDim(ByVal swFeat As SldWorks.Feature)

                Dim swDispDim As SldWorks.DisplayDimension

                Dim swAnn As SldWorks.Annotation

                Dim boolstatus As Boolean

                Set swDispDim = swFeat.GetFirstDisplayDimension

                Do While Not swDispDim Is Nothing

                    Set swAnn = swDispDim.GetAnnotation

                    'Debug.Print "    [" & swDim.FullName & "] = " & swDim.GetSystemValue2("")

                    If swAnn.IsDangling Then

                        boolstatus = swFeat.Select2(False, 0)

                        swModel.EditSketch

                        boolstatus = swAnn.Select3(False, Nothing)

                        boolstatus = swModel.Extension.DeleteSelection2(0)

                        swModel.InsertSketch2 True

                    End If

                    Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)

                Loop

            End Sub