04-18-2024
04:20 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
04-18-2024
04:20 PM
Thanks Wesley, given your comments about mouse click events I've changed tack and have the code below, which asks for an offset position instead
Ideally I'd like it to offer 3 options for text height (3.5/5/10mm) and to rename the mark feature in the browser and wrap it up nicely in a transaction so it can be undone easily.
Dim oAssDoc As Document Dim oAssDef As PartComponentDefinition Dim oFace As Face Dim oSketch As Sketch Dim oEdgeLoop As EdgeLoop Dim oMinPt As Point Dim oMaxPt As Point Dim insPoint As Point Dim oTextPt As Point2d Dim oSketchText As Inventor.TextBox Dim oPartNum As String Dim myX As Double Dim myY As Double Dim newX As Double Dim newY As Double oAssDoc = ThisApplication.ActiveDocument oAssDef = oAssDoc.ComponentDefinition ' Pick a planar face oFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllPlanarEntities, "Select the face for a part number mark") ' Make sure it is a planar face If oFace.SurfaceType = SurfaceTypeEnum.kPlaneSurface Then ' Add a sketch oSketch = oAssDef.Sketches.Add(oFace) ' Trying to choose an appropriate point ' Assume this planar face has one edge loop only oEdgeLoop = oFace.EdgeLoops(1) oMinPt = oEdgeLoop.RangeBox.MinPoint oMaxPt = oEdgeLoop.RangeBox.MaxPoint ' Ask for offset values myX = CDbl(InputBox("Enter X offset", "X Offset", "0")) myY = CDbl(InputBox("Enter Y offset", "Y Offset", "0")) ' Calculate new coordinates newX = oMinPt.X + (myX / 10) newY = oMinPt.Y + (myY / 10) ' Create insertion point insPoint = ThisApplication.TransientGeometry.CreatePoint(newX, newY + 0.375, oMinPt.Z) '0.375mm text offset - so that the text doesnt fall off the lower edge of the selected face ' Convert insertion point to sketch space oTextPt = oSketch.ModelToSketchSpace(insPoint) ' Add the textbox oPartNum = iProperties.Value("Project", "Part Number") 'MessageBox.Show(oPartNum) oSketchText = oSketch.TextBoxes.AddFitted(oTextPt, oPartNum) ' Create a mark feature on the textbox Dim oSObjs As ObjectCollection oSObjs = ThisApplication.TransientObjects.CreateObjectCollection oSObjs.Add(oSketchText) ' Convert text to geometry Dim oTextSketchEntities As SketchEntitiesEnumerator oTextSketchEntities = oSketchText.ConvertToGeometry("txt") Dim oMarkGeometry As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection For Each oSE As SketchEntity In oTextSketchEntities oMarkGeometry.Add(oSE) Next 'oSE Dim oMarkFeatures As MarkFeatures oMarkFeatures = oAssDef.Features.MarkFeatures Dim oMarkStyle As MarkStyle oMarkStyle = oAssDoc.MarkStyles.Item("Mark Surface") Dim oMarkDef As MarkDefinition oMarkDef = oMarkFeatures.CreateMarkDefinition(oMarkGeometry, oMarkStyle) Dim oMark As MarkFeature oMark = oMarkFeatures.Add(oMarkDef) Else MsgBox("Please select a planar face!") End If