i want a unique code of 3 alphanumeric text from a artistic text lines for example
parag PAR
corel8 CR8
coreldraw-x6 CX6
etc
Create an ArtisticTest keeping the Logos and name it "TextX". Copy the next code in a Module and run it:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
Option Explicit Private M() As String Sub TestThreeUniqueChar() Dim Interm As Variant, strPat As String, El As Variant, s As Shape, strTxt As String Dim boolFound As Boolean, i As Long, left As Double, width As Double, bottom As Double Dim font As Double, height As Double, sPatt As Shape, adjust As Double boolFound = False: ReDim M(1) ActiveDocument.Unit = cdrMillimeter: ActiveDocument.Rulers.HUnits = cdrMillimeter For Each s In ActivePage.Shapes If s.Type = cdrTextShape And s.Name = "TextX" Then left = s.LeftX: width = s.SizeWidth: bottom = s.BottomY font = s.Text.Story.Size: height = s.SizeHeight strTxt = s.Text.Story Interm = Split(strTxt, Chr(13)) adjust = height / (UBound(Interm) + 1) End If If s.Name = "Pattern" Then s.Delete Next For i = 0 To UBound(Interm) strPat = LeftB$(Interm(i), 6) For Each El In M() If El = strPat Then boolFound = True: Exit For Next If boolFound = False Then If sPatt Is Nothing Then Set sPatt = ActivePage.ActiveLayer.CreateArtisticText(left + width + 10, bottom + height - adjust / 3 * 2, strPat, , , , font) sPatt.Name = "Pattern" M(i) = strPat: ReDim Preserve M(i + 1) Else sPatt.Text.Story = sPatt.Text.Story & vbCrLf & strPat M(i) = strPat: ReDim Preserve M(i + 1) End If Else strPat = uniquePattern(Interm(i), strPat, i, sPatt) End If Next End Sub Function uniquePattern(ByVal strVal As String, strPat As String, i As Long, sPatt As Shape, Optional J As Long) Dim uniqueP As String, boolFound As Boolean, El As Variant If J <= 4 Then J = 4: boolFound = False uniqueP = left(strPat, 2) & Mid(strVal, J, 1) For Each El In M() If El = uniqueP Then boolFound = True: Exit For Next If boolFound = False Then If Len(uniqueP) = 3 Then sPatt.Text.Story = sPatt.Text.Story & vbCrLf & uniqueP M(i) = uniqueP: ReDim Preserve M(i + 1) Else sPatt.Text.Story = sPatt.Text.Story & vbCrLf & "Not enough characters" ReDim Preserve M(i + 1) End If Else J = J + 1 If J <= Len(strVal) Then uniquePattern strVal, strPat, i, sPatt, J Else If Mid(strVal, 4, 1) <> "" Then uniquePattern strVal, left(strPat, 1) & Right(strPat, 1) & Mid(strVal, 4, 1), i, sPatt End If End If End If End Function Sub testLeft() Dim x As String Dim Interm As Variant, T As String T = "testare,carare" Interm = Split(T, ",") x = "testare" Debug.Print left(x, 3), LeftB$(x, 6) Debug.Print left(Interm(0), 3) End Sub
Is that OK for you? If yes, how do you intend to use the resulted ArtisticText containing the unique patterns? Just in order not to die stupid...
FaneDuru said:If yes, how do you intend to use the resulted ArtisticText containing the unique patterns?
Some of what paraggoyal has been asking about would appear - to me - to perhaps be related to some of the discussion in this thread.
Although the posts from 2017-09-17 in that thread make it appear as if a specific issue was still unresolved at that point (having two lines for each "index text") , that is not the case. The forum software was so "sick" at that time that we could not reliably post to the main forum, and resolved that issue through private messages.
FaneDuru said:In this case wouldn't be better to already save each unique pattern in a separate textBox and use it like hi needs?
I was only pointing out some of the history, and that paraggoyal already had some code to:
and also has code to:
A very serious difficulty - as seen in the thread to which I linked - is trying to get a solid definition of the problem.
I finally got worn out. I completely understand your "I didn't want to work like Sisyphus" comment!
FaneDuru said:Understood...
From a completely selfish standpoint, it is good for ME.
I can learn some good stuff from looking at the code you have posted!
Thanks! It is not an optimized code... It could be recursively done for all possibilities of using the next character in case of similar pattern, but it was unnecessary here, I thought. And I was too lazy for making it elegant...
For instance it would be rapider to work on a string variable and create the ArtisticText at the end using that variable. It take time to update each line of the Text.Story...
In fact it looks he is not able to use it...