将底图图片导入CorelDraw中，在页面左下角拖放两条辅助线（操作前打开各种捕捉，可以准确贴齐页边缘）如图。

将导入的图片的坐标左下角移动到页面左下角（移动前要打开贴齐辅助线）

在图的上边框和有边框（也可以是已知刻度的位置），也拖放辅助线，如图

测量横轴距离和纵轴距离，使用左侧工具中的平行度量工具，如图：。操作过程中要捕捉辅助线交点。此处横轴距离15.401cm，纵轴距离10.830cm，单位是cm，测的是mm。

记录图的左下角坐标为横轴15.5，纵轴15.0，横轴辅助线间坐标距离19.0-15.5=3.5，纵轴距离为15.8-15.0=0.8。如图

测量完毕后，开始描绘底图上的线，如图。

加载CorelKits.gms宏插件（加载过程参照百度经验https://jingyan.baidu.com/article/ab0b5630d11cf4805afa7daf.html）。

线选中要获取坐标的线，然后点击右侧工具栏中的“线坐标编程用”工具，在对话框中输入前边计算的数据，然后点击确定，然后选择其他线继续上边的操作。如图：

线坐标存储在了C:\CurveCoordinates.txt，文件打开后如图：

主要函数如下：

Function GetLineCor(Xc As Double, Xt As Double, Yc As Double, Yt As Double, Xz As Double, Yz As Double)

Dim sl As Shape, xSel As ShapeRange

Dim sp As SubPath

Dim seg As Segment

ActiveDocument.Unit = cdrCentimeter

Set xSel = ActiveSelectionRange

If ActiveSelectionRange.Count 1 Or ActiveSelectionRange.Count = 0 Then

MsgBox 请先选中1条曲线。

Exit Function

End If

Dim cS As Long

cS = xSel.Shapes(1).Curve.Segments.Count seg num of curve

Dim Segnum As Long

Segnum = 2 * cS

Dim cur() As Double, cur1() As Double, cur2() As Double

ReDim cur(1 To Segnum, 1 To 2) As Double

ReDim cur1(1 To Segnum, 1 To 2) As Double

ReDim cur2(1 To Segnum, 1 To 2) As Double

Dim jcur() As Double, jcur1() As Double, jcur2() As Double

ReDim jcur(1 To Segnum, 1 To 2) As Double

ReDim jcur1(1 To Segnum, 1 To 2) As Double

ReDim jcur2(1 To Segnum, 1 To 2) As Double

i = 1

For j = 1 To xSel.Shapes(i).Curve.Segments.Count

Js = 2 * j - 1

jcur(Js, 1) = xSel.Shapes(i).Curve.Segments(j).StartNode.PositionX

jcur(Js, 2) = xSel.Shapes(i).Curve.Segments(j).StartNode.PositionY

Os = 2 * j

jcur(Os, 1) = xSel.Shapes(i).Curve.Segments(j).EndNode.PositionX

jcur(Os, 2) = xSel.Shapes(i).Curve.Segments(j).EndNode.PositionY

If xSel.Shapes(i).Curve.Segments(j).Type = 1 Then 线类型，0直线，1曲线

jcur1(Os, 1) = xSel.Shapes(i).Curve.Segments(j).StartingControlPointX

jcur1(Os, 2) = xSel.Shapes(i).Curve.Segments(j).StartingControlPointY

jcur2(Os, 1) = xSel.Shapes(i).Curve.Segments(j).EndingControlPointX

jcur2(Os, 2) = xSel.Shapes(i).Curve.Segments(j).EndingControlPointY

End If

Next j

Dim m As Long

m = 1

cur(1, 1) = jcur(1, 1): cur(1, 2) = jcur(i, 2):

cur1(1, 1) = jcur1(1, 1): cur1(1, 2) = jcur1(1, 2):

cur2(1, 1) = jcur2(1, 1): cur2(1, 2) = jcur2(1, 2):

For i = 2 To Segnum

If i Mod 2 = 0 Then

m = m + 1

cur(m, 1) = jcur(i, 1): cur(m, 2) = jcur(i, 2)

cur1(m, 1) = jcur1(i, 1): cur1(m, 2) = jcur1(i, 2)

cur2(m, 1) = jcur2(i, 1): cur2(m, 2) = jcur2(i, 2)

End If

If i Mod 2 = 1 And jcur(i, 1) jcur(i - 1, 1) And jcur(i, 2) jcur(i - 1, 2) Then

m = m + 1

cur(m, 1) = jcur(i, 1): cur(m, 2) = jcur(i, 2)

cur1(m, 1) = jcur1(i, 1): cur1(m, 2) = jcur1(i, 2)

cur2(m, 1) = jcur2(i, 1): cur2(m, 2) = jcur2(i, 2)

End If

Next i

Xxishu = 15.401 / 3.5 软件测得距离/图片对应距离Xcm

Yxishu = 10.83 / 0.8 软件测得距离/图片对应距离Ycm

xx = 13 左下角坐标X

yy = 15 左下角坐标Y

Dim Xxishu As Double, Yxishu As Double, xx As Double, yy As Double

Xxishu = Xc / Xt 软件测得距离/图片对应距离Xcm

Yxishu = Yc / Yt 软件测得距离/图片对应距离Ycm

xx = Xz 左下角坐标X

yy = Yz 左下角坐标Y

Open c:\CurveCoordinates.txt For Append As #1

For i = 1 To m

Print #1, x( i )= Format(cur(i, 1) / Xxishu + xx, 0.00000) :y( i )= Format(cur(i, 2) / Yxishu + yy, 0.00000)

Next i

Print #1, Set crv = Application.CreateCurve(ActiveDocument)

Print #1, Set sup = crv.CreateSubPath((x(1) - SPmin) * SPxishu, (y(1) - CZmin) * CZxishu)

Print #1, For m = 2 To m

Print #1, sup.AppendCurveSegment (x(m) - SPmin) * SPxishu, (y(m) - CZmin) * CZxishu

Print #1, Next m

Print #1, Set s = ActiveLayer.CreateCurve(crv)

Close #1

MsgBox Its a success to pick up the coordinates. Chr(13) The data is on disk C:\CurveCoordinates.txt

End Function

仅是测试版，欢迎大家一起改进。