2 Replies Latest reply on Sep 18, 2015 8:47 AM by Tien Dinh

    How to insert a filled surface from four 3D curves

    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

        • Re: How to insert a filled surface from four 3D curves
          Mark Olsen

          Try this.  I changed the variable typd of objSel to an array, changed the append on the last selectid2 to true (to keep all four curves selected), and then created the array of curves for the feature.  Oh, and I also added a clear selection to make sure that nothing else was selected.

           

           

          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(3) 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 swModel = swApp.ActiveDoc
          Set swModelDocExt = swModel.Extension
          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()

          swModel.ClearSelection2 True
          ' 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, True, 0, Nothing, 0)

          Set selObj(0) = swSelMgr.GetSelectedObject6(1, -1)
          Set selObj(1) = swSelMgr.GetSelectedObject6(2, -1)
          Set selObj(2) = swSelMgr.GetSelectedObject6(3, -1)
          Set selObj(3) = swSelMgr.GetSelectedObject6(4, -1)

          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