Get Maximum Edge and Vertex Gaps Example (VBA)
'----------------------------------------------------------------------------------------------------------------------------------------------------------
' This macro returns the same data returned by the Tools > Check dialog box
' when the checkboxes, Maximum
edge gap and Maximum vertex gap,
are selected.
'
' This macro uses IEdge::IsTolerant
to determine whether common edges are within tolerance of one another.
' This macro uses IVertex::IsTolerant
to determine whether common vertexes are within tolerance of one another.
'
' This macro iterates over each edge and vertex in a part
and reports the following:
'
' *
whether
the edge or vertex is tolerant (distance to neighbor is greater than 5.0E-9
mm)
' *
gap size
(or tolerance) in mm of each edge or vertex
' *
maximum
edge gap (or tolerance) in mm for the part
' *
maximum
vertex gap (or tolerance) in mm for the part
'
' Do
the following:
' 1.
Open a
part that contains gaps between common edges and/or vertexes
' (e.g.,
<install_dir>\samples\tutorial\assemblymates\head.sldprt).
' 2.
Open an
immediate window to view runtime messages.
' 3.
Run this
macro.
' 4.
Move cursor
across the part in the SolidWorks window. The
tolerant edges and vertexes are selected in each body of the part,
' and
tolerance data for all edges and vertexes is printed in the immediate
window.
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Public Enum swBodyType_e
swAllBodies
= -1
swSolidBody
= 0
swSheetBody
= 1
swWireBody
= 2
swMinimumBody
= 3
swGeneralBody
= 4
swEmptyBody
= 5
End Enum
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
vVertexArr As Variant
Dim
vVertex As Variant
Dim
swVertex As SldWorks.Vertex
Dim
swFaultEnt As
SldWorks.FaultEntity
Dim
i As
Long
Dim
bRet As
Boolean
Dim
tol As Double
Dim
vTangentEdgeArr As Variant
Dim
vTangentEdge As Variant
Dim
swTangentEdge As SldWorks.Edge
Dim
count As Integer
Dim
swTanEnt As
SldWorks.Entity
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
vEdgeArr
= swBody.GetEdges
vVertexArr
= swBody.GetVertices
Dim
maxEdgeGap As Double
maxEdgeGap
= 0#
For
Each vEdge In vEdgeArr
'
Find maximum edge gap which mirrors the UI functionality in Tools
> Check when Maximum edge gap
is selected
Set
swEdge = vEdge
bRet
= swEdge.IsTolerant(tol)
If
maxEdgeGap < tol Then
maxEdgeGap
= tol
End
If
If
(Not (bRet = False)) Then
Debug.Print
"Edge is tolerant: "
Debug.Print
" Tolerance
= " & tol
Set
swTanEnt = swEdge
bRet
= swTanEnt.Select4(True, Nothing)
Else
Debug.Print
"Edge is not tolerant: Tolerance
= " & tol
End
If
Set
swFaultEnt = swEdge.Check
Next
vEdge
Debug.Print
""
Debug.Print
"Maximum edge gap is " & maxEdgeGap
Debug.Print
""
Dim
maxVertexGap As Double
maxVertexGap
= 0#
For
Each vVertex In vVertexArr
'
Find maximum vertex gap which mirrors the UI functionality in Tools
> Check when Maximum vertex
gap is selected
Set
swVertex = vVertex
bRet
= swVertex.IsTolerant(tol)
If
maxVertexGap < tol Then
maxVertexGap
= tol
End
If
If
(Not (bRet = False)) Then
Debug.Print
"Vertex is tolerant: "
Debug.Print
" Tolerance
= " & tol
Set
swTanEnt = swVertex
bRet
= swTanEnt.Select4(True, Nothing)
Else
Debug.Print
"Vertex is not tolerant: Tolerance
= " & tol
End
If
Next
vVertex
Debug.Print
""
Debug.Print
"Maximum vertex gap is " & maxVertexGap
Debug.Print
""
Next
vBody
End Sub