获取直线坐标

zh_xwyg · 发表于 2020-2-29 21:24

在EXCEL内已经存在一条直线，要求通过获取直线的端点坐标，用shape方法可获取到对象的左、顶、宽、高，着实际上是一个矩形的四个顶点坐标，可以组成两条直线（直线(x1,y1)-(x2,y2) 和直线（x1,y2)-(x2,y1))，怎么获取真正的直线坐标？有一个想法是分别对四个点所在位置的屏幕颜色进行计算，找出两点颜色相同的就是要求的直线顶点坐标，但是，计算屏幕颜色涉及到坐标换算，现在请教各位大大，该怎么写VBA,或者更好的确定方法

zzj198237 · 发表于 2020-2-29 22:18

sub test()
Sheet1.Shapes(X).Top (顶位置)
Sheet1.Shapes(X).Left (左边位置)
Sheet1.Shapes(X).Width (宽度)
Sheet1.Shapes(X).Height (高度)
Sheet1.Shapes(X).Line.ForeColor.RGB (颜色)
end sub

复制代码

蓝桥玄霜 · 发表于 2020-3-1 08:56

shape直线只能得到一个矩形范围，可以是2条对角线。
端点确实难确定。不知谁对此有高见。

zopey · 发表于 2020-3-1 15:08

如何准确定位 shape图形的屏幕坐标？
1、GetPPI()函数用于获取显示硬件的PPI值，它是固定不变的；
2、shape图形的 .Left和.Top的值都是point(磅)，而不是像素，用GetPPI()函数转换为像素值；
3、ActiveWindow.PointsToScreenPixelsX(0)和ActiveWindow.PointsToScreenPixelsY(0) 返回的值是最左上角单元格的left和top的像素值，
它的参数为0时，可以获取单元格"A1"的左/上的屏幕像素坐标，
非0参数，只是得到"A1"单元格的左/上屏幕像素坐标与这个非0参数的和，并得不到指定单元格左/上的屏幕像素坐标。
以上观点、部分代码引用大灰狼1976 、overu88等。

以下是实践，未做更多测试。

识别直线方向.rar (19.8 KB, 下载次数: 9)

zopey · 发表于 2020-3-1 15:13

Sub 按钮1_Click()
Dim hDC As Long, junk, Px, Py, PPI
hDC = GetDC(0)
PPI = GetPPI
Px = ActiveWindow.PointsToScreenPixelsX(0)
Py = ActiveWindow.PointsToScreenPixelsY(0)
For Each shp In ActiveSheet.Shapes
If shp.Type = msoLine Then
With shp
l = .Left / 72 * PPI
t = .Top / 72 * PPI
h = .Height / 72 * PPI
w = .Width / 72 * PPI
temp = GetPixel(hDC, Px + l + w / 2, Py + t + h / 2)
temp1 = GetPixel(hDC, Px + l + w / 4, Py + t + h / 4)
temp2 = GetPixel(hDC, Px + l + w / 4, Py + t + h * 3 / 4)
'junk = SetCursorPos(Px + l + w / 4, Py + t + h * 3 / 4)
End With
Exit For
End If
Next
junk = ReleaseDC(0, hDC)
If temp1 = temp Then
If temp2 = temp Then MsgBox "水平或垂直" Else MsgBox "左上右下"
ElseIf temp2 = temp Then
MsgBox "左下右上"
Else
MsgBox "识别方向失败"
End If
End Sub

复制代码

cui26896 · 发表于 2020-3-1 17:06

受教了！谢谢zopey!

蓝桥玄霜 · 发表于 2020-3-1 19:57

对于粗线条可以识别，对细线条则不能。

zopey · 发表于 2020-3-1 20:32

笨办法是线条宽度先加粗上色，再复原。

zh_xwyg · 发表于 2020-3-12 11:34

非常感谢各位热心的帮助

		自动登录	找回密码
密码			免费注册

[求助] 获取直线坐标

评分

最新热点 /1