公益林小班与林地一张图小班融合后碎片处理思路肖玲0421.docx
《公益林小班与林地一张图小班融合后碎片处理思路肖玲0421.docx》由会员分享，可在线阅读，更多相关《公益林小班与林地一张图小班融合后碎片处理思路肖玲0421.docx（44页珍藏版）》请在冰豆网上搜索。
公益林小班与林地一张图小班融合后碎片处理思路肖玲0421
公益林小班与林地一张图小班融合后碎片处理思路
肖玲
2015.1.12
1总体流程图
2
公益林小班处理
（1）目的：
只保留公益林区划界线，通过合并方式清除公益林界定界线。
（2）将公益林小班按森林类别、事权等级、林地所有权、林木所有权、国家级公益林保护等级、工程类别用disolve工具进行融合：
（3）融合后的图层命名为“公益林小班面522628_2014_Dissolve”。
（4）兑现面积处理：
a）将“公益林小班面522628_2014”图层生成点图层，图层命名为“公益林小班面522628_2014_FeatureToP”：
b）打开SpatialJoin工具，“公益林小班面522628_2014_Dissolve”图层SpatialJoin“公益林小班面522628_2014_FeatureToP”图层，新图层命名为“公益林小班面522628_2014_融合”。
i.首先清除点图层字段：
ii.按“+”键新增“兑现面积”字段，用于将融合后的公益林图斑的兑现面积值更新为其范围内原公益林小班面积之和：
iii.按右键菜单“AddInputField”给新增“兑现面积”字段赋值：
（5）“公益林小班面522628_2014_融合”图层增加“gyl_id”字段（Longinteger），且gyl_id=ObjectID：
（注：
操作视频无此步骤，需补充！
）
3叠加林地一张图小班
（1）利用union工具将“公益林小班面522628_2014_融合”叠加到林地一张图小班上：
林地年度变更小班面522628union公益林小班面522628_2014_融合。
（2）新生成的图层命名为“林地年度变更小班面522628_union”。
（3）利用MultiparttoSinglepart工具打散“林地年度变更小班面522628_union”图层中的多部件，新图层命名为“林地年度变更小班面522628_Union_Multip”。
（4）“林地年度变更小班面522628_Union_Multip”图层增加DJH（字段类型：
TEXT，文本型；长度：
17），并按以下代码赋值：
[XIAN]&[XIANG]&[CUN]&[XIAO_BAN]
（5）“林地年度变更小班面522628_Union_Multip”图层增加CUN_ID（字段类型：
TEXT，文本型；长度：
12），并按以下代码赋值：
[XIAN]&[XIANG]&[CUN]
（6）“林地年度变更小班面522628_Union_Multip”图斑分成三类：
一是DJH有值且为17位；二是DJH有值且为12位，这部分图斑为非林地图斑，无小班号；三是DJH为空字符串，这部分图斑为县界外补充的公益林图斑。
4对“双眼皮”碎斑进行筛选
（1）计算图斑外接矩形面积。
“林地年度变更小班面522628_union_Multip”图层增加maxX（X最大值）、minX（X最小值）、maxY（Y最大值）、minY（Y最小值）、area_envelope（外接矩形面积）、area_percent（图斑图形面积占外接矩形面积比率）字段，字段类型均为double：
其中：
maxX、minX、maxY、minY用以下方法赋值：
a）在工具箱打开CalculateField工具：
b）针对maxX、minX、maxY、minY在Expression输入框分别录入以下PYTHON_9.3语句：
maxX：
!
shape.extent.XMax!
minX：
!
shape.extent.XMin!
maxY：
!
shape.extent.YMax!
minY：
!
shape.extent.YMin!
然后用以下公式计算外接矩形面积和图斑图形面积占外接矩形面积比率：
area_envelope＝（[maxX]-[minX]）*（[maxY]-[minY]）
area_percent＝[SHAPE_area]/[area_envelope]
（2）通过属性查找工具筛选出area_percent（图斑图形面积占外接矩形面积比率）＜0.3（该阈值可根据实际情况调整）的图斑，这种图斑一般是细长条形的，其中就包括了“双眼皮”图斑。
（3）“林地年度变更小班面522628_union_Multip”图层增加isSelected字段，字段类型ShortInteger，将选中的图斑赋值为1，值为1的图斑为待合并的图斑（注：
其中包含了合理区划的细长形小班，需在接下来的操作中进行剔除）。
（4）对“林地年度变更小班面522628”重复
（1）～
（2）步骤，目的在于进一步排除正常的细长条形图斑。
（5）筛选出“林地年度变更小班面522628”area_percent（图斑图形面积占外接矩形面积比率）＜0.3的图斑（注：
0.3不是固定值，可根据需要调整为任何小于0.5的数值）：
（6）将（5）选择结果导出为面图层，命名为“林地年度变更小班面522628细长小班_30”：
（7）通过空间位置查询，筛选出与“林地年度变更小班面522628细长小班_30”重叠的图斑：
（8）再从（7）的结果中进一步筛选出isSelected=1的图斑，将其值改为null，以达到排除正常图班的目的：
5筛选出小面积碎斑
（1）选择图形面积小于“公益林小班面522628_2014_融合”图层最小面积（以126m2为例）的碎片（注：
126m2不是固定值，可根据具体情况调整，在该选择结果中注意公益林小班的最小上图面积为67m2，若设置筛选的最小面积大于“公益林小班面522628_2014_融合”图层最小面积，需人工排查这部分小面积的公益林小班，从该选择结果中剔除）：
（2）将选中图斑的isselected字段赋值为1：
6对筛选出的碎斑在相邻图斑中选择相同地籍号的图斑进行定向合并（按属性进行合并）
（1）“林地年度变更小班面522628_union_Multip”图层增加“tb_id”字段，字段类型为longinteger，将OBJECTID的值赋给tb_id，以保证在后面的操作中，每个图斑都拥有一个唯一编号，在确定碎斑的合并方向后，会根据图斑的唯一编号进行合并：
（2）通过属性查询将“林地年度变更小班面522628_union_Multip”图层isselected字段为1的图斑选中，并将选中的图斑导出为新图层，命名为“selected”：
（3）通过属性查询将“林地年度变更小班面522628_union_Multip”图层isselected字段不为1的图斑选中，并将选中的图斑导出为新图层，命名为“unselected”：
（4）以上二步将已标识了不合并和待合并的图斑分成两部分，即“selected”图层和“unselected”图层。
（5）使用spatialjoin工具，将“selected”图层spatialjoin“unselected”图层，删除“unselected”图层字段，增加“near_tbid”、“near_DJH”和“near_CUN”字段，字段类型为TEXT（文本型），长度为255，并将这三个新增加字段的MergeRule设置为Join，Delimiter（分隔符）设置为“,”，以求出“selected”图层中的图斑在“unselected”图层中同一空间位置相邻图斑的唯一值（near_tbid）、地籍号（near_DJH）和村（near_CUN）序列，生成的图层命名为“selected_SpatialJoin”：
（6）分别在“near_tbid”、“near_DJH”和“near_CUN”字段上点击右键菜单，选择AddInputField菜单项，指定“unselected”图层中Join的字段，其中near_tbid对应unselected.near_tbid、near_DJH对应unselected.DJH、near_CUN对应unselected.CUN_ID：
：
（7）“selected”图层SpatialJoin“unselected”图层操作结果：
（8）分别在“unselected”和“selected_SpatialJoin”图层中增加tbid_dissolve字段，字段类型为text（文本型），长度为10，该字段的值为最后合并的依据：
（9）“selected_SpatialJoin”图层中tbid_dissolve字段运行以下VBA代码赋值，判断djh是否在near_DJH中存在，如果存在，将near_tbid对应位置的值赋给tbid_dissolve字段，即根据碎斑的合并方向调整tbid_dissolve的值：
dimserial（）asstring
dimdjh（）asstring
dimcun（）asstring
dims_dissolveasstring
dimi_maxasinteger
s_dissolve="Null"
ifinstr（[near_DJH],[DJH]）>0then
serial（）=split（[near_tbid],",",-1,1）
djh（）=split（[near_DJH],",",-1,1）
i_max=ubound（djh）
fori=0toi_max
ifdjh（i）=[DJH]then
s_dissolve=serial（i）
exitfor
endif
nexti
else
ifinstr（[near_CUN],[CUN_ID]）>0then
serial（）=split（[near_tbid],",",-1,1）
cun（）=split（[near_CUN],",",-1,1）
i_max=ubound（cun）
fori=0toi_max
ifcun（i）=[CUN_ID]then
s_dissolve=serial（i）
exitfor
endif
nexti
else
s_dissolve=[tb_id]
endif
endif
（10）将“unselected”图层中的tbid_dissolve字段赋值为tb_id：
（11）将“unselected”图层进行备份，新图层命名为“unselected_bak”。
（12）使用APPEND工具将“selected_SpatialJoin”图层合并到“unselected”图层：
（13）对“unselected”图层根据tbid_dissolve字段利用Dissolve工具进行融合，新图层命名为“unselected_Dissolve”：
（14）将“unselected_bak”图层生成点图层，命名为“unselected_bak_FeatureToPoin”：
（15）利用Spatialjoin工具，将“unselected_bak_FeatureToPoin”图层属性联接到“unselected_Dissolve”面图层，MatchOption选择contains方式，新图层命名为“无碎片小班面”：
7公益林小班兑现面积平差
（1）编程实现平差思路：
计算相同“gyl_id”值的图斑shape_area面积之和，按该图斑shape_area占相同“gyl_id”值的图斑shape_area面积之和的比率，进行兑现面积平差。
（2）增加“GylZMj”字段（双精度型），用于计算相同“gyl_id”值图斑shape_area面积之和：
（3）增加“pcxs”字段（双精度型），用于计算相同“gyl_id”值图斑面积平差系统：
（4）增加“NewDxMj”字段（双精度型），用于计算平差后的兑现面积：
（5）在ACCESS中新建两个模块：
“1公益林图斑计算面积赋值”和“2公益林图斑兑现面积平差差值处理”，用于公益林小班被剖分后兑现面积的平差处理。
代码如下：
'1公益林图斑计算面积赋值
OptionCompareDatabase
OptionExplicit
SubupdateData（）
DimcnnAsADODB.Connection
Setcnn=CurrentProject.Connection
DimstrsqlxxbAsString
DimrsXXBAsADODB.Recordset
SetrsXXB=NewADODB.Recordset
DimlngGylidAsLong
DimdouMjAsDouble
'
strsqlxxb="SELECTgyl_id,sum（[Shape_Area]）"
strsqlxxb=strsqlxxb+"FROM无碎片小班面WHEREnotgyl_id=0"
strsqlxxb=strsqlxxb+"GROUPBYgyl_id"
strsqlxxb=strsqlxxb+"ORDERBYgyl_id"
rsXXB.Openstrsqlxxb,cnn,adOpenForwardOnly,adLockBatchOptimistic
DimintXXBAsInteger
DoWhileNotrsXXB.EOF
lngGylid=rsXXB.Fields.Item（0）.Value
douMj=rsXXB.Fields.Item
（1）.Value
updateGylMjlngGylid,douMj
rsXXB.MoveNext
Loop
rsXXB.Close
SetrsXXB=Nothing
'2计算平差系数
updatexbpcxs
'3计算平差面积
updatexbpcmj
cnn.Close
Setcnn=Nothing
MsgBox"公益林图斑计算面积赋值结束！
",vbOKOnly,"提示"
EndSub
'1更新相同公益林图斑计算面积之和（即计算平差系数的分母）
SubupdateGylMj（gylidAsLong,sumMjAsDouble）
DimcnnXXBAsNewADODB.Connection
DimcmdxxbAsNewADODB.Command
SetcnnXXB=CurrentProject.Connection
DimrstAsNewADODB.Recordset
DimstrUpdateAsString
strUpdate="UPDATE无碎片小班面SETGylZMj="+Str（sumMj）+"WHEREgyl_id="+Str（gylid）
Withcmdxxb
.CommandText=strUpdate
.CommandType=adCmdUnknown
.ActiveConnection=cnnXXB
EndWith
Setrst=cmdxxb.Execute
cnnXXB.Close
Setcmdxxb=Nothing
SetcnnXXB=Nothing
EndSub
'2计算平差系数
Subupdatexbpcxs（）
DimcnnXXBAsNewADODB.Connection
DimcmdxxbAsNewADODB.Command
SetcnnXXB=CurrentProject.Connection
DimrstAsNewADODB.Recordset
DimstrUpdateAsString
strUpdate="UPDATE无碎片小班面SETpcxs=[Shape_Area]/[GylZMj]"+"WHEREgyl_id>0"
Withcmdxxb
.CommandText=strUpdate
.CommandType=adCmdUnknown
.ActiveConnection=cnnXXB
EndWith
Setrst=cmdxxb.Execute
cnnXXB.Close
Setcmdxxb=Nothing
SetcnnXXB=Nothing
EndSub
'3计算平差面积
Subupdatexbpcmj（）
DimcnnXXBAsNewADODB.Connection
DimcmdxxbAsNewADODB.Command
SetcnnXXB=CurrentProject.Connection
DimrstAsNewADODB.Recordset
DimstrUpdateAsString
strUpdate="UPDATE无碎片小班面SETNewDxMj=round（[pcxs]*[兑现面积],1）"
Withcmdxxb
.CommandText=strUpdate
.CommandType=adCmdUnknown
.ActiveConnection=cnnXXB
EndWith
Setrst=cmdxxb.Execute
cnnXXB.Close
Setcmdxxb=Nothing
SetcnnXXB=Nothing
EndSub
*******************************************
'2公益林图斑兑现面积平差差值处理
OptionCompareDatabase
OptionExplicit
SubupdateData（）
DimcnnAsADODB.Connection
Setcnn=CurrentProject.Connection
DimstrsqlxxbAsString
DimlngGylidAsLong
DimdouNewdxmjAsDouble
DimdouTbmjAsDouble
DimdouMjcAsDouble
DimstrStartAsString
strStart=Time
'
strsqlxxb="SELECTgyl_id,sum（NewDxMj）,兑现面积"
strsqlxxb=strsqlxxb+"FROM无碎片小班面WHEREgyl_id>0"
strsqlxxb=strsqlxxb+"GROUPBYgyl_id,兑现面积"
strsqlxxb=strsqlxxb+"ORDERBYgyl_id,兑现面积"
DimrsXXBAsADODB.Recordset
SetrsXXB=NewADODB.Recordset
rsXXB.Openstrsqlxxb,cnn,adOpenForwardOnly,adLockBatchOptimistic
DimintXXBAsInteger
DoWhileNotrsXXB.EOF
lngGylid=rsXXB.Fields.Item（0）.Value
douNewdxmj=Round（rsXXB.Fields.Item
（1）.Value,1）
douTbmj=Round（rsXXB.Fields.Item
（2）.Value,1）
douMjc=douNewdxmj-douTbmj
IfdouMjc<>0Then
updatexxblngGylid,douMjc
EndIf
rsXXB.MoveNext
Loop
rsXXB.Close
SetrsXXB=Nothing
cnn.Close
Setcnn=Nothing
MsgBoxstrStart+"开始，"+Str（Time）+"公益林图斑兑现面积平差差值处理结束！
",vbOKOnly,"提示"
EndSub
'公益林图斑兑现面积平差差值处理
Subupdatexxb（gylidAsLong,mjcAsDouble）
DimcnnXXBAsNewADODB.Connection
DimcmdxxbAsNewADODB.Command
DimstrUpdateAsString
SetcnnXXB=CurrentProject.Connection
'查找面积最大图斑
DimrsFindAsADODB.Recordset
SetrsFind=NewADODB.Recordset
DimstrFindAsString
strFind="SELECTgyl_id,Max（NewDxMj）ASxbmjMax"
strFind=strFind+"FROM无碎片小班面WHEREgyl_id="+Str（gylid）
strFind=strFind+"GROUPBYgyl_idORDERBYgyl_id"
rsFind.OpenstrFind,cnnXXB,adOpenForwardOnly,adLockBatchOptimistic
DimlngGylidAsLong
DimdouMaxMjAsDouble
lngGylid=rsFind.Fields.Item（0）.Value
douMaxMj=Round（rsFind.Fields.Item
（1）.Value,1）
'更新面积最大图斑兑现面积
DimrsMAsNewADODB.Recordset
strUpdate="UPDATE无碎片小班面SETNewDxMj="+Str（douMaxMj-mjc）+"WHEREgyl_id="+Str（gylid）
strUpdate=strUpdate+"ANDNewDxMj="+Str（douMaxMj）
Withcmdxxb
.CommandText=strUpdate
.CommandType=adCmdUnknown
.ActiveConnection=cnnXXB
EndWith
SetrsM=cmdxxb.Execute
cnnXXB
升级会员 