2 Replies Latest reply on Jun 13, 2017 10:48 PM by Yong Ning

    InsertModelAnnotations3

    Yong Ning

      Options

      Include items from hidden features. Inserts model items for hidden features. Clear this option to prevent the insertion of annotations that belong to hidden model items. Performance is slower while hidden model items are filtered.

      Use dimension placement in sketch. Inserts model dimensions from the part in the same locations in the drawing.

       

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

      Private Sub ll()

          Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

              Set SwApp = Application.SldWorks

              Set SwModel = SwApp.ActiveDoc

          Dim SwDraw As DrawingDoc

              Set SwDraw = SwModel

          Dim SwSelMgr As SelectionMgr

              Set SwSelMgr = SwModel.SelectionManager

          Dim SwView As View

              Set SwView = SwSelMgr.GetSelectedObject5(1)

          Dim Anns, Tmp

              Anns = SwDraw.InsertModelAnnotations3(0, 1737215, True, True, True, True)

              'Anns = SwDraw.InsertModelAnnotations3(0, 1212425, False, True, False, True)

              'Anns = SwDraw.InsertModelAnnotations3(0, swInsertDimensionsMarkedForDrawing, False, True, False, True)

              Stop

      End Sub

       

       

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

      InsertModelAnnotations3_1.jpg

       

      ''

      Function BreakOut(SwDraw As DrawingDoc, SwView As View)

       

       

          Dim Var, vPos, tmp, oScale

            

              oScale = 1 / SwView.ScaleDecimal

            

          Dim SwDim As Dimension, Depth

          Dim SwModel As ModelDoc2

              Set SwModel = SwView.ReferencedDocument

              Debug.Print SwModel.GetPathName

              'PrintModelDimension SwModel

              Set SwDim = SwModel.Parameter("Depth@PlateSize") '("Depth@PlateSize")

              Depth = SwDim.Value

            

          Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double

              With SwDraw

                   Var = SwView.GetOutline

                   vPos = SwView.Position

                 

                   For ii = 0 To UBound(Var)

                       Var(ii) = oScale * Var(ii)

                       If ii < 2 Then

                          vPos(ii) = oScale * vPos(ii)

                       End If

                   Next ii

                 

                 

                   tmp = .SketchRectangle(-Var(2), -Var(3), 0, Var(2), Var(3), 0, 1)

                   .CreateBreakOutSection Depth / 1000

                End With

      End Function

       

       

      '

      Private Sub del20161124()

         Dim Xls As Excel.Application, Rng As Range

             Set Xls = GetObject(, "Excel.Application")

             Set Rng = Xls.Cells(1, 1)

           

         Dim ModelName, ViewName, Xx, Yy, Str

             ModelName = Rng(1, 1)

             ViewName = Rng(1, 2)

             Xx = Rng(1, 3) / 1000

             Yy = Rng(1, 4) / 1000

             'Debug.Print Rng.Address, Rng

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

             Set SwApp = Application.SldWorks

             Set SwModel = SwApp.ActiveDoc

         Dim SwDraw As DrawingDoc

             Set SwDraw = SwModel

         Dim SwView As View

             Set SwView = SwDraw.CreateDrawViewFromModelView2(ModelName, ViewName, Xx, Yy, 0)

             ''

             BreakOut SwDraw, SwView

             'Debug.Print SwModel.GetPathName

             'PrintModelDimension SwModel

         Dim Annotations As Variant, SwAnn As Annotation

         Dim SwDispDim As DisplayDimension, SwDim As Dimension

           

             boolstatus = SwDraw.Extension.SelectByID2(SwView.Name, "DRAWINGVIEW", 0.08943651860342, 0.1646920297141, 0, True, 0, Nothing, 0)

             Annotations = SwDraw.InsertModelAnnotations3(0, 32776, False, False, True, True)

             SwDraw.ClearSelection2 True

             For ii = 0 To UBound(Annotations)

           

                 Set SwAnn = Annotations(ii)

                 'Debug.Print SwAnn.GetName

                 'SwAnn.IGetDisplayData

                 Set SwDispDim = SwAnn.GetSpecificAnnotation

                 Set SwDim = SwDispDim.GetDimension

                 If Not SwDim.FullName Like "*DrwDim*" Then

                      SwAnn.Select True

                 Else

                      SwDispDim.CenterText = True

                      Debug.Print SwDispDim.GetDimension.FullName

                 End If

               

             Next ii

             Stop

             SwModel.EditDelete

       

       

           

      End Sub

      ''

      '

      Private Sub del20161127()

         Dim Xls As Excel.Application, Rng As Range

             Set Xls = GetObject(, "Excel.Application")

             Set Rng = Xls.Cells(1, 1)

           

         Dim ModelName, ViewName, Xx, Yy, Str

             ModelName = Rng(1, 1)

             ViewName = Rng(1, 2)

             Xx = Rng(1, 3) / 1000

             Yy = Rng(1, 4) / 1000

             'Debug.Print Rng.Address, Rng

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

             Set SwApp = Application.SldWorks

             Set SwModel = SwApp.ActiveDoc

             SwModel.ClearSelection

         Dim SwSelMgr As SelectionMgr

             Set SwSelMgr = SwModel.SelectionManager

         Dim SwDraw As DrawingDoc

             Set SwDraw = SwModel

         Dim SwView As View, vViewName

             vViewName = "壳体主视图"

             'tmp = SwDraw.Extension.SelectByID2(vViewName, "DRAWINGVIEW", 0#, 0#, 0, True, 0, Nothing, 0)

             'Set SwView = SwSelMgr.GetSelectedObject5(1)

             'Debug.Print SwView.Name

           

           

             'PrintModelDimension SwModel

         Dim Annotations As Variant, SwAnn As Annotation

         Dim SwDispDim As DisplayDimension, SwDim As Dimension

           

             boolstatus = SwDraw.Extension.SelectByID2(vViewName, "DRAWINGVIEW", 0#, 0#, 0, True, 0, Nothing, 0)

             Annotations = SwDraw.InsertModelAnnotations3(0, 32776, False, False, True, True)

       

       

             'swInsertDimensionsNotMarkedForDrawing

             'swInsertDimensionsNotMarkedForDrawing

           

             SwDraw.ClearSelection2 True

             For ii = 0 To UBound(Annotations)

           

                 Set SwAnn = Annotations(ii)

                 'Debug.Print SwAnn.GetName

                 'SwAnn.IGetDisplayData

                 Set SwDispDim = SwAnn.GetSpecificAnnotation

                 Set SwDim = SwDispDim.GetDimension

                 If Not SwDim.FullName Like "*DrwDim*" Then

                      SwAnn.Select True

                 Else

                      SwDispDim.CenterText = True

                      Debug.Print SwDispDim.GetDimension.FullName

                 End If

               

             Next ii

             Stop

             SwModel.EditDelete

       

       

           

      End Sub

        • Re: InsertModelAnnotations3
          Peter Brinkhuis

          What is your question?

            • Re: InsertModelAnnotations3
              Yong Ning

              Thank you,question, follow code, don't insert Model dimensiion of hide in feature.

              retval = DrawingDoc.InsertModelAnnotations3 ( option, types, allViews, duplicateDims, hiddenFeatureDims, usePlacementInSketch)

               

              2.jpg

               

              My question , use  hiddenFeatureDims, don't option  →, Include items from hidden features

              TRUE to insert dimensions from features that are hidden

              1.jpg

              Private Sub ll()

                Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                    Set SwApp = Application.SldWorks

                    Set SwModel = SwApp.ActiveDoc

                Dim SwDraw  As DrawingDoc

                    Set SwDraw = SwModel

                Dim SwSelMgr As SelectionMgr

                    Set SwSelMgr = SwModel.SelectionManager

                Dim SwView As View

                    Set SwView = SwSelMgr.GetSelectedObject5(1)

                    Debug.Print SwView.Name

               

                     Annotations = SwDraw.InsertModelAnnotations3(0, swInsertDimensionsMarkedForDrawing, False, False, True, True)

                    Stop

                    Stop

               

               

              End Sub

               

               

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

               

              InsertModelAnnotations3_1.jpg

               

               

              ''

              Function BreakOut(SwDraw As DrawingDoc, SwView As View)

               

               

                  Dim Var, vPos, tmp, oScale

                

                      oScale = 1 / SwView.ScaleDecimal

                

                  Dim SwDim As Dimension, Depth

                  Dim SwModel As ModelDoc2

                      Set SwModel = SwView.ReferencedDocument

                      Debug.Print SwModel.GetPathName

                      'PrintModelDimension SwModel

                      Set SwDim = SwModel.Parameter("Depth@PlateSize") '("Depth@PlateSize")

                      Depth = SwDim.Value

                

                  Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double

                      With SwDraw

                           Var = SwView.GetOutline

                           vPos = SwView.Position

                     

                           For ii = 0 To UBound(Var)

                               Var(ii) = oScale * Var(ii)

                               If ii < 2 Then

                                  vPos(ii) = oScale * vPos(ii)

                               End If

                           Next ii

                     

                     

                           tmp = .SketchRectangle(Var(0), Var(1), 0, Var(2), Var(3), 0, 1)

                           .CreateBreakOutSection Depth / 1000

                        End With

              End Function

              Function DelDimension(SwDraw As DrawingDoc, ViewName, DelDim)

                  Dim SwDim As Dimension, SwDispDim As DisplayDimension, Annotations

                      tmp = SwDraw.Extension.SelectByID2(ViewName, "DRAWINGVIEW", 0#, 0#, 0, True, 0, Nothing, 0)

                      Annotations = SwDraw.InsertModelAnnotations3(0, 32776, False, False, True, True)

                      ''

                      SwDraw.ClearSelection2 True

                      For ii = 0 To UBound(Annotations)

                         ''

                         Set SwAnn = Annotations(ii)

                         Set SwDispDim = SwAnn.GetSpecificAnnotation

                         Set SwDim = SwDispDim.GetDimension

                         If Not SwDim.FullName Like "*" & DelDim & "*" Then

                              SwAnn.Select True

                         Else

                              SwDispDim.CenterText = True

                              'Debug.Print SwDispDim.GetDimension.FullName

                         End If

                   

                      Next ii

                      ''

                      SwDraw.EditDelete

              End Function

               

               

               

               

               

               

               

               

              Private Sub ll2()

                  Dim Xls As Excel.Application, Rng As Range

                      Set Xls = GetObject(, "Excel.Application")

                      Set Rng = Xls.Cells(1, 1)

               

                  Dim ModelName, ViewName, Xx, Yy, Str

                      ModelName = Rng(1, 1)

                      ViewName = Rng(1, 2)

                      Xx = Rng(1, 3) / 1000

                      Yy = Rng(1, 4) / 1000

                 

                  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 SwDraw As DrawingDoc

                      Set SwDraw = SwModel

                  Dim SwSheet As Sheet, SwView As View

               

                      SwDraw.ActivateSheet "壳体"

                      Set SwView = SwDraw.GetFirstView

                      Do While Not SwView Is Nothing

                          tmp = SwModel.Extension.SelectByID2(SwView.Name, "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)

                     

                          Set SwView = SwView.GetNextView

                          SwModel.EditDelete

                      Loop

                      Set SwView = SwDraw.CreateDrawViewFromModelView2(ModelName, ViewName, Xx, Yy, 0)

               

               

                      ''

                      BreakOut SwDraw, SwView

                 

                      DelDimension SwDraw, SwView.Name, "DrwDim"

                 

              End Sub

               

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

               

               

               

               

              Private Sub del()

                 Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                      Set SwApp = Application.SldWorks

                      Set SwModel = SwApp.ActiveDoc

                 Dim SwDraw As DrawingDoc

                      Set SwDraw = SwModel

                 Dim SwView As View

                      Set SwView = SwDraw.GetFirstView

                      Set SwView = SwView.GetNextView

                      tmp = SwModel.Extension.SelectByID2(SwView.Name, "DRAWINGVIEW", 0, 0, 0, True, 0, Nothing, 0)

                      Stop

                 Dim Anns, SwAnn As Annotation

                      Anns = SwDraw.InsertModelAnnotations3(3, swInsertDimensionsMarkedForDrawing, True, True, True, True)

                      Anns = SwDraw.InsertModelAnnotations3(2, swInsertDimensionsMarkedForDrawing, True, True, True, True)

                      Anns = SwDraw.InsertModelAnnotations3(1, swInsertDimensionsMarkedForDrawing, True, True, True, True)

                      Anns = SwDraw.InsertModelAnnotations3(0, swInsertDimensionsMarkedForDrawing, True, True, True, True)

                      'Annotations = SwDraw.InsertModelAnnotations3(3, 32776, True, True, True, True)

                      Stop

                      Stop

              End Sub