赌东道
路人甲
路人甲
  • 注册日期2003-11-14
  • 发帖数122
  • QQ
  • 铜币99枚
  • 威望0点
  • 贡献值0点
  • 银元0个
40楼#
发布于:2005-11-17 09:29
<P>谢谢了</P>
<P>  适合新手学习</P>
举报 回复(0) 喜欢(0)     评分
冲亚
路人甲
路人甲
  • 注册日期2005-06-01
  • 发帖数83
  • QQ
  • 铜币389枚
  • 威望0点
  • 贡献值0点
  • 银元0个
41楼#
发布于:2005-11-16 22:18
<P>呵呵呵呵……</P>
<P>受宠若惊……</P>
<P>加油加油……</P>


<P>'放大/缩小<BR>Sub MyZoom()</P>
<P>  Dim pDoc As IMxDocument    '地图文档<BR>  Dim pActiveView As IActiveView    '活动地图<BR>  Dim pEnv As IEnvelope    '显示范围</P>
<P>  Set pDoc = Application.Document    '获取当前文档,等同于ThisDoucument<BR>  Set pActiveView = pDoc.ActiveView    '获取当前活动地图 <BR> <BR>  Set pEnv = pActiveView.Extent    '获取当前显示范围<BR>  pEnv.Expand 0.5, 0.5, True    '按比例放大两倍,把0.5改为2则为缩小一半<BR>  pActiveView.Extent = pEnv    '更新显示范围<BR>  pActiveView.Refresh    '刷新</P>
<P>End Sub</P>
<P><BR>MxApplication代表ArcMap本身,只管理一个文档MxDocument(ArcMap是单文档界面)。MxDocument管理一组Map对象和一个PageLayout对象。在数据视图下,ActiveView是一个Map;而在页面视图下,ActiveView是PageLayout。无论在何种视图下,总是只有一个FocusMap,显示操作都是对ActiveView进行。</P>


<P>'全图:<BR>Sub FullExtentPlus()</P>
<P>  Dim pDoc As IMxDocument    '地图文档<BR>  Dim pActiveView As IActiveView    '活动地图</P>
<P>  Set pDoc = Application.Document    '获取当前地图文档<BR>  Set pActiveView = pDoc.activeView    '获取当前活动地图<BR>  <BR>  pActiveView.Extent = pDoc.ActiveView.FullExtent    '全图显示<BR>  pActiveView.Refresh    '刷新当前视图</P>
<P>End Sub</P>


<P><BR>'清除图层<BR>Private Sub ClearLayers() </P>
<P>  Dim pDoc As IMxDocument    '地图文档<BR>  Dim pActiveView as IActiveView    '活动地图 <BR>  Dim pMap As IMap    '地图</P>
<P>  Set pDoc = Application.Document    '获取当前地图文档<BR>  Set pActiveView = pDoc.ActiveView    '获取当前活动地图</P>
<P>  If TypeOf pActiveView Is IMap Then    '如果当前活动地图为数据视图模式 <BR>    Set pMap = pActiveView    '获取当前地图 <BR>    pMap.ClearLayers    '清除所有图层 <BR>    pDoc.UpdateContents    '更新窗口内容表 <BR>    pActiveView.Refresh    '刷新 <BR>  End If </P>
<P>End Sub</P>


<P>'查找图层<BR>Function FindLayer(map As IMap, name As String) As ILayer</P>
<P>  Dim i As Integer </P>
<P>  For i = 0 To map.LayerCount - 1    '第一层的索引为1 <BR>    If map.Layer(i).name = name Then    '如果第i层的名称为name <BR>      Set FindLayer = map.Layer(i)    '获取并返回该层 <BR>      Exit Function <BR>    End If <BR>  Next </P>
<P>End Function</P>



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



