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

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

''

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