Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Create surface extrusion - VBA

gopinathmY575P
Advocate

Create surface extrusion - VBA

gopinathmY575P
Advocate
Advocate

Hello all,

 

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

0 Likes
Reply
Accepted solutions (2)
527 Views
6 Replies
Replies (6)

FINET_Laurent
Advisor
Advisor

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 : 

FINET_Laurent_0-1689057365241.png

 

Kind regards,

FINET L.

If this post solved your question, please kindly mark it as "Solution"

If this post helped out in any way to solve your question, please drop a "Like"

@LinkedIn     @JohnCockerill

0 Likes

FINET_Laurent
Advisor
Advisor

And here is the file with the code.

 

Kind regards,

FINET L.

If this post solved your question, please kindly mark it as "Solution"

If this post helped out in any way to solve your question, please drop a "Like"

@LinkedIn     @JohnCockerill

0 Likes

gopinathmY575P
Advocate
Advocate

Hi,

 Actually, i need a surface extrusion.

0 Likes

FINET_Laurent
Advisor
Advisor
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)

 

FINET_Laurent_0-1689064070420.png

 

Kind regards,

FINET L. 

If this post solved your question, please kindly mark it as "Solution"

If this post helped out in any way to solve your question, please drop a "Like"

@LinkedIn     @JohnCockerill

FINET_Laurent
Advisor
Advisor
Accepted solution

@gopinathmY575P 

 

You just have to change here as stated above : 

NewSketch.Profiles.AddForSurface, PartFeatureOperationEnum.kSurfaceOperation

 

Kind regards,

FINET L.

If this post solved your question, please kindly mark it as "Solution"

If this post helped out in any way to solve your question, please drop a "Like"

@LinkedIn     @JohnCockerill

gopinathmY575P
Advocate
Advocate

@FINET_Laurent Thank you very much. Its solved.