Embossed Text

alanrichardson · ‎06-08-2015

Hi

Can anyone help - I'd like to be able to Emboss the Text contained in the iPorperties, Stock Number field onto a face of my choosing at the point of selection. (this would be an etch).

I believe it needs to be done via VBA but since I'm an absolute novice with VBA I'm struggling.

I did find some code (below, courtesy of Dshortway) that works, but I've no idea how to modify it for my purposes.

Can any VBA guru point me in the right direction?

Thanks

Copy/paste this code whitin a module

Option Explicit

Public Sub EmbossedText()
' Create a new clsSelect object.
Dim oSelect As New clsSelect

' Set a reference to the part component definition.
' This assumes that a part document is active.
Dim oCompDef As PartComponentDefinition
Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition

' Call the pick method of the clsSelect object and set
' the filter to pick any face.
Dim oFace As Face
Set oFace = oSelect.Pick(kPartFaceFilter)

' Check to make sure an object was selected.
If Not oFace Is Nothing Then
Dim oSketch As PlanarSketch
Set oSketch = oCompDef.Sketches.Add(oFace, True)
oSketch.Name = "Embossed text"

' Create text with simple string as input. Since this doesn't use
' any text overrides, it will default to the active text style.
Dim sText As String
Dim oTextBox As TextBox
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry

' Simple single line text.
sText = "Here is the last and final line of text."
Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(oSketch.OriginPointGeometry.X, _
oSketch.OriginPointGeometry.Y), sText)
With oTextBox
.VerticalJustification = kAlignTextMiddle
.HorizontalJustification = kAlignTextCenter
End With

' Add the text box to an object collection
Dim oPaths As ObjectCollection
Set oPaths = ThisApplication.TransientObjects.CreateObjectCollection
oPaths.Add oTextBox

' Create a profile. Calling the AddForSolid method without any
' arguments will result in a profile containing all possible
' paths in the sketch. By passing in the text box, the profile
' is restricted to the input text path.
Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid(False, oPaths)

' Extrude the text.
Dim oExtrudeDef As ExtrudeDefinition
Set oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
Call oExtrudeDef.SetDistanceExtent(0.25, kNegativeExtentDirection)
Dim oExtrude As ExtrudeFeature
Set oExtrude = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
End If
End Sub

Copy/paste this code in a class named "clsSelect" (Inventor API help)

Option Explicit

' Declare the event objects
Private WithEvents oInteractEvents As InteractionEvents
Private WithEvents oSelectEvents As SelectEvents

' Declare a flag that's used to determine when selection stops.
Private bStillSelecting As Boolean

Public Function Pick(filter As SelectionFilterEnum) As Object
' Initialize flag.
bStillSelecting = True

' Create an InteractionEvents object.
Set oInteractEvents = ThisApplication.CommandManager.CreateInteractionEvents

' Ensure interaction is enabled.
oInteractEvents.InteractionDisabled = False

' Set a reference to the select events.
Set oSelectEvents = oInteractEvents.SelectEvents

' Set the filter using the value passed in.
oSelectEvents.AddSelectionFilter filter

' Start the InteractionEvents object.
oInteractEvents.Start

' Loop until a selection is made.
Do While bStillSelecting
ThisApplication.UserInterfaceManager.DoEvents
Loop

' Get the selected item. If more than one thing was selected,
' just get the first item and ignore the rest.
Dim oSelectedEnts As ObjectsEnumerator
Set oSelectedEnts = oSelectEvents.SelectedEntities
If oSelectedEnts.Count > 0 Then
Set Pick = oSelectedEnts.Item(1)
Else
Set Pick = Nothing
End If

' Stop the InteractionEvents object.
oInteractEvents.Stop

' Clean up.
Set oSelectEvents = Nothing
Set oInteractEvents = Nothing
End Function

Private Sub oInteractEvents_OnTerminate()
' Set the flag to indicate we're done.
bStillSelecting = 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 View)
' Set the flag to indicate we're done.
bStillSelecting = False
End Sub

-----------------------------------------
Inventor 2020, Windows 10

Balaji_Ram · ‎06-11-2015

Hi Alan,

Here are the changes to get the stock number at the selected point :

Inside the clsSelect class :

Private ptSelected As Inventor.Point

