Message 1 of 1
CANNOT SET A SKETCH ELLIPTICAL ARC TO PROFILE FOR EXTRUSION
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi guys,
I have a Function using VB.net to create an AISC W Shape. I have a problem with set the sketch to profile,
Here is my code:
Public Function CreateWSection(sec As Wsec) As PartDocument
Dim R_k1_web As Double = sec.k1 - sec.tw / 2
Dim R_kdet_flg As Double = sec.kdet - sec.tf
Dim isVE As Boolean = False
''Convert WSections properties to inches
Dim i_depth = sec.Depth * 2.54
Dim i_D_depth = sec.D_det * 2.54
Dim i_bf = sec.bf * 2.54
Dim i_bf_det = sec.bf_det * 2.54
Dim i_tw = sec.tw * 2.54
Dim i_twdet_2 = sec.twdet_2 * 2.54
Dim i_tf = sec.tf * 2.54
Dim i_tfdet = sec.tfdet * 2.54
Dim i_kdet = sec.kdet * 2.54
Dim i_k1 = sec.k1 * 2.54
'Try to get an existing instance of Inventor
Try
oApp = System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application")
Catch ex As Exception
oApp = CreateObject("Inventor.Application") 'Create object if not exist
End Try
Dim WPart As PartDocument
WPart = CreatePartTemplate()
'Define Part Document Definition
oCompDef = WPart.ComponentDefinition
' Set a reference to the transient geometry object.
Dim oTransGeom As TransientGeometry
oTransGeom = oApp.TransientGeometry
'Make sure Inventor is visible
oApp.Visible = True
'Create a base sketch first on a workplanes
Dim oSketch As PlanarSketch
oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes(3))
'Create AISC W properties on the XY plane
' 11 10
' -------------------
' ------- -------
' 6 7 8 9
' 12- -14
' - -
' 13- -15
' 5 4- -3 2
' ------- -------
' -------------------
' 0 1
'Create reference construction line
'oSketch.SketchLines.AddByTwoPoints(oTransGeom.CreatePoint2d(0, 5.0), oTransGeom.CreatePoint2d(0, -5.0))
'oSketch.SketchLines.AddByTwoPoints(oTransGeom.CreatePoint2d(-5.0, 0), oTransGeom.CreatePoint2d(5.0, 0))
'oSketch.SketchLines.Item(1).Construction = True
'oSketch.SketchLines.Item(2).Construction = True
'Define all sketchpoints
Dim oSkPnts As SketchPoints
oSkPnts = oSketch.SketchPoints
Dim oP(0 To 19) As SketchPoint
'Define all sketchlines
Dim oLines As SketchLines
oLines = oSketch.SketchLines
Dim oLine(0 To 13) As SketchLine
'Dim all sketchEllipArc
Dim oSkElArcs As SketchEllipticalArcs
oSkElArcs = oSketch.SketchEllipticalArcs
Dim oSkElArc(0 To 3) As SketchEllipticalArc
'Bottom flange
oP(0) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_bf / 2, -i_depth / 2), False)
oP(1) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_bf / 2, -i_depth / 2), False)
oP(2) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_bf / 2, -i_depth / 2 + i_tf), False)
oP(3) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_k1, -i_depth / 2 + i_tf), False)
oP(4) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_k1, -i_depth / 2 + i_tf), False)
oP(5) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_bf / 2, -i_depth / 2 + i_tf), False)
oLine(0) = oLines.AddByTwoPoints(oP(0), oP(1))
oLine(1) = oLines.AddByTwoPoints(oP(1), oP(2))
oLine(2) = oLines.AddByTwoPoints(oP(2), oP(3))
oLine(3) = oLines.AddByTwoPoints(oP(4), oP(5))
oLine(4) = oLines.AddByTwoPoints(oP(5), oP(0))
'Top flange
oP(6) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_bf / 2, i_depth / 2 - i_tf), False)
oP(7) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_k1, i_depth / 2 - i_tf), False)
oP(8) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_k1, i_depth / 2 - i_tf), False)
oP(9) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_bf / 2, i_depth / 2 - i_tf), False)
oP(10) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_bf / 2, i_depth / 2), False)
oP(11) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_bf / 2, i_depth / 2), False)
oLine(5) = oLines.AddByTwoPoints(oP(6), oP(7))
oLine(6) = oLines.AddByTwoPoints(oP(8), oP(9))
oLine(7) = oLines.AddByTwoPoints(oP(9), oP(10))
oLine(8) = oLines.AddByTwoPoints(oP(10), oP(11))
oLine(9) = oLines.AddByTwoPoints(oP(11), oP(6))
'Web
oP(12) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_tw / 2, i_depth / 2 - i_kdet), False)
oP(13) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_tw / 2, -i_depth / 2 + i_kdet), False)
oP(14) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_tw / 2, i_depth / 2 - i_kdet), False)
oP(15) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_tw / 2, -i_depth / 2 + i_kdet), False)
oLine(10) = oLines.AddByTwoPoints(oP(12), oP(13))
oLine(11) = oLines.AddByTwoPoints(oP(14), oP(15))
'oLine(12) = oLines.AddByTwoPoints(oP(12), oP(14))
'oLine(13) = oLines.AddByTwoPoints(oP(13), oP(15))
'4 Elliptical Arcs
Dim oPEA(0 To 3) As SketchPoint
oPEA(0) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_k1, i_depth / 2 - i_kdet), False)
oPEA(1) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_k1, i_depth / 2 - i_kdet), False)
oPEA(2) = oSkPnts.Add(oTransGeom.CreatePoint2d(-i_k1, -i_depth / 2 + i_kdet), False)
oPEA(3) = oSkPnts.Add(oTransGeom.CreatePoint2d(i_k1, -i_depth / 2 + i_kdet), False)
'Dim UV2d As Sketch
Dim UV2d As UnitVector2d = oTransGeom.CreateUnitVector2d
oSkElArc(0) = oSkElArcs.Add(oPEA(0), UV2d, (i_kdet - i_tf), (i_k1 - i_tw / 2), -Math.PI / 2, Math.PI / 2)
oSkElArc(1) = oSkElArcs.Add(oPEA(1), UV2d, (i_kdet - i_tf), (i_k1 - i_tw / 2), Math.PI / 2, -Math.PI / 2)
oSkElArc(2) = oSkElArcs.Add(oPEA(2), UV2d, (i_kdet - i_tf), (i_k1 - i_tw / 2), Math.PI, Math.PI / 2)
oSkElArc(3) = oSkElArcs.Add(oPEA(3), UV2d, (i_kdet - i_tf), (i_k1 - i_tw / 2), Math.PI / 2, Math.PI / 2)
Dim WProfile As Profile
WProfile = oSketch.Profiles.AddForSolid(True)
'Define an Extrude feature
Dim W_ExtrudeDef As ExtrudeDefinition = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(WProfile,
PartFeatureOperationEnum.kJoinOperation)
Call W_ExtrudeDef.SetDistanceExtent(120 * 2.54, PartFeatureExtentDirectionEnum.kSymmetricExtentDirection)
'Add Extrude Definition to Features
Dim W_Extrude As ExtrudeFeature
W_Extrude = oCompDef.Features.ExtrudeFeatures.Add(W_ExtrudeDef)
Return WPart
End Function
It always get error at the step Adding the sketch to Profiles.
Please help me.
