在CAD中获取当前显示范围的左下角和右上角坐标

在CAD中获取当前显示范围的左下角和右上角坐标

背景：我想在CAD中插入ArcServer发布的服务，那么首先要在CAD下获取一个范围，以当前显示范围为例，代码如下：

‘————————————————————————————————
‘名称：GetActiveRange
‘作者：罗简单
‘日期：2010-8-3
‘功能：获取当前显示范围
‘————————————————————————————————
Public Sub GetActiveRange(varWS As Variant, varEN As Variant)
  ‘思路：1、先获取当前显示范围的中心点、高度、和当前范围像素X、Y；
  ‘      2、根据高度、像素X、Y求出宽度
  ‘      3、根据中心点、高度、宽度求出范围
  ‘系统变量的意义：
  ‘VIEWCTR：获取当前显示范围中心点坐标
  ‘VIEWSIZE：获取当前显示范围高度
  ‘SCREENSIZE：获取当前显示范围的大小（X和Y，以像素为单位存储）
 
  Dim varCenter As Variant  ‘中心点
  Dim dblHeight As Double  ‘高度
  Dim dblWidth As Double  ‘宽度
  Dim varRange As Variant  ‘像素范围
  varCenter = ThisDrawing.GetVariable("VIEWCTR")  ‘获取中心点坐标
  dblHeight = ThisDrawing.GetVariable("VIEWSIZE")  ‘获取高度
  varRange = ThisDrawing.GetVariable("SCREENSIZE") ‘获取像素单位X和Y
  dblWidth = dblHeight * varRange(0) / varRange(1) ‘计算出宽度
 
  Dim dblWS(2) As Double  ‘西南角坐标
  Dim dblEN(2) As Double  ‘东北角坐标
  dblWS(0) = varCenter(0) – dblWidth / 2
  dblWS(1) = varCenter(1) – dblHeight / 2
  dblEN(0) = varCenter(0) + dblWidth / 2
  dblEN(1) = varCenter(1) + dblHeight / 2
  varWS = dblWS
  varEN = dblEN
End Sub

转载至:http://www.cadzj.com/n/30118.html