Thanks Jelte that works a treat. I've made a few edits as seen below.
It works but there's some weirdness in the model browser with phantom-like features if you repeat a few times.
I'm not sure about how i've renamed the mark feature - i want it work so that if you run the rule again on a different face it still does the business but haven't tested it yet.
I'd be grateful if you spot any other improvements.
Public Class ThisRule
Sub Main()
Dim doc As PartDocument = ThisDoc.Document
Dim def As PartComponentDefinition = doc.ComponentDefinition
Dim m_inventorApplication As Inventor.Application = ThisApplication
Dim oTransMgr As TransactionManager
oTransMgr = m_inventorApplication.TransactionManager
Dim oTrans As Transaction = oTransMgr.StartTransaction(doc,"Part Number Mark Feature")
Dim selector As New Selector(ThisApplication)
selector.Pick()
Dim sketch = def.Sketches.Add(selector.SelectedObject)
Dim modelPoint As Point2d = sketch.ModelToSketchSpace(selector.ModelPosition)
Dim oTextSize As String
'ask for text height
Dim oTS As String
oTS = InputBox("Select from 3.5 / 5.0 / 10.0", "Select Text Height - iLogic", "10.00")
'massage user input to suit text styles
Select Case oTS
Case Is <5.00
oTextSize = "Arial 3.50mm"
Case Is =5.00
oTextSize = "Arial 5.00mm"
Case Is >5.00
oTextSize = "Arial 10.00mm"
End Select
Dim partNumber = iProperties.Value("Project", "Part Number")
Dim sketchText = sketch.TextBoxes.AddFitted(modelPoint, partNumber, oTextSize)
Dim textSketchEntities As SketchEntitiesEnumerator = sketchText.ConvertToGeometry("txt")
Dim markGeometry As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
For Each oSE As SketchEntity In textSketchEntities
markGeometry.Add(oSE)
Next
Dim markFeatures As MarkFeatures = def.Features.MarkFeatures
Dim markStyle As MarkStyle = doc.MarkStyles.Item("Mark Surface")
Dim markDef As MarkDefinition = markFeatures.CreateMarkDefinition(markGeometry, markStyle)
markDef.Direction = PartFeatureExtentDirectionEnum.kNegativeExtentDirection
markFeatures.Add(markDef)
'Rename the mark feature
Try
Dim oMark As MarkFeature
oMark = def.Features.MarkFeatures.Item(1)
oMark.Name = "Mark: Part Number"
Catch
MessageBox.Show("Feature not found, or new name is already in use.", "iLogic")
End Try
oTrans.End()
End Sub
End Class
Public Class Selector
Private WithEvents _interactEvents As InteractionEvents
Private WithEvents _selectEvents As SelectEvents
Private _stillSelecting As Boolean
Private _inventor As Inventor.Application
Public Sub New(ThisApplication As Inventor.Application)
_inventor = ThisApplication
End Sub
Public Sub Pick()
_stillSelecting = True
_interactEvents = _inventor.CommandManager.CreateInteractionEvents
_interactEvents.InteractionDisabled = False
_interactEvents.StatusBarText = "Select a LinearGeneralDimension."
_interactEvents.SetCursor(CursorTypeEnum.kCursorBuiltInLineCursor)
_selectEvents = _interactEvents.SelectEvents
_selectEvents.WindowSelectEnabled = False
_interactEvents.Start()
Do While _stillSelecting
_inventor.UserInterfaceManager.DoEvents()
Loop
_interactEvents.Stop()
_inventor.CommandManager.StopActiveCommand()
End Sub
Public Property SelectedObject As Face = Nothing
Public Property ModelPosition As Point = Nothing
Private Sub oSelectEvents_OnPreSelect(
ByRef PreSelectEntity As Object,
ByRef DoHighlight As Boolean,
ByRef MorePreSelectEntities As ObjectCollection,
SelectionDevice As SelectionDeviceEnum,
ModelPosition As Point,
ViewPosition As Point2d,
View As Inventor.View) Handles _selectEvents.OnPreSelect
DoHighlight = False
If TypeOf PreSelectEntity Is Face Then
If TypeOf PreSelectEntity.Geometry Is Plane Then
DoHighlight = True
End If
End If
End Sub
Private Sub oInteractEvents_OnTerminate() Handles _interactEvents.OnTerminate
_stillSelecting = False
End Sub
Private Sub oSelectEvents_OnSelect(
ByVal JustSelectedEntities As ObjectsEnumerator,
ByVal SelectionDevice As SelectionDeviceEnum,
ByVal ModelPosition As Point,
ByVal ViewPosition As Point2d,
ByVal View As Inventor.View) Handles _selectEvents.OnSelect
SelectedObject = JustSelectedEntities.Item(1)
If TypeOf SelectedObject Is Face Then
If TypeOf SelectedObject.Geometry Is Plane Then
Me.SelectedObject = SelectedObject
Me.ModelPosition = ModelPosition
End If
End If
_stillSelecting = False
End Sub
End Class