<P>'添加文本<BR>Private Sub Hello()<BR> <BR>  Dim pDoc As IMxDocument    '地图文档<BR>  Dim pActiveView As IActiveView    '活动地图<BR>  Dim sym As ITextSymbol    '文本符号<BR>  Dim bnds As IArea    '面</P>
<P>  Set pDoc = Application.Document    '获取当前地图文档<BR>  Set pActiveView = pDoc.activeView    '获取当前活动地图</P>
<P>  Set sym = New TextSymbol    '创建文本符号<BR>  sym.Font.size = 18    '设置字体大小</P>
<P>  With pActiveView.ScreenDisplay    '对显示屏操作<BR>    Set bnds = .DisplayTransformation.VisibleBounds    '获取可视范围<BR>    .StartDrawing .hDC, esriNoScreenCache<BR>    .SetSymbol sym    '设置要绘制的符号<BR>    .DrawText bnds.Centroid, "Hello"    '添加文本<BR>    .FinishDrawing    '完成绘制<BR>  End With</P>
<P>End Sub</P>



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



<P><BR>'监听</P>
<P>Dim WithEvents g_Map As map</P>
<P>Private Sub UIButtonControl1_Click()<BR>  Dim mxDoc As IMxDocument    '地图文档<BR>  Dim lyr As IFeatureLayer    '要素层<BR>  Dim sel As IFeatureSelection    '选择集<BR>  Dim filter As IQueryFilter    '查询过滤器<BR>  Dim selEvents As ISelectionEvents    '???</P>
<P>  Set g_Map = mxDoc.FocusMap    '获取当前地图</P>
<P>  Set mxDoc = Application.Document    '获取当前地图文档<BR>  Set lyr = FindLayer(mxDoc.FocusMap, "BUILDING")    '调用FindLayer函数查找图层<BR>  Set sel = lyr    '将找到的图层设为选择集<BR>  Set filter = New QueryFilter    '创建查询过滤器<BR>  filter.WhereClause = "BDNAME ='实验楼A'"    '设置where子句<BR>  sel.SelectFeatures filter, esriSelectionResultNew, False    '选中满足条件的要素<BR>  mxDoc.activeView.PartialRefresh esriViewGeoSelection, Nothing, Nothing    '绘出选中的要素<BR>  Set selEvents = mxDoc.FocusMap    '???<BR>  selEvents.SelectionChanged    '通知系统选择已经改变了</P>
<P>End Sub</P>
<P>'查找图层<BR>Function FindLayer(map As IMap, name As String) As ILayer</P>
<P>  Dim i As Integer</P>
<P>  For i = 0 To map.LayerCount - 1    '第一层的索引为1<BR>    If map.Layer(i).name = name Then    '如果第i层的名称为name<BR>      Set FindLayer = map.Layer(i)    '获取并返回该层<BR>      Exit Function<BR>    End If<BR>  Next</P>
<P>End Function</P>
<P>Private Sub g_Map_SelectionChanged()</P>
<P>  Dim activeView As IActiveView    '活动地图<BR>  Dim featureEnum As IEnumFeature    '列举的要素?<BR>  Dim feat As IFeature    '要素<BR>  Dim index As Long<BR>  Dim Msg As String</P>
<P>  Set activeView = g_Map    '获取当前地图<BR>  Set featureEnum = activeView.Selection    '列举所选的要素<BR>  featureEnum.Reset    '还原至初始顺序<BR>  Set feat = featureEnum.Next    '获取选择集中第一个要素<BR>  Do While Not feat Is Nothing    '如果要素存在  <BR>    index = feat.Fields.FindField(“Name”)    '获取Name字段的索引值 <BR>    If index <> -1 Then MsgBox Msg ; chr(13) ; chr(10) ; feat.Value(index)    '显示该要素的Name <BR>    Set feat = featureEnum.Next    '移至选择集中的下一个要素 <BR>  Loop </P>
<P>End Sub</P>


<P><BR> </P>
举报 回复(0) 喜欢(0)     评分
license
路人甲
路人甲
  • 注册日期2003-08-20
  • 发帖数235
  • QQ33281522
  • 铜币366枚
  • 威望0点
  • 贡献值0点
  • 银元0个
42楼#
发布于:2005-11-16 00:53
hao
Gis的小石块 QICQ:33281522 EMAIL:license@vip.sina.com GIS的麦田守望者,希望和大家交流。 〓〓〓〓〓〓〓〓〓 〓 GISEMPIRE 〓 〓 灌水★波菜 〓 〓 专 用 章 〓 〓〓〓〓〓〓〓〓〓
举报 回复(0) 喜欢(0)     评分
上一页 下一页
游客

返回顶部