如何判断鼠标在某个视口区域内？[已解决！]

nhy12345678

如何判断鼠标在某个视口区域内？这样我就可以得到该视口的比例，相应的就可以在图纸空间中创建正确的尺寸标注了，谢谢大家！

nhy12345678

Public Function getVportCustomScale(ByVal Point As Variant) As Double '得到当前鼠标点击点的视口比例，如果点内没有视口返回1
Dim n As Long '视口个数
Dim minxx() As Double
Dim maxxx() As Double
Dim minyy() As Double
Dim maxyy() As Double
Dim sc() As Double '视口的比例
Dim mid As Variant
Dim h, w As Double '暂存视口的宽度和高度
Dim newVport As AcadPViewport
Dim i As Long
Dim NewEnt(0 To 0) As AcadEntity
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.SelectionSets.Add("ss")
For i = 0 To ThisDrawing.PaperSpace.Count - 1
    Set NewEnt(0) = ThisDrawing.PaperSpace.Item(i)
    If NewEnt(0).ObjectName = "AcDbViewport" Then
        ss.AddItems NewEnt
    End If
Next i
n = ss.Count
ReDim minxx(0 To n) As Double
ReDim maxxx(0 To n) As Double
ReDim minyy(0 To n) As Double
ReDim maxyy(0 To n) As Double
ReDim sc(0 To n) As Double
For i = 1 To n - 1
      Set newVport = ss.Item(i)
      mid = newVport.center
      w = newVport.Width
      h = newVport.Height
      minxx(i) = mid(0) - 0.5 * w
      minyy(i) = mid(1) - 0.5 * h
      maxxx(i) = mid(0) + 0.5 * w
      maxyy(i) = mid(1) + 0.5 * h
      sc(i) = 1 / newVport.CustomScale
Next i
For i = 1 To n - 1
    If Point(0) > minxx(i) And Point(0) < maxxx(i) And Point(1) > minyy(i) And Point(1) < maxyy(i) Then
       getVportCustomScale = sc(i)'这里第i个就是鼠标所在的视口
       ss.Delete
       Exit Function
    End If
Next i
getVportCustomScale = 1

ss.Delete
End Function

尘缘一生

顶起来，正需要这个问题的