Creating a Polygon Sketch in VBA

[austen_27_t]

I need to create a sketch of a polygon using VBA but I do not know the code to make the happen.

I would appreciate any help!

This is the code i have i changed the code that i had for a circle and tried to make it work for the polygon the problem should be in the area of the code that is double spaced out.

Public Sub hex()
Dim doc As PartDocument
Set doc = ThisApplication.ActiveDocument

Dim partD As PartComponentDefinition
Set partD = doc.ComponentDefinition

Dim dim1, dim2

dim1 = InputBox("Enter Radius of Cylinder", "Radius")
dim2 = InputBox("Enter Length of Cylinder", "Length")

Dim sketch As PlanarSketch
Set sketch = partD.Sketches.Add(partD.WorkPlanes.Item(3))

Dim tg As TransientGeometry
Set tg = ThisApplication.TransientGeometry

Dim hex As SketchPolygon
Set hex = sketch.SketchPolygons.AddByCenterRadius(ThisApplication.TransientGeometry.CreatePoint2d(0, 0), dim1)

'Creates a profile.
Dim Pfile As Profile
Set Pfile = sketch.Profiles.AddForSolid

'Create an extrusion.
Dim extrudeDef As ExtrudeDefinition
Set extrudeDef = partD.Features.ExtrudeFeatures.CreateExtrudeDefinition(Pfile, kJoinOperation)

Call extrudeDef.SetDistanceExtent(dim2, kNegativeExtentDirection)
Dim extrude As ExtrudeFeature
Set extrude = partD.Features.ExtrudeFeatures.Add(extrudeDef)

End Sub

[arron.craig]

I think you would need to sketch one from lines similar to the API sample

https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2018/ENU/Inventor-API/files/Sk...

[dgreatice]

identify number of side?

identify inscribed or circumscribed?

[ravikmb5]

Try This

but i was not able to figure it out

to Dimension the Sketch Entities of polygon

