Hide Table of Contents

Cut Body and Keep All Bodies Example (VBA)

This example shows how to cut a body and keep all bodies.

Module

' ******************************************************************************

' Preconditions: Open new part document.

'

'                NOTE: The macro must contain two modules:

'                      one module for the Main and Creation subs and

'                      a second macro for the class module.

'

' Postconditions: Body is created and then split into two.

'                 The body, or bodies, are kept

'                 depending on the option set in Class1.

'

' ******************************************************************************

Option Explicit

 

Dim swApp As SldWorks.SldWorks

Dim Part As SldWorks.ModelDoc2

Dim SelMgr As SldWorks.SelectionMgr

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Dim Feature As SldWorks.Feature

Dim PartEvents As Class1

 

Sub main()

 

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

Set PartEvents = New Class1

Set PartEvents.swPartDoc = swApp.ActiveDoc

Set SelMgr = Part.SelectionManager

 

Call CreateBodiesAndSketch

 

boolstatus = Part.Extension.SelectByID2("Sketch2", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

Set Feature = Part.FeatureManager.FeatureCut(True, False, False, 0, 0, 0.08, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, False, True, True)

If (Feature Is Nothing) Then

    Debug.Print "No feature created."

End If

 

Part.SelectionManager.EnableContourSelection = 0

 

End Sub

 

 

Sub CreateBodiesAndSketch()

 

'Create body

boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", -0.06869486923422, 0.06291203863612, -0.006492164309718, False, 0, Nothing, 0)

Part.ClearSelection2 True

Part.SketchRectangle -0.0424567617866, 0.0388405707196, 0, 0.05638579404467, -0.03750124069479, 0, 1

Part.ShowNamedView2 "*Trimetric", 8

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Line3", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)

Part.FeatureManager.FeatureExtrusion2 True, False, False, 0, 0, 0.12, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 1, 1, 1, 0, 0, False

Part.SelectionManager.EnableContourSelection = 0

Part.ClearSelection2 True

 

'Create sketch for cut feature

boolstatus = Part.Extension.SelectByID2("", "FACE", -0.02909828822015, 0.03884057071963, 0.09843602253397, False, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Part.ClearSelection2 True

Dim vSkLines As Variant

vSkLines = Part.SketchManager.CreateCornerRectangle(-0.0628943705795, -0.07743122635196, 0, 0.1160562766823, -0.04532565168643, 0)

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Line3", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)

 

End Sub

Class module

Option Explicit

 

Public WithEvents swPartDoc   As SldWorks.PartDoc

 

Public Function swPartDoc_PromptBodiesToKeepNotify(ByVal swFeat As Object, ByRef bodies As Variant) As Long

    Debug.Print "PartDoc_PromptBodiesToKeepNotify"

    Dim theFeature As SldWorks.Feature

    If Not swFeat Is Nothing Then

        Set theFeature = swFeat

     

        Dim bodiesToKeep(0) As Object

 

        'This case statements shows how to use IFeature::SetBodiesToKeep

        'Change BodyOption to "Body1" or "Body2" to show other options

        

        Dim BodyOption As String

        BodyOption = "AllBodies"

        

        Select Case BodyOption

            Case "AllBodies"

                theFeature.SetBodiesToKeep True, bodiesToKeep, swThisConfiguration, Nothing

                

            Case "Body1"

                Set bodiesToKeep(0) = bodies(0)

                theFeature.SetBodiesToKeep False, bodiesToKeep, swThisConfiguration, Nothing

                

            Case "Body2"

                Set bodiesToKeep(0) = bodies(1)

                theFeature.SetBodiesToKeep False, bodiesToKeep, swThisConfiguration, Nothing

        End Select

        

    End If

    swPartDoc_PromptBodiesToKeepNotify = 1

End Function



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 and Keep All Bodies 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) 2014 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.