基于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。
升级会员 