Check Edges for Faults Example (VBA)

This example shows how to check edges for faults.

 

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

'

' Preconditions: Part or assembly is open.

'

' Postconditions: None

'

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

Option Explicit

Public Enum swBodyType_e

    swAllBodies = -1

    swSolidBody = 0

    swSheetBody = 1

    swWireBody = 2

    swMinimumBody = 3

    swGeneralBody = 4

    swEmptyBody = 5

End Enum

Public Enum swFaultEntityErrorCode_e

    swBodyCorrupt = 1

    swBodyInvalidIdentifiers = 2

    swBodyInsideOut = 3

    swBodyRegionsInconsistent = 4

    swEdgeNonPeriodicCurve = 5

    swEdgeNonPeriodicNomGeom = 6

    swEdgeVertexNotLie = 7

    swEdgeVertexNotLieNomGeom = 8

    swEdgeWrongDir = 9

    swEdgeWrongDirNomGeom = 10

    swEdgeSpcurveOutOfTol = 11

    swEdgeSpcurveOutOfTolNomGeom = 12

    swEdgeVerticesTouch = 13

    swEdgeBadFaceOrder = 14

    swEdgeBadWire = 15

    swFaceBadVertex = 16

    swFaceBadEdge = 17

    swFaceBadEdgeOrder = 18

    swFaceNoAccomVertex = 19

    swFaceBadLoops = 20

    swFaceSelfIntersecting = 21

    swFaceBadWireframe = 22

    swFaceCheckerFailure = 23

    swFaceFaceInconsistency = 24

    swGeomStateSelfIntersect = 25

    swGeomDegenerate = 26

    swRegionBadShells = 27

    swShellBadTopologyGeometry = 28

    swShellIntersect = 29

    swTopolNotG1Continuous = 30

    swTopolSizeBoxViolation = 31

    swTopolStateCheckFail = 32

    swTopolStateNoGeometry = 33

End Enum

Function GetStringFromID _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    vPIDarr As Variant _

) As String

    Dim vPID                        As Variant

    For Each vPID In vPIDarr

        Debug.Assert vbByte = VarType(vPID)

        GetStringFromID = GetStringFromID & Format(vPID, "###000")

    Next vPID

End Function

Sub ProcessFaultEntity _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swEdge As SldWorks.Edge, _

    swFaultEnt As SldWorks.FaultEntity _

)

    Dim swModExt                As SldWorks.ModelDocExtension

    Dim vPIDarr                 As Variant

    Dim nCount                  As Long

    Dim swEnt                   As SldWorks.entity

    Dim bRet                    As Boolean

    Dim i                       As Long

    

    nCount = swFaultEnt.Count: If 0 = nCount Then Exit Sub

    

    Set swModExt = swModel.Extension

    

    vPIDarr = swModExt.GetPersistReference3(swEdge): Debug.Assert Not IsEmpty(vPIDarr)

    Debug.Print "    Edge ID = " & GetStringFromID(swApp, swModel, vPIDarr)

    

    For i = 0 To nCount - 1

        Set swEnt = swFaultEnt.entity(i)

        

        If Not swEnt Is Nothing Then

            bRet = swEnt.Select4(True, Nothing): Debug.Assert bRet

        End If

    

        Debug.Print "      Fault[" & i & "]                         = " & swFaultEnt.errorCode(i)

    Next i

End Sub

Sub main()

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim swPart                  As SldWorks.PartDoc

    Dim vBodyArr                As Variant

    Dim vBody                   As Variant

    Dim swBody                  As SldWorks.body2

    Dim nRetval1                As Long

    Dim nRetval2                As Long

    Dim vEdgeArr                As Variant

    Dim vEdge                   As Variant

    Dim swEdge                  As SldWorks.Edge

    Dim swFaultEnt              As SldWorks.FaultEntity

    Dim i                       As Long

    Dim bRet                    As Boolean

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swPart = swModel

    

    Debug.Print "File = " & swModel.GetPathName

    

    vBodyArr = swPart.GetBodies2(swAllBodies, True): Debug.Assert Not IsEmpty(vBodyArr)

    For Each vBody In vBodyArr

        Set swBody = vBody

        

        Debug.Print "  Body[" & swBody.GetType & "] --> " & swBody.GetSelectionId

        

        nRetval1 = swBody.Check ' obsolete method

        nRetval2 = swBody.Check2 ' obsolete method

                

        Debug.Print " Body2::Check (1 if valid; 0 if not)   = " & nRetval1

        Debug.Print " Body2::Check2(number of faults)       = " & nRetval2

        

        vEdgeArr = swBody.GetEdges

        For Each vEdge In vEdgeArr

            Set swEdge = vEdge

            Set swFaultEnt = swEdge.Check

            

    

            ProcessFaultEntity swApp, swModel, swEdge, swFaultEnt

        Next vEdge

    Next vBody

End Sub

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