#1




Recreating curves in VBA code
Sometimes when you write a VBA macro for CorelDRAW/Designer, you need to create some complicate curves in it. It could be rather slow and tedious to create the curves segment by segment. There is Document.CreateCurveFromArray method which helps create curves quickly but is still quite cumbersome to use (need to initialize each array element in the code one by one).
The following subroutine could do it quickly and it's easy to use: Code:
Function ReCreateCurve(ByVal sDefinition As String) As Shape Dim ci() As CurveElement Dim nUBound As Long, n As Long Dim vArray As Variant, vData As Variant Dim nFlag As Integer vArray = Split(sDefinition, ":") nUBound = vArray(0) sDefinition = vArray(1) ReDim ci(0 To nUBound) vArray = Split(sDefinition, "") For n = 0 To nUBound vData = Split(vArray(n), ",") ci(n).PositionX = ActiveDocument.ToUnits(HexVal(vData(0)), cdrTenthMicron) ci(n).PositionY = ActiveDocument.ToUnits(HexVal(vData(1)), cdrTenthMicron) nFlag = HexVal(vData(2)) ci(n).ElementType = (nFlag \ 256) And 3 ci(n).NodeType = (nFlag \ 1024) And 3 ci(n).flags = nFlag And 255 Next n Set ReCreateCurve = ActiveLayer.CreateCurve(ActiveDocument.CreateCurveFromArray(ci)) End Function Private Function HexVal(ByVal strHex) As Long HexVal = Val("&h" & strHex) End Function Code:
Sub CopyCurveToClipboard() Dim d As New DataObject d.SetText GetCurveDef(ActiveShape.Curve) d.PutInClipboard End Sub Private Function GetCurveDef(ByVal crv As Curve) As String Dim ci() As CurveElement Dim nCount As Long, n As Long Dim strDef As String Dim nFlag As Integer ci = crv.GetCurveInfo() nCount = UBound(ci)  LBound(ci) strDef = nCount & ":" For n = LBound(ci) To UBound(ci) strDef = strDef & Hex(ActiveDocument.FromUnits(ci(n).PositionX, cdrTenthMicron)) & "," strDef = strDef & Hex(ActiveDocument.FromUnits(ci(n).PositionY, cdrTenthMicron)) & "," nFlag = ci(n).ElementType * 256 + ci(n).NodeType * 1024 + ci(n).flags strDef = strDef & Hex(nFlag) If n <> UBound(ci) Then strDef = strDef & "" Next n GetCurveDef = strDef End Function Code:
Sub Test() ReCreateCurve "3:A9B4C,1200C8,8C10B354,1200C8,184D93CC,192008,184A9B4C,1200C8,188" End Sub I hope this is useful. 
#2




Hi Alex, wow, quite nice.
One small request: I get error due to VBA Editor wrapping on sub test 1 below. When I break my shape into pieces as in test 2, code is less. This is ok, but I want the drawn results combined in that case. is there easy way to autocombine results of the drawn shapes? For example... some day we might need very complex shapes broken down into numerous ReCreateCurve sections. Then combined. Thanks so much, Code:
Sub Test1() ReCreateCurve "68:13C2C7,E401F,8C133A30,DECC7,18412F1C2,E186F,18412E4DC,E3F21,38012B88A,E632E,380126CCE,E83EC,28411B99C,ED1F0,38010BF84,F213F,38010BF84,FD348,68410BF84,10F3A4,38012B296,10B033,38012B296,F82EA,68412B296,EBEB4,38012767C,EFDC6,38013C2C7,E401F,28812FB59,D89E4,8C174210,1034D9,184177AAE,10496C,3801830BE,1023A6,380187FE4,100391,28417D998,FA30B,38013ED76,D51B3,38013947A,D3098,68412D3CC,CE8E9,38013CBB9,C56F5,38012B78C,B711E,28411CF2F,AAF5A,38010BF84,AE113,38010BF84,B8943,68410BF84,C3A10,38012FD00,CF622,38012FD00,D7661,68412FD00,D7A59,38012FC57,D80A1,38012FB59,D89E4,288143634,D4CB5,8C14CB5C,DA601,184187FE4,B859F,1841828C1,B620B,3801780DF,B43A6,380173E18,B5CF1,284143634,D4CB5,188118845,F3CCD,8C11E056,F11B0,380126CCE,EC7EC,380126CCE,F7408,684126CCE,100878,3801197CF,108B4C,380112EA4,1025A2,28410E28F,FDBD5,380110B0A,F7CE1,380118845,F3CCD,288124D0E,C824D,8C11FA0F,C4E99,380110945,BCF61,380110945,B8899,684110945,B1C7C,38011DEAB,B1BBE,380128051,B9EC2,684132740,C260F,3801336B5,D0DE3,380124D0E,C824D,28813F365,D937B,8C14343A,D937B,38014343B,DEEC3,38013F365,DEEC3,68413B36C,DEEC3,38013B36D,D937B,38013F365,D937B,288" End Sub Sub Test2() ReCreateCurve "37:13A8E9,1068FF,8C143E11,10C24B,18417F299,EA1E9,184179B76,E7E55,38016F394,E5FF0,38016B0CD,E793B,28413A8E9,1068FF,188126E0E,10A62E,8C16B4C5,135123,18416EE32,136602,38017A36B,133FF3,38017F299,131FDB,284174C4D,12BF55,38013602B,106DFD,38013072F,104CE2,684124681,100533,380133E6E,F733F,380122A41,E8D68,68410E087,D7AFF,380F4613,E666E,38010D7EB,F61BC,684116C14,FBE64,380127932,103E33,380126E0E,10A62E,28813357C,115C69,8C12ACE5,110911,18411EE58,117BEB,38012CC47,113885,380111619,11F884,684F9E3C,129D35,380103A98,13AA6F,38010FAFA,13AA6F,6841193F8,13AA6F,38012254B,133520,38012254B,129F34,68412254B,11DAFE,38011E931,121A10,38013357C,115C69,288" ReCreateCurve "26:13661A,10AFC5,8C13A6EF,10AFC5,38013A6F0,110B0D,38013661A,110B0D,684132621,110B0D,380132622,10AFC5,38013661A,10AFC5,28810FAFA,125917,8C11530B,122DFA,38011DF83,11E436,38011DF83,129052,68411DF83,136C61,380107BFA,13B5BB,380107BFA,12EC98,684107BFA,12B5B1,38010A64F,12846A,38010FAFA,125917,28811BFC3,F9E97,8C116CC4,F6AE3,380107BFA,EEBAB,380107BFA,EA4E3,684107BFA,DEEF0,380126E0E,E8B6C,380126E0E,F8672,684126E0E,FF2DD,38012096D,FCA99,38011BFC3,F9E97,288" End Sub 
#3