Sub Main()


	' Defining This Document
	Dim oPartDoc As PartDocument = ThisApplication.ActiveDocument
	'Definining a Component Definition
	Dim oPartDef As PartComponentDefinition = oPartDoc.ComponentDefinition
	Dim oParams As Parameters
	oParams = oPartDef.Parameters
	Dim oUserParams As UserParameters
	oUserParams = oParams.UserParameters
	

	'[ Create's a Profile Sketch
	Dim sketch1 As PlanarSketch
	sketch1 = oPartDef.Sketches.Add(oPartDef.WorkPlanes.Item(3))
	sketch1.Name = "Profile Extrude Sketch"
	'Collecting Transient Geometry
	Dim tg As TransientGeometry
	tg = ThisApplication.TransientGeometry





	'''CentreOrigin Projected
	 Dim oProjectionPoint As SketchPoint
	oProjectionPoint = sketch1.AddByProjectingEntity(oPartDef.WorkPoints.Item(1))

	'''PolyGon Sketch
		Dim hex As SketchEntitiesEnumerator
		hex = sketch1.SketchLines.AddAsPolygon(5,oProjectionPoint,tg.CreatePoint2d(-0.5,-0.6882),True)
		
	''' Construcyion Circle	
		Dim oCir As SketchCircle
		oCir = sketch1.SketchCircles.AddByCenterRadius(oProjectionPoint, 1.3764 / 2)
		oCir.Construction = True
		
		
		'' Constrained Circle tangent to Lines of Polygon
		Call sketch1.GeometricConstraints.AddTangent(hex.Item(1), oCir)
		Call sketch1.GeometricConstraints.AddTangent(hex.Item(2),oCir)
		Call sketch1.GeometricConstraints.AddTangent(hex.Item(3),oCir)
		
		
		''' Circle Centre Point to Origin Point Merge
		Call oCir.CenterSketchPoint.Merge(oProjectionPoint)
		
		''' Adding Horizontal Constraint to one of the Lines of Polygon
		Call sketch1.GeometricConstraints.AddHorizontal(hex.Item(1))
		
'Dim oOffsetDim As OffsetDimConstraint
'		oOffsetDim = sketch1.DimensionConstraints.AddOffset()



'	ThisDoc.Save
End Sub

[austen_27_t]

I ended up figuring it out 

[arron.craig]

It would be appreciated if you could share the code, others may stumble on this looking for an answer

[austen_27_t]

Dim sides As Long
sides = 6

'create new reference sketch plane
Dim sketch As PlanarSketch
Set sketch = pdef.Sketches.Add(pdef.WorkPlanes.Item(3))

'Sets reference to tg transient geometry
Dim tg As TransientGeometry
Set tg = ThisApplication.TransientGeometry

'Create lines for polygon
Call sketch.SketchLines.AddAsPolygon(sides, tg.CreatePoint2d(0, 0), tg.CreatePoint2d(0, dim1), False)

[ravikmb5]

here is the Completed Code of ilogic

added dimensions

Sub Main()


	' Defining This Document
	Dim oPartDoc As PartDocument = ThisApplication.ActiveDocument
	'Definining a Component Definition
	Dim oPartDef As PartComponentDefinition = oPartDoc.ComponentDefinition
	Dim oParams As Parameters
	oParams = oPartDef.Parameters
	Dim oUserParams As UserParameters
	oUserParams = oParams.UserParameters
	    Dim oPolygonfaces As Long
  
    
'''Getting Data From User
   Dim oPolygonsides As Long
   oPolygonsides = InputBox("No of Polygon Sides", "Enter No of Sides of Polygon", "5")



	'[ Create's a Profile Sketch
	Dim sketch1 As PlanarSketch
	sketch1 = oPartDef.Sketches.Add(oPartDef.WorkPlanes.Item(3))
	sketch1.Name = "Profile Extrude Sketch"
	'Collecting Transient Geometry
	Dim tg As TransientGeometry
	tg = ThisApplication.TransientGeometry





	'''CentreOrigin Projected
	 Dim oProjectionPoint As SketchPoint
	oProjectionPoint = sketch1.AddByProjectingEntity(oPartDef.WorkPoints.Item(1))

	'''PolyGon Sketch
		Dim hex As SketchEntitiesEnumerator
		hex = sketch1.SketchLines.AddAsPolygon(oPolygonsides,oProjectionPoint,tg.CreatePoint2d(-0.5,-0.6882),True)
		
	''' Construcyion Circle	
		Dim oCir As SketchCircle
		oCir = sketch1.SketchCircles.AddByCenterRadius(oProjectionPoint, 1.3764 / 2)
		oCir.Construction = True
		
		
		'' Constrained Circle tangent to Lines of Polygon
		Call sketch1.GeometricConstraints.AddTangent(hex.Item(1), oCir)
		Call sketch1.GeometricConstraints.AddTangent(hex.Item(2),oCir)
		Call sketch1.GeometricConstraints.AddTangent(hex.Item(3),oCir)
		
		
		''' Circle Centre Point to Origin Point Merge
		Call oCir.CenterSketchPoint.Merge(oProjectionPoint)
		
		''' Adding Horizontal Constraint to one of the Lines of Polygon
		Call sketch1.GeometricConstraints.AddHorizontal(hex.Item(1))
		
		Dim oSketchLine As SketchLine
		oSketchLine = hex.Item(1)
		
Dim oOffsetDim As TwoPointDistanceDimConstraint
		oOffsetDim = sketch1.DimensionConstraints.AddTwoPointDistance(oSketchLine.EndSketchPoint, oSketchLine.StartSketchPoint,DimensionOrientationEnum.kHorizontalDim,tg.CreatePoint2d(0,-1.2), False)
oOffsetDim.Parameter.Expression = "Length = 10 mm"

Call sketch1.Solve

'	ThisDoc.Save
End Sub