存心CDR VBA插件详解系列03全面解析小顺自动角线

存心 · 发表于 2016-6-20 12:23:45

插件的窗体界面

这是编辑工具下插件的显示

小顺除了会装逼，还会编写角线插件，特别是这一次的CDR VBA角线插件，我对些非常感兴趣，也特别感谢小顺不厌其烦的解答与帮助，才能全面的理解他的插件
这是插件界面按钮下的代码以及详细解析：
[mw_shl_code=vb,true]Private Sub CommandButton1_Click()
'自动角线
jiaoxian_changdu = TextBox3.Value  '角线长度
jiaoxian_pianyi = TextBox2.Value  '角线偏移
jiaoxian_miaobian = TextBox4.Value '角线描边
jiaoxian_chuxue = TextBox1.Value  '角线出血
huoquzuobiao (1)
End Sub[/mw_shl_code]
这是模块下的代码以及详细解析：
[mw_shl_code=vb,true]Private Type xuanzewAIkuang '自定义类型函数
zuobian As Double
youbian As Double
dingbian As Double
dibian As Double
End Type

Public xuanzewaikuang As xuanzewaikuang '定义各种变量
Public jiaoxian_changdu As Double
Public jiaoxian_pianyi As Double
Public jiaoxian_miaobian As Double
Public jiaoxian_chuxue As Double

Public Function paixu_xiaodaoda(Arr) '选择排序法，按递增的方式排序
Dim i, j
Dim bound, t
bound = UBound(Arr)

For i = 1 To bound - 1
      For j = i + 1 To bound
         If Arr(i) > Arr(j) Then
            t = Arr(i)
            Arr(i) = Arr(j)
            Arr(j) = t
         End If
      Next
Next
paixu_xiaodaoda = Arr
End Function

Public Function huoquzuobiao(canshu)

ActiveDocument.Unit = cdrMillimeter '定义当前文档单位为毫米
Dim duixiang_dangqianxuanzhong As ShapeRange '定义duixiang_dangqianxuanzhong为选择范围类型
Set duixiang_dangqianxuanzhong = ActiveSelectionRange '让当前的选择范围赋值给duixiang_dangqianxuanzhong

Dim shuzu_zuoyou() As Double '定义双精度类型动态数组,数组名为：shuzu_zuoyou()
Dim shuzu_shangxia() As Double '定义双精度类型动态数组，数组名为shuzu_shangxia()

ReDim shuzu_zuoyou(ActiveSelectionRange.Count * 2) '重新定义动态数组的个数，为什么*2，那是因为每个框，都有左右两个坐标
ReDim shuzu_shangxia(ActiveSelectionRange.Count * 2) '重新定义动态数组的个数，为什么*2，那是因为每个框，都有上下两个坐标

Dim jilu_zuoyou As Integer '定义jilu_zuoyou为整型
Dim jilu_shangxia As Integer '定义jilu_shangxia为整型
jilu_zuoyou = 1 '为jilu_zuoyou赋值初始值
jilu_shangxia = 1 '为jilu_shangxia赋值初始值

'自定义类型xuanzewaikuang各个值的极限范围
xuanzewaikuang.zuobian = 99999
xuanzewaikuang.youbian = -99999
xuanzewaikuang.dingbian = -99999
xuanzewaikuang.dibian = 99999

'通过FOR循环语句实现数组的输入

For i = 1 To ActiveSelectionRange.Count '从1到所选数量的循环

shuzu_zuoyou(jilu_zuoyou) = ActiveSelectionRange(i).LeftX '将所选左坐标赋值给数组
shuzu_zuoyou(jilu_zuoyou + 1) = ActiveSelectionRange(i).RightX  '将所选右坐标赋值给数组
jilu_zuoyou = jilu_zuoyou + 2 '计次

shuzu_shangxia(jilu_shangxia) = ActiveSelectionRange(i).TopY '将所选上坐标赋值给数组
shuzu_shangxia(jilu_shangxia + 1) = ActiveSelectionRange(i).BottomY '将所选下坐标赋值给数组
jilu_shangxia = jilu_shangxia + 2 '计次

