冲亚
路人甲
路人甲
  • 注册日期2005-06-01
  • 发帖数83
  • QQ
  • 铜币389枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:12225回复:33

VBA+AO入门50例完全注释版

楼主#
更多 发布于:2005-11-15 22:07
<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>
喜欢0 评分0
ferrywuliwen
路人甲
路人甲
  • 注册日期2012-09-19
  • 发帖数3
  • QQ
  • 铜币106枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2012-09-19 23:49
楼主加油,多翻译,让我们这些刚接触的能更快入门<img src="images/post/smile/dvbbs/em80.gif" />
举报 回复(0) 喜欢(0)     评分
liumiao
路人甲
路人甲
  • 注册日期2008-05-06
  • 发帖数9
  • QQ
  • 铜币122枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2009-11-16 21:25
<img src="images/post/smile/dvbbs/em01.gif" />
举报 回复(0) 喜欢(0)     评分
sshbear
路人甲
路人甲
  • 注册日期2008-09-02
  • 发帖数2
  • QQ
  • 铜币105枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2009-10-20 16:08
非常感谢<br><br><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em05.gif" />
举报 回复(0) 喜欢(0)     评分
Gis-fhm
路人甲
路人甲
  • 注册日期2009-07-08
  • 发帖数9
  • QQ
  • 铜币118枚
  • 威望0点
  • 贡献值0点
  • 银元0个
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>
举报 回复(0) 喜欢(0)     评分
chi222428
路人甲
路人甲
  • 注册日期2005-04-25
  • 发帖数82
  • QQ
  • 铜币299枚
  • 威望0点
  • 贡献值0点
  • 银元0个
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" />
天地不仁,以万物为刍狗; 圣人不仁,以百姓为刍狗。
举报 回复(0) 喜欢(0)     评分
lhtfh
路人甲
路人甲
  • 注册日期2004-01-04
  • 发帖数67
  • QQ
  • 铜币236枚
  • 威望0点
  • 贡献值0点
  • 银元0个
6楼#
发布于:2006-04-26 07:44
<P>辛苦了,他感谢了,我正想学啦</P><img src="images/post/smile/dvbbs/em02.gif" />
举报 回复(0) 喜欢(0)     评分
carp_1979
路人甲
路人甲
  • 注册日期2006-03-08
  • 发帖数2
  • QQ
  • 铜币116枚
  • 威望0点
  • 贡献值0点
  • 银元0个
7楼#
发布于:2006-04-10 14:32
谢谢楼主
举报 回复(0) 喜欢(0)     评分
chenyongfeng
路人甲
路人甲
  • 注册日期2004-08-31
  • 发帖数29
  • QQ
  • 铜币184枚
  • 威望0点
  • 贡献值0点
  • 银元0个
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" />
眼小聚光
举报 回复(0) 喜欢(0)     评分
dongshan
路人甲
路人甲
  • 注册日期2005-06-25
  • 发帖数26
  • QQ155351222
  • 铜币257枚
  • 威望0点
  • 贡献值0点
  • 银元0个
9楼#
发布于:2006-04-07 23:28
<P>谢谢!</P>
举报 回复(0) 喜欢(0)     评分
上一页
游客

返回顶部