There were numerous coding issues going on within the sketch renaming section of the code, so I only dabbled with that section a little bit, then commended it out entirely for now. For one thing, you can't check the value of a variable, if that variable hasn't been created yet, and has not been given a value yet. This was the case with the 'oHoleType' variable, and the 'FrontEdge' variable. Then it looks like you tried to assign a name to the 'oSketch' variable before you have given 'oSketch' a value (it wasn't pointing to a specific sketch object yet). I don't know if that line was intended to be within the loop above, or after the lines below, where we create the new sketch object.
Then I focused on the main function of the rule, which was to allow you to select edges, create projected sketch geometry from those edges, then create work points at the end points of each projected sketch geometry, so you can use the resulting work points to generate new sections of model geometry. I believe I have this main part of the code working for you as intended.
Dim oPart As PartDocument = ThisApplication.ActiveDocument
Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
'[
'Dim oSketchNameSuffix As Integer
'Dim oNameCompare As String
'Dim oNameNumCount As Integer
'Dim oNameCharCount As Integer
''the variable oHoleType was not defined yet, so none of the related code was working
'Dim oHoleTypes As New List(Of String) From {"Thru", "Pilot"}
'Dim oHoleType As String = InputListBox("", oHoleTypes, "Thru", "Hole Types", "Hole Types List")
'If String.IsNullOrEmpty(oHoleType) Then
' Exit Sub
'ElseIf oHoleType = "Thru" Then
' oSketchNameSuffix = 0
' oNameCompare = "SK_Hole_"
' oNameCharCount = 8
' oNameNumCount = 9
'ElseIf oHoleType = "Pilot" Then
' oSketchNameSuffix = 0
' oNameCompare = "SK_Pilot_"
' 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.
'On Error Resume Next
' For Each oSketchNameCheck As Sketch In oDef.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
''you haven't given the variable oSketch a value yet,
''so it doesn't know which sketch you are talking about,
''so it isn't doing anything here
'oSketch.Name = oNameCompare & oSketchNameSuffix
']
Dim oFace As Inventor.Face
SelectFace :
oFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Select Face to Place Sketch")
If oFace Is Nothing Then
MsgBox("No face was selected. Exiting.",,"")
Exit Sub
ElseIf oFace.SurfaceType <> SurfaceTypeEnum.kPlaneSurface Then
MsgBox("Selected face was not planar. Please select planar (flat) face.", , "")
GoTo SelectFace
End If
Dim oSketch As PlanarSketch = oDef.Sketches.Add(oFace, False)
'the variable FrontEdge has not been created or a value given to it yet, so the following 2 lines will do nothing
'oSketch.AxisEntity = FrontEdge
'oSketch.OriginPoint = FrontEdge.StartVertex
'oSketch.NaturalAxisDirection = True
Dim oTO As TransientObjects = ThisApplication.TransientObjects
Dim oEdges As ObjectCollection = oTO.CreateObjectCollection
Dim oPoints As ObjectCollection = oTO.CreateObjectCollection
Dim oEdge As Edge
Dim oPoint As Inventor.Point
Do
oEdge = ThisApplication.CommandManager.Pick( _
SelectionFilterEnum.kPartEdgeFilter, "Select a edge")
' If nothing gets selected then we're done
If oEdge IsNot Nothing Then
oEdges.Add(oEdge)
Else
Exit Do
End If
Dim oSE As SketchEntity = oSketch.AddByProjectingEntity(oEdge)
If TypeOf oSE Is SketchLine Then
Dim oSL As SketchLine = oSE
oPoints.Add(oSL.StartSketchPoint.Geometry3d)
oPoints.Add(oSL.EndSketchPoint.Geometry3d)
ElseIf TypeOf oSE Is SketchArc Then
Dim oSA As SketchArc = oSE
oPoints.Add(oSA.StartSketchPoint.Geometry3d)
oPoints.Add(oSA.EndSketchPoint.Geometry3d)
End If
MsgBox("oEdges.Count = " & oEdges.Count & vbCrLf & _
"oPoints.Count = " & oPoints.Count,,"")
Loop Until oEdge Is Nothing
'oSketch.ExitEdit 'don't need this because we never entered interactive Edit mode
'oSketch.Visible = False
'or
'oSketch.Delete
For Each oPoint In oPoints
Dim oDuplicate As Boolean = False
Dim oWP As WorkPoint = Nothing
For Each oWP In oDef.WorkPoints
If oWP.Point.X = oPoint.X And _
oWP.Point.Y = oPoint.Y And _
oWP.Point.Z = oPoint.Z Then
oDuplicate = True
End If
Next
If oDuplicate = False Then
oWP = oDef.WorkPoints.AddFixed(oPoint, False)
End If
Next
However, it seems like a very inefficient process to go through, if all you really need is the set of work points. Since this process already includes a bunch of manual user interactions (mouse selections), why not just skip creating a sketch and directly select the vertexes to be used as work point location?
If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS) 👍.
If you want and have time, I would appreciate your Vote(s) for My IDEAS 💡or you can Explore My CONTRIBUTIONS
Wesley Crihfield
(Not an Autodesk Employee)
