VBA Macro for Adding Etched Text

[alanrichardson]

Hi 

Can anyone help - I'd like to be able to Etch/Emboss the Text contained in the iProperties, 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

[Balaji_Ram]

Hi Alan,

I have posted a reply to your other forum post on this topic :

http://forums.autodesk.com/t5/inventor-customization/embossed-text/m-p/5668061#M56484

Regards,

Balaji