• CorelDRAW X4 VBA自动闭合曲线 分享


    此程序用于自动闭合曲线,相邻两点自动连接,应用此程序时,需要注意以下两点:
    ①将所要自动闭合的曲线“组合”(Ctrl+L),不是群组(Ctrl+G);
    ②组合的曲线中没有杂点、单线,如从CAD或AI中导过来的图形,需仔细检查。
    ③如上面两点没处理好,将导致程序处理缓慢,甚至假死。
    ④如有高人能将此程序加上几句以处理以上问题,再好不过了。

    Sub CloseShape() '自动闭合曲线

     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 For

      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
  • 相关阅读:
    URAL 2014 Zhenya moves from parents 线段树
    git 安装及命令
    在eclipse中执行sql
    在eclipse中配置server和database
    java的regex问题笔记
    在开发中写一些tool来提升自己的效率
    在Eclipse中给JRE-Library添加本地Javadoc
    利用eclipse中的各种功能帮助你理解代码
    Eclipse中直接操作本地文件系统
    form action中如何填写相对目录
  • 原文地址:https://www.cnblogs.com/top5/p/1591544.html
Copyright © 2020-2023  润新知