Check Faces for Faults Example (VBA)
This example shows how to check faces 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, _
swFace
As SldWorks.face2, _
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(swFace):
Debug.Assert Not IsEmpty(vPIDarr)
Debug.Print
" Face
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
swFace As
SldWorks.face2
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
Set
swFace = swBody.GetFirstFace
Do
While Not swFace Is Nothing
Set
swFaultEnt = swFace.Check
ProcessFaultEntity
swApp, swModel, swFace, swFaultEnt
Set
swFace = swFace.GetNextFace
Loop
Next
vBody
End Sub
'---------------------------------------