Hi Jeff,
Each one of these curves is a shape. Just add them to a ShapeRange then use the Combine method when you are done. I do this in DragonCNC to recreate CorelDRAW shapes from LINE / ARC lists that I have done operations on with the computational geometry library I use. James 
#4




Quote:
This makes the most sense for this case. BTW, I've been sending some people your way for the DXF tool. We chatted about it in the very early at days of macromonster.com.. maybe the time is right for us to sell some for you from our site as well as your existing outlets? 
#5




Quote:
James 
#6




Error 9 while executing Recreatecurve
While recreating curve (Malphabet) i get error 9.
Can you suggest the workaround. 
#7




Create M
I was successful in creating the M with the following code:
Code:
Sub CreateM() ReCreateCurve "56:13E452,C207F,8C13E63A,C23F0,38013EA5D,C263F,38013EE46,C27A9,28413F4C7," & _ "C2A6D,18413F16C,C27A9,18413EA5C,C217C,38013E74B,C154A,38013E891,C06A9,284" & _ "13EAB1,BF5BE,38013F4D6,BF7BC,38013FC21,C0025,284140629,C0E11,380140FF5," & _ "C1C2D,380141984,C2A6D,2841428DF,C4155,3801432FC,C51B9,380143930,C5AC6,284" & _ "143FE2,C6439,380144192,C6579,380144298,C5572,2841443C5,C4281,380144492,C1C46,380" & _ "144705,C1C13,284144A83,C1BCF,380145AE6,C391A,380146563,C4722,284146A58,C4DC0,380" & _ "14726C,C4CC6,380147342,C4519,2841475CA,C3241,3801475A5,C1F07,380147645,C0C24,284" & _ "1472B1,C0A2E,380146EB9,C08DF,380146B25,C06EA,284146B83,C1B9D,380146C3E,C39C7,380" & _ "146561,C3D66,284145EC5,C40B8,3801442F0,C0862,380143D65,C070C,284143A4C,C0903,380" & _ "1439F8,C4884,38014356E,C4C05,284143154,C4E1A,380141B95,C2A6D,3801419D0,C27A9,284" & _ "1411A1,C1ADD,380140986,C0E02,3801400FE,C0170,28413F716,BF24C,38013E7A1,BEDA5,380" & _ "13E02C,BF571,28413DAFD,BFADE,38013DC25,C11BF,38013E452,C207F,288" End Sub Shelby 
#8




when i tried the code for M i get error 13 type mismatch.
The m i am trying is more complicated the M, the cdr file is attached 
#10




Thanx Shelby,
the code are working. the fault, i trying to get the copied code of clipboard through INPUTBOX which was not taking the whole string. 
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)  
Thread Tools  Search this Thread 
Display Modes  


Similar Threads  
Thread  Thread Starter  Forum  Replies  Last Post 
Simple Bar code generator  Webster  Code Critique  2  06092010 01:41 
HOWTO call coreldraw12 find dialog from VBA code????  wOxxOm  CorelDRAW/Corel DESIGNER VBA  4  02032008 08:32 
Howto uniquely identify a shape in VBA code  jemmyell  CorelDRAW/Corel DESIGNER VBA  9  11022005 21:05 
Text ENCODE  Craig Tucker  CorelDRAW/Corel DESIGNER VBA  10  26012005 13:59 
How can I extract a piece of a bitmap object using VBA code  oswaldon  Corel PhotoPaint VBA  2  25042004 19:37 