CorelDraw X4 VBA auto-closing curve sharing

Source: Internet
Author: User
This Program It is used to automatically close the curve and automatically connect two adjacent points. When using this program, pay attention to the following two points:
① "Combination" (CTRL + l) of the curve to be automatically closed, not a group (CTRL + G );
② There are no miscellaneous or single lines in the combination curve, such as images imported from CAD or AI, which need to be carefully checked.
③ If the above two points are not handled properly, the program may be slow to process or even be suspended.
④ It would be better for someone to add a few words to this program to solve the above problems.

Sub closeshape ()'Automatically close the curve

Dim s as shape

Dim e as double, R as double, NR as double

Dim SP as subpath

Dim sn as node, en as node, N1 as node, N2 as node

Dim B as Boolean

Set S = activeshape

If S. Type <> cdrcurveshape then

Msgbox "curve must be selected"

Exit sub

End if

'E is auto-join limit beyond which the nodes are joined rather than connected

'Here assumed to be 1% of an average object size

E = S. sizeheight * S. sizewidth/10000

Do

Set Sn = nothing

Set en = nothing

Set n1 = nothing

Set n2 = nothing

B = false

For each SP in S. curve. subpaths

If not sp. Closed then

Set n1 = sp. startnode

Set n2 = sp. endnode

Nr = n1.getdistancefrom (N2)

If Nr <E and sp. nodes. Count> 2 then

N1.joinwith N2

B = true

Else

If Sn is nothing then

Set Sn = N1

Set en = n2

R = nR

Else

Nr = Sn. getdistancefrom (N1)

If Nr <r then

Set en = N1

R = nR

End if

Nr = Sn. getdistancefrom (N2)

If Nr <r then

Set en = n2

R = nR

End if

End if

End if

End if

If B then exit

Next sp

If not B and not Sn is nothing then

If r <E then Sn. joinwith en else SN. connectwith en

B = true

End if

Loop while B

End sub

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.