'得到鼠标屏幕坐标

Private Type POINTAPI
    x As Long
    Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Dim CAD_Point1 As Variant
Dim CAD_Point2 As Variant
Dim ScreenPoint1 As POINTAPI
Dim ScreenPoint2(1) As Long
Dim BiLi As Double
'获取CAD坐标系统和屏幕像素的比值
Function ViewScreen() As Double
    Dim ScreenSize As Variant
    ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度
    Dim H As Variant
    H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
    ViewScreen = Abs(H / ScreenSize(1))
End Function
'通过CAD坐标计算屏幕坐标
Sub GetScreenPoint()

    BiLi = ViewScreen
    CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
    ThisDrawing.ModelSpace.AddPoint CAD_Point1
    GetCursorPos ScreenPoint1   '通过api直接获得鼠标所在位置的屏幕坐标
    MsgBox "屏幕坐标：" & ScreenPoint1.x & " / " & ScreenPoint1.Y
    MsgBox "对应的CAD坐标：" & CAD_Point1(0) & " / " & CAD_Point1(1)
    '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了
    
    CAD_Point2 = ThisDrawing.Utility.GetPoint(CAD_Point1, "指定下一点,这个点将通过计算得到屏幕坐标:")
    
    ScreenPoint2(0) = Int(ScreenPoint1.x + (CAD_Point2(0) - CAD_Point1(0)) / BiLi)
    ScreenPoint2(1) = Int(ScreenPoint1.Y - (CAD_Point2(1) - CAD_Point1(1)) / BiLi)
    MsgBox "屏幕坐标：" & ScreenPoint2(0) & " / " & ScreenPoint2(1)
    '为了验证计算坐标，将CAD窗口在屏幕上移动到该点，看看效果吧。
    ThisDrawing.Application.WindowState = acNorm
    ThisDrawing.Application.WindowLeft = ScreenPoint2(0)
    ThisDrawing.Application.WindowTop = ScreenPoint2(1)
    
    
End Sub
'   通过屏幕坐标计算CAD坐标
Sub GetCAD_Point()
    BiLi = ViewScreen
    CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
    ThisDrawing.ModelSpace.AddPoint CAD_Point1
    GetCursorPos ScreenPoint1   '通过api直接获得鼠标所在位置的屏幕坐标
    MsgBox "屏幕坐标：" & ScreenPoint1.x & " / " & ScreenPoint1.Y
    MsgBox "对应的CAD坐标：" & CAD_Point1(0) & " / " & CAD_Point1(1)
    '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了
    
    Dim ScreenPoint3 As POINTAPI
    GetCursorPos ScreenPoint3
    
    Dim CAD_Point3(2) As Double
    '计算cad坐标
    CAD_Point3(0) = CAD_Point1(0) + BiLi * (ScreenPoint3.x - ScreenPoint1.x)
    CAD_Point3(1) = CAD_Point1(1) - BiLi * (ScreenPoint3.Y - ScreenPoint1.Y)
    CAD_Point3(2) = 0
    MsgBox "屏幕坐标：" & CAD_Point3(0) & " / " & CAD_Point3(1)
    '为了验证计算坐标，将画一条直线，看看效果吧。
    ThisDrawing.ModelSpace.AddLine CAD_Point1, CAD_Point3
End Sub