Dim m_inventorApp As Inventor.Application = Nothing
m_inventorApp = System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application")
Dim doc As PartDocument = m_inventorApp.ActiveDocument
Dim comp As PartComponentDefinition = doc.ComponentDefinition
Dim IsSheetMetal As Boolean = comp.Type = ObjectTypeEnum.kSheetMetalComponentDefinitionObject
Dim sketch1 As PlanarSketch = doc.ComponentDefinition.Sketches(1)
Dim profile As Profile = sketch1.Profiles.AddForSolid(False)
If IsSheetMetal Then
Dim faceDef As FaceFeatureDefinition = comp.Features.FaceFeatures.CreateFaceFeatureDefinition(profile)
faceDef.Direction = PartFeatureExtentDirectionEnum.kNegativeExtentDirection
comp.Features.FaceFeatures.Add(faceDef)
Else
'Change the thickness for non-Sheetmetal parts here.
Dim thickness = "6 mm"
Dim extrudeDef = comp.Features.ExtrudeFeatures.CreateExtrudeDefinition(profile, PartFeatureOperationEnum.kNewBodyOperation)
extrudeDef.SetDistanceExtent(thickness, PartFeatureExtentDirectionEnum.kNegativeExtentDirection)
comp.Features.ExtrudeFeatures.Add(extrudeDef)
End If
'Group circles by position
Dim circleGroups
circleGroups = sketch1.SketchCircles.Cast(Of SketchCircle)().GroupBy(Function(c)
Dim point = c.CenterSketchPoint.Geometry
Return Math.Round(point.X, 3) & ", " & Math.Round(point.Y, 3)
End Function)
'Group single circles by diameter
Dim drilledCircleGroups
drilledCircleGroups = circleGroups.Where(Function(g)
Return g.Count() = 1
End Function).Select(Function(g)
Return g.Single()
End Function).GroupBy(Function(c)
Return Math.Round(c.Geometry.Radius * 2 * 10, 3)
End Function)
'Group pairs of circles by diameters
Dim counterBoreCirclesGroups = circleGroups.Where(Function(g) g.Count() = 2).Select(
Function(g)
Dim o = g.OrderBy(Function(c) c.Radius)
Return New With {.Center = g.First().CenterSketchPoint, .InnerDiameter = Math.Round(o(0).Radius * 2, 3), .OuterDiameter = Math.Round(o(1).Radius * 2, 3)}
End Function
).GroupBy(Function(item) item.InnerDiameter * 10 & "x" & item.OuterDiameter * 10)
Dim circleGroup
For Each circleGroup In drilledCircleGroups
Dim points As ObjectCollection = m_inventorApp.TransientObjects.CreateObjectCollection()
For Each Circle In circleGroup
points.Add(Circle.CenterSketchPoint)
Next
Dim placementDef As HolePlacementDefinition = comp.Features.HoleFeatures.CreateSketchPlacementDefinition(points)
Dim depth As Double 'Unit: mm
'Dim thread As String
If IsSheetMetal Then depth = comp.Thickness.Value * 10
'Create drilled holes according to different diameters
' Dim hole As HoleFeature
Dim direction = PartFeatureExtentDirectionEnum.kPositiveExtentDirection
'Uncomment and change these case statements to adapt to your need
Dim thread
Select Case circleGroup.Key 'Diameter, Unit: mm
Case 6 'Unit: mm
depth = 35
'Change thread definition here if needed
thread = "M6x1"
'Create threaded hole
Dim tapinfo = comp.Features.HoleFeatures.CreateTapInfo(True, "ISO Metric profile", thread, "6H", True)
comp.Features.HoleFeatures.AddDrilledByDistanceExtent(placementDef, tapinfo, depth / 10, direction)
Case 10, 12
depth = 50
comp.Features.HoleFeatures.AddDrilledByDistanceExtent(placementDef, circleGroup.Key / 10, depth / 10, direction)
Case 16
depth = 75
comp.Features.HoleFeatures.AddDrilledByDistanceExtent(placementDef, circleGroup.Key / 10, depth / 10, direction)
Case Else
comp.Features.HoleFeatures.AddDrilledByThroughAllExtent(placementDef, circleGroup.Key / 10, direction)
End Select
Next
Dim circlesGroup
Dim counterBoreCircles
For Each circlesGroup In counterBoreCirclesGroups
Dim points As ObjectCollection = m_inventorApp.TransientObjects.CreateObjectCollection()
For Each counterBoreCircles In circlesGroup
points.Add(counterBoreCircles.Center)
Next
Dim placementDef As HolePlacementDefinition = comp.Features.HoleFeatures.CreateSketchPlacementDefinition(points)
Dim id As Double = circlesGroup.First().InnerDiameter
Dim od As Double = circlesGroup.First().OuterDiameter
Dim depth As Double 'Unit: mm
Dim sinkDepth As Double 'Unit: mm
Dim angle As Double = 100 'Unit: degree
If IsSheetMetal Then depth = comp.Thickness.Value * 10
'Create countersink or counterbore holes according to different diameters
' Dim hole As HoleFeature
Dim direction = PartFeatureExtentDirectionEnum.kPositiveExtentDirection
'Uncomment and change these case statements to adapt to your need
Select Case circlesGroup.Key '<Hole Diameter>x<CounterSink Diameter>, Unit: mm
Case "6x14"
depth = 40
comp.Features.HoleFeatures.AddCSinkByDistanceExtent(placementDef, id, depth / 10, direction, od, angle)
Case "8x20"
depth = 50
comp.Features.HoleFeatures.AddCSinkByDistanceExtent(placementDef, id, depth / 10, direction, od, angle)
Case "12x35"
sinkDepth = 2
comp.Features.HoleFeatures.AddSpotFaceByThroughAllExtent(placementDef, id, direction, od, sinkDepth / 10)
Case Else
sinkDepth = 3
comp.Features.HoleFeatures.AddCBoreByThroughAllExtent(placementDef, id, direction, od, sinkDepth / 10)
End Select
Next
