Attribute VB_Name = "FramedBoxPMP"
'********************************************************************'
'
' This macro has been modified to accommodate "FramedBox" macro in a
' PropertyManagerPage.  This example is tightly based on example
' supplied by SolidWorks Corp.
'
'********************************************************************'
'  This Macro shows how to create a simple PropertyManagerPage for
'  SolidWorks.  It includes an example of every control that can
'  be placed on a PropertyManagerPage.
'********************************************************************'

  Global swApp        As Object
  Global Part         As Object
  Global ModelDocExt  As Object
  Global MassValue    As Variant
  Global MassStatus   As Long

' The controls on the page
  Global fb_BoxHeight           As SldWorks.PropertyManagerPageNumberbox
  Global fb_BoxWidth            As SldWorks.PropertyManagerPageNumberbox
  Global fb_BoxDepth            As SldWorks.PropertyManagerPageNumberbox
  Global fb_FrameWidth          As SldWorks.PropertyManagerPageNumberbox

' The application's PropertyManagerPage
  Global swPage                  As fbPropMgr
  
' Track feature and sketch names freated with this macro
  Global fb_ExtrFeature  As String
  Global fb_ExtrSketch   As String
  Global fb_CutASketch   As String
  Global fb_CutBSketch   As String
  Global fb_CutCSketch   As String
  
  Global UpdateModel As Boolean

Sub BuildModel()
  Dim fb_NameFeat       As Boolean
  Dim fb_InputDim       As Boolean
  Dim fb_AutoRelate     As Boolean
  Dim fb_SnapEnable     As Boolean
  Dim fb_featCount      As Integer
  Dim theFeature        As Object
  Dim featChild         As Variant
  Dim swSketch          As Object
  
' Get current values of SolidWorks settings
  fb_NameFeat = swApp.GetUserPreferenceToggle(swFeatureManagerNameFeatureWhenCreated)
  fb_InputDim = swApp.GetUserPreferenceToggle(swInputDimValOnCreate)
  fb_AutoRelate = swApp.GetUserPreferenceToggle(swSketchAutomaticRelations)
  fb_SnapEnable = swApp.GetUserPreferenceToggle(swSnapToPoints)
  
' Set values of SolidWorks settings as needed for proper operation of macro
  swApp.SetUserPreferenceToggle swFeatureManagerNameFeatureWhenCreated, False   ' Off
  swApp.SetUserPreferenceToggle swInputDimValOnCreate, False                    ' Off
  swApp.SetUserPreferenceToggle swSketchAutomaticRelations, True                ' On
  swApp.SetUserPreferenceToggle swSnapToPoints, False                           ' Off
  
