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

部分內容來自《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
  

來自：https://mp.weixin.qq.com/s?__biz=MzUxMTY4ODY5Mw==&mid=2247483920&idx=1&sn=5551ab658e31856ca13f8a1d298f5cd3&chksm=f96ea88ace19219cc1dd67264fd0758ba8b84179c07d49bb6b0e0c77fbed67c741e095ed4e7d&mpshare=1&scene=23&srcid=0724g8BtYmJAeOUZAStJ2dtU&sharer_sharetime=1595548963585&sharer_shareid=7148a001c4203b53e043c2b97146c8ed#rd