Private Sub oSelectEvents_OnSelect(ByVal JustSelectedEntities As ObjectsEnumerator, ByVal SelectionDevice As SelectionDeviceEnum, ByVal modelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
    ' Set the flag to indicate we're done.
    Set ptSelected = modelPosition
    bStillSelecting = False
End Sub

Public Property Get SelectedPoint() As Variant
    Set SelectedPoint = ptSelected
End Property

In the module that creates embossed text :

    ' Call the pick method of the clsSelect object and set
    ' the filter to pick any face.
    Dim oFace As Face
    Set oFace = oSelect.Pick(kPartFaceFilter)
    
    Dim ptSelected As Inventor.Point
    Set ptSelected = oSelect.SelectedPoint

After you have the selected point, use it to create the sketch :

        'Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(oSketch.OriginPointGeometry.X, _
        '                                           oSketch.OriginPointGeometry.Y), sText)
        
        Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(ptSelected.X, _
                                                   ptSelected.Y), sText)

Modify the text contents to use the stock number

        ' Get the design tracking property set.
        Dim invDesignInfo As PropertySet
        Set invDesignInfo = ThisDocument.PropertySets.Item("Design Tracking Properties")
        ' Get the stock number property.
        Dim invPartNumberProperty As Property
        Set invPartNumberProperty = invDesignInfo.Item("Stock Number")
       
        ' Simple single line text.
        sText = invPartNumberProperty.Value

Regards,

Balaji

Balaji
Developer Technical Services
Autodesk Developer Network

alanrichardson · ‎06-11-2015

Hi Balaji,

Thanks for the information, being the total VBA novice that I am, having attempted to follow you instructions I have a problem with PtSelected Variable.

I have modified the code, but not confidently. Here is my Latest Effort.

clsSelect Code

---------------------------

Option Explicit

' Declare the event objects
Private WithEvents oInteractEvents As InteractionEvents
Private WithEvents oSelectEvents As SelectEvents

' Declare a flag that's used to determine when selection stops.
Private bStillSelecting As Boolean

Public Function Pick(filter As SelectionFilterEnum) As Object
' Initialize flag.
bStillSelecting = True

' Create an InteractionEvents object.
Set oInteractEvents = ThisApplication.CommandManager.CreateInteractionEvents

' Ensure interaction is enabled.
oInteractEvents.InteractionDisabled = False

' Set a reference to the select events.
Set oSelectEvents = oInteractEvents.SelectEvents

' Set the filter using the value passed in.
oSelectEvents.AddSelectionFilter filter

' Start the InteractionEvents object.
oInteractEvents.Start

' Loop until a selection is made.
Do While bStillSelecting
ThisApplication.UserInterfaceManager.DoEvents
Loop

' Get the selected item. If more than one thing was selected,
' just get the first item and ignore the rest.
Dim oSelectedEnts As ObjectsEnumerator
Set oSelectedEnts = oSelectEvents.SelectedEntities
If oSelectedEnts.Count > 0 Then
Set Pick = oSelectedEnts.Item(1)
Else
Set Pick = Nothing
End If

' Stop the InteractionEvents object.
oInteractEvents.Stop

' Clean up.
Set oSelectEvents = Nothing
Set oInteractEvents = Nothing
End Function

Private Sub oInteractEvents_OnTerminate()
' Set the flag to indicate we're done.
bStillSelecting = False
End Sub

Private ptSelected As Inventor.Point

Private Sub oSelectEvents_OnSelect(ByVal JustSelectedEntities As ObjectsEnumerator, ByVal SelectionDevice As SelectionDeviceEnum, ByVal modelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
' Set the flag to indicate we're done.
Set ptSelected = modelPosition
bStillSelecting = False
End Sub

Public Property Get SelectedPoint() As Variant
Set SelectedPoint = ptSelected
End Property

Module Code

------------------

Option Explicit

Public Sub EmbossedText()
    ' Create a new clsSelect object.
    Dim oSelect As New clsSelect
    
    ' Set a reference to the part component definition.
    ' This assumes that a part document is active.
    Dim oCompDef As PartComponentDefinition
    Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition
   
    ' Call the pick method of the clsSelect object and set
    ' the filter to pick any face.
    Dim oFace As Face
    Set oFace = oSelect.Pick(kPartFaceFilter)
      
    ' Check to make sure an object was selected.
    If Not oFace Is Nothing Then
        Dim oSketch As PlanarSketch
        Set oSketch = oCompDef.Sketches.Add(oFace, True)
        oSketch.Name = "Embossed text"
        
    ' Set the point selected
    Dim ptSelected As Inventor.Point
    Set ptSelected = oSelect.SelectedPoint
    
    
       ' Create text with simple string as input.  Since this doesn't use
       ' any text overrides, it will default to the active text style.
       Dim sText As String
       Dim oTextBox As TextBox
       Dim oTG As TransientGeometry
       Set oTG = ThisApplication.TransientGeometry
    
       
       'Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(oSketch.OriginPointGeometry.X, _
        '                                           oSketch.OriginPointGeometry.Y), sText)
        
        Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(ptSelected.X, _
                                                   ptSelected.Y), sText)

       ' Get the design tracking property set.
        Dim invDesignInfo As PropertySet
        Set invDesignInfo = ThisDocument.PropertySets.Item("Design Tracking Properties")
        
        ' Get the stock number property.
        Dim invPartNumberProperty As Property
        Set invPartNumberProperty = invDesignInfo.Item("Stock Number")
       
        ' Simple single line text.
        sText = invPartNumberProperty.Value

       With oTextBox
           .VerticalJustification = kAlignTextMiddle
           .HorizontalJustification = kAlignTextCenter
       End With
    
    
       ' Add the text box to an object collection
       Dim oPaths As ObjectCollection
       Set oPaths = ThisApplication.TransientObjects.CreateObjectCollection
       oPaths.Add oTextBox
    
       ' Create a profile. Calling the AddForSolid method without any
       ' arguments will result in a profile containing all possible
       ' paths in the sketch. By passing in the text box, the profile
       ' is restricted to the input text path.
       Dim oProfile As Profile
       Set oProfile = oSketch.Profiles.AddForSolid(False, oPaths)

       ' Extrude the text.
       Dim oExtrudeDef As ExtrudeDefinition
       Set oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
       Call oExtrudeDef.SetDistanceExtent(0.25, kNegativeExtentDirection)
       Dim oExtrude As ExtrudeFeature
       Set oExtrude = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
   End If
