Create surface extrusion - VBA

[gopinathmY575P]

Hello all,

i have point/axis, from that i need to create the surface extrusion for dia of 5mm through vba.

[FINET_Laurent]

Hi @gopinathmY575P,

The code below let you select a surface (planar) and a work axis, then create the sketch and extrude the circle (cut operation) : 

Dim s As Inventor.Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Pick face")
Dim w As Inventor.WorkAxis = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kWorkAxisFilter, "Pick work axis")

Dim tg As Inventor.TransientGeometry = ThisApplication.TransientGeometry
Dim Doc As Inventor.PartDocument = ThisApplication.ActiveDocument
Dim PartCompDef As Inventor.PartComponentDefinition = Doc.ComponentDefinition

Dim NewSketch As Inventor.PlanarSketch = PartCompDef.Sketches.Add(s, False)
Dim p As Inventor.SketchPoint = NewSketch.AddByProjectingEntity(w)

Dim c As Inventor.SketchCircle = NewSketch.SketchCircles.AddByCenterRadius(p, 0.25)
NewSketch.DimensionConstraints.AddDiameter(c, tg.CreatePoint2d(0,0), False)

NewSketch.Solve

Dim def As Inventor.ExtrudeDefinition = PartCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(NewSketch.Profiles.AddForSolid, PartFeatureOperationEnum.kCutOperation)
'def.SetDistanceExtent(10, PartFeatureExtentDirectionEnum.kSymmetricExtentDirection)
def.SetThroughAllExtent(PartFeatureExtentDirectionEnum.kSymmetricExtentDirection)

Dim f As Inventor.ExtrudeFeature = PartCompDef.Features.ExtrudeFeatures.Add(def)

Here is the end result : 

Kind regards,

FINET L.

[FINET_Laurent]

And here is the file with the code.

Kind regards,

FINET L.

[gopinathmY575P]

Hi,

 Actually, i need a surface extrusion.

[FINET_Laurent · Accepted solution]

@gopinathmY575P 

Actually very similar : 

Dim s As Inventor.Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Pick face")
Dim w As Inventor.WorkAxis = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kWorkAxisFilter, "Pick work axis")

Dim tg As Inventor.TransientGeometry = ThisApplication.TransientGeometry
Dim Doc As Inventor.PartDocument = ThisApplication.ActiveDocument
Dim PartCompDef As Inventor.PartComponentDefinition = Doc.ComponentDefinition

Dim NewSketch As Inventor.PlanarSketch = PartCompDef.Sketches.Add(s, False)
Dim p As Inventor.SketchPoint = NewSketch.AddByProjectingEntity(w)

Dim c As Inventor.SketchCircle = NewSketch.SketchCircles.AddByCenterRadius(p, 0.25)
NewSketch.DimensionConstraints.AddDiameter(c, tg.CreatePoint2d(0,0), False)

NewSketch.Solve

Dim def As Inventor.ExtrudeDefinition = PartCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(NewSketch.Profiles.AddForSurface, PartFeatureOperationEnum.kSurfaceOperation)
def.SetDistanceExtent(5, PartFeatureExtentDirectionEnum.kSymmetricExtentDirection)
'def.SetThroughAllExtent(PartFeatureExtentDirectionEnum.kSymmetricExtentDirection)

Dim f As Inventor.ExtrudeFeature = PartCompDef.Features.ExtrudeFeatures.Add(def)

Kind regards,

FINET L. 

[FINET_Laurent · Accepted solution]

@gopinathmY575P 

You just have to change here as stated above : 

NewSketch.Profiles.AddForSurface, PartFeatureOperationEnum.kSurfaceOperation

Kind regards,

FINET L.

[gopinathmY575P]

@FINET_Laurent Thank you very much. Its solved.