Extrude Feature using Project Geometry Profile

[luccla]

Below is the code and the image after I've run the code.

I would like to use ilogic to extrude from the top surface using the projected geometry/edges as the profile. 

When I try to create extrude feature, I get error. And I'm not sure how to trouble shoot. 

Sub Main()
	
	Dim pdoc As PartDocument
	pdoc = ThisApplication.ActiveDocument
	
	Dim comDef As PartComponentDefinition
	comDef = pdoc.ComponentDefinition
	
	Dim sketches As PlanarSketches
	sketches = comDef.Sketches
	
	Dim feats As PartFeatures
	feats = comDef.Features
	
	Dim derive As DerivedAssemblyComponents
	derive = comDef.ReferenceComponents.DerivedAssemblyComponents
	
	Dim surfaces As SurfaceBody
	surfaces = comDef.SurfaceBodies.Item(1)
	
	sketches.Item("TOP_SURFACE").Delete
	
	Dim i As Integer = 1
	
	Dim top(2) As Face
	top(0) = Nothing
	top(1) = Nothing
	
	Dim n As Integer
	n = 1
	
	While i < surfaces.Faces.Count
		
			If surfaces.Faces.Item(i).EdgeLoops.Count > 1 Then
				top(n - 1) = surfaces.Faces.Item(i)
				n = n + 1
			End If

		i = i + 1
		
	End While	
	
	Dim sketch As PlanarSketch
	sketch = sketches.Add(top(1),True)
	sketches.Item(1).Name = "TOP_SURFACE"
	
	
'	Dim profile As Profile
'	profile = sketch.Profiles.AddForSurface

	
'	Dim def As ExtrudeDefinition
'	def = feats.ExtrudeFeatures.CreateExtrudeDefinition(profile, kJoinOperation)
	
	
'	feats.ExtrudeFeatures.Add(def)
	
	
	
End Sub

The image below is the desired effect, but it does it automatically through ilogic rule.

Any assistance would be greatly appreciated.

Thank you

[Curtis_Waguespack · Accepted solution]

Hi @luccla,

I'm sure this isn't exactly what you are after, but attached is a quick example of the syntax for creating an extruded surface.

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

Dim pdoc As PartDocument
pdoc = ThisApplication.ActiveDocument

Dim comDef As PartComponentDefinition
comDef = pdoc.ComponentDefinition

Dim sketches As PlanarSketches
sketches = comDef.Sketches

Dim feats As PartFeatures
feats = comDef.Features

Dim surfaces As SurfaceBody
surfaces = comDef.SurfaceBodies.Item(1)

Try
	sketches.Item("TOP_SURFACE").Delete
Catch
End Try

Try
	feats.Item("Test").Delete
Catch
End Try

Dim i As Integer = 1

Dim top As Face
top = surfaces.Faces.Item(29)

Dim sketch As PlanarSketch
sketch = sketches.Add(top, True)
sketch.Name = "TOP_SURFACE"


Dim profile As Profile
profile = sketch.Profiles.AddForSurface

Dim def As ExtrudeDefinition
def = feats.ExtrudeFeatures.CreateExtrudeDefinition(profile, PartFeatureOperationEnum.kSurfaceOperation)
def.SetDistanceExtent(1, PartFeatureExtentDirectionEnum.kPositiveExtentDirection)

Dim oExtrude As ExtrudeFeature
oExtrude = feats.ExtrudeFeatures.Add(def)
oExtrude.Name = "Test"

[luccla]

I applied some of your code, but so much has changed. I

It's only creating one edge loop now, and it's creating a second sketch. 

This is what I changed the code too.

Sub Main()
	
	Dim pdoc As PartDocument
	pdoc = ThisApplication.ActiveDocument
	
	Dim comDef As PartComponentDefinition
	comDef = pdoc.ComponentDefinition
	
	Dim sketches As PlanarSketches
	sketches = comDef.Sketches
	
	Dim feats As PartFeatures
	feats = comDef.Features
	
	Dim derive As DerivedAssemblyComponents
	derive = comDef.ReferenceComponents.DerivedAssemblyComponents
	
	Dim surfaces As SurfaceBody
	surfaces = comDef.SurfaceBodies.Item(1)
	
	Try 
		sketches.Item("TOP_SURFACE").Delete
	Catch 
	End Try
	
	Try
	feats.Item("Test").Delete
	Catch
	End Try
	
	
	Dim i As Integer = 1
	
	Dim top(2) As Face
	top(0) = Nothing
	top(1) = Nothing
	
	Dim n As Integer
	n = 1
	
	
	While i < surfaces.Faces.Count
		
			If surfaces.Faces.Item(i).EdgeLoops.Count > 1 Then
				top(n - 1) = surfaces.Faces.Item(i)
				n = n + 1
			End If

		i = i + 1
		
	End While	
	
	Dim sketch As PlanarSketch
	sketch = sketches.Add(top(1),True)
	sketches.Item(1).Name = "TOP_SURFACE"
	
	
	Dim profile As Profile
	profile = sketch.Profiles.AddForSurface

	
	Dim def As ExtrudeDefinition
	def = feats.ExtrudeFeatures.CreateExtrudeDefinition(profile, PartFeatureOperationEnum.kJoinOperation)
	
	
	feats.ExtrudeFeatures.Add(def)
	def.SetDistanceExtent(1, PartFeatureExtentDirectionEnum.kPositiveExtentDirection)
	
	Dim oExtrude As ExtrudeFeature
	oExtrude = feats.ExtrudeFeatures.Add(def)
	oExtrude.Name = "Test"
	
	
End Sub

The upside, something happened that wasn't an error. Noice. Baby steps.

[luccla]

Okay Curtis,

My initial reply was bad, I made multiple mistakes.

But, I think I figured it out. 

I used your code, but instead of: 

Dim profile As Profile
profile = sketch.Profiles.AddForSurface	

I changed it to:

Dim profile As Profile
profile = sketch.Profiles.AddForSolid

Additionally, I changed:

Dim def As ExtrudeDefinition
def = feats.ExtrudeFeatures.CreateExtrudeDefinition(profile, PartFeatureOperationEnum.kSurfaceOperation)

to this:

Dim def As ExtrudeDefinition
def = feats.ExtrudeFeatures.CreateExtrudeDefinition(profile, kJoinOperation)

I'm not entirely sure I understand, but it works.

I hope this was informative for you. 

Thanks