Help with SweptProtrusion

 

Hi,

I am looking for help with SweptProtrusion API. I am trying to do this with a SyncPart, but working example in a traditional part would be great.

 

 Private Sub Command1_Click()

    Dim objApp As SolidEdgeFramework.Application

    Dim objPart As SolidEdgePartSync.PartDocument

    Dim objRefPlanes As SolidEdgePartSync.RefPlanes

    Dim objRefPlane As SolidEdgePartSync.RefPlane

    Dim objSketches As SolidEdgePartSync.Sketchs

    Dim objSketch As SolidEdgePartSync.Sketch

    Dim objProfiles As SolidEdgePartSync.Profiles

    Dim objProfile As SolidEdgePartSync.Profile

    Dim objLines2d As SolidEdgeFrameworkSupport.Lines2d

    Dim objLine2d As SolidEdgeFrameworkSupport.Line2d

    Dim objPoints2d As SolidEdgeFrameworkSupport.Points2d

    Dim objPoint2d As SolidEdgeFrameworkSupport.Point2d

 

    Dim objRefPlaneNormal As SolidEdgePartSync.RefPlane

    Dim objSketchCS As SolidEdgePartSync.Sketch

    Dim objProfileCS As SolidEdgePartSync.Profile

    Dim objLines2dCS As SolidEdgeFrameworkSupport.Lines2d

 

    Dim lngTraceCurveTypes(1 To 2) As Long

    Dim lngCrossSectionTypes(1 To 2) As Long

    Dim vOriginArray(2) As Variant

    Dim TraceCurveSet(1) As Object

    Dim EdgeSet(1 To 4) As Object

 

    Dim objModel As SolidEdgePartSync.Model

 

 

    Dim X1 As Double

    Dim Y1 As Double

    Dim X2 As Double

    Dim Y2 As Double

    Dim Z As Double

 

    Dim xx As Double

    Dim yy As Double

 

    Const WIDTH As Double = 0.01

    Const HEIGTH As Double = 0.02

 

    X1 = 0.1

    Y1 = 0

    X2 = 0.1

    Y2 = 0.1

    Z = 0.1

 

    ' Connect to a running instance of Solid Edge

    Set objApp = GetObject(, "SolidEdge.Application")

    ' Create a new part document

    Set objPart = objApp.Documents.Add("SolidEdge.DMPartDocument")

    ' Get a reference to the ref planes collection

    Set objRefPlanes = objPart.RefPlanes

 

    ' Get a reference to the sketches collection

    Set objSketches = objPart.Sketches

 

 

    Set objRefPlane = objRefPlanes.AddParallelByDistance(objRefPlanes(0), Z, SolidEdgePartSync.ReferenceElementConstants.igNormalSide, , , False)

    Set objSketch = objSketches.AddByPlanarFace(objRefPlane)

    Set objProfile = objSketch.Profile

    Set objLines2d = objProfile.Lines2d

    Set objLine2d = objLines2d.AddBy2Points(X1, Y1, X2, Y2)

 

    Set objRefPlaneNormal = objRefPlanes.AddNormalToCurve(objProfile.CurveBody.Curves(1), igCurveStart, objRefPlanes(0), igPivotStart, False)

 

    Set objSketchCS = objSketches.AddByPlanarFace(objRefPlaneNormal)

    Set objProfileCS = objSketchCS.Profile

    Set objLines2dCS = objProfileCS.Lines2d

 

    Call objProfileCS.Convert3DCoordinate(X1, Y1, Z, xx, yy)

 

    xx = xx - (WIDTH / 2)

 

    With objLines2dCS

        .AddBy2Points xx, yy, xx + WIDTH, yy

        .AddBy2Points xx + WIDTH, yy, xx + WIDTH, yy - HEIGTH ' 2mm deep

        .AddBy2Points xx + WIDTH, yy - HEIGTH, xx, yy - HEIGTH

        .AddBy2Points xx, yy - HEIGTH, xx, yy

    End With

 

 

    lngTraceCurveTypes(1) = igProfileBasedCrossSection

    lngCrossSectionTypes(1) = igProfileBasedCrossSection

    vOriginArray(1) = 0

    Set EdgeSet(1) = objProfile.CurveBody.Curves(1)

    Set EdgeSet(2) = objProfile.CurveBody.Curves(2)

    Set EdgeSet(3) = objProfile.CurveBody.Curves(3)

    Set EdgeSet(4) = objProfile.CurveBody.Curves(3)

 

    Set TraceCurveSet(1) = objProfile.CurveBody.Curves(1)

 

 

