默认头像
路人甲
路人甲
  • 注册日期2005-03-18
  • 发帖数46
  • QQ
  • 铜币247枚
  • 威望0点
  • 贡献值0点
  • 银元0个
30楼#
发布于:2005-11-30 11:34

对初学者应该是个好东西,想起我上半年学的时候,多辛苦哦!

举报 回复(0) 喜欢(0)     评分
默认头像
路人甲
路人甲
  • 注册日期2005-01-14
  • 发帖数114
  • QQ
  • 铜币414枚
  • 威望0点
  • 贡献值0点
  • 银元0个
31楼#
发布于:2005-11-17 14:30

呵呵

翻译的这么详细,当初学的时候有这个看就好了~~~

辛苦了

女口果人尔能看日月白这段言舌,那言兑日月人尔白勺目艮目青有严重白勺散光 
举报 回复(0) 喜欢(0)     评分
默认头像
路人甲
路人甲
  • 注册日期2005-06-01
  • 发帖数83
  • QQ
  • 铜币389枚
  • 威望0点
  • 贡献值0点
  • 银元0个
32楼#
发布于:2005-11-16 22:32

上帝啊!!总统竟然光临寒舍……

'放大/缩小
Sub MyZoom()

 Dim pDoc As IMxDocument    '地图文档
 Dim pActiveView As IActiveView    '活动地图
 Dim pEnv As IEnvelope    '显示范围

 Set pDoc = Application.Document    '获取当前文档,等同于ThisDoucument
 Set pActiveView = pDoc.ActiveView    '获取当前活动地图

 Set pEnv = pActiveView.Extent    '获取当前显示范围
 pEnv.Expand 0.5, 0.5, True    '按比例放大两倍,把0.5改为2则为缩小一半
 pActiveView.Extent = pEnv    '更新显示范围
 pActiveView.Refresh    '刷新

End Sub


MxApplication代表ArcMap本身,只管理一个文档MxDocument(ArcMap是单文档界面)。MxDocument管理一组Map对象和一个PageLayout对象。在数据视图下,ActiveView是一个Map;而在页面视图下,ActiveView是PageLayout。无论在何种视图下,总是只有一个FocusMap,显示操作都是对ActiveView进行。

'全图:
Sub FullExtentPlus()

 Dim pDoc As IMxDocument    '地图文档
 Dim pActiveView As IActiveView    '活动地图

 Set pDoc = Application.Document    '获取当前地图文档
 Set pActiveView = pDoc.activeView    '获取当前活动地图
 
 pActiveView.Extent = pDoc.ActiveView.FullExtent    '全图显示
 pActiveView.Refresh    '刷新当前视图

End Sub


'清除图层
Private Sub ClearLayers()

 Dim pDoc As IMxDocument    '地图文档
 Dim pActiveView as IActiveView    '活动地图
 Dim pMap As IMap    '地图

 Set pDoc = Application.Document    '获取当前地图文档
 Set pActiveView = pDoc.ActiveView    '获取当前活动地图

 If TypeOf pActiveView Is IMap Then    '如果当前活动地图为数据视图模式
   Set pMap = pActiveView    '获取当前地图
   pMap.ClearLayers    '清除所有图层
   pDoc.UpdateContents    '更新窗口内容表
   pActiveView.Refresh    '刷新
 End If

End Sub

'查找图层
Function FindLayer(map As IMap, name As String) As ILayer

 Dim i As Integer

 For i = 0 To map.LayerCount - 1    '第一层的索引为1
   If map.Layer(i).name = name Then    '如果第i层的名称为name
     Set FindLayer = map.Layer(i)    '获取并返回该层
     Exit Function
   End If
 Next

End Function

'添加图层
Sub AddLayer()

 Dim wksFact As IWorkspaceFactory     '工作空间管理器
 Dim wks As IFeatureWorkspace    '要素工作空间
 Dim fc As IFeatureClass    '要素类
 Dim lyr As IFeatureLayer    '要素层
 Dim ds As IDataset    '数据集
 Dim mxDoc As IMxDocument    '地图文档
 Dim map As IMap    '地图

 Set wksFact = New ShapefileWorkspaceFactory    '创建Shape工作空间管理器
 Set wks = wksFact.OpenFromFile(“c:\Data\shp”, 0)    '获取工作空间
 Set fc = wks.OpenFeatureClass(“BigCypress”)    '获取要素类
 Set lyr = New FeatureLayer    '创建要素层
 Set lyr.FeatureClass = fc    '向要素层中添加要素类
 Set ds = fc    '获取数据集
 lyr.Name = ds.Name    '用要素类的名称命名要素层
 Set pDoc = Application.Document    '获取当前地图文档  
 Set mxmap = mxDoc.FocusMap    '获取当前地图
 map.AddLayer lyr    '添加图层

