Is it possible for a macro to figure out if two adjacent letters in a text string overlap (intersect) without converting the letters to curved objects? My hope is to come up with a macro that can loop through the words and letters in a text string, incrementally decrease the kerning between two adjacent letters until they overlap (visibly touching each other), and then increase the kerning until they have a certain spacing between them?
This will check if text or shapes overlap and return a "CAUTION". Don't know about having it automatically adjust kerning to fix though.
Sub DetectIntersects() Dim sr As ShapeRange, srText As ShapeRange Dim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape Dim bDuplicated As Boolean, bFound As Boolean bFound = False Set sr = ActiveSelectionRange.Shapes.FindShapes() 'Find all the shapes inside groups, this will also return the group as a shape sr.RemoveRange sr.FindAnyOfType(cdrGroupShape, cdrGuidelineShape, cdrBitmapShape) 'Remove any groups, guidelines or Bitmaps For Each s1 In sr.Shapes bDuplicated = False If bFound Then Exit For ' If the shape is text, make a duplicate and convert the duplicate to curves If s1.Type = cdrTextShape Then Set s1 = s1.Duplicate s1.ConvertToCurves bDuplicated = True End If 'Loop each shape to see if it intersects with the current shape For Each s2 In sr.Shapes If Not s1 Is s2 And s2.Type <> cdrTextShape Then If s1.DisplayCurve.IntersectsWith(s2.DisplayCurve) Then bFound = True Exit For End If End If Next s2 'If the shape was text we need to break it apart and see if any letters intersect If bDuplicated Then Set srText = s1.BreakApartEx For Each s3 In srText.Shapes If bFound Then Exit For For Each s4 In srText.Shapes If Not s3 Is s4 Then If s3.DisplayCurve.IntersectsWith(s4.DisplayCurve) Then bFound = True Exit For End If End If Next s4 Next s3 srText.Delete End If Next s1 If bFound Then MsgBox "CAUTION, Something Intersects!!!", vbCriticalIf Not bFound Then MsgBox "File is good, Nothing Interects."End Sub
Hi Myron,
Thank you so much for taking the time to make up this code. Your approach is very similar to what I did over the last day (staying up until 2:30 this morning). I took it a bit further and can share my script, if you are curious.
I have two questions for you now.
1. What is the Corel VBA method for increasing or decreasing the kerning between to letters? Hidden away in the Tools, Options, Customization dialog, there are Commands to Increase Kerning and Decrease Kerning. Shortcuts like Alt + > and Alt + < can be assigned to these for convenient use on the page. What I am looking for is the VBA command to execute these actions as part of a macro.
I found the TextRange.RangeKerning property which is almost what I am looking for, however it is simply changing the overall letter spacing by percentages. It can be limited to just acting upon two characters but this is not what I'm looking for. I need a way to access the above-described kerning actions using code.
I also found another member of the TextRange class called CharSpacing. I can't quite imagine how to get this to work for me either in the way that I need.
So the short question is, do you know how I can use a VBA command to increase or decrease the kerning between two selected characters in a connected line of artistic text?
2. My second question is, how do I turn on notifications at this site so that I am notified when I receive a reply? I just happened to come back and notice your message, but I received no email alert.
Coding isn't my fortay. I don't take credit for the code I posted either. I can't remember who I got it from. As for notifications check settings
Thank you. For some reason, it wasn't showing me the Settings option. Now it is.