CorelDraw (CDR) VBA 实现导出贴图坐标

创作上位机动画时, 喜欢用Corel做画面设计,毕竟不管是亚控还是力控还是wincc,画图都太难受了.

贴图动画要贴准的话, 最好用坐标精确对齐.

所以写了这段代码, 用来把Corel中的坐标写入文本文件, 做上位机画面时, 就可以使用这些坐标进行贴图了.

上代码

 1 Sub Macro1()
 2     Dim 元件树(10) As Variant
 3     Dim 元件类型, i, 层数 As Integer
 4     Dim fso, f
 5     Dim filename As String         '声明文件地址
 6     元件类型 = 0
 7     i = 0
 8     Set 元件树(0) = CorelDRAW.Application.ActiveSelection.Shapes.First
 9     MsgBox 计算坐标(元件树(0))
10     元件类型 = CorelDRAW.Application.ActiveSelection.Shapes.First.Type
11     Do While i <= 10
12         i = i + 1
13         If 元件树(i - 1).TreeNode.IsGroupChild Then
14             Set 元件树(i) = 元件树(i - 1).TreeNode.Parent.Shape
15             元件类型 = 元件树(i).Type
16             'MsgBox 元件树(i).Name + " " + Str(元件树(i).Type)
17         Else
18             i = i - 1
19             Exit Do
20         End If
21     Loop
22     层数 = i + 1
23 
24     
25     filename = "C:\Users\DP\Documents\work\CorelOutput\CorelOutput.txt"
26     Set fso = CreateObject("Scripting.FileSystemObject")
27     Set f = fso.OpenTextFile(filename, 8, True)
28     For i = 0 To 层数 - 1
29         f.Write 计算坐标(元件树(层数 - 1 - i))
30     Next
31     f.Write Chr(13) + Chr(10)
32     f.Close
33     
34     
35 End Sub
36 
37 Function 计算坐标(元件) As String
38     '这是一个特殊项目,画布是7680x3680,实际导出要缩小4倍,此处计算的是导出的图片中,元件的坐标位置
39     '坐标由4组整数组成,由逗号分隔
40     '需要注意的是,Corel中坐标的原点在画布左下角,而在 组态王 中,原点在 左上角, 此函数会对此进行变换
41     'Corel中得到的数都是以英寸为单位的浮点,而设计时是以像素为单位,本项目设定为 300像素/英寸,函数会将英寸换算为像素
42     Dim 输出文本 As String
43     Dim 中心坐标x, 中心坐标y, 宽度, 高度, 左上坐标x, 左上坐标y As Double
44     
45     输出文本 = 元件.Name
46     输出文本 = 输出文本 + Chr(9)
47     中心坐标x = 元件.BoundingBox.CenterX
48     中心坐标y = 元件.BoundingBox.CenterY
49     宽度 = 元件.BoundingBox.Width
50     高度 = 元件.BoundingBox.Height
51     左上坐标x = 中心坐标x - 宽度 / 2
52     左上坐标y = 3680 / 300 - 中心坐标y - 高度 / 2
53     
54     输出文本 = 输出文本 + Str(Round(左上坐标x * 300 / 4)) + "," + Str(Round(左上坐标y * 300 / 4)) + "," + Str(Round(宽度 * 300 / 4)) + "," + Str(Round(高度 * 300 / 4)) + Chr(13) + Chr(10)
55     计算坐标 = 输出文本
56 End Function