AnsweredAssumed Answered

How to insert a filled surface from four 3D curves

Question asked by Tien Dinh on Sep 17, 2015
Latest reply on Sep 18, 2015 by Tien Dinh

Dear all,

 

I have been trying to write a code to insert a filled surface from four 3D curves. However, it does not work out . Below is my code

 

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swSelMgr As SldWorks.SelectionMgr

Dim swSketchMgr As SldWorks.SketchManager

Dim swSketchSegment As SldWorks.SketchSegment

Dim swFeatMgr As SldWorks.FeatureManager

Dim swRefPlane As SldWorks.RefPlane

Dim swFeat As SldWorks.Feature

Dim selObj As Object

Dim status As Boolean

Dim edges As SldWorks.Edge

Dim a As Double, h As Double, p1 As Double

Dim p2 As Double, p3 As Double, p4 As Double

Dim p5 As Double, p6 As Double, p7 As Double

 

Sub main()

a = 2 * Sqr(2)

h = 1

p1 = 0

p2 = 1

p3 = 0.2

p4 = 0.3

p5 = 0

p6 = 0

p7 = 1

Set swApp = _

Application.SldWorks

 

 

Set swModel = swApp.NewDocument("C:\Program Files\SolidWorks Corp\SolidWorks\lang\english\Tutorial\part.prtdot", 0, 0, 0)

Set swModelDocExt = swModel.Extension

'swApp.ActivateDoc2 "Part1", False, longstatus

Set swModel = swApp.ActiveDoc

Set swSelMgr = swModel.SelectionManager

Set swFeatMgr = swModel.FeatureManager

swModel.InsertCurveFileBegin

boolstatus = swModel.InsertCurveFilePoint(0, -(a + p1), p2)

boolstatus = swModel.InsertCurveFilePoint(-(a / 2 - p3), -(a / 2 - p4), p5)

boolstatus = swModel.InsertCurveFilePoint(-(a + p6), 0, -p7)

boolstatus = swModel.InsertCurveFileEnd()

swModel.InsertCurveFileBegin

boolstatus = swModel.InsertCurveFilePoint(a + p6, 0, -p7)

boolstatus = swModel.InsertCurveFilePoint(a / 2 - p3, -(a / 2 - p4), 0)

boolstatus = swModel.InsertCurveFilePoint(0, -(a + p1), p2)

boolstatus = swModel.InsertCurveFileEnd()

swModel.InsertCurveFileBegin

boolstatus = swModel.InsertCurveFilePoint(0, (a + p1), p2)

boolstatus = swModel.InsertCurveFilePoint(-(a / 2 - p3), a / 2 - p4, 0)

boolstatus = swModel.InsertCurveFilePoint(-(a + p6), 0, -p7)

boolstatus = swModel.InsertCurveFileEnd()

swModel.InsertCurveFileBegin

boolstatus = swModel.InsertCurveFilePoint(0, a + p1, p2)

boolstatus = swModel.InsertCurveFilePoint(a / 2 - p3, a / 2 - p4, p5)

boolstatus = swModel.InsertCurveFilePoint(a + p6, 0, -p7)

boolstatus = swModel.InsertCurveFileEnd()

 

 

' Insert a filled surface

boolstatus = swModel.Extension.SelectByID2("Curve1", "REFERENCECURVES", 0, 0, 0, True, 0, Nothing, 0)

boolstatus = swModel.Extension.SelectByID2("Curve2", "REFERENCECURVES", 0, 0, 0, True, 0, Nothing, 0)

boolstatus = swModel.Extension.SelectByID2("Curve3", "REFERENCECURVES", 0, 0, 0, True, 0, Nothing, 0)

boolstatus = swModel.Extension.SelectByID2("Curve4", "REFERENCECURVES", 0, 0, 0, False, 0, Nothing, 0)

 

 

Set selObj = swSelMgr.GetSelectedObject6(1, -1)

'Debug.Print swSelMgr.GetSelectedObjectType3(4, -1) // returns 26

'If Not selObj Is Nothing Then

'   MsgBox "selObj isn't empty!"

'End If

Set Edge = selObj(0)

 

 

Set swFeat = swFeatMgr.InsertFillSurface2(2, swFeatureFillSurfaceOptions_e.swOptimizeSurface, selObj, swContactType_e.swContact, Nothing, Nothing)

If swFeat Is Nothing Then

   MsgBox "swFeat is empty!"

End If

End Sub

 

Any help or suggestion is highly appreciated.

 

Best regards,

Tien

Outcomes