基于ACCESS的林地保护利用规划小班号细班号自动顺号模块使用方法.docx
- 文档编号:9896755
- 上传时间:2023-02-07
- 格式:DOCX
- 页数:13
- 大小:230.38KB
基于ACCESS的林地保护利用规划小班号细班号自动顺号模块使用方法.docx
《基于ACCESS的林地保护利用规划小班号细班号自动顺号模块使用方法.docx》由会员分享,可在线阅读,更多相关《基于ACCESS的林地保护利用规划小班号细班号自动顺号模块使用方法.docx(13页珍藏版)》请在冰豆网上搜索。
基于ACCESS的林地保护利用规划小班号细班号自动顺号模块使用方法
基于ACCESS2003的林地保护利用规划
小班号细班号自动顺号模块使用说明
一、在ARCMAP9.3中增加四个辅助字段:
1、将林保细班矢量图层另存为SHAPE文件进行备份;
2、打开林保细班矢量图层属性表,增加以下四个字段:
字段名
字段类型
自动小班号
ShortInteger
自动细班号
ShortInteger
X
Double
Y
Double
二、为多边形中心点X、Y坐标赋值:
1、选中X列,按右键,在右键菜单中选择CalculateGeometry:
2、在CalculateGeometry对话框Property项选择XCoordinateofCentroid:
按OK按钮后就可将多边形中心点的X坐标值赋值给X字段。
3、Y字段的赋值与X字段类似,唯一不同的是在在CalculateGeometry对话框Property项选择YCoordinateofCentroid。
三、在ACCESS2003中运行自动顺号模块:
1、关闭ARCMAP9.3,打开ACCESS2003
;
2、打开林保矢量数据库:
3、在左侧选择“查询”,然后点击窗口上方的新建,进入新建查询窗口:
4、选择“设计视图”:
5、“显示表”对话框选择关闭:
6、在查询窗口左上角点击“SQL”,进入SQL视图
7、清空窗口中的代码,将以下代码粘贴进窗口:
SELECTInt([XIANG])AS乡镇代码,Int([CUN])AS村代码,Int([LIN_BAN])AS内业小班,Max(Y)ASY最大值,Min(X)ASX最小值
FROM细班面
GROUPBYInt([XIANG]),Int([CUN]),Int([LIN_BAN])
ORDERBYInt([XIANG]),Int([CUN]),Int([LIN_BAN]),Max(Y)DESC;
8、保存新建的查询,命名为“查询小班号”:
9、在左侧选择“模块”,然后点击窗口上方的新建,进入新建模块窗口:
10、清空窗口中的代码,将以下代码粘贴至代码窗口:
OptionCompareDatabase
OptionExplicit
SubupdateData()
DimcnnAsADODB.Connection
Setcnn=CurrentProject.Connection
DimstrSQLAsString
'更新小班号
DimintXZAsInteger
DimintOldXZAsInteger
intOldXZ=0
DimintCAsInteger
DimintOldCAsInteger
intOldC=0
DimintXBAsInteger
DimintXB0AsInteger
intXB0=0
DimintNewXBAsInteger
intNewXB=1
DimrsDLAsADODB.Recordset
strSQL="SELECT乡镇代码,村代码,内业小班"
strSQL=strSQL+"FROM查询小班号"
strSQL=strSQL+"ORDERBY乡镇代码,村代码,int(Y最大值/100)DESC,X最小值"
SetrsDL=NewADODB.Recordset
rsDL.OpenstrSQL,cnn,adOpenForwardOnly,adLockBatchOptimistic
DoWhileNotrsDL.EOF
IfIsNull(rsDL.Fields.Item(0).Value)OrIsNull(rsDL.Fields.Item
(1).Value)OrrsDL.Fields.Item(0).Value=0OrrsDL.Fields.Item
(1).Value=0Then
MsgBox"林保乡镇代码XIANG或村代码(CUN)存在空值或0值,请修改后重新顺号!
",vbInformation,"出错提示"
rsDL.Close
SetrsDL=Nothing
cnn.Close
Setcnn=Nothing
ExitSub
EndIf
intXZ=rsDL.Fields.Item(0).Value
intC=rsDL.Fields.Item
(1).Value
IfNotIsNull(rsDL.Fields.Item
(2).Value)Then
intXB=rsDL.Fields.Item
(2).Value
IfintXZ<>intOldXZThen
intOldXZ=intXZ
intOldC=1
intXB0=0
intNewXB=1
Else
IfintC<>intOldCThen
intOldC=intC
intXB0=0
intNewXB=1
EndIf
EndIf
IfintXB<>intXB0Then
UpdateXBintXZ,intC,intXB,intNewXB
intNewXB=intNewXB+1
intXB0=intXB
EndIf
EndIf
rsDL.MoveNext
Loop
rsDL.Close
SetrsDL=Nothing
'更新细班号
DimstrSQLxxbAsString
DimdouXAsDouble
DimdouYAsDouble
DimrsXBAsADODB.Recordset
strSQL="SELECTint(XIANG),int(CUN),自动小班号"
strSQL=strSQL+"FROM细班面"
strSQL=strSQL+"GROUPBYint(XIANG),int(CUN),自动小班号"
strSQL=strSQL+"ORDERBYint(XIANG),int(CUN),自动小班号"
SetrsXB=NewADODB.Recordset
rsXB.OpenstrSQL,cnn,adOpenForwardOnly,adLockBatchOptimistic
DoWhileNotrsXB.EOF
intXZ=rsXB.Fields.Item(0).Value
intC=rsXB.Fields.Item
(1).Value
IfNotIsNull(rsXB.Fields.Item
(2).Value)Then
intXB=rsXB.Fields.Item
(2).Value
strSQLxxb="SELECTXIANG,CUN,自动小班号,round([Y],6),round([X],6)"
strSQLxxb=strSQLxxb+"FROM细班面"
strSQLxxb=strSQLxxb+"WHEREint(XIANG)="+LTrim(RTrim(intXZ))+"ANDint(CUN)="+LTrim(RTrim(intC))+"AND自动小班号="+LTrim(RTrim(intXB))
strSQLxxb=strSQLxxb+"GROUPBYXIANG,CUN,自动小班号,round([Y],6),round([X],6)"
strSQLxxb=strSQLxxb+"ORDERBYXIANG,CUN,自动小班号,round([Y],6)DESC,round([X],6)"
DimrsXXBAsADODB.Recordset
SetrsXXB=NewADODB.Recordset
rsXXB.OpenstrSQLxxb,cnn,adOpenForwardOnly,adLockBatchOptimistic
DimintXXBAsInteger
intXXB=1
DoWhileNotrsXXB.EOF
douY=rsXXB.Fields.Item(3).Value
douX=rsXXB.Fields.Item(4).Value
UpdateXXBintXZ,intC,intXB,intXXB,douY,douX
intXXB=intXXB+1
rsXXB.MoveNext
Loop
rsXXB.Close
SetrsXXB=Nothing
EndIf
rsXB.MoveNext
Loop
rsXB.Close
SetrsXB=Nothing
cnn.Close
Setcnn=Nothing
EndSub
'更新细班号
SubUpdateXXB(xzAsInteger,cAsInteger,xbAsInteger,xxbAsInteger,yyAsDouble,xxAsDouble)
DimcnnXXBAsNewADODB.Connection
DimcmdxxbAsNewADODB.Command
DimstrUpdateAsString
DimlngRaAsLong
SetcnnXXB=CurrentProject.Connection
strUpdate="UPDATE细班面SET自动细班号="+LTrim(RTrim(Str(xxb)))+"WHEREint(XIANG)="+LTrim(RTrim(xz))+"ANDint(CUN)="+LTrim(RTrim(c))
strUpdate=strUpdate+"AND自动小班号="+LTrim(RTrim(xb))+"ANDround([Y],6)="+LTrim(RTrim(yy))+"ANDround([X],6)="+LTrim(RTrim(xx))
Withcmdxxb
.CommandText=strUpdate
.CommandType=adCmdUnknown
.ActiveConnection=cnnXXB
.ExecutelngRa
EndWith
cnnXXB.Close
Setcmdxxb=Nothing
SetcnnXXB=Nothing
EndSub
'更新小班号
SubUpdateXB(xzAsInteger,cAsInteger,xbAsInteger,newxbAsInteger)
DimcnnDLAsNewADODB.Connection
DimcmdAsNewADODB.Command
DimstrUpdateAsString
DimlngRaAsLong
SetcnnDL=CurrentProject.Connection
strUpdate="UPDATE细班面SET自动小班号="+LTrim(RTrim(Str(newxb)))+"WHEREint(XIANG)="+LTrim(RTrim(xz))+"ANDint(CUN)="+LTrim(RTrim(c))
strUpdate=strUpdate+"ANDint(LIN_BAN)="+LTrim(RTrim(xb))
Withcmd
.CommandText=strUpdate
.CommandType=adCmdUnknown
.ActiveConnection=cnnDL
.ExecutelngRa
EndWith
cnnDL.Close
Setcmd=Nothing
SetcnnDL=Nothing
EndSub
11、保存模块,建议命名为“小班号细班号自动顺号模块”;
12、运行模块:
在模块窗口菜单中选择“运行”菜单项;(视细班数量多少,模块运行所需时间不一,请耐心等待)
13、关闭ACCESS2003。
四、在ARCMAP9.3中整理字段:
1、将“自动小班号”和“自动细班号”用Lable形式标注出来,检查是否有误,如果没有错误,在细班矢量图层的属性表中调出FieldCalculator,将自动小班号赋值给内业小班号,将自动细班号赋值给内业细班号:
2、删除辅助字段:
自动小班号、自动细班号、X、Y。
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 基于 ACCESS 林地 保护 利用 规划 小班 号细班号 自动 模块 使用方法