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