Sub Main Dim oPickedFace As Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Select a flat face.") If oPickedFace Is Nothing Then Return If Not TypeOf oPickedFace.Geometry Is Plane Then Return '<<< get Part Number value >>> Dim oCD As ComponentDefinition = oPickedFace.Parent.ComponentDefinition Dim oDoc As Inventor.Document = oCD.Document Dim sPN As String = oDoc.PropertySets.Item(3).Item(2).Value 'Part Number '<<< get center point of face >>> Dim oBounds As Inventor.Box = Nothing Dim oELs As EdgeLoops = oPickedFace.EdgeLoops For Each oEL As EdgeLoop In oELs If oEL.IsOuterEdgeLoop Then oBounds = oEL.RangeBox Exit For End If Next 'oEL 'Logger.Info("MinPoint: " & oBounds.MinPoint.X.ToString & " x " & oBounds.MinPoint.Y.ToString & " x " & oBounds.MinPoint.Z.ToString) 'Logger.Info("MaxPoint: " & oBounds.MaxPoint.X.ToString & " x " & oBounds.MaxPoint.Y.ToString & " x " & oBounds.MaxPoint.Z.ToString) Dim oTG As TransientGeometry = ThisApplication.TransientGeometry Dim oCenter As Inventor.Point = oBounds.MinPoint.Copy Dim oVect As Inventor.Vector = oCenter.VectorTo(oBounds.MaxPoint) oVect.ScaleBy(0.5) oCenter.TranslateBy(oVect) 'Logger.Info("Center: " & oCenter.X.ToString & " x " & oCenter.Y.ToString & " x " & oCenter.Z.ToString) '<<< start a transaction to bundle actions into one item in UNDO list >>> Dim oTrans As Inventor.Transaction oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Put Part Number TextBox On Face - iLogic") '<<< using a large 'Try' here to be able to 'Abort' all actions past this point, if any error happens >>> Try '<<< create the sketch (if an error happens later, this will be removed) >>> Dim oPSketches As PlanarSketches = oCD.Sketches Dim oPSketch As PlanarSketch = oPSketches.Add(oPickedFace, False) '<<< translate the face center point (3D) in 'model space' to a point (2D) in sketch space >>> Dim oCenter2d As Point2d = oPSketch.ModelToSketchSpace(oCenter) '<<< create TextBox >>> Dim oTBoxes As Inventor.TextBoxes = oPSketch.TextBoxes 'uses custom Function to specify wanted format of text 'text size is always in centimeters, even if that is not your document units Dim sFontSize As String = (0.25 * 2.54).ToString '0.25 inches Dim sFText As String = CreateStyleOverrideFormattedText(sPN, "Arial", sFontSize) 'Logger.Info(vbCrLf & "sFText = " & vbCrLf & sFText) Dim oTBox As Inventor.TextBox = oTBoxes.AddFitted(oCenter2d, sFText) 'oTBox.SingleLineText = True '<<< center TextBox on face center point >>> oTBox.HorizontalJustification = HorizontalTextAlignmentEnum.kAlignTextCenter oTBox.VerticalJustification = VerticalTextAlignmentEnum.kAlignTextMiddle '<<< convert text to geometry - change 'SHXfont' here if needed >>> Dim oTextSketchEntities As SketchEntitiesEnumerator = oTBox.ConvertToGeometry("txt") 'collect all the sketch entities making up the text geometry, for input into the MarkFeature later Dim oMarkGeometry As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection For Each oSE As SketchEntity In oTextSketchEntities oMarkGeometry.Add(oSE) Next 'oSE 'now create the MarkFeature Dim oMarkFeats As MarkFeatures = Nothing Try : oMarkFeats = oCD.Features.MarkFeatures : Catch : End Try If oMarkFeats Is Nothing Then Return Dim oMarkStyle As MarkStyle = Nothing Try : oMarkStyle = oDoc.MarkStyles.Item("Mark Through") : Catch : End Try 'Try : oMarkStyle = oDoc.MarkStyles.Item("Mark Surface") : Catch : End Try If oMarkStyle Is Nothing Then Return Dim oMarkDef As MarkDefinition = oMarkFeats.CreateMarkDefinition(oMarkGeometry, oMarkStyle) oMarkDef.SetMethod(MarkMethodTypeEnum.kProjectionMethodType) 'always when marking through 'oMarkDef.SetMethod(MarkMethodTypeEnum.kWrapToFaceMethodType) 'possible when marking surface only ' oMarkDef.Direction = PartFeatureExtentDirectionEnum.kNegativeExtentDirection 'may not be needed Dim oMarkFeat As MarkFeature = oMarkFeats.Add(oMarkDef) oTrans.End Catch oEx As Exception 'abort this Transaction if an error happened Logger.Error(oEx.Message & vbCrLf & oEx.StackTrace) oTrans.Abort End Try End Sub Function CreateStyleOverrideFormattedText(sText As String, _ Optional sFont As String = vbNullString, _ Optional sFontSize As String = vbNullString, _ Optional sBold As String = vbNullString, _ Optional sItalic As String = vbNullString, _ Optional sUnderLine As String = vbNullString, _ Optional sStrikethrough As String = vbNullString) As String Dim sFText As String = "" Dim sStart As String = " "" Then sFText = sFText & ">" & sText & sEnd Return sFText End Function