阅读:13304回复:33
VBA+AO入门50例完全注释版
<P>网上下的码,自己加的注。</P>
<P>初学,瞎搞,不好,见笑。</P> <P>和跟我一样的初学者探讨一下怎么入门最快最好,为中国GIS教育事业添一根小火柴</P> <P>1.<BR>Sub MyMacro()<BR> Dim pMxDocument As IMxDocument '地图文档<BR> Set pMxDocument = Application.Document '获取当前应用程序的文档 <BR> MsgBox pMxDocument.FocusMap.Name '显示当前地图的名称<BR>End Sub</P> <P><BR>2.<BR>Sub MyMacro()<BR> Dim pMxDocument As IMxDocument '地图文档<BR> Dim pMaps As IMaps '地图集<BR> Dim pMap As IMap '地图<BR> Set pMxDocument = Application.Document '获取当前应用程序的文档<BR> Set pMaps = pMxDocument.Maps '获取当前地图文档的地图集<BR> If pMaps.Count > 1 Then '如果该地图集的地图数大于1<BR> Set pMap = pMaps.Item(1) '获取该地图集中的第一幅地图<BR> MsgBox pMap.Name '显示该地图的名称<BR> End If<BR>End Sub</P> <P><BR>3.<BR>Sub MyMacro()<BR> Dim pMxDocument As IMxDocument '地图文档<BR> Dim pMap As IMap '地图<BR> Dim lCount As Long<BR> Dim lIndex As Long<BR> Set pMxDocument = Application.Document '获取当前应用程序的文档<BR> Set pMap = pMxDocument.FocusMap '获取当前地图<BR> lCount = 0<BR> For lIndex = 0 To (pMap.LayerCount - 1)<BR> If TypeOf pMap.Layer(lIndex) Is IFeatureLayer Then '如果当前地图的第lIndex层的类型是IFeatureLayer<BR> lCount = lCount + 1 '计数器加1<BR> End If<BR> Next lIndex<BR> MsgBox "Number of the feature layers " ; _<BR> "in the active map: " ; lCount '显示当前地图的要素层的总数<BR>End Sub</P> <P><BR>4.<BR>Sub MyMacro()<BR> Dim pMxDocument As IMxDocument '获取当前应用程序的文档<BR> Dim pMaps As IMaps '地图集<BR> Dim pMap As IMap '地图<BR> On Error GoTo SUB_ERROR '错误处理<BR> Set pMxDocument = Application.Document '获取当前应用程序的文档<BR> Set pMaps = pMxDocument.Maps '获取当前地图文档的地图集<BR> Set pMap = pMaps.Item(1) '获取该地图集中的第一幅地图<BR> MsgBox pMap.Name '显示该地图的名称<BR> Exit Sub<BR>SUB_ERROR: '行标签<BR> MsgBox "Error: " ; Err.Number ; "-" ; Err.Description '显示错误数和错误信息<BR>End Sub</P> <P><BR>5.<BR>'是图层可视<BR>Public Sub MakeLayerVisible()<BR> Dim pMxDocument As IMxDocument '地图文档<BR> Dim pMap As IMap '地图<BR> Dim pFeatureLayer As IFeatureLayer '要素层<BR> Dim pActiveView As IActiveView '活动视图<BR> Dim pContentsView As IContentsView '窗口内容表<BR> <BR> '获取地图的第一层<BR> Set pMxDocument = ThisDocument '获取当前应用程序的文档<BR> Set pMap = pMxDocument.FocusMap '获取当前地图<BR> Set pFeatureLayer = pMap.Layer(0) '获取当前地图的第一层 <BR> <BR> '如果要素层不可见,则使其可见<BR> If Not pFeatureLayer.Visible Then<BR> pFeatureLayer.Visible = True<BR> End If<BR> <BR> '刷新地图<BR> Set pActiveView = pMap '将当前地图设为活动地图<BR> pActiveView.Refresh '刷新<BR> <BR> '刷新窗口内容表<BR> Set pContentsView = pMxDocument.CurrentContentsView '获取当前地图文档的窗口内容表<BR> pContentsView.Refresh pFeatureLayer '刷新<BR>End Sub</P> <P><BR>6.<BR>'按NAME查询要素<BR>Private Function GetCountyFeature(pFeatureLayer As IFeatureLayer, strCountyName As String) As IFeature<BR> <BR> '查找要素类<BR> Dim pFeatureClass As IFeatureClass '要素类<BR> Dim pQueryFilter As IQueryFilter '查询过滤器<BR> Dim pFeatureCursor As IFeatureCursor<BR> <BR> Set pFeatureClass = pFeatureLayer.FeatureClass '从要素层获取要素类<BR> Set pQueryFilter = New QueryFilter '创建一个新的查询过滤器<BR> pQueryFilter.WhereClause = "NAME = '" ; strCountyName ; "'" '按郡名查找<BR> Set pFeatureCursor = pFeatureClass.Search (pQueryFilter, False) '获取查询到的要素对象<BR> <BR> '获取要素<BR> Dim pFeature As IFeature '要素<BR> <BR> Set pFeature = pFeatureCursor.NextFeature '获取查询结果的下一个要素<BR> If pFeature Is Nothing Then '如果该要素不存在 <BR> Set GetCountyFeature = Nothing '返回值设为空<BR> Else<BR> Set GetCountyFeature = pFeature '将该要素设为返回值<BR> End If<BR>End Function</P> <P><BR>未完待续</P> |
|
1楼#
发布于:2012-09-19 23:49
楼主加油,多翻译,让我们这些刚接触的能更快入门<img src="images/post/smile/dvbbs/em80.gif" />
|
|
2楼#
发布于:2009-11-16 21:25
<img src="images/post/smile/dvbbs/em01.gif" />
|
|
3楼#
发布于:2009-10-20 16:08
非常感谢<br><br><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em05.gif" />
|
|
4楼#
发布于:2009-10-05 12:28
<TABLE fixed; WORD-BREAK: break-all" height="85%" width="95%" align=center border=0>
<TR> <TD 9pt; LINE-HEIGHT: 12pt" vAlign=top width=* height="100%"><IMG src="http://www.gisempire.com/bbs/Skins/Default/topicface/face7.gif"> <B></B><BR> <P>支持,</P></TD></TR></TABLE> |
|
5楼#
发布于:2006-04-28 21:16
感谢···<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em05.gif" />
|
|
|
6楼#
发布于:2006-04-26 07:44
<P>辛苦了,他感谢了,我正想学啦</P><img src="images/post/smile/dvbbs/em02.gif" />
|
|
7楼#
发布于:2006-04-10 14:32
谢谢楼主
|
|
8楼#
发布于:2006-04-08 18:56
din<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em03.gif" /><img src="images/post/smile/dvbbs/em04.gif" /><img src="images/post/smile/dvbbs/em05.gif" /><img src="images/post/smile/dvbbs/em06.gif" /><img src="images/post/smile/dvbbs/em07.gif" /><img src="images/post/smile/dvbbs/em08.gif" />
|
|
|
9楼#
发布于:2006-04-07 23:28
<P>谢谢!</P>
|
|
上一页
下一页