I am trying to create 4 ISO M16 Clearance holes and keep getting an run time error on the following line saying the method of object failed. Any help in creating the clearance hole would be most appreciated. I think I have defined the HoleClearanceInfo correctly but that might be the problem. Thank you
Line of run time error
Set oHoleFeature = oHoleFeatures.AddDrilledByThroughAllExtent(oHolePlacementDef, oHoleClearanceInfo, kNegativeExtentDirection)
My current code is as follows.
Sub CreatePart()
' Declare variables
Dim oApp As Application
Dim oPartDoc As PartDocument
Dim oPartCompDef As PartComponentDefinition
Dim oTransGeom As TransientGeometry
Dim oSketch As PlanarSketch
Dim oProfile As Profile
Dim oExtrudeDef As ExtrudeDefinition
Dim oExtrude As ExtrudeFeature
Dim oHoleFeatures As HoleFeatures
Dim oHolePlacementDef As HolePlacementDefinition
Dim oHoleFeature As HoleFeature
Dim oSketchPointsCollection As ObjectCollection
Dim oSketchPoints As SketchPoints
Dim oSketchPoint As SketchPoint
' Set the Inventor application
Set oApp = ThisApplication
' Create a new part document
Set oPartDoc = oApp.Documents.Add(kPartDocumentObject, oApp.FileManager.GetTemplateFile(kPartDocumentObject))
' Set the units to metric (millimeters)
oPartDoc.UnitsOfMeasure.LengthUnits = kMillimeterLengthUnits
' Set the component definition
Set oPartCompDef = oPartDoc.ComponentDefinition
' Set the transient geometry object
Set oTransGeom = oApp.TransientGeometry
' Create the first sketch on the XY plane
Set oSketch = oPartCompDef.Sketches.Add(oPartCompDef.WorkPlanes.Item(3))
' Draw the rectangle (450x300 mm)
With oSketch.SketchLines
.AddAsTwoPointRectangle oTransGeom.CreatePoint2d(0, 0), oTransGeom.CreatePoint2d(450, 300)
End With
' Create the profile for the extrusion
Set oProfile = oSketch.Profiles.AddForSolid
' Create the extrusion (20 mm thick)
Set oExtrudeDef = oPartCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
oExtrudeDef.SetDistanceExtent 20, kPositiveExtentDirection
Set oExtrude = oPartCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
' Identify the front face of the extrusion (450x300 mm face)
Dim oFrontFace As Face
Dim oFace As Face
For Each oFace In oExtrude.Faces
' Check if the face is 450x300 mm within a tolerance
If IsFaceApproxEqual(oFace, 450, 300) Then
Set oFrontFace = oFace
Exit For
End If
Next oFace
' Create a new sketch on the front face of the extruded rectangle
Set oSketch = oPartCompDef.Sketches.Add(oFrontFace)
' Initialize the object collection for hole points
Set oSketchPointsCollection = oApp.TransientObjects.CreateObjectCollection
' Add hole centers
Dim centerPoints As Variant
centerPoints = Array( _
oTransGeom.CreatePoint2d(100, 100), _
oTransGeom.CreatePoint2d(350, 100), _
oTransGeom.CreatePoint2d(100, 200), _
oTransGeom.CreatePoint2d(350, 200))
' Add sketch points to the collection
Set oSketchPoints = oSketch.SketchPoints
Dim i As Integer
For i = LBound(centerPoints) To UBound(centerPoints)
Set oSketchPoint = oSketchPoints.Add(centerPoints(i))
Call oSketchPointsCollection.Add(oSketchPoint)
Next i
' Get the hole features collection
Set oHoleFeatures = oPartCompDef.Features.HoleFeatures
' Create hole placement definition
Set oHolePlacementDef = oHoleFeatures.CreateSketchPlacementDefinition(oSketchPointsCollection)
' Define the hole feature with clearance for M16
Dim oHoleClearanceInfo As HoleClearanceInfo
Set oHoleClearanceInfo = oHoleFeatures.CreateClearanceInfo("ISO", "Hex Head Cap Screw ISO 24017", "M16", kNormalFitType)
' Add the clearance hole feature
Set oHoleFeature = oHoleFeatures.AddDrilledByThroughAllExtent(oHolePlacementDef, oHoleClearanceInfo, kNegativeExtentDirection)
' Save the part
oPartDoc.SaveAs "C:\Temp\Part1.ipt", False
End Sub
' Function to check if a face is approximately equal to given dimensions
Function IsFaceApproxEqual(oFace As Face, width As Double, height As Double, Optional epsilon As Double = 0.1) As Boolean
Dim oEvaluator As SurfaceEvaluator
Set oEvaluator = oFace.Evaluator
Dim oRangeBox As Box
Set oRangeBox = oEvaluator.RangeBox
Dim faceWidth As Double
Dim faceHeight As Double
faceWidth = Abs(oRangeBox.MaxPoint.X - oRangeBox.MinPoint.X)
faceHeight = Abs(oRangeBox.MaxPoint.Y - oRangeBox.MinPoint.Y)
IsFaceApproxEqual = Abs(faceWidth - width) < epsilon And Abs(faceHeight - height) < epsilon
End Function
