I did find an issue with my previous macro. It expected that the only thing
in the sketch would be text. If you have the auto project edges setting
turned on, you'll also get the edges of the face and that causes it
problems. I've made a modification so that it doesn't matter now and it
will only use the text that's in the sketch and ignore everything else.
This macro won't work in Inventor 10. I takes advantage of a capability in
the API that was introduced in Inventor 11.
Here's the updated macro:
Public Sub ExplodeText()
Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument
On Error Resume Next
Dim oSketch As PlanarSketch
Set oSketch = oDoc.SelectSet.Item(1)
If Err Then
MsgBox "A sketch must be selected when running this macro."
Exit Sub
End If
On Error GoTo ErrorFound
Dim oTrans As Transaction
Set oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc,
"Explode Text")
oSketch.SetEndOfPart True
Dim oSketchEnt As Face
Set oSketchEnt = oSketch.PlanarEntity
Dim lKeyContext As Long
lKeyContext = oDoc.ReferenceKeyManager.CreateKeyContext
Dim abtSketchFaceRefKey() As Byte
Call oSketchEnt.GetReferenceKey(abtSketchFaceRefKey, lKeyContext)
Call oDoc.ComponentDefinition.SetEndOfPartToTopOrBottom(False)
Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid
' Remove any non-text profile paths from the profile
Dim oPath As ProfilePath
For Each oPath In oProfile
If Not oPath.TextBoxPath Then
oPath.Delete
End If
Next
Dim oExtrude As ExtrudeFeature
Set oExtrude =
oDoc.ComponentDefinition.Features.ExtrudeFeatures.AddByDistanceExtent( _
oProfile, 0.1,
kPositiveExtentDirection, kJoinOperation)
Dim oResult As Object
Set oResult =
oDoc.ReferenceKeyManager.BindKeyToObject(abtSketchFaceRefKey, lKeyContext)
If TypeOf oResult Is ObjectCollection Then
Set oSketchEnt = oResult.Item(1)
Else
Set oSketchEnt = oResult
End If
Dim oNewSketch As PlanarSketch
Set oNewSketch = oDoc.ComponentDefinition.Sketches.Add(oSketchEnt)
oNewSketch.DeferUpdates = True
Dim oFace As Face
For Each oFace In oExtrude.EndFaces
Dim oEdge As Edge
For Each oEdge In oFace.Edges
ThisApplication.StatusBarText = "Processing Text Curves..."
Dim oEnt As SketchEntity
Set oEnt = oNewSketch.AddByProjectingEntity(oEdge)
oEnt.Reference = False
Next
Next
Call oExtrude.Delete(True, False)
oNewSketch.DeferUpdates = False
oTrans.End
Exit Sub
ErrorFound:
oTrans.Abort
MsgBox "Unexpected error while exploding text."
End Sub
--
Brian Ekins
Autodesk Inventor API
wrote in message news:5204368@discussion.autodesk.com...
not working in either 10 or 11. perhaps its something to do with how I
copied in the macro, I dunno.
here's my file: