ArcGIS三分式標註、四分式標註和同時上下標實現

阿新 • • 發佈：2020-08-03

部分內容來自《ArcGIS從0到1》，掃碼下面加微信公眾號

可以在：https://item.jd.com/12668816.html購買

1.三分式有後三分式和前分式，後三分式多一些，如下：

使用資料：“chp7\三分式.mxd”文件，，系統標註的顯示效果如下：該標註格式為三分是標註，其中分子為圖斑的地類程式碼，中間為分隔線+圖斑的面積，分母為圖斑的地類名稱。實現該樣式標註的詳細VBscript程式碼如下：

程式碼如下：'設計人：閆磊'----------FUNCTION STRLEN(STR)----------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   NEXTEND functionFUNCTION 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 編輯字型符號

單擊“編輯符號”，切換到格式化文字，設定字元間距和行距，都設定為負值，根據效果設定，如圖所示。

設定字型間距和行間距

2.前三分式，效果如下：

'----------FUNCTION STRLEN(STR)----------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
'編制日期:2012-03-25Function FindLabel ([小班號],[林種],[樹種],[小班面積],[完成面積],[密度],[完成情況])  FindLabel = myFind( [林種] & "-" & [小班面積] & "（" & [完成面積] & "）",[樹種] & "-" & [密度] & "-" & [完成情況], [小班號])End Function

設定和上面一樣

3.四分式，效果如下：

'----------FUNCTION STRLEN(STR)----------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
'編制日期:2012-03-25Function FindLabel ([小班號],[林種],[樹種],[小班面積],[完成面積],[密度],[完成情況],[類別] )  FindLabel = myFind( [林種] & "-" & [小班面積] & "（" & [完成面積] & "）",[樹種] & "-" & [密度] & "-" & [完成情況], [小班號],[類別])End Function

4.上下標同時，效果如下

程式碼如下

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 Functionfunction strlen(str)dim p_lenp_len=0strlen=0p_len=len(str)for xx=1 to p_lenif asc(mid(str,xx,1))<0 thenstrlen=int(strlen) + 2elsestrlen=int(strlen) + 1end ifnextend function