背景：

在CASS中提高做图效率，房屋注记一般是通过赋值产生的，这样房屋注记将不会在房屋的中心，现结合ARCGIS实现注记的重新生成，生成的位置将位于房屋的几何中心。

步骤如下：

1、执行ACCS操作；

2、导出SHP；

3、在ARCMAP中打开第二步导出的图，添加X、Y两个字段，类型为DOUBLE，然后通过Calculate Values计算X、Y的值，选择Advance，代码如下：

Dim dblX As Double

Dim pArea As IArea

Set pArea = [Shape]

dblX = pArea.Centroid.X，如果是计算Y坐标，则将X修改为Y

3.1、添加FWZJ字段，代码如下：

dim strZJ as string
if [FWCS] ="1" then
  strzj= [FWJG]
else
  strzj= [FWJG] & [FWCS]
endif

4、修改属性表，并输出为TXT文件，如下：

,561409.991771,3676128.587770,"混"
,560294.425791,3676084.308800,"混2"
,560484.864260,3676094.070100,"简"
,560209.018156,3676078.224680,"混3"
,560252.264983,3676097.674680,"砖"

5、然后在CASS下编写程序，重新生成房屋注记，设好图层、颜色、大小等特性。

'*******************************************************
'名称：Zhan_FWZJ
'作者：罗简单
'日期：2008-10-13
'功能：将从ARCGIS出来的房屋注记重新在CASS中生成，生成的注记
'将位于房屋的几何中心。
'*******************************************************

Public Sub Zhan_FWZJ()
  '打开文件
  Close #1
  Open "C:\11.txt" For Input As #1
  
  Dim myFWZJPosition(0 To 2) As Double
  Dim strData As String
  Dim varData As Variant
  Dim varCoor As Variant
  '进行文件循环
  Do Until EOF(1)
    Input #1, strData, myFWZJ.X, myFWZJ.Y, myFWZJ.ZJ

    myFWZJPosition(0) = myFWZJ.X: myFWZJPosition(1) = myFWZJ.Y: myFWZJPosition(2) = 0
   
    '将注记重新生成，层为JMD
    Dim myFWZJ_Txt As AcadText
    Set myFWZJ_Txt = ThisDrawing.ModelSpace.AddText(myFWZJ.ZJ, myFWZJPosition, 2.5)
    '特性设置
    With myFWZJ_Txt
      .Layer = "JMD"
      .Alignment = acAlignmentMiddle
      .TextAlignmentPoint = myFWZJPosition
    End With
  Loop
 
  '关闭文件
  Close #1
 
  MsgBox "房屋注记重新生成完毕", vbInformation, "房屋注记重生成"
  ThisDrawing.Application.Update  '刷新
End Sub

总结：房屋注记将位于房屋的几何中心，简单房屋、棚房等可根据需要选择注记还是不注记。