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 |