Hi There,
I finally figured it out. I have combined a part of the rule from another post;
How to assign a iProperty to a textbox in my title through VB
The ruleline by @WCrihfield does the trick 🙂 :
Dim sText As String
sText = "<Property Document='Model' PropertySet='User Defined Properties' Property='Tekeningnummer' FormatID='{D5CDD505-2E9C-101B-9397-08002B2CF9AE}'>Tekeningnummer</Property>"Now the "Tekeningnummer" as a Field is inserted in the textbox and I get what I want.
Many thanks to all of you, espacially mentioned @JelteDeJong and @A.Acheson
For you all to use and benifit from I've pasted the Rule for engraving below.
Hope you can use it and have fun with it 🙂
Last remark is that on some faces of the sheetmetal the text is placed not right but I hope to fix this in the future. For now I can work fine with it.
Sub Main()
'===================== DECLERATIONS ===============================
' a reference to the currently active document.
' This assumes that it is a part document.
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument
Dim oCompDef As PartComponentDefinition
oCompDef = oPartDoc.ComponentDefinition
' Set a reference to the transient geometry object.
Dim oTransGeom As TransientGeometry
oTransGeom = ThisApplication.TransientGeometry
Dim oPartCompDef As PartComponentDefinition
oPartCompDef = ThisApplication.ActiveDocument.ComponentDefinition
'===================Checking If the Custom Property has already been made in the part =================
'Find Sketch named already For marking so the user can delete it
For Each oSketchCheck As PlanarSketch In oPartCompDef.Sketches
If oSketchCheck.Name = "MarkingSketch" Then
MessageBox.Show("A sketch named " & oSketchCheck.Name & " already exists. Custom Iprop Tekeningnummer will be updated", "Controle op MarkingSketch")
'Updating Custom IProperty with filenumber in it calling it Tekeningnummer
iProperties.Value("Custom", "Tekeningnummer") = ThisDoc.FileName(False) 'false = without extension
iProperties.Value("Custom", "Tekeningnummer") = (Left(ThisDoc.FileName(False),14))
Return
End If
Next
'==================================================================================================================================================
'Select Face and Edges to place the textbox in a certain direction = Van JelteDejong Forum
Dim oFace As Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Select Surface to Place Textbox")
Dim oHorizontalEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Horizontal Edge of Tekeningnummer on Face")
Dim orignVertex As Vertex = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartVertexFilter, "Select Point (vertex) on the plane")
Dim testVertex As Vertex = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartVertexFilter, "Select a 2nd Point (vertex) that is on a positive point in the sketch and not on the axes")
'Add Sketch and set sketch origin point to the stopVertex of the FrontEdge, this is where the TextBox starts
Dim oSketch As PlanarSketch = oPartCompDef.Sketches.Add(oFace, False)
oSketch.AxisEntity = oHorizontalEdge
oSketch.OriginPoint = orignVertex
oSketch.NaturalAxisDirection = True
'Check if the testVertex has positive coordinates = Van JelteDejong Forum
Dim testPoint As Point2d = oSketch.ModelToSketchSpace(testVertex.Point)
If (testPoint.X <= 0 Or testPoint.Y <= 0) Then
oSketch.NaturalAxisDirection = False
End If
testPoint = oSketch.ModelToSketchSpace(testVertex.Point)
Dim positiveQuadrantIsOnPlane = (testPoint.Y >= 0)
' ===================== Create a Custom Parameter in Iproperties "Tekeningnummer"======================
'Creating Custom IProperty with filenumber in it calling it Tekeningnummer
iProperties.Value("Custom", "Tekeningnummer") = ThisDoc.FileName(False) 'false = without extension
iProperties.Value("Custom", "Tekeningnummer") = (Left(ThisDoc.FileName(False),14))
'Creating a UserParameter Where the Tekeningnummer value Is put In
Dim PropValue As String = iProperties.Value("Custom", "Tekeningnummer")
'updates the user-defined Text Parameter
TagName = PropValue
'================================ Create a textbox in the Sketch to place the Custom Iporperty Tekeningnummer ====================
' Create Text With simple String As Input. Since this doesn't use
' any Text Overrides, it will Default To the active Text Style.
Dim oTG As TransientGeometry
oTG = ThisApplication.TransientGeometry
Dim sText As String
sText = "<Property Document='Model' PropertySet='User Defined Properties' Property='Tekeningnummer' FormatID='{D5CDD505-2E9C-101B-9397-08002B2CF9AE}'>Tekeningnummer</Property>"
Dim oTextBox As Inventor.TextBox
If (positiveQuadrantIsOnPlane) Then
oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(0.3, 0.5), sText)
Else
oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(0.3, -0.3), sText)
End If
'Changing Font and/or size
Dim dTextSize As Double
dTextSize = 0.4 ' value is in cm. equals .125 in
Dim sTextFont As String
' sTextFont = "SIMPLEX"
oTextBox.FormattedText = "<StyleOverride Font = '" & sTextFont & "' FontSize = '" & dTextSize & "'>" & _
sText & "</StyleOverride>"
'==================== Creating an Objectcollection to be Marked ======================
Dim oSketchObjects As ObjectCollection
oSketchObjects = ThisApplication.TransientObjects.CreateObjectCollection
' Get all entities in the sketch
Dim oSketchText As Inventor.TextBox
For Each oSketchText In oSketch.TextBoxes
oSketchObjects.Add(oSketchText)
Next
'==================== Creating the Mark on the textbox ======================
Dim oMarkFeatures As MarkFeatures
oMarkFeatures = oCompDef.Features.MarkFeatures
' Get a mark style.
Dim oMarkStyle As MarkStyle
oMarkStyle = oPartDoc.MarkStyles.Item(1)
' Create mark definition.
Dim oMarkDef As MarkDefinition
oMarkDef = oMarkFeatures.CreateMarkDefinition(oSketchObjects, oMarkStyle)
' Create a mark feature.
Dim oMark As MarkFeature
oMark = oMarkFeatures.Add(oMarkDef)
'====================
'Naming the sketch And markfeature For detection In future
oSketch.Name = "MarkingSketch"
oMark.Name = "Gravering Tekeningnummer"
Call ZoomAll
oPartDoc.Save
End Sub
Sub ZoomAll
'zoom all, this to be sure the part is in ISOmetrich position saved so it is ISO visible in explorer
ThisApplication.CommandManager.ControlDefinitions.Item("AppIsometricViewCmd").Execute
End Sub
