Hide Table of Contents

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



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Cut Body in Half using Macro Feature Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2010 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.