[第110期] 将在散点图范围内的自由曲线转化为散点图[已开贴评分]

lee1892

题目内容：

如上图动画演示的，将在散点图范围内的自由曲线转化为散点图的数据，使得这些曲线完整、重合的显示在散点图内。

答题要求：
请下载附件，并添加代码完成题目，再麻烦传附件上来，Excel 文件最好是2003格式的，文件名请改为如下格式：Lee1892_转化自由曲线至散点图.xls


评分规则：
1、比例一致，仅有少许平移偏差，1分
2、如动画能够基本重合的，加1分
3、严格重合，加1分

提示：
这题比较简单哈，熟悉图表操作、文件内形状信息获得、定位之类的。

是否参与评论：
可以参与

参考答案：
另加~

qy1219no2

楼主没有说清楚，如果Chart移动位置后，所画出的图形与形状是否仍然保持重合。
我的附件是：在形状图形不动的情况下，不管怎样移动Chart，或者改变Chart大小，所画出的图形均与形状保持重合。
不知道是否符合题意？

看来2003和2007还是有一些差距，当时没有考虑版本的问题，另外，通过2003也发现原来的计算还是存在一个漏洞，即没有考虑绘图区与图表区的边界因素（及PlotArea.Left/Top)
并且，也发现，在没有坐标轴的情况下，绘图区的最上（Top）和最左（Left）可以达到-4磅，这些都在此次附件中予以修正，请测试。
楼主，最新附件已修改为2003版合法代码，11月24日晚16:00上传，请重新下载，谢谢！

lee1893

Delete没有锁贴？

~~
我还没下过，目前为止有2个人下过2楼附件了

aoe1981

　　大侠，这是我做的，您审阅：
　　图如下：

　　代码如下：

1. Option Explicit
   
2. 
   
3. Private Sub cmdClear_Click()
   
4. Range("a2:b" & Rows.Count) = ""
   
5. End Sub
   
6. 
   
7. Private Sub cmdDrawCurve_Click()
   
8. Dim shp As Shape, i&, m&, n&, zbx#, zby#, zb()
   
9. m = 0
   
10. With Sheet1.Shapes("Chart 1").Chart
    
11.     .Axes(xlCategory).MinimumScale = 0
    
12.     .Axes(xlValue).MinimumScale = 0
    
13.     .Axes(xlValue).ReversePlotOrder = True
    
14.     .Axes(xlCategory).MaximumScale = .PlotArea.Width
    
15.     .Axes(xlValue).MaximumScale = .PlotArea.Height
    
16.     zbx = .PlotArea.Left + Sheet1.Shapes("Chart 1").Left + 3
    
17.     zby = .PlotArea.Top + Sheet1.Shapes("Chart 1").Top + 3
    
18. End With
    
19. For Each shp In Sheet1.Shapes
    
20.     If shp.Type = msoFreeform Then
    
21.         n = shp.Nodes.Count
    
22.         ReDim Preserve zb(1 To 2, 1 To n + m)
    
23.         For i = 1 To n
    
24.             zb(1, i + m) = shp.Nodes(i).Points(1, 1) - zbx
    
25.             zb(2, i + m) = shp.Nodes(i).Points(1, 2) - zby
    
26.         Next i
    
27.         m = m + n + 1
    
28.     End If
    
29. Next shp
    
30. Range("a2").Resize(m - 1, 2) = WorksheetFunction.Transpose(zb)
    
31. End Sub
    

复制代码

　　附件如下：
　　
　　我的文件格式是2003，但是在2010中编辑，在2003中运行效果目前未测试，2010中正常。


　　在2003中录制、测试了半天，传一个2003版的：
　　

sevenstar

比葫芦画瓢做一个，呵呵

wcymiss

不晓得能符合题意不：

jsxjd

增加了捕捉直线的功能，参数 NumberOfPoints 可调

效果如下：

lee1892

此题参考答案：

效果如下：


题目本意是要测试如下知识点：
1）Chart 对象的属性的了解，包括Chart对象中的PlotArea对象的属性值
2）Shapes对象的属性的了解，主要是 Type 为 msoFreeform 的自由曲线 的 Vertices 属性 及其 含义
3）表中对象的定位与散点图坐标的换算
4）贝塞尔三次样条曲线插值计算方法

题目的做法：

1、由自由曲线的 Vertices 属性的帮助文件 可以了解到：该属性返回一组坐标对，表示了图形对象的顶点（以及贝塞尔曲线的控制点）的坐标。实际上，对于自由曲线，该组坐标的点为曲线顶点和两个顶点间的三次贝塞尔曲线的两个控制点。所以，实际顶点的数量为 (N - 1) / 3 + 1 个，N 为坐标对数量。间隔其中的为贝塞尔曲线控制点。

2、ChartObject -> Chart -> PlotArea ，这一组对象的左上角定位决定了散点图显示范围的左上角在表中的定位，而 PlotArea 的高和宽与散点图的横纵坐标的最大最小值决定了表中定位单位与散点图坐标单位的比例。此题鼓励采用单位比例换算，而不是直接修改散点图的坐标最大最小值，是因为考虑到在实际应用中散点图会有其它数据显示。另外需要注意的是对于 PlotArea 对象，需要使用 InsideTop、InsideLeft、InsideHeight、InsideWidth 这一系列属性，以排除坐标轴的干扰。

3、对经过单位换算的实际顶点进行三次贝塞尔插值计算，插值点数量在5~8个就可以使得散点图中的曲线很好的符合自由曲线了。

附件中的三次贝塞尔插值计算的代码参考的是 中文Wiki

lsdongjh

alzbz

有意思。