Use follow code, Drawing Rectangle is not in the target location.

Need Rectangle target location in GetOutline.

Sub Mm16_3()

  Dim SwApp As SldWorks.SldWorks, SwDraw As ModelDoc2

  Dim SwView As SldWorks.View

  Dim swSelMgr As SldWorks.SelectionMgr

  Set SwApp = Application.SldWorks

  Set SwDraw = SwApp.ActiveDoc

  Set swSelMgr = SwDraw.SelectionManager

  Set SwView = swSelMgr.GetSelectedObject2(1)   

  With SwView

       Vpts = SwView.GetXform

        var = .GetOutline

        vPos = .Position

    End With   

    Dim Ww, Hh

    Ww = var(2) - var(0)

    xx1 = (-vPos(0) - Ww) / 2

    xx2 = (vPos(0) + Ww) / 2

    Hh = var(3) - var(1)

    yy1 = vPos(1) ' - Hh / 2

    yy2 = vPos(1) + Hh / 2

    SwDraw.SketchRectangle xx1, yy1, 0, xx2, yy2, 0, True

End Sub