End Sub

The code compiles but when I select a face I get the message variable not defined [ptSelected] (see attached clip)

Where should I have set this variable?

(I've attached the part file I'm using, if that helps)

Regards and thanks

Alan

-----------------------------------------
Inventor 2020, Windows 10

Balaji_Ram · ‎06-11-2015

Hi Alan,

That should be a private variable of the "clsSelect" class and declared at the top. For example, below the line that declares

Private bStillSelecting As Boolean

Private ptSelected As Inventor.Point

Regards,

Balaji

Balaji
Developer Technical Services
Autodesk Developer Network

alanrichardson · ‎06-12-2015

Hi Balaji,

Sorry to be a pain . . .

I've added the variable, but I get a runtime error when I select a face. (Method 'ADD' of object 'Extrude Feature' failed).

I also think my pick point is incorrect.

The sketch 'embossed text' is created but the creation point appears to be off the face.

Could you take a look at my IPT file please?

Regards

Alan

-----------------------------------------
Inventor 2020, Windows 10

Balaji_Ram · ‎06-14-2015

Hi Alan,

Not a problem at all.

I have attached the modified part file.

Because the stock number (sText) is required for the sketch creation, it is to be moved prior to this line :

oSketch.TextBoxes.AddFitted

Regards,

Balaji

Balaji
Developer Technical Services
Autodesk Developer Network

alanrichardson · ‎06-15-2015

Hi Balaji

Thanks for the information, didn't quite understand the iLogic in the attached file . . .

I have moved the required code and I'm now getting the stocknumber into my part.

However, it's not being placed at the point that the face is selected. I selected the approx centre of the yellow face(see attached pic) and the text is

being placed off the face to the lower left hand side.

Do I have some more code incorrectly placed?

MODULE CODE

--------------------

Option Explicit

