OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 28-04-2005, 13:05
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,941
Blog Entries: 4
Default 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
This function takes a string which contains the curve information specially encoded. To get this string, use the following macro:

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
So, you just create whatever curve you want in CorelDRAW, then run CopyCurveToClipboard macro. It will get the curve information, encode it into a string and copy the string to clipboard. Now all you need to do is to create a VBA command to call ReCreateCurve function and pass in the string. Here is an example:

Code:
Sub Test()
    ReCreateCurve "3:A9B4C,1200C8,8C|10B354,1200C8,184|D93CC,192008,184|A9B4C,1200C8,188"
End Sub
Creates a nice triangle

I hope this is useful.
Reply With Quote
  #2  
Old 17-04-2009, 01:28
Jeff Harrison
Guest
 
Posts: n/a
Default

Quote:
Originally Posted by Alex View Post

I hope this is useful.
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 auto-combine 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,8C|133A30,DECC7,184|12F1C2,E186F,184|12E4DC,E3F21,380|12B88A,E632E,380|126CCE,E83EC,284|11B99C,ED1F0,380|10BF84,F213F,380|10BF84,FD348,684|10BF84,10F3A4,380|12B296,10B033,380|12B296,F82EA,684|12B296,EBEB4,380|12767C,EFDC6,380|13C2C7,E401F,288|12FB59,D89E4,8C|174210,1034D9,184|177AAE,10496C,380|1830BE,1023A6,380|187FE4,100391,284|17D998,FA30B,380|13ED76,D51B3,380|13947A,D3098,684|12D3CC,CE8E9,380|13CBB9,C56F5,380|12B78C,B711E,284|11CF2F,AAF5A,380|10BF84,AE113,380|10BF84,B8943,684|10BF84,C3A10,380|12FD00,CF622,380|12FD00,D7661,684|12FD00,D7A59,380|12FC57,D80A1,380|12FB59,D89E4,288|143634,D4CB5,8C|14CB5C,DA601,184|187FE4,B859F,184|1828C1,B620B,380|1780DF,B43A6,380|173E18,B5CF1,284|143634,D4CB5,188|118845,F3CCD,8C|11E056,F11B0,380|126CCE,EC7EC,380|126CCE,F7408,684|126CCE,100878,380|1197CF,108B4C,380|112EA4,1025A2,284|10E28F,FDBD5,380|110B0A,F7CE1,380|118845,F3CCD,288|124D0E,C824D,8C|11FA0F,C4E99,380|110945,BCF61,380|110945,B8899,684|110945,B1C7C,380|11DEAB,B1BBE,380|128051,B9EC2,684|132740,C260F,380|1336B5,D0DE3,380|124D0E,C824D,288|13F365,D937B,8C|14343A,D937B,380|14343B,DEEC3,380|13F365,DEEC3,684|13B36C,DEEC3,380|13B36D,D937B,380|13F365,D937B,288"
End Sub

Sub Test2()

ReCreateCurve "37:13A8E9,1068FF,8C|143E11,10C24B,184|17F299,EA1E9,184|179B76,E7E55,380|16F394,E5FF0,380|16B0CD,E793B,284|13A8E9,1068FF,188|126E0E,10A62E,8C|16B4C5,135123,184|16EE32,136602,380|17A36B,133FF3,380|17F299,131FDB,284|174C4D,12BF55,380|13602B,106DFD,380|13072F,104CE2,684|124681,100533,380|133E6E,F733F,380|122A41,E8D68,684|10E087,D7AFF,380|F4613,E666E,380|10D7EB,F61BC,684|116C14,FBE64,380|127932,103E33,380|126E0E,10A62E,288|13357C,115C69,8C|12ACE5,110911,184|11EE58,117BEB,380|12CC47,113885,380|111619,11F884,684|F9E3C,129D35,380|103A98,13AA6F,380|10FAFA,13AA6F,684|1193F8,13AA6F,380|12254B,133520,380|12254B,129F34,684|12254B,11DAFE,380|11E931,121A10,380|13357C,115C69,288"
 ReCreateCurve "26:13661A,10AFC5,8C|13A6EF,10AFC5,380|13A6F0,110B0D,380|13661A,110B0D,684|132621,110B0D,380|132622,10AFC5,380|13661A,10AFC5,288|10FAFA,125917,8C|11530B,122DFA,380|11DF83,11E436,380|11DF83,129052,684|11DF83,136C61,380|107BFA,13B5BB,380|107BFA,12EC98,684|107BFA,12B5B1,380|10A64F,12846A,380|10FAFA,125917,288|11BFC3,F9E97,8C|116CC4,F6AE3,380|107BFA,EEBAB,380|107BFA,EA4E3,684|107BFA,DEEF0,380|126E0E,E8B6C,380|126E0E,F8672,684|126E0E,FF2DD,380|12096D,FCA99,380|11BFC3,F9E97,288"
    
