ArcGIS三分式标注、四分式标注和同时上下标实现
- 三分式有后三分式和前分式，后三分式多一些，如下：
系统标注的显示效果：
该标注格式为三分是标注，其中分子为图斑的地类代码，中间为分隔线+图斑的面积，分母为图斑的地类名称。实现该样式标注的详细VBscript代码如下：
点击查看代码
FUNCTION strlen(str)
dim p_len
p_len=0
strlen=0
p_len=len(str)
FOR xx=1 to p_len
IF asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
ELSE
strlen=int(strlen) + 1
END if
NEXT
END function
FUNCTION myFind(cunname,DJH,SHAPE_Area )
dim str
str=SHAPE_Area
dim d
d=strlen(str)
dim d1
dim d2
d1=strlen(cunname) /2
d2=strlen(DJH) /2
if d2>d1 then
d1=d2
end if
myFind = cunname & space(d) &vbnewline & string(d1,"—") & str& vbnewline & DJH & space(d)
END Function
Function FindLabel([DLBM],[DLMC],[shape_area] )
FindLabel = myFind([DLBM],[DLMC],Round([shape_area]*3/2000,1) &"亩" )
End Function
修改FindLabel函数参数，可以是三个，也可以是更多参数；如该函数的标注处理效果，使得字体间隔不符合使用要求的，还需要设置标注字符的间距，具体操作如图所示。
在该图层的属性界面的“标注”选项中，单击“符号”按钮，出现如图所示：
图7-107 编辑字体符号
单击“编辑符号”，切换到格式化文本，设置字符间距和行距，都设置为负值，根据效果设置，如图所示。
设置字体间距和行间距
- 前三分式，效果如下：
点击查看代码
FUNCTION strlen(str)
dim p_len
p_len=0
strlen=0
p_len=len(str)
FOR xx=1 to p_len
IF asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
ELSE
strlen=int(strlen) + 1
END if
NEXT
END function
FUNCTION myFind( cunname, DJH,SHAPE_Area )
dim str
str=SHAPE_Area
dim d
d=strlen(str)
dim d1
dim d2
d1=strlen(cunname) /2
d2=strlen(DJH) /2
if d2>d1 then
d1=d2
end if
myFind =" " & space(d-1) &cunname & vbnewline & str & string(d1, "—") & vbnewline & space(d) & DJH
END Function
Function FindLabel ([小班号],[林种],[树种],[小班面积],[完成面积],[密度],[完成情况])
FindLabel = myFind( [林种] & "-" & [小班面积] & "（" & [完成面积] & "）",[树种] & "-" & [密度] & "-" & [完成情况], [小班号])
End Function
设置和上面一样
- 四分式，效果如下：
点击查看代码
FUNCTION strlen(str)
dim p_len
p_len=0
strlen=0
p_len=len(str)
FOR xx=1 to p_len
IF asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
ELSE
strlen=int(strlen) + 1
END if
NEXT
END function
FUNCTION myFind( cunname, DJH,SHAPE_Area,lb )
dim str
str=SHAPE_Area
dim d
d=strlen(str)
dim d1
dim d2
d1=strlen(cunname) /2
d2=strlen(DJH) /2
if d2>d1 then
d1=d2
end if
myFind =" " & space(d-1) &cunname & vbnewline & str & string(d1, "—") & lb & vbnewline & space(d) & DJH
END Function
Function FindLabel ([小班号],[林种],[树种],[小班面积],[完成面积],[密度],[完成情况],[类别] )
FindLabel = myFind( [林种] & "-" & [小班面积] & "（" & [完成面积] & "）",[树种] & "-" & [密度] & "-" & [完成情况], [小班号],[类别])
End Function
- 上下标同时，效果如下
点击查看代码
Function FindLabel ( [NAME] )
Dim lLen
lLen=StrLen( [NAME] )/2
Dim i
Dim sStr
sStr=""
i=0
Do While i<lLen * 2
sStr=sStr & " "
i=i+1
Loop
FindLabel = [NAME] & "<SUP>" & "上面" & vbcrlf & sStr & "下面" & "</SUP>"
End Function
function strlen(str)
dim p_len
p_len=0
strlen=0
p_len=len(str)
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
else
strlen=int(strlen) + 1
end if
next
end function