'' This didnt work either

'    Set objModel = objPart.Models.AddSweptProtrusion(1, TraceCurveSet, lngTraceCurveTypes, 1, EdgeSet, lngCrossSectionTypes, vOriginArray, 0, igLeft, igNone, 0, Nothing, igNone, 0, Nothing)

 

'' Not how to struture all these parameters

    Set objModel = objPart.Models.AddSweptProtrusion(1, objProfile, lngTraceCurveTypes, 1, objProfileCS, lngCrossSectionTypes, vOriginArray, 0, igLeft, igNone, 0, Nothing, igNone, 0, Nothing)

 

 

    Set objApp = Nothing

    Set objPart = Nothing

    Set objRefPlanes = Nothing

    Set objSketches = Nothing

        Set objRefPlane = Nothing

        Set objSketch = Nothing

        Set objProfiles = Nothing

        Set objProfile = Nothing

        Set objLines2d = Nothing

        Set objLine2d = Nothing

        Set objPoints2d = Nothing

        Set objPoint2d = Nothing

'        Set edgeSet = Nothing

    Set objRefPlaneNormal = Nothing

 

    Set objRefPlaneNormal = Nothing

    Set objSketchCS = Nothing

    Set objProfileCS = Nothing

    Set objLines2dCS = Nothing

 

    Set TraceCurveSet(0) = Nothing

    Set TraceCurveSet(1) = Nothing

 

    For i = 1 To 4

        Set EdgeSet(i) = Nothing

    Next i

    Set objModel = Nothing

 

End Sub

 

Posted by: David Stonely
Post date: 1/19/2010 4:37:53 AM

2 REPLIES

RE: Help with SweptProtrusion

 

I found an old example i did for someone else in the SE programming newsgroup.

Find it attached.

Regards,

Julian

 

Posted by: Julian Guillo
Post date: 1/19/2010 5:14:25 AM

RE: Help with SweptProtrusion

 

Julian,

Thanks for the help. Your example had enough hints to help me out.

David

 

