Oscillate position

puff · #1 06-13-2018, 02:25 PM

Hi all! I'm developing a script to make a doc more hand-written like. I originally used randomization to alter the position of each character. Yet, the result is a bit weird since common people write in a line that is oscillating rather than random.
Here is the original code:

Code:

Sub HandWrittenSimulation()
Dim R_Character As Range
Dim ParagraphSpace(3)
    ParagraphSpace(1) = "11"
    ParagraphSpace(2) = "12"
    ParagraphSpace(3) = "13"
For Each R_Character In ActiveDocument.Characters
        VBA.Randomize
        R_Character.font.Position = Int(VBA.Rnd * 3) + 1
        R_Character.font.Spacing = 0
    Next
    Application.ScreenUpdating = True
   For Each Cur_Paragraph In ActiveDocument.Paragraphs
        Cur_Paragraph.LineSpacing = ParagraphSpace(Int(VBA.Rnd * 3) + 1)
    Next
        Application.ScreenUpdating = True
End Sub

As you can see, I randomize every character's font position as 11, 12, or 13. However, can I let a character to determine its paragraph space from the character before. Like if the previous character is 12, then itself can be either 11 or 13; if the previous one is 11, it can only be 13; if the previous one is 13, then it can only be 12. I will add more choices later such that a middle position can have more options, like for 11, 12, 13, 14, a character after a 12 can randomize if it's 11 (minus) or 13 (add).

Since I assume the natural paragraph will break the continuity, I think just randomize the 1st character of every paragraph should work.

Thank you very much XD

Guessed · #2 06-13-2018, 04:42 PM

I'm not seeing in the code anything that uses the ParagraphSpace values so your description doesn't match the code. To just look at oscillating the position of the text I would do it like this

Code:

Sub HandWrittenSimulation()
  Dim arrPattern() As String, lngChar As Long, iPattCount As Integer, iScale As Integer
  arrPattern = Split("0,1,1,1,2,2,2,3,3,3,4,4,4,3,3,3,2,2,2,1,1,1,0,0", ",")
  iPattCount = UBound(arrPattern) + 1
  iScale = Int(ActiveDocument.Characters(1).Font.Size) / 8
  
  For lngChar = 1 To ActiveDocument.Characters.Count
    ActiveDocument.Characters(lngChar).Font.Position = Int(VBA.Rnd * iScale + arrPattern(lngChar Mod iPattCount))
  Next lngChar
End Sub

puff · #3 06-13-2018, 05:07 PM

I just notice that. Now the code has the spacing part

Guessed · #4 06-13-2018, 07:24 PM

I don't see the point of variation in the line spacing. If it was imaginary handwriting then I choose to imagine that the writer was following the pale blue lines on the page which don't vary.

A more realistic variation would be to vary the font size from character to character within a band. If you did this then it is simple to just let the paragraph spacing use whatever the font size is on the paragraph mark (since this is varied by the code too)

Code:

Sub HandWrittenSimulation()
  Dim arrPattern() As String, lngChar As Long, iPattCount As Integer, iScale As Integer, aPar As Paragraph
  arrPattern = Split("0,1,1,1,2,2,2,3,3,3,4,4,4,3,3,3,2,2,2,1,1,1,0,0", ",")
  iPattCount = UBound(arrPattern) + 1
  iScale = ActiveDocument.Characters(1).Font.Size
  ActiveDocument.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
  
  For lngChar = 1 To ActiveDocument.Characters.Count
    ActiveDocument.Characters(lngChar).Font.Position = Int(VBA.Rnd * iScale / 10 + arrPattern(lngChar Mod iPattCount))
    ActiveDocument.Characters(lngChar).Font.Size = Int(2 * (iScale - 1) + (VBA.Rnd * 5)) / 2
  Next lngChar
End Sub

Note for future reference: By default, arrays start at zero so declaring it as
Dim ParagraphSpace(3)
means that there are 4 possible array positions (0, 1, 2, 3) but you ignore the first position.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Textboxes position isn't equal to initial position	dxdevil	Word VBA	0	01-30-2017 04:32 AM
Shadow Position	shanemarkley	Excel	0	07-30-2014 08:23 PM
Hyperlink goes to wrong position	Stephen0352	Word	6	10-03-2012 04:41 AM
VBA: how can I know the position on a document?	tinfanide	Excel Programming	3	02-27-2012 03:24 PM
fix position for a segment in a doc	tai	Word	3	10-20-2011 01:04 PM