Message 1 of 2
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have created some code to create a hole pattern and create a separate sketch afterwards. My code runs fine in an assembly unless the part I am trying to put the hole pattern in has been rotated or a face on the part has been rotated using the Direct Edit however it runs fine if I run the rule in the part itself. It doesn't just cause the rule to crash but it causes Inventor itself to crash. If anyone can explain what might be causing the problem it would be very appreciated. Here is the code for the hole pattern rule I made. It seems to be crashing at the point where it is trying to dimesion a line that is drawn in by the code but only when I run the rule in an assembly .
Option explicit on
Class ThisRule
Dim RepeatRule As Boolean
Dim oAsmDoc As AssemblyDocument
Dim oAsmCompDef As AssemblyComponentDefinition
Dim oPartDoc As PartDocument
Dim oPartCompDef As PartComponentDefinition
Dim oCompOcc As ComponentOccurrence
Dim oPart As ComponentOccurrence
Dim oFace As Face
Dim oFrontEdge As Edge
Dim oLeftEdge As Edge
Dim oRightEdge As Edge
Dim oTG As TransientGeometry
Dim oSelCompName As String
End Class
Sub Main()
' RepeatRule = True
' While RepeatRule = True
CreateHoles()
' End While
End Sub
Sub CreateHoles()
'Main Declarations
oTG = ThisApplication.TransientGeometry
'Check Document Type
Dim oDocType As Document = ThisDoc.Document
Dim DocumentType As Integer
If oDocType.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
DocumentType = 1
Else If oDocType.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
DocumentType = 2
Else If oDocType.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
MessageBox.Show("This rule can only be run in an" _
& vbLf & "Assembly or Part Document. Please" _
& vbLf & "open the correct document type and" _
& vbLf & "run the rule again", "iLogic")
Exit Sub
End If
Dim oSelFace As Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllPlanarEntities, "Select Face")
If oSelFace Is Nothing Then
RepeatRule = False
Exit Sub
End If
If DocumentType = 1 Then
oAsmDoc = ThisDoc.Document
oAsmCompDef = oAsmDoc.ComponentDefinition
oCompOcc = oSelFace.Parent.Parent
oPartCompDef = oCompOcc.Definition
oSelCompName = oCompOcc.Name
oFace = oSelFace.NativeObject
For Each oCompOcc In oAsmCompDef.Occurrences
If oCompOcc.DefinitionDocumentType <> kPartDocumentObject Then
MessageBox.Show("This rule cannot be run in an assembly with" _
& vbLf & "sub-assemblies. Please open the sub-assembly" _
& vbLf & "in a new window and run the rule again", "iLogic")
Exit Sub
End If
Next
For Each oCompOcc In oAsmCompDef.Occurrences
Dim oOccName As String = oCompOcc.Name
If Not oCompOcc.Name = oSelCompName Then
oCompOcc.Enabled = False
End If
Next
Else If DocumentType = 2 Then
oPartDoc = ThisDoc.Document
oPartCompDef = oPartDoc.ComponentDefinition
oFace = oSelFace
End If
Dim oSelFrontEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeLinearFilter, "Select Front Edge")
If oSelFrontEdge Is Nothing Then
If DocumentType = 1 Then
For Each oCompOcc In oAsmCompDef.Occurrences
Dim oOccName As String = oCompOcc.Name
If Not oCompOcc.Name = oSelCompName Then
oCompOcc.Enabled = True
End If
Next
End If
RepeatRule = False
Exit Sub
End If
Dim oSelLeftEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllLinearEntities, "Select Left Edge")
If oSelLeftEdge Is Nothing Then
If DocumentType = 1 Then
For Each oCompOcc In oAsmCompDef.Occurrences
Dim oOccName As String = oCompOcc.Name
If Not oCompOcc.Name = oSelCompName Then
oCompOcc.Enabled = True
End If
Next
End If
RepeatRule = False
Exit Sub
End If
Dim oSelRightEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllLinearEntities, "Select Right Edge")
If oSelRightEdge Is Nothing Then
If DocumentType = 1 Then
For Each oCompOcc In oAsmCompDef.Occurrences
Dim oOccName As String = oCompOcc.Name
If Not oCompOcc.Name = oSelCompName Then
oCompOcc.Enabled = True
End If
Next
End If
RepeatRule = False
Exit Sub
End If
If DocumentType = 1 Then
oFrontEdge = oSelFrontEdge.NativeObject
oLeftEdge = oSelLeftEdge.NativeObject
oRightEdge = oSelRightEdge.NativeObject
Else If DocumentType = 2 Then
oFrontEdge = oSelFrontEdge
oLeftEdge = oSelLeftEdge
oRightEdge = oSelRightEdge
End If
'Create Sketch and Set Origin and Direction
Dim oSketch1 As PlanarSketch = oPartCompDef.Sketches.Add(oFace, False)
oSketch1.OriginPoint = oFrontEdge.StartVertex
oSketch1.AxisEntity = oFrontEdge
oSketch1.AxisIsX = True
oSketch1.NaturalAxisDirection = True
'Project Edges into Sketch
Dim oFrontLine As SketchLine = oSketch1.AddByProjectingEntity(oFrontEdge)
Dim oLeftLine As SketchLine = oSketch1.AddByProjectingEntity(oLeftEdge)
Dim oRightLine As SketchLine = oSketch1.AddByProjectingEntity(oRightEdge)
Dim oMaterial As String = Parameter.Param("MaterialType").Value
Dim oHoleType As String = Parameter.Param("HoleType").Value
Dim oHoleSize As String = Parameter.Param("HoleLayers").Value
'Add Sketch and set sketch origin point to the startVertex of the FrontEdge
'Project a SketchLine and check direction in X to see if the coordinate system needs
'To be flipped so the circles fall inside the parent part.
Dim oLeftDist As Double = ThisApplication.MeasureTools.GetMinimumDistance(oFrontLine.StartSketchPoint, oLeftLine)
Dim oRightDist As Double = ThisApplication.MeasureTools.GetMinimumDistance(oFrontLine.StartSketchPoint, oRightLine)
If oLeftDist > oRightDist Then
oSketch1.OriginPoint = oFrontEdge.StopVertex
If oFrontLine.Geometry.Direction.X > 0 Then
oSketch1.NaturalAxisDirection = False
End If
Else If oLeftDist < oRightDist Then
oSketch1.OriginPoint = oFrontEdge.StartVertex
If oFrontLine.Geometry.Direction.X < 0 Then
oSketch1.NaturalAxisDirection = False
End If
End If
' 'Create the name for the sketch based on user assigned parameters
Dim oSketchNameSuffix As Integer
Dim oNameType As String
Dim oSketchName As String
Dim oNameCompare As String
Dim oNameNumCount As Integer
Dim oNameCharCount As Integer
If oHoleType = "Thru" Then
oSketchNameSuffix = 0
oNameType = "_Hole_"
oNameCompare = "SK" & oNameType
oNameCharCount = 8
oNameNumCount = 9
Else If oHoleType = "Pilot" Then
oSketchNameSuffix = 0
oNameType = "_Pilot_"
oNameCompare = "SK" & oNameType
oNameCharCount = 9
oNameNumCount = 10
End If
' 'Check all sketches in the model tree and compare the names to the
' 'name of the newly created sketch and if name exists increment the
' 'suffix by 1. Continue until the newly created sketch name is unique
' 'and can be used.
For Each oSketchNameCheck As Sketch In oPartCompDef.Sketches
If Left(oSketchNameCheck.Name,oNameCharCount) = oNameCompare Then
Dim oSketchNumber As Integer = Val(Mid(oSketchNameCheck.Name, oNameNumCount, 2))
While oSketchNameSuffix <= oSketchNumber
oSketchNameSuffix = oSketchNameSuffix + 1
End While
End If
Next
Dim oLayer As String = Parameter.Param("HoleLayers").Value
oSketchName = oNameCompare & oSketchNameSuffix
Dim oHoleName As String = "HL" & oNameType & oSketchNameSuffix
Dim oPatternName As String = "PT" & oNameType & oSketchNameSuffix
Dim oSketchLayerName As String = "SK_" & oSketchNameSuffix & "_" & oLayer
oSketch1.Name = oSketchName
' 'QTY of holes and distance from front, left and right edges
Dim oFrontEdgeDistance As Double = ThisApplication.MeasureTools.GetMinimumDistance(oFrontEdge.StartVertex, oFrontEdge.StopVertex)
Dim oFromLeftEdge As Double = Parameter.Param("FromLeftEdge").Value
Dim oFromRightEdge As Double = oFrontEdgeDistance - (Parameter.Param("FromRightEdge").Value)
Dim oFromFrontEdge As Double = Parameter.Param("FromFrontEdge").Value
Dim oLine As SketchLine = oSketch1.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(oFromLeftEdge, oFromFrontEdge), oTG.CreatePoint2d(oFromRightEdge, oFromFrontEdge))
Dim oLineLength As Double = oLine.Length
Dim oQty As Integer = Floor(oLineLength / (Parameter.Param("DesiredHoleSeperation").Value)) + 1
Dim oActualHoleSep As Double = (oLineLength / (oQty - 1)) / 2.54
Parameter("ActualHoleSeperation") = oActualHoleSep
Parameter("LineLength") = oLineLength / 2.54
Parameter.UpdateAfterChange = True
Parameter("HoleQty") = oQty
' 'Dimension the FitToPath Line
Dim oConstraint As DimensionConstraint
Dim TextPoint As Point2d
TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(oFromLeftEdge - 1, oFromFrontEdge + 1)
oConstraint = oSketch1.DimensionConstraints.AddTwoPointDistance(oLine.StartSketchPoint, oFrontLine.StartSketchPoint, DimensionOrientationEnum.kVerticalDim, TextPoint, False)
TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(oFromLeftEdge -1, oFromFrontEdge + 2)
oConstraint = oSketch1.DimensionConstraints.AddTwoPointDistance(oLine.StartSketchPoint, oLeftLine.EndSketchPoint, DimensionOrientationEnum.kHorizontalDim, TextPoint, False)
TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(oFromRightEdge + 1, oFromFrontEdge + 1)
oConstraint = oSketch1.DimensionConstraints.AddTwoPointDistance(oLine.EndSketchPoint, oFrontLine.EndSketchPoint, DimensionOrientationEnum.kVerticalDim, TextPoint, False)
TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(oFromRightEdge + 1, oFromFrontEdge + 2)
oConstraint = oSketch1.DimensionConstraints.AddTwoPointDistance(oLine.EndSketchPoint, oRightLine.StartSketchPoint, DimensionOrientationEnum.kHorizontalDim, TextPoint, False)
TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(oFromLeftEdge + oLine.Length/2, oFromFrontEdge + 2)
oConstraint = oSketch1.DimensionConstraints.AddTwoPointDistance(oLine.StartSketchPoint, oLine.EndSketchPoint, DimensionOrientationEnum.kHorizontalDim, TextPoint, True)
Dim oLineLengthParam As String = oConstraint.Parameter.Name
Dim oHoleCenters As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
oHoleCenters.Add(oLine.StartSketchPoint)
Dim oPoint As Point = oSketch1.SketchToModelSpace(oTG.CreatePoint2d(oFromLeftEdge, oFromFrontEdge))
Dim oLinearPlacementDef As LinearHolePlacementDefinition = oPartCompDef.Features.HoleFeatures.CreateLinearPlacementDefinition(oFace, oLeftEdge, oFromLeftEdge, oFrontEdge, oFromFrontEdge, oPoint)
Dim oDrillDia As String
Dim Separators() As Char = {"."c, "-"c}
Dim Sentence As String = oLayer
Dim Words As Array = Sentence.Split(Separators)
Dim i As Integer = 0
For Each wrd In Words
If i = 2 Then
oDrillDia = "." &(Val(Words(i)))
End If
i += 1
Next
'specify word splitting characters "space" and "dash"
Dim oHoleFeature As HoleFeature = oPartCompDef.Features.HoleFeatures.AddDrilledByThroughAllExtent(oLinearPlacementDef, oDrillDia, kPositiveExtentDirection)
oHoleFeature.Name = oHoleName
' Create the object collection.
Dim FeatureColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Dim oHoleFeatureItem As Integer
' Add the newly created hole feature to the collection.
For Each oHoleFeature In oPartCompDef.Features.HoleFeatures
If oHoleFeature.Name = oHoleName Then
Call FeatureColl.Add(oHoleFeature)
End If
Next
Dim oPatternPath As Object = oPartCompDef.Features.CreatePath(oSketch1.SketchLines.Item(4))
' Create the pattern
Dim oPatternFeature As RectangularPatternFeature = oPartCompDef.Features.RectangularPatternFeatures.Add(FeatureColl, oPatternPath, True, oQty, _
20, PatternSpacingTypeEnum.kFitToPathLength, , , , , , , , , kIdentical)
oPatternFeature.Name = oPatternName
Dim oSketch2 As PlanarSketch = oPartCompDef.Sketches.Add(oFace, False)
Dim oHoleFace As Face = oHoleFeature.Faces.Item(1)
Dim oHoleEdge As Edge = oHoleFace.Edges.Item(1)
oSketch2.AddByProjectingEntity(oHoleEdge)
For Each oPatFace As Face In oPatternFeature.Faces
Dim oPatEdge As Edge = oPatFace.Edges.Item(1)
oSketch2.AddByProjectingEntity(oPatEdge)
Next
oSketch2.Name = oSketchLayerName
oSketch2.Visible = False
If DocumentType = 1 Then
For Each oCompOcc In oAsmCompDef.Occurrences
Dim oOccName As String = oCompOcc.Name
If Not oCompOcc.Name = oSelCompName Then
oCompOcc.Enabled = True
End If
Next
End If
' iLogicVb.UpdateWhenDone = True
InventorVb.DocumentUpdate()
End Sub
Solved! Go to Solution.
