Create Temporary Extruded Body Example (VBA)

This example shows how to create a temporary extruded body.

 

'------------------------------------------------

'

' Preconditions:

'             (1) Model document must be open.

'             (2) Sheet body must exist and be selected.

'

' Postconditions: Temporary extruded body is created.

'

'------------------------------------------------

Option Explicit

 

Dim swApp As SldWorks.SldWorks

Dim swDoc As SldWorks.ModelDoc2

Dim swModeler As SldWorks.Modeler

Dim swMath As SldWorks.MathUtility

Dim SelMgr As SldWorks.SelectionMgr

 

Sub main()

 

Set swApp = Application.SldWorks

Set swModeler = swApp.GetModeler

Set swMath = swApp.GetMathUtility

 

Set swDoc = swApp.ActiveDoc

 

Dim selPoint As SldWorks.SketchPoint

Dim selEdge As SldWorks.Edge

Dim slotWidth As Double

Dim slotLength As Double

Dim slotDepth As Double

Dim slotThruAll As Boolean

 

slotDepth = 0.01

slotWidth = 0.04

slotLength = 0.09

slotThruAll = False

 

Dim halfWidth As Double

Dim halfLength As Double

halfWidth = slotWidth / 2

halfLength = slotLength / 2

 

Dim startArr(2) As Double

Dim endArr(2) As Double

Dim ptArr(2) As Double

Dim dirArr(2) As Double

Dim planeSurf As SldWorks.Surface

Dim trimCurves(3) As SldWorks.Curve

 

ptArr(0) = 0#

ptArr(1) = 0#

ptArr(2) = 0#

dirArr(0) = 0#

dirArr(1) = 0#

dirArr(2) = 1#

startArr(0) = 1#

startArr(1) = 0#

startArr(2) = 0#

Set planeSurf = swModeler.CreatePlanarSurface2((ptArr), (dirArr), (startArr))

 

ptArr(0) = -halfLength

ptArr(1) = halfWidth

ptArr(2) = 0#

dirArr(0) = 1#

dirArr(1) = 0#

dirArr(2) = 0#

Set trimCurves(0) = swModeler.CreateLine((ptArr), (dirArr))

Set trimCurves(0) = trimCurves(0).CreateTrimmedCurve2(-halfLength, halfWidth, 0#, halfLength, halfWidth, 0#)

 

ptArr(0) = halfLength

ptArr(1) = 0#

ptArr(2) = 0#

startArr(0) = halfLength

startArr(1) = halfWidth

startArr(2) = 0#

endArr(0) = halfLength

endArr(1) = -halfWidth

endArr(2) = 0#

dirArr(0) = 0#

dirArr(1) = 0#

dirArr(2) = -1#

Set trimCurves(1) = swModeler.CreateArc((ptArr), (dirArr), halfWidth, (startArr), (endArr))

Set trimCurves(1) = trimCurves(1).CreateTrimmedCurve2(halfLength, halfWidth, 0#, halfLength, -halfWidth, 0#)

 

ptArr(0) = halfLength

ptArr(1) = -halfWidth

ptArr(2) = 0#

dirArr(0) = -1#

dirArr(1) = 0#

dirArr(2) = 0#

Set trimCurves(2) = swModeler.CreateLine((ptArr), (dirArr))

Set trimCurves(2) = trimCurves(2).CreateTrimmedCurve2(halfLength, -halfWidth, 0#, -halfLength, -halfWidth, 0#)

 

ptArr(0) = -halfLength

ptArr(1) = 0#

ptArr(2) = 0#

startArr(0) = -halfLength

startArr(1) = -halfWidth

startArr(2) = 0#

endArr(0) = -halfLength

endArr(1) = halfWidth

endArr(2) = 0#

dirArr(0) = 0#

dirArr(1) = 0#

dirArr(2) = -1#

Set trimCurves(3) = swModeler.CreateArc((ptArr), (dirArr), halfWidth, (startArr), (endArr))

Set trimCurves(3) = trimCurves(3).CreateTrimmedCurve2(-halfLength, -halfWidth, 0#, -halfLength, halfWidth, 0#)

 

Dim profileBody As SldWorks.Body2

Dim extrudedBody As SldWorks.Body2

Dim dirVector As SldWorks.MathVector

 

Set profileBody = planeSurf.CreateTrimmedSheet((trimCurves))

 

dirArr(0) = 0#

dirArr(1) = 0#

dirArr(2) = -1#

Set dirVector = swMath.CreateVector((dirArr))

Set extrudedBody = swModeler.CreateExtrudedBody(profileBody, dirVector, slotDepth)

extrudedBody.Display2 swDoc, RGB(1, 0, 0), 0

End Sub