图形对象控制点到图表数据的转换

kgdwxl001

将在图表对象上绘制的多边形控制点转换成图表内对应的数据点，我写了一个VB宏，但是转换的点与实际的多边形始终有一点差距，不明白原因，望高手赐教呀！！！


代码
Sub macwu1()
Dim sht1, sht2, sht3 As ChartArea
Dim sht As Chart
Dim oform As Shape
Dim num, i, j As Integer
Dim Points(5000, 2) As Double
Dim xst, xed, yst, yed As Double
Dim ShapeTop, ShapeLeft, ShapeWidth, ShapeHeight As Double
Dim xmin, xmax, ymin, ymax As Double
Dim xmin1, xmax1, ymin1, ymax1 As Double
Dim shxmin, shxmax, shymin, shymax As Double



Dim cleft, ctop, cheight, cwidth As Integer

'获得绘图区边界及几何大小


Sheets("数据编辑").Select

cleft = ActiveChart.PlotArea.Left
ctop = ActiveChart.PlotArea.Top
cheight = ActiveChart.PlotArea.Height
cwidth = ActiveChart.PlotArea.Width

'获得坐标最大最小值

xmin = ActiveChart.Axes(xlCategory).MinimumScale
xmax = ActiveChart.Axes(xlCategory).MaximumScale
ymin = ActiveChart.Axes(xlValue).MinimumScale
ymax = ActiveChart.Axes(xlValue).MaximumScale

'取相反数是为了和屏幕坐标系统一致
  ymin1 = -ymax
  ymax1 = -ymin

  
'获得多边形坐标

ActiveChart.Shapes("Freeform 1").Select
  ct = Selection.Vertices
  
num = ActiveChart.Shapes("Freeform 1").ConnectionSiteCount

ShapeTop = ActiveChart.Shapes("Freeform 1").Top
ShapeLeft = ActiveChart.Shapes("Freeform 1").Left
ShapeWidth = ActiveChart.Shapes("freeform 1").Width
ShapeHeight = ActiveChart.Shapes("freeform 1").Height

shxmin = 100000000000#
shxmax = -100000000000#
shymin = 100000000000#
shymax = -100000000000#


For i = 1 To num - 1
   Points(i, 1) = ct(i, 1)
   If (Points(i, 1) > shxmax) Then
     shxmax = Points(i, 1)
   End If
   If (Points(i, 1) < shxmin) Then
     shxmin = Points(i, 1)
   End If
   
   Points(i, 2) = ct(i, 2)
   If (Points(i, 2) > shymax) Then
     shymax = Points(i, 2)
   End If
   If (Points(i, 2) < shymin) Then
     shymin = Points(i, 2)
   End If
Next i


  For i = 1 To num - 1
   Worksheets("数据").Cells(i, 8) = Points(i, 1)
   Worksheets("数据").Cells(i, 9) = Points(i, 2)
  Next i

'归一化

For i = 1 To num - 1
   Points(i, 1) = (Points(i, 1) - shxmin) / (shxmax - shxmin)
   Points(i, 1) = ShapeLeft - cleft + Points(i, 1) * ShapeWidth
   Points(i, 1) = xmin + (Points(i, 1) - cleft) * (xmax - xmin) / cwidth
   'Points(i, 1) = xmin + Points(i, 1) * (xmax - xmin) / cwidth
   
   Points(i, 2) = (Points(i, 2) - shymin) / (shymax - shymin)
   Points(i, 2) = ShapeTop + Points(i, 2) * ShapeHeight
   Points(i, 2) = ymin1 + (Points(i, 2) - ctop) * (ymax1 - ymin1) / cheight

   'Points(i, 2) = -60#
Next i

For i = 1 To 10000
    Worksheets("数据").Cells(i, 10) = ""
    Worksheets("数据").Cells(i, 11) = ""
Next i
  For i = 1 To num - 1
   Worksheets("数据").Cells(i, 10) = Points(i, 1)
   Worksheets("数据").Cells(i, 11) = -Points(i, 2)
  Next i
'未完………………
End Sub

dul