Public Sub EmbossedTextVBA()
    ' Create a new clsSelect object.
    Dim oSelect As New clsSelect
    
    ' Set a reference to the part component definition.
    ' This assumes that a part document is active.
    Dim oCompDef As PartComponentDefinition
    Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition
   
    ' Call the pick method of the clsSelect object and set
    ' the filter to pick any face.
    Dim oFace As Face
    Set oFace = oSelect.Pick(kPartFaceFilter)
      
    ' Check to make sure an object was selected.
    If Not oFace Is Nothing Then
        Dim oSketch As PlanarSketch
        Set oSketch = oCompDef.Sketches.Add(oFace, True)
        oSketch.Name = "Embossed text"
        
       ' Set the point selected
       Dim ptSelected As Inventor.Point
       Set ptSelected = oSelect.SelectedPoint
    
    
       ' Create text with simple string as input.  Since this doesn't use
       ' any text overrides, it will default to the active text style.
       Dim sText As String
       Dim oTextBox As TextBox
       Dim oTG As TransientGeometry
       Set oTG = ThisApplication.TransientGeometry
    
       ' Get the design tracking property set.
       Dim invDesignInfo As PropertySet
       Set invDesignInfo = ThisDocument.PropertySets.Item("Design Tracking Properties")
        
       ' Get the stock number property.
       Dim invPartNumberProperty As Property
       Set invPartNumberProperty = invDesignInfo.Item("Stock Number")
       
       ' Simple single line text.
       sText = invPartNumberProperty.Value
       
       'Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(oSketch.OriginPointGeometry.X, _
       '                                           oSketch.OriginPointGeometry.Y), sText)
        
       Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(ptSelected.X, _
                                                   ptSelected.Y), sText)
       
       With oTextBox
           .VerticalJustification = kAlignTextMiddle
           .HorizontalJustification = kAlignTextCenter
       End With
          
       ' Add the text box to an object collection
       Dim oPaths As ObjectCollection
       Set oPaths = ThisApplication.TransientObjects.CreateObjectCollection
       oPaths.Add oTextBox
    
       ' Create a profile. Calling the AddForSolid method without any
       ' arguments will result in a profile containing all possible
       ' paths in the sketch. By passing in the text box, the profile
       ' is restricted to the input text path.
       Dim oProfile As Profile
       Set oProfile = oSketch.Profiles.AddForSolid(False, oPaths)

       ' Extrude the text.
       Dim oExtrudeDef As ExtrudeDefinition
       Set oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
       Call oExtrudeDef.SetDistanceExtent(0.25, kNegativeExtentDirection)
       Dim oExtrude As ExtrudeFeature
       
       'On Error Resume Next
       
       Set oExtrude = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
       
   End If
End Sub

CLASS (CLSSELECT CODE)

---------------------------------

Option Explicit

' Declare the event objects
Private WithEvents oInteractEvents As InteractionEvents
Private WithEvents oSelectEvents As SelectEvents

' Declare a flag that's used to determine when selection stops.
Private bStillSelecting As Boolean
Private ptSelected As Inventor.Point

Public Function Pick(filter As SelectionFilterEnum) As Object
' Initialize flag.
bStillSelecting = True

' Create an InteractionEvents object.
Set oInteractEvents = ThisApplication.CommandManager.CreateInteractionEvents

' Ensure interaction is enabled.
oInteractEvents.InteractionDisabled = False

' Set a reference to the select events.
Set oSelectEvents = oInteractEvents.SelectEvents

' Set the filter using the value passed in.
oSelectEvents.AddSelectionFilter filter

' Start the InteractionEvents object.
oInteractEvents.Start

' Loop until a selection is made.
Do While bStillSelecting
ThisApplication.UserInterfaceManager.DoEvents
Loop

' Get the selected item. If more than one thing was selected,
' just get the first item and ignore the rest.
Dim oSelectedEnts As ObjectsEnumerator
Set oSelectedEnts = oSelectEvents.SelectedEntities
If oSelectedEnts.Count > 0 Then
Set Pick = oSelectedEnts.Item(1)
Else
Set Pick = Nothing
End If

' Stop the InteractionEvents object.
oInteractEvents.Stop

' Clean up.
Set oSelectEvents = Nothing
Set oInteractEvents = Nothing
End Function

Private Sub oInteractEvents_OnTerminate()
' Set the flag to indicate we're done.
bStillSelecting = 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 View)
' Set the flag to indicate we're done.
Set ptSelected = modelPosition
bStillSelecting = False
End Sub

Public Property Get SelectedPoint() As Variant
Set SelectedPoint = ptSelected
End Property

I appreciate the help, you have no idea, potentially, how much time this will save me in my daily work.

Thanks

Alan

-----------------------------------------
Inventor 2020, Windows 10

Balaji_Ram · ‎06-15-2015

Hi Alan,

I can reproduce the behavior with the part that you shared.

I am looking into this and will get back to you soon.

Regards,

Balaji

Balaji
Developer Technical Services
Autodesk Developer Network

Balaji_Ram · ‎06-15-2015

Hi Alan,

Please try this code that converts the selected point coordinates from model to sketch coordinates.

The "öPnt2d" which is now in sketch coordinates can be used with the "AddFitted" method.

       Dim oPnt2d As Point2d
       Set oPnt2d = oSketch.ModelToSketchSpace(ptSelected)
       
       Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(oPnt2d.X, _
                                                   oPnt2d.Y), sText)

Also, please ignore the iLogic code in the file that i earlier shared, I was trying that out for another query from a developer.

Regards,

Balaji

Balaji
Developer Technical Services
Autodesk Developer Network

alanrichardson · ‎06-15-2015

Hi Balaji

That's absolutely great!

Works a treat!

Thanks & Regards

Alan

-----------------------------------------
Inventor 2020, Windows 10

Community

Embossed Text

Embossed Text

Embossed Text