anyone know what the vba code would be to do this?
HI.
Try this.
s will remain referenced to the circle in this code.
Sub circleText() Dim s As Shape, sText As Shape, sr As ShapeRange Set s = ActiveLayer.CreateEllipse2(0, 0, 12) Set sText = ActiveLayer.CreateArtisticText(0, 0, "Test Text") sText.SetSize 8 sText.Text.FitToPath s s.CreateSelection End Sub
close.
I already have the macro to fit my selected text to path but it ends with both selected. I'd like to end it with just the circle selected so I can just size as needed without distorting the text.
Myron said: close. I already have the macro to fit my selected text to path but it ends with both selected. I'd like to end it with just the circle selected so I can just size as needed without distorting the text.
That's what the s.CreateSelection does.
Using this I can select any text anywhere and end up with the image shown above on the left.
Sub FitToCircle() ' Recorded 11/11/2013 Optimization = True Dim OrigSelection As ShapeRange Set OrigSelection = ActiveSelectionRange OrigSelection.Cut ActiveLayer.Paste Dim Paste1 As ShapeRange Set Paste1 = ActiveSelectionRange ActiveLayer.Import "C:\Corel macro stuff\circle for fit to path.cdr", cdrCDR Dim s1 As Shape Set s1 = ActiveShape Dim grp1 As ShapeRange Set grp1 = s1.UngroupEx grp1.AlignToShape cdrAlignTop, Paste1(1), cdrTextAlignBoundingBox grp1.AlignToShape cdrAlignLeft + cdrAlignRight, Paste1(1), cdrTextAlignBoundingBox ' Recording of this command is not supported: TextFitToPath SendKeys "^(z)" SendKeys "^+(z)" SendKeys "%f" Optimization = False ActiveWindow.RefreshEnd Sub
The last SendKeys is my shortcut to Fit Text To Path.
Hi.
Try this. It's hard to test your code with Send Keys so I had to guess a little. You are selecting a single line of artistic text and then fitting to path on an imported circle.
Sub circleText() Dim s As Shape, sText As Shape, sr As ShapeRange Set sText = ActiveShape If sText.Type <> cdrTextShape Then MsgBox "SElect a single line of artistic text. Exiting...": Exit Sub ActiveLayer.Import "C:\Corel macro stuff\circle for fit to path.cdr", cdrCDR 'ActiveLayer.Import "D:\All Graphics\test.cdr", cdrCDR 'my test Set s = ActiveShape If s Is Nothing Then MsgBox "Nothing imported. Exiting...": Exit Sub sText.Text.FitToPath s s.CreateSelectionEnd Sub
Not to be a pia but that puts everything to center of page. Yes, mine cuts the selected text pastes it back then imports my circle and aligns it top and center of that text then does fit to path.
I honestly don't remember if this is supported in X4, but here is how I would do this in X6. :-) This should create the text, circle, place it at the top, and then select your circle as requested:
Sub TestTextOnPath() Dim sText As Shape, sEllipse As Shape Set sText = ActiveLayer.CreateArtisticText(0, 0, "Text On Path") Set sEllipse = ActiveLayer.CreateEllipse2(4, 5, 2) sText.Text.FitToPath sEllipse sText.Effects(1).TextOnPath.Quadrant = cdrTopQuadrant sEllipse.CreateSelection End Sub
Yep!! That does it! Thanks a bunch guys!
Wait a minute. That still puts it center of page. I want it to stay at least in the general area where I had it.