End Sub

'添加文本
Private Sub Hello()

 Dim pDoc As IMxDocument    '地图文档
 Dim pActiveView As IActiveView    '活动地图
 Dim sym As ITextSymbol    '文本符号
 Dim bnds As IArea    '面

 Set pDoc = Application.Document    '获取当前地图文档
 Set pActiveView = pDoc.activeView    '获取当前活动地图

 Set sym = New TextSymbol    '创建文本符号
 sym.Font.size = 18    '设置字体大小

 With pActiveView.ScreenDisplay    '对显示屏操作
   Set bnds = .DisplayTransformation.VisibleBounds    '获取可视范围
   .StartDrawing .hDC, esriNoScreenCache
   .SetSymbol sym    '设置要绘制的符号
   .DrawText bnds.Centroid, "Hello"    '添加文本
   .FinishDrawing    '完成绘制
 End With

End Sub

'选择要素
Sub SelectFeatures()

 Dim mxDoc As IMxDocument    '地图文档
 Dim lyr As IFeatureLayer    '要素层
 Dim sel As IFeatureSelection    '选择集
 Dim filter As IQueryFilter    '查询过滤器
 Dim selEvents As ISelectionEvents    '???

 Set mxDoc = Application.Document    '获取当前地图文档
 Set lyr = FindLayer(mxDoc.FocusMap, "BUILDING")    '调用FindLayer函数查找图层
 Set sel = lyr    '将找到的图层设为选择集
 Set filter = New QueryFilter    '创建查询过滤器
 filter.WhereClause = "BDNAME ='实验楼A'"    '设置where子句
 sel.SelectFeatures filter, esriSelectionResultNew, False    '选中满足条件的要素
 mxDoc.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing    '绘出选中的要素
 Set selEvents = mxDoc.FocusMap    '???
 selEvents.SelectionChanged    '通知系统选择已经改变了

End Sub


'监听

Dim WithEvents g_Map As map

Private Sub UIButtonControl1_Click()
 Dim mxDoc As IMxDocument    '地图文档
 Dim lyr As IFeatureLayer    '要素层
 Dim sel As IFeatureSelection    '选择集
 Dim filter As IQueryFilter    '查询过滤器
 Dim selEvents As ISelectionEvents    '???

 Set g_Map = mxDoc.FocusMap    '获取当前地图

 Set mxDoc = Application.Document    '获取当前地图文档
 Set lyr = FindLayer(mxDoc.FocusMap, "BUILDING")    '调用FindLayer函数查找图层
 Set sel = lyr    '将找到的图层设为选择集
 Set filter = New QueryFilter    '创建查询过滤器
 filter.WhereClause = "BDNAME ='实验楼A'"    '设置where子句
 sel.SelectFeatures filter, esriSelectionResultNew, False    '选中满足条件的要素
 mxDoc.activeView.PartialRefresh esriViewGeoSelection, Nothing, Nothing    '绘出选中的要素
 Set selEvents = mxDoc.FocusMap    '???
 selEvents.SelectionChanged    '通知系统选择已经改变了

End Sub

'查找图层
Function FindLayer(map As IMap, name As String) As ILayer

 Dim i As Integer

 For i = 0 To map.LayerCount - 1    '第一层的索引为1
   If map.Layer(i).name = name Then    '如果第i层的名称为name
     Set FindLayer = map.Layer(i)    '获取并返回该层
     Exit Function
   End If
 Next

End Function

Private Sub g_Map_SelectionChanged()

 Dim activeView As IActiveView    '活动地图
 Dim featureEnum As IEnumFeature    '列举的要素?
 Dim feat As IFeature    '要素
 Dim index As Long
 Dim Msg As String

 Set activeView = g_Map    '获取当前地图
 Set featureEnum = activeView.Selection    '列举所选的要素
 featureEnum.Reset    '还原至初始顺序
 Set feat = featureEnum.Next    '获取选择集中第一个要素
 Do While Not feat Is Nothing    '如果要素存在  
   index = feat.Fields.FindField(“Name”)    '获取Name字段的索引值
   If index <> -1 Then MsgBox Msg ; chr(13) ; chr(10) ; feat.Value(index)    '显示该要素的Name
   Set feat = featureEnum.Next    '移至选择集中的下一个要素
 Loop

End Sub

举报 回复(0) 喜欢(0)     评分
默认头像
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
33楼#
发布于:2005-11-16 11:51
希望看到楼主继续翻译下去,
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
上一页 下一页
默认头像

返回顶部