here the coding ii

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

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swBody = swPart.Body

' 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 we've successfully sewn surfaces 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