End Sub
Reply With Quote
  #3  
Old 17-04-2009, 10:07
jemmyell jemmyell is offline
Senior Member
 
Join Date: Jan 2005
Location: Orange County, California, USA, Earth, Solar System, Milky Way Galaxy
Posts: 157
Default

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
__________________
-James Leonard
CNC Inlay Guy - www.CorelDRAWCadCam.com
Reply With Quote
  #4  
Old 19-04-2009, 17:04
Jeff Harrison
Guest
 
Posts: n/a
Default

Quote:
Originally Posted by jemmyell View Post
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
hi James,

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?
Reply With Quote
  #5  
Old 20-04-2009, 10:48
jemmyell jemmyell is offline
Senior Member
 
Join Date: Jan 2005
Location: Orange County, California, USA, Earth, Solar System, Milky Way Galaxy
Posts: 157
Default

Quote:
Originally Posted by Jeff Harrison View Post
hi James,

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?
Jeff, I will contact you at MacroMonster.

-James
__________________
-James Leonard
CNC Inlay Guy - www.CorelDRAWCadCam.com
Reply With Quote
  #6  
Old 03-05-2009, 13:49
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 164
Default Error 9 while executing Recreatecurve

While recreating curve (M-alphabet) i get error 9.
Can you suggest the workaround.
Attached Files
File Type: cdr m.cdr (15.3 KB, 1077 views)
Reply With Quote
  #7  
Old 03-05-2009, 14:39
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,791
Blog Entries: 15
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Create M

I was successful in creating the M with the following code:
Code:
Sub CreateM()
    ReCreateCurve "56:13E452,C207F,8C|13E63A,C23F0,380|13EA5D,C263F,380|13EE46,C27A9,284|13F4C7," & _
                  "C2A6D,184|13F16C,C27A9,184|13EA5C,C217C,380|13E74B,C154A,380|13E891,C06A9,284" & _
                  "|13EAB1,BF5BE,380|13F4D6,BF7BC,380|13FC21,C0025,284|140629,C0E11,380|140FF5," & _
                  "C1C2D,380|141984,C2A6D,284|1428DF,C4155,380|1432FC,C51B9,380|143930,C5AC6,284|" & _
                  "143FE2,C6439,380|144192,C6579,380|144298,C5572,284|1443C5,C4281,380|144492,C1C46,380" & _
                  "|144705,C1C13,284|144A83,C1BCF,380|145AE6,C391A,380|146563,C4722,284|146A58,C4DC0,380" & _
                  "|14726C,C4CC6,380|147342,C4519,284|1475CA,C3241,380|1475A5,C1F07,380|147645,C0C24,284|" & _
                  "1472B1,C0A2E,380|146EB9,C08DF,380|146B25,C06EA,284|146B83,C1B9D,380|146C3E,C39C7,380|" & _
                  "146561,C3D66,284|145EC5,C40B8,380|1442F0,C0862,380|143D65,C070C,284|143A4C,C0903,380|" & _
                  "1439F8,C4884,380|14356E,C4C05,284|143154,C4E1A,380|141B95,C2A6D,380|1419D0,C27A9,284|" & _
                  "1411A1,C1ADD,380|140986,C0E02,380|1400FE,C0170,284|13F716,BF24C,380|13E7A1,BEDA5,380|" & _
                  "13E02C,BF571,284|13DAFD,BFADE,380|13DC25,C11BF,380|13E452,C207F,288"
End Sub
Best of luck,

-Shelby
Reply With Quote
  #8  
Old 03-05-2009, 14:54
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 164
Default

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
Reply With Quote
  #9  
Old 03-05-2009, 15:03
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,791
Blog Entries: 15
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default M

I used the M in your attached CDR to create the code. It should recreate the exact M in your document.

-Shelby
Reply With Quote
  #10  
Old 06-05-2009, 13:29
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 164
Default

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.
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Simple Bar code generator Webster Code Critique 2 06-09-2010 01:41
HOW-TO call coreldraw12 find dialog from VBA code???? wOxxOm CorelDRAW/Corel DESIGNER VBA 4 02-03-2008 08:32
Howto uniquely identify a shape in VBA code jemmyell CorelDRAW/Corel DESIGNER VBA 9 11-02-2005 21:05
Text ENCODE Craig Tucker CorelDRAW/Corel DESIGNER VBA 10 26-01-2005 13:59
How can I extract a piece of a bitmap object using VBA code oswaldon Corel Photo-Paint VBA 2 25-04-2004 19:37


All times are GMT -5. The time now is 00:26.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2023, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com