' Start by creating the box
  Set SelMgr = Part.SelectionManager
  ' Select plane
  boolstatus = Part.Extension.SelectByID2("Front", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
  ' Create sketch
  Part.InsertSketch2 True
  ' Get current sketch object and retrieve name
  Set swSketch = Part.GetActiveSketch2
  fb_ExtrSketch = swSketch.Name
  Set swSketch = Nothing
  ' Create rectangle
  Part.SketchRectangle -0.0371, -0.0381, 0, 0.0371, 0.0381, 0, 1
  ' Create diagonal line
  Part.CreateLine2(-0.0381, -0.0381, 0, 0.0381, 0.0381, 0).ConstructionGeometry = True
  ' Enable pick mode
  Part.SetPickMode
  ' Pick points at lower left of rectangle and diagonal line
  ' Do not use x,y,z pick points when selecting by name
  boolstatus = Part.Extension.SelectByID2("Point1", "SKETCHPOINT", 0, 0, 0, False, 0, Nothing, 0)
  boolstatus = Part.Extension.SelectByID2("Point5", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
  ' Add MergePoints constraint
  Part.SketchAddConstraints "sgMERGEPOINTS"
  ' Pick points at upper right of rectangle and diagonal line
  ' Do not use x,y,z pick points when selecting by name
  boolstatus = Part.Extension.SelectByID2("Point2", "SKETCHPOINT", 0, 0, 0, False, 0, Nothing, 0)
  boolstatus = Part.Extension.SelectByID2("Point6", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
  ' Add MergePoints constraint
  Part.SketchAddConstraints "sgMERGEPOINTS"
  ' Pick diagonal line and part origin
  ' Do not use x,y,z pick points when selecting by name
  boolstatus = Part.Extension.SelectByID2("Point1@Origin", "EXTSKETCHPOINT", 0, 0, 0, False, 0, Nothing, 0)
  boolstatus = Part.Extension.SelectByID2("Line5", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  ' Add MidPoint constraint
  Part.SketchAddConstraints "sgATMIDDLE"
  ' Select line and add dimension
  boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
  Set Annotation = Part.AddDimension2(-0.0895437, 0.00973622, 0)
  ' Select line and add dimension
  boolstatus = Part.Extension.SelectByID2("Line3", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
  Set Annotation = Part.AddDimension2(-0.00103263, 0.055762, 0)
  ' Set view to Trimetric for consistent selections to follow
  Part.ShowNamedView2 "*Trimetric", 8
  ' Extrude feature
  Part.FeatureManager.FeatureExtrusion2 True, False, False, 6, 0, 0.0762, 0.003175, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 1, 1, 1, 0, 0, False
  ' Get feature count
  featCount = Part.GetFeatureCount
  ' Get last feature
  Set theFeature = Part.FeatureByPositionReverse(0)
  ' Get name of last feature
  fb_ExtrFeature = theFeature.Name
  ' Clear theFeature
  Set theFeature = Nothing

' Select and cut thru top face
  ' Enable face selection
  Part.SelectionManager.EnableContourSelection = 0
  ' Select face
  boolstatus = Part.Extension.SelectByID2("", "FACE", 0.01, 0.02, -0.01, False, 0, Nothing, 0)
  ' Insert Sketch
  Part.InsertSketch2 True
  ' Get current sketch object and retrieve name
  Set swSketch = Part.GetActiveSketch2
  fb_CutASketch = swSketch.Name
  Set swSketch = Nothing
  ' Offset face
  boolstatus = Part.SketchOffsetEntities2(-0.00635, False, False)
  ' Cut thru all
  Part.FeatureManager.FeatureCut True, False, False, 1, 0, 0.0762, 0.0762, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 0, 1, 1
  
' Select and cut thru right face
  ' Enable face selection
  Part.SelectionManager.EnableContourSelection = 0
  ' Select face
  boolstatus = Part.Extension.SelectByID2("", "FACE", 0.04, -0.002, -0.03, False, 0, Nothing, 0)
  ' Insert Sketch
  Part.InsertSketch2 True
  ' Get current sketch object and retrieve name
  Set swSketch = Part.GetActiveSketch2
  fb_CutBSketch = swSketch.Name
  Set swSketch = Nothing
  ' Offset face
  boolstatus = Part.SketchOffsetEntities2(-0.00635, False, False)
  ' Cut thru all
  Part.FeatureManager.FeatureCut True, False, False, 1, 0, 0.0762, 0.0762, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 0, 1, 1
  
' Select and cut thru left face
  ' Enable face selection
  Part.SelectionManager.EnableContourSelection = 0
  ' Select face
  boolstatus = Part.Extension.SelectByID2("", "FACE", 0.01, 0.008, 0.04, False, 0, Nothing, 0)
  ' Insert Sketch
  Part.InsertSketch2 True
  ' Get current sketch object and retrieve name
  Set swSketch = Part.GetActiveSketch2
  fb_CutCSketch = swSketch.Name
  Set swSketch = Nothing
  ' Offset face
  boolstatus = Part.SketchOffsetEntities2(-0.00635, False, False)
  ' Cut thru all
  Part.FeatureManager.FeatureCut True, False, False, 1, 0, 0.0762, 0.0762, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 0, 1, 1
  
  
  ' Enable face selection
  Part.SelectionManager.EnableContourSelection = 0
  ' Set specific view
  Part.ShowNamedView2 "*Isometric", 7
  ' Clear any selections
  Part.ClearSelection2 True

' Reset SolidWorks settings as they were before running this macro
  swApp.SetUserPreferenceToggle swFeatureManagerNameFeatureWhenCreated, fb_NameFeat
  swApp.SetUserPreferenceToggle swInputDimValOnCreate, fb_InputDim
  swApp.SetUserPreferenceToggle swSketchAutomaticRelations, fb_AutoRelate
  swApp.SetUserPreferenceToggle swSnapToPoints, fb_SnapEnable

' Ensure models is a 3 x 3 x 3 framed box
  Part.Parameter("D1@" & fb_ExtrSketch).SystemValue = 0.0762
  Part.Parameter("D2@" & fb_ExtrSketch).SystemValue = 0.0762
  Part.Parameter("D1@" & fb_ExtrFeature).SystemValue = 0.0762

End Sub

Sub main()
    Dim nRetVal             As Long

    Set swApp = CreateObject("SldWorks.Application")

    ' Make sure that there is a model to add the
    ' page to.  If there is no model get rid
    ' of references to any previoud pages.
    If swApp.ActiveDoc Is Nothing Then
        Set Part = swApp.NewPart
        Set swPage = Nothing
    Else
        Set Part = swApp.ActiveDoc            ' Get active document
        Set swPage = Nothing
    End If
    
    ' Ensure we have a model
    If Not Part Is Nothing Then
      FileTyp = Part.GetType              ' Get document type
      If FileTyp = swDocPART Then         ' Is it a part model?
        Set ModelDocExt = Part.Extension
        MassValue = ModelDocExt.GetMassProperties(1, MassStatus)
        If MassStatus = 2 Then
          BuildModel
          ' If there is no page create a new one and show it.
          ' If there is a page, then show it.
          If swPage Is Nothing Then
              Set swPage = New fbPropMgr
              swPage.Show 'display it
          Else
              swPage.Show
          End If
       
        Else
          MsgBox "Part model has mass.  Please start with blank part model.", vbExclamation
        End If
      Else
        MsgBox "Current document is not a part model.  Please start with blank part model.", vbExclamation
      End If
    Else
      MsgBox "Could automatically load part.  Please start with blank part model.", vbExclamation
    End If

End Sub
'-----------------------------------------------------------

