help with macro code

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.

        HI.

        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.Refresh
          End 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.CreateSelection
            End 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