If ActiveSelectionRange(i).LeftX < xuanzewaikuang.zuobian Then
xuanzewaikuang.zuobian = ActiveSelectionRange(i).LeftX
End If
'判断最左坐标
If ActiveSelectionRange(i).RightX > xuanzewaikuang.youbian Then
xuanzewaikuang.youbian = ActiveSelectionRange(i).RightX
End If
'判断最右坐标
If ActiveSelectionRange(i).TopY > xuanzewaikuang.dingbian Then
xuanzewaikuang.dingbian = ActiveSelectionRange(i).TopY
End If
'判断最上坐标
If ActiveSelectionRange(i).BottomY < xuanzewaikuang.dibian Then
xuanzewaikuang.dibian = ActiveSelectionRange(i).BottomY
End If
'判断最下坐标

Next

shuzu_zuoyou = paixu_xiaodaoda(shuzu_zuoyou)  '进入排序，按递增
shuzu_shangxia = paixu_xiaodaoda(shuzu_shangxia) '进入排序，按递增

huaxian_zuoyou (shuzu_shangxia) '进入画角线
huaxian_shangxia (shuzu_zuoyou) '进入画角线

End Function

Public Function huaxian_zuoyou(shuzu)
ActiveDocument.Unit = cdrMillimeter

Set crv = Application.CreateCurve(ActiveDocument) '内存创建一条路径
Dim linshishu As Double
linshishu = 17268.7578

For i = 1 To UBound(shuzu) '画线循环

If Abs(linshishu - shuzu(i)) > 0.1 Then
Set spath = crv.CreateSubPath(xuanzewaikuang.zuobian - jiaoxian_pianyi, shuzu(i))  ' 指定路径起始点的xy坐标
spath.AppendLineSegment xuanzewaikuang.zuobian - jiaoxian_pianyi - jiaoxian_changdu, shuzu(i) ' 指定路径结束点的xy坐标
Set spath = crv.CreateSubPath(xuanzewaikuang.youbian + jiaoxian_pianyi, shuzu(i)) ' 指定路径起始点的xy坐标
spath.AppendLineSegment xuanzewaikuang.youbian + jiaoxian_pianyi + jiaoxian_changdu, shuzu(i) ' 指定路径结束点的xy坐标
End If
linshishu = shuzu(i) '临时数赋值，通过排序，过滤掉重复的线
Next

spath.Closed = True
Set sh = ActiveLayer.CreateCurve(crv) '内存路径生成
sh.Outline.Width = jiaoxian_miaobian '线宽赋值
sh.Outline.Color = CreateRegistrationColor '线注册色赋值

End Function

Public Function huaxian_shangxia(shuzu) '道理同上，注释就忽略了
ActiveDocument.Unit = cdrMillimeter

Set crv = Application.CreateCurve(ActiveDocument)
Dim linshishu As Double
linshishu = 17268.7578

For i = 1 To UBound(shuzu)

If Abs(linshishu - shuzu(i)) > 0.1 Then

Set spath = crv.CreateSubPath(shuzu(i), xuanzewaikuang.dingbian + jiaoxian_pianyi)
spath.AppendLineSegment shuzu(i), xuanzewaikuang.dingbian + jiaoxian_pianyi + jiaoxian_changdu
Set spath = crv.CreateSubPath(shuzu(i), xuanzewaikuang.dibian - jiaoxian_pianyi)
spath.AppendLineSegment shuzu(i), xuanzewaikuang.dibian - jiaoxian_pianyi - jiaoxian_changdu
End If
linshishu = shuzu(i)
Next

spath.Closed = True
Set sh = ActiveLayer.CreateCurve(crv)
sh.Outline.Width = jiaoxian_miaobian
sh.Outline.Color = CreateRegistrationColor

End Function[/mw_shl_code]