Solidworks added a new single line font a few versions back.  Unfortunately, there is no way to project said sketch onto a non planar surface (at least that I know of).  So I created a macro to do it.  It requires a sketch with the lettering in it, and the lettering must be 'dissolved'.   Select the sketch, and all faces to project onto, run the macro and a 3D sketch on the faces is created.  It does work, but it's really slow.  Anyone have any ideas on how to make it faster?

Thanks,

Mark

' ProjectSketchOnSurfaces
' Written by Mark Olsen - 09/16/2015
'
' Preconditions:
'   A 2D sketch and one or more faces must be selected (in that order)
'   The sketch must contain any sketch entities except blocks
'       Note: If sketch plane intersects any selected face, output is
'           unpredictable (especially if sketch segments intersect face).
'
' Postconditions:
'   A 3D sketch is created with each of the segments in the 2D sketch
'       projected onto the selected faces.  The 3D sketch is completely
'       unconstrained.
'__________________________________________________________________________
Option Explicit
Dim swApp As SldWorks.SldWorks
Sub main()
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSketchMgr As SldWorks.SketchManager
Dim vSegments As Variant
Dim vSelSeg As Variant
Dim swSketchSegment As SldWorks.SketchSegment
Dim swSketch As SldWorks.Sketch
Dim swFeature As SldWorks.Feature
Dim swFeatMgr As SldWorks.FeatureManager
Dim swPlane As Object
Dim sSketchPlane As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

On Error GoTo ErrorHandler:

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSketchMgr = swModel.SketchManager
Set swFeatMgr = swModel.FeatureManager

swApp.CommandInProgress = True
swSketchMgr.AddToDB = True

'check for open part
If swModel Is Nothing Then
    MsgBox "Nothing open.  Open a part and try again", vbOKOnly, "Error - No File"
    Exit Sub
End If
If Not swModel.GetType = 1 Then
    MsgBox "Not a part.  Open a part and try again", vbOKOnly, "Error - Not a part"
    Exit Sub
End If
'get sketch
If Not swSelMgr.GetSelectedObjectType3(1, -1) = swSelSKETCHES Then
    MsgBox "First selection must be a sketch. Reselect entities", vbOKOnly, "Error - Not a sketch"
    Exit Sub
End If

'Suspend update of window
Dim swModelView As SldWorks.ModelView
Set swModelView = swModel.ActiveView
swModelView.EnableGraphicsUpdate = False
swFeatMgr.EnableFeatureTree = False
swFeatMgr.EnableFeatureTreeWindow = False
'========================

Set swSketch = swSelMgr.GetSelectedObject(1).GetSpecificFeature2()
Set swPlane = swSketch.GetReferenceEntity(swSelDATUMPLANES) 'Get sketch plane
sSketchPlane = swPlane.Name

Dim swFace As SldWorks.Face2
Dim vFaces() As Variant
Dim swbody As SldWorks.Body2

For i = 2 To swSelMgr.GetSelectedObjectCount2(-1) ' Get selected faces
    If Not swSelMgr.GetSelectedObjectType3(i, -1) = 2 Then ' Check that selected objects (2 ->) are faces
        MsgBox "Selection" & i & " is not a face.  Select sketch to project, then faces to project onto.", _
                vbOKOnly, "Error - Not a Face"
        Exit Sub
    End If
    ReDim Preserve vFaces(0 To i - 2)
    Set swFace = swSelMgr.GetSelectedObject6(i, -1)
    Set vFaces(i - 2) = swFace
Next i

Dim vCurves() As Variant
Dim sCurveList() As String
Dim sSketchList() As String

vSegments = swSketch.GetSketchSegments
j = 0: k = 0
For Each vSelSeg In vSegments
    Set swSketchSegment = vSelSeg ' Create 2D sketch
    swModel.Extension.SelectByID2 sSketchPlane, "PLANE", 0, 0, 0, False, 0, Nothing, 0
    swSketchMgr.InsertSketch False
    swSketchSegment.Select4 False, Nothing
    swSketchMgr.SketchUseEdge2 (False)
    Set swFeature = swSketchMgr.ActiveSketch
    swSketchMgr.InsertSketch True
    ReDim Preserve sSketchList(0 To j)
    sSketchList(j) = swFeature.Name ' Build sketch list for later deletion
    j = j + 1
   
    For i = 0 To UBound(vFaces) ' Create Curves
        swSelMgr.AddSelectionListObject vFaces(i), Nothing
    Next i
    Set swFeature = swModel.InsertProjectedSketch2(0)
    If swFeature Is Nothing Then
        Set swFeature = swModel.InsertProjectedSketch2(1) ' If the sketch normal is the wrong way, reverse projection
    End If
    If Not swFeature Is Nothing Then ' If the curve isn't created (projection misses surface), don't add to the list
        ReDim Preserve vCurves(0 To k)
        ReDim Preserve sCurveList(0 To k)
        Set vCurves(k) = swFeature
        sCurveList(k) = swFeature.Name ' Build curve list for later deletion
        k = k + 1
    End If
Next vSelSeg
swModel.ClearSelection2 True

For i = 0 To UBound(vCurves) ' Create 3D sketch from all curves
    swSelMgr.AddSelectionListObject vCurves(i), Nothing
Next i
swSketchMgr.Insert3DSketch False
swSketchMgr.SketchUseEdge2 False
Set swSketch = swSketchMgr.ActiveSketch
vSegments = swSketch.GetSketchSegments
For Each vSelSeg In vSegments
    vSelSeg.Select4 False, Nothing
Next vSelSeg
swModel.SketchConstraintsDelAll 'Delete all constraints
swSketchMgr.Insert3DSketch False
swModel.ClearSelection2 True

For i = UBound(sCurveList) To 0 Step -1 ' Remove Curves - last to first
    swModel.Extension.SelectByID2 sCurveList(i), "REFCURVE", 0, 0, 0, True, 0, Nothing, 0
    swModel.DeleteSelection 2
Next i
swModel.ClearSelection2 True

For i = UBound(sSketchList) To 0 Step -1 'Remove sketches - last to first
    swModel.Extension.SelectByID2 sSketchList(i), "SKETCH", 0, 0, 0, True, 0, Nothing, 0
    swModel.DeleteSelection 2
Next i
swModel.ClearSelection2 True

swModelView.EnableGraphicsUpdate = True 'Restore update of window
swFeatMgr.EnableFeatureTree = True
swFeatMgr.EnableFeatureTreeWindow = True

swSketchMgr.AddToDB = False

'Error Handler
Exit Sub
ErrorHandler:
swModelView.EnableGraphicsUpdate = True 'Restore update of window
swFeatMgr.EnableFeatureTree = True
swFeatMgr.EnableFeatureTreeWindow = True

MsgBox "An error occured -  error  " & Err.Number & ": " & Err.Description

End Sub

​BTW, anyone know how to post code so that the formatting and coloring doesn't get messed up?