Excel在尺寸位置的计算上是非常麻烦的事，Ms并未公布具体细节 图表中和单元格上的尺寸计算是有出入的
这个问题很烦的

single_star

转换的点要依显示比例的不同乘上不同的修正系数，100%显示比例要除以0.75,
其他的可以自行用VBA抓点坐标来判定，可参考以下帖8楼Chart7-4范例。。。
http://club.excelhome.net/viewth ... p;page=1#pid3747464

‘*******部分代码参考如下(x2,y2为点x,y转换后的值）
Private Sub myChartClass_Mousedown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)   
    Dim lElementID As Long
    Dim lArg1      As Long
    Dim lArg2      As Long
    Set pa = myChartClass.PlotArea   
    w0 = pa.InsideLeft
    h0 = pa.InsideTop
    w1 = pa.InsideWidth
    h1 = pa.InsideHeight
    x0 = w0 / 0.75
    y0 = h0 / 0.75
    x1 = x0 + w1 / 0.75
    y1 = y0 + h1 / 0.75
    w2 = w1 / 0.75
    h2 = h1 / 0.75
    xd1 = myChartClass.Axes(xlCategory).MinimumScale
    xd2 = myChartClass.Axes(xlCategory).MaximumScale
    yd1 = myChartClass.Axes(xlValue).MinimumScale
    yd2 = myChartClass.Axes(xlValue).MaximumScale
    '***********************************************************
    myChartClass.GetChartElement x, y, lElementID, lArg1, lArg2
    If x >= x0 And x <= x1 And y >= y0 And y <= y1 Then
    x2 = (x - x0) / w2 * (xd2 - xd1) + xd1
    y2 = yd2 - (y - y0) / h2 * (yd2 - yd1)
    n0 = Evaluate(ActiveWorkbook.Names("n").RefersTo)
    st = Evaluate(ActiveWorkbook.Names("st").RefersTo)
    If Button = 1 Then
    '*****************************
    If lElementID = 3 Then
    x3 = myChartClass.SeriesCollection(lArg1).XValues
    y3 = myChartClass.SeriesCollection(lArg1).Values
    x2 = x3(lArg2)
    y2 = y3(lArg2)
      
    End If
   
   
    With ActiveSheet
        .Cells(st + 1, 1).Value2 = x2
        .Cells(st + 1, 2).Value2 = y2
        .Cells(1, 3) = st + 1
    End With
   
    End If
    If Button = 2 And n0 > 0 Then
      If ActiveSheet.Cells(st, 1) > 0 Then
       myChartClass.SeriesCollection(1).Points(1).Select
       ActiveSheet.Cells(st, 1).ClearContents
       ActiveSheet.Cells(st, 2).ClearContents
       ActiveSheet.Cells(1, 3) = st - 1
      End If
    End If
    End If
   
     Application.SendKeys ("{ESC}")
End Sub

[ 本帖最后由 single_star 于 2010-10-22 10:21 编辑 ]

aoe1981

single_star 发表于 2010-10-22 06:26
转换的点要依显示比例的不同乘上不同的修正系数，100%显示比例要除以0.75,
其他的可以自行用VBA抓点坐标来 ...

从这段代码中学习到了：
“该属性与 Value 属性的唯一区别是：Value2 属性不使用 Currency 和 Date 数据类型。可以通过使用 Double 数据类型，以浮点数形式返回这些数据类型格式的数值。”

标记下。

aoe1981

single_star 发表于 2010-10-22 06:26
转换的点要依显示比例的不同乘上不同的修正系数，100%显示比例要除以0.75,
其他的可以自行用VBA抓点坐标来 ...

从这段代码中学习到了：
“该属性与 Value 属性的唯一区别是：Value2 属性不使用 Currency 和 Date 数据类型。可以通过使用 Double 数据类型，以浮点数形式返回这些数据类型格式的数值。”

标记下。

aoe1981

从上楼代码中学习到了：
“该属性与 Value 属性的唯一区别是：Value2 属性不使用 Currency 和 Date 数据类型。可以通过使用 Double 数据类型，以浮点数形式返回这些数据类型格式的数值。”

标记下。