Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Rich-T
in reply to: Rich-T

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