Cut Body in Half using Macro Feature Example (VBA)
This example shows how to cut a body in a part document in half using
a macro feature. In the macro feature's PropertyManager, the user selects
the body to cut in half and the half of the body to keep. The example
contains this code:
Modules
Macros
_____________________________________________________________________________________
Option Explicit
_____________________________________________________________________________________
' Macro feature rebuild function
Function swmMain(swAppIn, partIn, featureIn)
Dim
featData As SldWorks.MacroFeatureData
Dim
Config As SldWorks.Configuration
Dim
ConfigName As String
Set
featData = featureIn.GetDefinition
' Get name of
configuration being rebuilt
Set Config =
featData.CurrentConfiguration
ConfigName
= Config.Name
Dim
sels, types, selmarks
Dim
body1 As SldWorks.Body2
Call
featData.GetSelections3(sels,
types, selmarks, Nothing, Nothing)
If
IsEmpty(sels) Then
swmMain
= "Body has not been selected!"
Exit
Function
End
If
If
sels(0) Is Nothing Then
swmMain
= "Body has not been selected!"
Exit
Function
End
If
Set
body1 = sels(0)
Dim
modeler As SldWorks.modeler
Set
modeler = swAppIn.GetModeler
Dim
props As Variant
props
= body1.GetMassProperties(1)
Dim
p1(0 To 2) As Double
Dim
v1(0 To 2) As Double
Dim
v2(0 To 2) As Double
p1(0)
= props(0)
p1(1)
= props(1)
p1(2)
= props(2)
v1(0)
= 0
v1(1)
= 0
v1(2)
= 1
v2(0)
= 1
v2(1)
= 0
v2(1)
= 0
Dim
surf As SldWorks.surface
Set
surf = modeler.CreatePlanarSurface2(p1,
v1, v2)
Dim
box As Variant
box
= body1.GetBodyBox
Dim
uvLow, uvHigh As Variant
uvLow
= surf.GetClosestPointOn(box(0),
box(1), box(2))
uvHigh
= surf.GetClosestPointOn(box(3),
box(4), box(5))
Dim
midPt(0 To 2) As Double
Dim
i As Integer
For
i = 0 To 2
midPt(i)
= (uvLow(i) + uvHigh(i)) / 2
Next
i
For
i = 0 To 2
uvLow(i)
= (uvLow(i) - midPt(i)) * 1.1 + midPt(i)
uvHigh(i)
= (uvHigh(i) - midPt(i)) * 1.1 + midPt(i)
Next
i
uvLow
= surf.GetClosestPointOn(uvLow(0),
uvLow(1), uvLow(2))
uvHigh
= surf.GetClosestPointOn(uvHigh(0),
uvHigh(1), uvHigh(2))
Dim
sheet As SldWorks.Body2
Dim
uv(0 To 3) As Double
uv(0)
= uvLow(3)
uv(1)
= uvHigh(3)
uv(2)
= uvLow(4)
uv(3)
= uvHigh(4)
Set
sheet = modeler.CreateSheetFromSurface(surf,
uv)
'
Transform with angle
Dim
mathUtil As SldWorks.MathUtility
Set
mathUtil = swAppIn.GetMathUtility
Dim
aXform As SldWorks.MathTransform
Dim
basePt As SldWorks.MathPoint
Dim
retval as Boolean
Set
basePt = mathUtil.CreatePoint(midPt)
Dim
xAxis As MathVector
Set
xAxis = mathUtil.CreateVector(v2)
Set
aXform = mathUtil.CreateTransformRotateAxis(basePt,
xAxis, 3.1416159 / 2)
retval
= sheet.applytransform (aXform)
'
Assign edge ID
Dim
edges As Variant
Dim
faces As Variant
featData.GetEntitiesNeedUserId sheet, faces,
edges
edges
= sheet.GetEdges
For
i = 0 To UBound(edges)
featData.SetEdgeUserId edges(i), i, 0
Dim
id1 As Long
Dim
id2 As Long
featData.GetEdgeUserId edges(i), id1, id2
Next
i
Dim
editBdy As Body2, resBody As Body2
Set
editBdy = featData.EditBody
Dim
result As Variant
Dim
err As Long
result
= editBdy.Operations2(SWBODYCUT,
sheet, err)
Dim
wb As Long
featData.GetIntegerByName "WhichBody",
wb
Set
resBody = result(wb - 1)
Set
swmMain = resBody
resBody.Hide partIn
End Function
_____________________________________________________________________________________
' Macro feature edit definition
function
Sub swmPM(swAppIn, partIn, featureIn)
Dim
swPage As New PropMgr
swPage.Init
swAppIn, partIn, featureIn, swCmdEdit, swAppIn.GetCurrentMacroPathName
swPage.Show
End Sub
_____________________________________________________________________________________
'Inserts macro feature with
customized PropertyManager page
Public Sub swmInsertCustomizedMacroFeature()
Dim
swAppIn, partIn, featureIn
Set
swAppIn = Application.SldWorks
Set
partIn = swAppIn.activeDoc
If
partIn.GetType() <> swDocPart
Then
MsgBox
("Available only from part document!")
Exit
Sub
End
If
Dim
swPage As New PropMgr
swPage.Init
swAppIn, partIn, featureIn, swCmdCreate, swAppIn.GetCurrentMacroPathName
swPage.Show
End Sub
Back to top
Class Modules
PropMgr
_____________________________________________________________________________________
Option Explicit
Private m_swApp As SldWorks.SldWorks
Private m_Part As SldWorks.ModelDoc2
Private m_feature As SldWorks.feature
Private m_Page As PropertyManagerPage2
Private m_Group As PropertyManagerPageGroup
Private m_Selection As PropertyManagerPageSelectionbox
Private m_NumberBox As PropertyManagerPageNumberbox
Private m_Text As PropertyManagerPageTextbox
Private m_swPageCmd As New PropMgrCmd
Private m_cmdState As swPageCmdState
Private m_pageHdlr As New PropMgrHdlr
_____________________________________________________________________________________
Private Sub Layout()
Dim
swPage As PropertyManagerPage2
Dim
swControl As PropertyManagerPageControl
Dim
title As String
Dim
buttonTypes As Long
Dim
message As String
Dim
Id As Long
Dim
controlType As Integer
Dim
caption As String
Dim
alignment As Integer
Dim
options As Long
Dim
tip As String
Dim
filterArray(0 To 1) As Long
m_pageHdlr.Init
Me
If
m_cmdState = swCmdCreate Then
title
= "Cut body macro feature"
Else
title
= m_feature.Name
End
If
buttonTypes
= swPropertyManagerOptions_OkayButton + swPropertyManagerOptions_CancelButton
+ swPropertyManagerOptions_LockedPage
Dim
errorh As Long
Set
m_Page = m_swApp.CreatePropertyManagerPage(title,
buttonTypes, m_pageHdlr, errorh)
If
Not m_Page Is Nothing Then
'Initial
set up of the dialog
message
= "message = "Select body to cut, then select the side of the
body to keep."
m_Page.SetMessage
message, swImportantMessageBox
'Begin
adding the required controls to the PropertyManager
'Group
box
Id
= ID_GROUP
caption
= "Surface on Mass Center"
options
= swGroupBoxOptions_Visible + swGroupBoxOptions_Expanded '+ swGroupBoxOptions_Checked
Set
m_Group = m_Page.AddGroupBox(Id,
caption, options)
If
Not m_Group Is Nothing Then
'Selection
box
Id
= ID_SELECTION
controlType
= swControlType_Selectionbox
caption
= "Selection box"
alignment
= swControlAlign_Indent
options
= swControlOptions_Visible + swControlOptions_Enabled
tip
= "Select body"
Set
swControl = m_Group.AddControl(Id,
controlType, caption, alignment, options, tip)
If
Not swControl Is Nothing Then
Set
m_Selection = swControl
filterArray(0)
= swSelSOLIDBODIES
filterArray(1)
= swSelSURFACEBODIES
m_Selection.SingleEntityOnly = True
m_Selection.Height = 50
m_Selection.SingleEntityOnly = True
m_Selection.SetSelectionFilters (filterArray)
m_Selection.SetStandardPictureLabel swBitmapLabel_SelectFaceSurface
End
If
'Selection
box
Id
= ID_SELECTION
controlType
= swControlType_Numberbox
caption
= "Number box"
alignment
= swControlAlign_Indent
options
= swControlOptions_Visible + swControlOptions_Enabled
tip
= "Select the body to keep"
Set
swControl = m_Group.AddControl(Id,
controlType, caption, alignment, options, tip)
If
Not swControl Is Nothing Then
Set
m_NumberBox = swControl
m_NumberBox.SetRange swNumberBox_UnitlessInteger,
1, 2, 1, True
m_NumberBox.value = GetCmd().GetNumberValue()
End
If
End
If
End
If
End Sub
_____________________________________________________________________________________
Public Sub Show()
m_Page.Show2
End Sub
_____________________________________________________________________________________
Sub Init(swApp, part, feature, cmdState
As swPageCmdState, macroPath As String)
Set
m_swApp = swApp
Set
m_Part = part
If
Not IsEmpty(feature) Then
Set
m_feature = feature
End
If
m_cmdState
= cmdState
m_Part.ClearSelection2 True
m_swPageCmd.Init
swApp, part, feature, cmdState, macroPath
Layout
End Sub
_____________________________________________________________________________________
Public Function GetCmd() As PropMgrCmd
Set
GetCmd = m_swPageCmd
End Function
_____________________________________________________________________________________
Back to top
PropMgrCmd
_____________________________________________________________________________________
Option Explicit
Private m_swApp As SldWorks.SldWorks
Private m_Part As SldWorks.ModelDoc2
Private m_feature As SldWorks.feature
Private m_bodySel As Object
Private m_whichBody As Long
Private m_featData As SldWorks.MacroFeatureData
Private m_modelComp As SldWorks.Component2
Private m_cmdState As swPageCmdState
Private m_macroPath As String
_____________________________________________________________________________________
Public Sub Init(swApp, part, feature, cmdState
As swPageCmdState, macroPath As String)
Set
m_swApp = swApp
Set
m_Part = part
m_macroPath
= macroPath
m_whichBody
= 1
If
Not IsEmpty(feature) Then
Set
m_feature = feature
End
If
If
cmdState = swCmdEdit Then ' On Edit Definition
Dim
ret As Boolean
Set
m_featData = m_feature.GetDefinition
Set
m_modelComp = m_feature.GetComponent
m_cmdState
= cmdState
ret
= m_featData.AccessSelections(m_Part,
m_modelComp)
Dim
sels, types, selmarks
Call
m_featData.GetSelections3(sels,
types, selmarks, Nothing, Nothing)
If
Not IsEmpty(sels) And Not sels(0) Is Nothing Then
Set
m_bodySel = sels(0)
Call
m_bodySel.Select(True, selmarks(0))
End
If
m_featData.GetIntegerByName "WhichBody",
m_whichBody
End
If
End Sub
_____________________________________________________________________________________
Public Sub OnOk()
If
m_cmdState = swCmdEdit Then ' On Edit Definition
Dim
sels, types, selmarks
Call
m_featData.GetSelections3(sels,
types, selmarks, Nothing, Nothing)
Dim
newSels(0 To 0) As Object
Dim
newSelMarks(0 To 0) As Long
Set
newSels(0) = m_bodySel
newSelMarks(0)
= 0
sels
= newSels
selmarks
= newSelMarks
Call
m_featData.SetSelections2(sels, selmarks, Nothing)
m_featData.SetIntegerByName "WhichBody",
m_whichBody
Call
m_feature.ModifyDefinition(m_featData,
m_Part, m_modelComp)
Else
' On Insert feature
Dim
paramNames, paramTypes, paramValues
Dim
pNames(0 To 0) As String
Dim
pTypes(0 To 0) As Long
Dim
pValues(0 To 0) As String
Dim
methods(0 To 8) As String
methods(0)
= m_macroPath
methods(1)
= "Macros"
methods(2)
= "swmMain"
methods(3)
= m_macroPath
methods(4)
= "Macros"
methods(5)
= "swmPM"
methods(6)
= ""
methods(7)
= ""
methods(8)
= ""
Dim
feat As Object
pNames(0)
= "WhichBody"
pTypes(0)
= swMacroFeatureParamTypeInteger
pValues(0)
= m_whichBody
paramNames
= pNames
paramTypes
= pTypes
paramValues
= pValues
Set
feat = m_Part.FeatureManager.InsertMacroFeature2("AngleSurf",
"", methods, (paramNames), (paramTypes), (paramValues), Nothing,
Nothing, m_bodySel, Nothing, swMacroFeatureByDefault)
End
If
End Sub_
____________________________________________________________________________________
Public Sub OnCancel()
If
m_cmdState = swCmdEdit Then
m_featData.ReleaseSelectionAccess
End
If
End Sub
_____________________________________________________________________________________
Public Sub OnBodySelect()
Dim
selM
Set
selM = m_Part.SelectionManager
Set
m_bodySel = Nothing
Set
m_bodySel = selM.GetSelectedObject6(1,
-1)
End Sub
_____________________________________________________________________________________
Public Sub OnNumberChanged(value As Long)
m_whichBody
= value
End Sub
_____________________________________________________________________________________
Public Function GetNumberValue()
GetNumberValue
= m_whichBody
End Function
_____________________________________________________________________________________
Back to top
PropMgrHdlr
_____________________________________________________________________________________
Option Explicit
Implements PropertyManagerPage2Handler
Dim m_pageObj As PropMgr
_____________________________________________________________________________________
Public Sub Init(pageObj As PropMgr)
Set
m_pageObj = pageObj
End Sub
_____________________________________________________________________________________
Private Function PropertyManagerPage2Handler_ConnectToSW(ByVal
ThisSW As Object, ByVal Cookie As Long) As Boolean
End Function
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnButtonPress(ByVal
Id As Long)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnClose(ByVal
reason As Long)
If
reason = swPropertyManagerPageClose_Okay Then
m_pageObj.GetCmd().OnOk
ElseIf
reason = swPropertyManagerPageClose_Cancel Then
m_pageObj.GetCmd().OnCancel
End
If
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnCheckboxCheck(ByVal
Id As Long, ByVal Checked As Boolean)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnComboboxSelectionChanged(ByVal
Id As Long, ByVal Item As Long)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnGroupCheck(ByVal
Id As Long, ByVal Checked As Boolean)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnGroupExpand(ByVal
Id As Long, ByVal Expanded As Boolean)
End Sub
_____________________________________________________________________________________
Private Function PropertyManagerPage2Handler_OnHelp()
As Boolean
End Function
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnListboxSelectionChanged(ByVal
Id As Long, ByVal Item As Long)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnNumberboxChanged(ByVal
Id As Long, ByVal value As Double)
m_pageObj.GetCmd().OnNumberChanged
Int(value)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_AfterClose()
Set
m_pageObj = Nothing
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnOptionCheck(ByVal
Id As Long)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnSelectionboxFocusChanged(ByVal
Id As Long)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnTextboxChanged(ByVal
Id As Long, ByVal Text As String)
End Sub
_____________________________________________________________________________________
Private Sub PropertyManagerPage2Handler_OnSelectionBoxListChanged(ByVal
Id As Long, ByVal Text As Long)
m_pageObj.GetCmd().OnBodySelect
End Sub
_____________________________________________________________________________________
Back to top