- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi There,
I am having trouble to make the Mark for Engraving on the face in the right direction and position.
Sometimes the mark is outside of the geometry. and the rule can't compleet.
This is not always the case.
GOAL:
I want to place the mark for engraving on a picted face at a certain point in a certain direction.
I've tried this to do with a direction vector which i copied from the forum.
Still I can't get it right on several geometries.
Please help me with this.
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
'=========================================================================
'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. Please Delete this sketch", "Controle op MarkingSketch")
Return
End If
Next
'=========================================================================
'Select Face and Edges to place the textbox in a certain direction
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 oVerticalEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Vertical Edge of Tekeningnummer on Face")
'Add Sketch and set sketch origin point to the stopVertex of the FrontEdge, this is where the TextBox starts
Dim oSketch As PlanarSketch
oSketch = oPartCompDef.Sketches.Add(oFace, False)
oSketch.AxisEntity = oVerticalEdge
oSketch.OriginPoint = oHorizontalEdge.StopVertex
oSketch.NaturalAxisDirection = True
' ===================== 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 Iporp 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 = TagName
Dim oTextBox As Inventor.TextBox
oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(0.5, 0.5), sText)
'Changing Font and/or size
Dim dTextSize As Double
dTextSize = 0.350 ' 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
Solved! Go to Solution.