Hide Table of Contents

Get Intersecting Faces Example (VBA)

This example shows how to get the intersection of two faces.

 

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

'

' Problem:

'       Two faces intersect in a series of curves.

'

'       This code shows how to use some of the geometry-related and

'       topology-related APIs to get the intersecting surfaces.

'       Specifically, it shows the use of:

'

'           ISurface::IntersectSurface

'

' Preconditions:

'       (1) Part of assembly is open.

'       (2) Assembly is fully resolved.

'       (3) Two items are selected in the graphics window.

'       (4) Face is the first selected item.

'       (5) Face is the second selected item.

'       (6) Two faces intersect.

'

' Postconditions: For each intersection curve, a 3D sketch is inserted with

'          a series of line segments approximating the intersection

'          curve.

'

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

Option Explicit

Sub CreateTessCurve _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swTrimCurve As SldWorks.Curve _

)

    Const nChordTol             As Double = 0.001

    Const nLengthTol            As Double = 0.001

    Dim nStartParam             As Double

    Dim nEndParam               As Double

    Dim bIsClosed               As Boolean

    Dim bIsPeriodic             As Boolean

    Dim vStartPt                As Variant

    Dim vEndPt                  As Variant

    Dim vTessPts                As Variant

    Dim swSketchSeg             As SldWorks.SketchSegment

    Dim bRet                    As Boolean

    Dim i                       As Long

    

    ' Not needed because curve is a trimmed curve

    ' Could pass in trim points as parameters

    bRet = swTrimCurve.GetEndParams(nStartParam, nEndParam, bIsClosed, bIsPeriodic)

    Debug.Assert bRet

    

    vStartPt = swTrimCurve.Evaluate(nStartParam)

    vEndPt = swTrimCurve.Evaluate(nEndParam)

    

    vTessPts = swTrimCurve.GetTessPts(nChordTol, nLengthTol, (vStartPt), (vEndPt))

    

    swModel.SetAddToDB True

    swModel.Insert3DSketch2 False

    

    

    ' Disable Visual Basic range checking because tessellation points

    ' may not be a multiple of 6

    On Error Resume Next

    For i = 0 To UBound(vTessPts) Step 6

        Set swSketchSeg = swModel.CreateLine2( _

                            vTessPts(i + 0), vTessPts(i + 1), vTessPts(i + 2), _

                            vTessPts(i + 3), vTessPts(i + 4), vTessPts(i + 5))

    Next i

    On Error GoTo 0

    swModel.SetAddToDB False

    swModel.Insert3DSketch2 True

    

    bRet = swModel.EditRebuild3

    Debug.Assert bRet

End Sub

Function CreateTrimmedCurve _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSurf As SldWorks.surface, _

    swCurve As SldWorks.Curve _

) As SldWorks.Curve

    Dim nStartParam             As Double

    Dim nEndParam               As Double

    Dim bIsClosed               As Boolean

    Dim bIsPeriodic             As Boolean

    Dim vStartPt                As Variant

    Dim vEndPt                  As Variant

    Dim nCurveBounds(0 To 5)    As Double

    Dim vCurveBounds            As Variant

    Dim vPointArray             As Variant

    Dim vTArray                 As Variant

    Dim vUVArray                As Variant

    Dim bRet                    As Boolean

    

    

    bRet = swCurve.GetEndParams(nStartParam, nEndParam, bIsClosed, bIsPeriodic)

    Debug.Assert bRet

    

    

    vStartPt = swCurve.Evaluate(nStartParam)

    vEndPt = swCurve.Evaluate(nEndParam)

    

    

    nCurveBounds(0) = vStartPt(0)

    nCurveBounds(1) = vStartPt(1)

    nCurveBounds(2) = vStartPt(2)

    nCurveBounds(3) = vEndPt(0)

    nCurveBounds(4) = vEndPt(1)

    nCurveBounds(5) = vEndPt(2)

    vCurveBounds = nCurveBounds

    

    bRet = swSurf.IntersectCurve(swCurve, (vCurveBounds), vPointArray, vTArray, vUVArray)

    Debug.Assert bRet

    

    

    Set CreateTrimmedCurve = swCurve.CreateTrimmedCurve( _

                                vPointArray(0), vPointArray(1), vPointArray(2), _

                                vPointArray(3), vPointArray(4), vPointArray(5))

End Function

Sub main()

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim swSelMgr                As SldWorks.SelectionMgr

    Dim swFace1                 As SldWorks.face2

    Dim swFace2                 As SldWorks.face2

    Dim swSurf1                 As SldWorks.surface

    Dim swSurf2                 As SldWorks.surface

    Dim swCurve1                As SldWorks.Curve

    Dim swCurve2                As SldWorks.Curve

    Dim vCurveArray             As Variant

    Dim vBoundArray             As Variant

    Dim swIntCurve              As SldWorks.Curve

    Dim swTrimCurve             As SldWorks.Curve

    Dim nLength                 As Double

    Dim i                       As Long

    Dim bRet                    As Boolean

    

        

    Set swApp = CreateObject("SldWorks.Application")

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swFace1 = swSelMgr.GetSelectedObject5(1)

    Set swFace2 = swSelMgr.GetSelectedObject5(2)

    Set swSurf1 = swFace1.GetSurface

    Set swSurf2 = swFace2.GetSurface

    

    bRet = swSurf1.IntersectSurface(swSurf2, vCurveArray, vBoundArray)

    Debug.Assert bRet

    

    For i = 0 To UBound(vCurveArray)

        Set swIntCurve = vCurveArray(i)

        

        ' Beware - curve could be infinite (that is, a straight line)!

        If swIntCurve.IsTrimmedCurve Then

            nLength = swIntCurve.GetLength2(vBoundArray(2 * i), vBoundArray(2 * i + 1))

            Debug.Print "Curve(" & i & ") = " & nLength * 1000# & " mm"

        

            Set swTrimCurve = swIntCurve

        Else

            ' Create a trimmed curve by re-intersecting intersection curve with surface

            Set swTrimCurve = CreateTrimmedCurve(swApp, swModel, swSurf1, swIntCurve)

        End If

        

        CreateTessCurve swApp, swModel, swTrimCurve

    Next i

End Sub

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



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:   Get Intersecting Faces 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.