Here is my functional Code for searchers

 Private Sub Command1_Click()

    Dim objApp As SolidEdgeFramework.Application

    Dim objPart As SolidEdgePartSync.PartDocument

    Dim objRefPlanes As SolidEdgePartSync.RefPlanes

    Dim objRefPlane As SolidEdgePartSync.RefPlane

    Dim objSketches As SolidEdgePartSync.Sketchs

    Dim objSketch As SolidEdgePartSync.Sketch

    Dim objProfiles As SolidEdgePartSync.Profiles

    Dim objProfile As SolidEdgePartSync.Profile

    Dim objLines2d As SolidEdgeFrameworkSupport.Lines2d

    Dim objLine2d As SolidEdgeFrameworkSupport.Line2d

    Dim objPoints2d As SolidEdgeFrameworkSupport.Points2d

    Dim objPoint2d As SolidEdgeFrameworkSupport.Point2d

 

    Dim objRefPlaneNormal As SolidEdgePartSync.RefPlane

    Dim objSketchCS As SolidEdgePartSync.Sketch

    Dim objProfileCS As SolidEdgePartSync.Profile

    Dim objLines2dCS As SolidEdgeFrameworkSupport.Lines2d

 

    Dim lngTraceCurveTypes(1 To 1) As Long

    Dim lngCrossSectionTypes(1 To 1) As Long

    Dim vOriginArray(1 To 1) As Variant

    Dim TraceCurveSet(1 To 1) As Object

    Dim EdgeSet(1 To 1) As Object

 

    Dim objModel As SolidEdgePartSync.Model

 

 

    Dim X1 As Double

    Dim Y1 As Double

    Dim X2 As Double

    Dim Y2 As Double

    Dim Z As Double

 

    Dim xx As Double

    Dim yy As Double

 

    Const WIDTH As Double = 0.01

    Const HEIGTH As Double = 0.02

 

    X1 = 0.1

    Y1 = 0

    X2 = 0.1

    Y2 = 0.1

    Z = 0.1

 

    ' Connect to a running instance of Solid Edge

    Set objApp = GetObject(, "SolidEdge.Application")

    ' Create a new part document

    Set objPart = objApp.Documents.Add("SolidEdge.DMPartDocument")

    ' Get a reference to the ref planes collection

    Set objRefPlanes = objPart.RefPlanes

 

    ' Get a reference to the sketches collection

    Set objSketches = objPart.Sketches

 

 

    Set objRefPlane = objRefPlanes.AddParallelByDistance(objRefPlanes(0), Z, SolidEdgePartSync.ReferenceElementConstants.igNormalSide, , , False)

    Set objSketch = objSketches.AddByPlanarFace(objRefPlane)

    Set objProfile = objSketch.Profile

    Set objLines2d = objProfile.Lines2d

    Set objLine2d = objLines2d.AddBy2Points(X1, Y1, X2, Y2)

    objProfile.End igProfileClosed

 

    Set objRefPlaneNormal = objRefPlanes.AddNormalToCurve(objProfile.CurveBody.Curves(1), igCurveStart, objRefPlanes(0), igPivotStart, False)

 

    Set objSketchCS = objSketches.AddByPlanarFace(objRefPlaneNormal)

    Set objProfileCS = objSketchCS.Profile

    Set objLines2dCS = objProfileCS.Lines2d

 

    Call objProfileCS.Convert3DCoordinate(X1, Y1, Z, xx, yy)

 

    xx = xx - (WIDTH / 2)

 

    With objLines2dCS

        .AddBy2Points xx, yy, xx + WIDTH, yy

        .AddBy2Points xx + WIDTH, yy, xx + WIDTH, yy - HEIGTH ' 2mm deep

        .AddBy2Points xx + WIDTH, yy - HEIGTH, xx, yy - HEIGTH

        .AddBy2Points xx, yy - HEIGTH, xx, yy

    End With

 

    objProfileCS.End igProfileClosed

 

    lngTraceCurveTypes(1) = igProfileBasedCrossSection

    lngCrossSectionTypes(1) = igProfileBasedCrossSection

    vOriginArray(1) = 0

    Set EdgeSet(1) = objProfileCS

    Set TraceCurveSet(1) = objProfile

 

    Set objModel = objPart.Models.AddSweptProtrusion(1, TraceCurveSet, lngTraceCurveTypes, 1, EdgeSet, lngCrossSectionTypes, vOriginArray, 0, igLeft, igNone, 0, Nothing, igNone, 0, Nothing)

 

 

    Set objApp = Nothing

    Set objPart = Nothing

    Set objRefPlanes = Nothing

    Set objSketches = Nothing

        Set objRefPlane = Nothing

        Set objSketch = Nothing

        Set objProfiles = Nothing

        Set objProfile = Nothing

        Set objLines2d = Nothing

        Set objLine2d = Nothing

        Set objPoints2d = Nothing

        Set objPoint2d = Nothing

'        Set edgeSet = Nothing

    Set objRefPlaneNormal = Nothing

 

    Set objRefPlaneNormal = Nothing

    Set objSketchCS = Nothing

    Set objProfileCS = Nothing

    Set objLines2dCS = Nothing

 

    Set TraceCurveSet(1) = Nothing

 

        Set EdgeSet(1) = Nothing

 

 

    Set objModel = Nothing

 

 

End Sub

 

 

Posted by: David Stonely
Post date: 1/19/2010 8:47:47 AM