Hide Table of Contents

Fill Holes in Part Example VB

In CAM drilling operations, it might be useful to deduce the appearance of an item before machining begins. This is slightly different from calculating the minimum amount of raw material required, that is, the stock size.

This example shows how to use some of the geometry- and topology-related APIs to fill all holes in a part.

 

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

'

' Preconditions:

'       (1) Part is open.

'       (2) Part contains only one solid body.

'

' Postconditions:

'       (1) New part is created.

'       (2) New part is similar to original part but has all

'           holes filled.

'

' NOTES:

'       (1) Only holes that are completely on a face are filled

'       (2) Fillets and chamfers are not taken into account.

'

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

Option Explicit

Public Enum swBodyType_e

    swSolidBody = 0

    swSheetBody = 1

    swWireBody = 2

    swMinimumBody = 3

    swGeneralBody = 4

    swEmptyBody = 5

End Enum

Public Enum swUserPreferenceStringValue_e

    swDefaultTemplatePart = 8

End Enum

Public Enum swCreateFeatureBodyOpts_e

    swCreateFeatureBodyCheck = &H1

    swCreateFeatureBodySimplify = &H2

End Enum

Public Enum swDwgPaperSizes_e

    swDwgPaperAsize = 0

    swDwgPaperAsizeVertical = 1

    swDwgPaperBsize = 2

    swDwgPaperCsize = 3

    swDwgPaperDsize = 4

    swDwgPaperEsize = 5

    swDwgPaperA4size = 6

    swDwgPaperA4sizeVertical = 7

    swDwgPaperA3size = 8

    swDwgPaperA2size = 9

    swDwgPaperA1size = 10

    swDwgPaperA0size = 11

    swDwgPapersUserDefined = 12

End Enum

Sub main()

    Dim swApp                       As SldWorks.SldWorks

    Dim swModel                     As SldWorks.ModelDoc2

    Dim swPart                      As SldWorks.PartDoc

    Dim swBody                      As SldWorks.Body2

    Dim swFace                      As SldWorks.face2

    Dim swLoop                      As SldWorks.Loop2

    Dim vEdgeArr                    As Variant

    Dim swCurve()                   As SldWorks.Curve

    Dim vCurveArr                   As Variant

    Dim swEdge                      As SldWorks.Edge

    Dim swTempBody                  As SldWorks.Body2

    Dim swSurf                      As SldWorks.surface

    Dim swSurfCopy                  As SldWorks.surface

    Dim sPartTemplateName           As String

    Dim swNewModel                  As SldWorks.ModelDoc2

    Dim swNewPart                   As SldWorks.PartDoc

    Dim swFeat()                    As SldWorks.feature

    Dim swKnitFeat                  As SldWorks.feature

    Dim swThickFeat                 As SldWorks.feature

    Dim swNewFeatMgr                As SldWorks.FeatureManager

    Dim i                           As Long

    Dim bRet                        As Boolean

    Dim vBodies                     As Variant

    

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swPart = swModel

    vBodies = swPart.GetBodies2(swSolidBody, False)

    Set swBody = vBodies(0)

        

    ' create new part

    sPartTemplateName = swApp.GetUserPreferenceStringValue(swDefaultTemplatePart)

    Set swNewModel = swApp.NewDocument(sPartTemplateName, swDwgPaperAsize, 0#, 0#)

    Set swNewFeatMgr = swNewModel.FeatureManager

    Set swNewPart = swNewModel

        

    ReDim swFeat(0)

    

    Set swFace = swBody.GetFirstFace

    Do While Not swFace Is Nothing

        Set swLoop = swFace.GetFirstLoop

        Do While Not swLoop Is Nothing

            If swLoop.IsOuter Then

                vEdgeArr = swLoop.GetEdges

                If UBound(vEdgeArr) >= 0 Then

                    ReDim swCurve(UBound(vEdgeArr))

                    For i = 0 To UBound(vEdgeArr)

                        Set swEdge = vEdgeArr(i)

                        Set swCurve(i) = swEdge.GetCurve

                    Next i

                    vCurveArr = swCurve

        

                    Set swSurf = swFace.GetSurface

                    Set swSurfCopy = swSurf.Copy

                    Set swTempBody = swSurfCopy.CreateTrimmedSheet(vCurveArr)

        

                    ' Typically returns NULL if the loop is

                    ' perpendicular to the surface as in the

                    ' end loops of a cylinder

                    If Not swTempBody Is Nothing Then

                        ' sheet body will only have one face

                        Debug.Assert 1 = swTempBody.GetFaceCount

                        Debug.Assert swSheetBody = swTempBody.GetType

                        

                        Set swFeat(UBound(swFeat)) = swNewPart.CreateFeatureFromBody3(swTempBody, False, swCreateFeatureBodyCheck)

                        Debug.Assert Not swFeat(UBound(swFeat)) Is Nothing

                        

                        ReDim Preserve swFeat(UBound(swFeat) + 1)

                    End If

                End If

            End If

    

            Set swLoop = swLoop.GetNext

        Loop

    

        Set swFace = swFace.GetNextFace

    Loop

    

    ' Remove last NULL feature

    ReDim Preserve swFeat(UBound(swFeat) - 1)

    

    swNewModel.ClearSelection2 True

    For i = 0 To UBound(swFeat)

        bRet = swFeat(i).Select2(True, 1): Debug.Assert bRet

    Next i

    

    swNewModel.InsertSewRefSurface

    

    ' Make sure surfaces successfully sewn together

    Set swKnitFeat = swNewModel.FeatureByPositionReverse(0)

    Debug.Assert Not swKnitFeat Is Nothing

    Debug.Assert "SewRefSurface" = swKnitFeat.GetTypeName

    

    bRet = swKnitFeat.Select2(False, 1): Debug.Assert bRet

    

    Set swThickFeat = swNewFeatMgr.FeatureBossThicken(0.01, 0, 0, True, True, True, True)

    Debug.Assert Not swThickFeat Is Nothing

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:   Fill Holes in Part Example VB
*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) 2013 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.