自动赋值代码从100开始赋

Private Function getSouthBM(ByRef aEnt As AcadEntity) As String
On Error GoTo EH
  getSouthBM = getSouthX(aEnt)
EH:
  'Debug.Print "产生错误于模块  getSouthCodeBM,错误说明为:     " & Err.Description
End Function

Private Function getSouthX(ByRef aEnt As AcadEntity, Optional idx As Integer = 1) As String
On Error GoTo EH

    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    Dim groupCode As Variant, dataCode As Variant
    aEnt.GetXData "SOUTH", xtypeOut, xdataOut
    If IsEmpty(xtypeOut) Then
      getSouthX = ""
    Else
      getSouthX = CStr(xdataOut(idx))
    End If
    Exit Function
EH:

End Function
Private Sub setSouthX(ByRef aEnt As AcadEntity, ByRef sVal As String, Optional idx As Integer = 1)
On Error GoTo EH

    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    Dim groupCode As Variant, dataCode As Variant
    aEnt.GetXData "SOUTH", xtypeOut, xdataOut
    xdataOut(idx) = sVal
    aEnt.SetXData xtypeOut, xdataOut


    Exit Sub
EH:

End Sub

Private Function getSouthZDH(ByRef aEnt As AcadEntity) As String
On Error GoTo EH
  getSouthZDH = getSouthX(aEnt, 2)
EH:

End Function
Private Function getSouthQLR(ByRef aEnt As AcadEntity) As String
On Error GoTo EH
  getSouthQLR = getSouthX(aEnt, 3)
EH:

End Function

Private Function getSouthDLH(ByRef aEnt As AcadEntity) As String
On Error GoTo EH
  getSouthDLH = getSouthX(aEnt, 4)
EH:

End Function

Private Sub BatchModify(idx As Integer)
'idx =2 修改宗地号 idx =3 修改权利人 idx =4 修改地类
On Error Resume Next
  Dim aEnt As AcadEntity
  Dim sOld As String
  Dim sNew As String
  '<1>加前缀<2>加后缀<3>字符替换
  Dim sPstr As String '前缀
  Dim sEstr As String '后缀
  Dim sFind, sReplace As String
  Dim sOp As String

  sFind = ""
  sReplace = ""
  sPstr = ""
  sEstr = ""

  sOp = ThisDrawing.Utility.GetString(False, "<1>加前缀<2>加后缀<3>字符替换<4>前缀自动赋值")

  Select Case CInt(sOp)
    Case 1
      sPstr = ThisDrawing.Utility.GetString(False, "输入前缀 :" + vbCrLf)
    Case 2
      sEstr = ThisDrawing.Utility.GetString(False, vbCrLf & "输入后缀 :" + vbCrLf)
    Case 3
      sFind = ThisDrawing.Utility.GetString(False, vbCrLf & "请输入查找的字符 :" + vbCrLf)
      sReplace = ThisDrawing.Utility.GetString(True, vbCrLf & "请输入替换的字符 :" + vbCrLf)
    Case 4

        自动赋值代码？100开始递增？？？？？？？？？？

？？？？？？？？？？？？？？？？？？？？？？？

    Case Else
  End Select


  For Each aEnt In ThisDrawing.ModelSpace
    If getSouthBM(aEnt) = "300000" Then  '权属线
      sOld = getSouthX(aEnt, idx)

      If sReplace = " " Then sReplace = ""
      sNew = sPstr & Replace(sOld, sFind, sRepalce) & sEstr
      setSouthX aEnt, sNew, idx

    End If
  Next


End Sub

Public Sub modifyDJH()
BatchModify (2)
End Sub

Public Sub modifyQLR()
BatchModify (3)
End Sub
Public Sub modifyDLH()
BatchModify (4)
End Sub

大家好，请问CAD中这样子的修改属性，自动赋值怎么修改这段代码呢？谢谢！坐等啊，急用

Private Function getSouthBM(ByRef aEnt As AcadEntity) As String

On Error GoTo EH

  getSouthBM = getSouthX(aEnt)

EH:

  'Debug.Print "产生错误于模块  getSouthCodeBM,错误说明为:     " & Err.Description

End Function





Private Function getSouthX(ByRef aEnt As AcadEntity, Optional idx As Integer = 1) As String

On Error GoTo EH



    Dim xdataOut As Variant

    Dim xtypeOut As Variant

    Dim groupCode As Variant, dataCode As Variant

    aEnt.GetXData "SOUTH", xtypeOut, xdataOut

    If IsEmpty(xtypeOut) Then

      getSouthX = ""

    Else

      getSouthX = CStr(xdataOut(idx))

    End If

    Exit Function

EH:



End Function

Private Sub setSouthX(ByRef aEnt As AcadEntity, ByRef sVal As String, Optional idx As Integer = 1)

On Error GoTo EH



    Dim xdataOut As Variant

    Dim xtypeOut As Variant

    Dim groupCode As Variant, dataCode As Variant

    aEnt.GetXData "SOUTH", xtypeOut, xdataOut

    xdataOut(idx) = sVal

    aEnt.SetXData xtypeOut, xdataOut



    

    Exit Sub

EH:



End Sub











Private Function getSouthZDH(ByRef aEnt As AcadEntity) As String

On Error GoTo EH

  getSouthZDH = getSouthX(aEnt, 2)

EH:



End Function

Private Function getSouthQLR(ByRef aEnt As AcadEntity) As String

On Error GoTo EH

  getSouthQLR = getSouthX(aEnt, 3)

EH:



End Function



Private Function getSouthDLH(ByRef aEnt As AcadEntity) As String

On Error GoTo EH

  getSouthDLH = getSouthX(aEnt, 4)

EH:



End Function



Private Sub BatchModify(idx As Integer)

 'idx =2 修改宗地号 idx =3 修改权利人 idx =4 修改地类

On Error Resume Next

  Dim aEnt As AcadEntity

  Dim sOld As String

  Dim sNew As String

  '<1>加前缀<2>加后缀<3>字符替换

  Dim sPstr As String '前缀

  Dim sEstr As String '后缀

  Dim sFind, sReplace As String

  Dim sOp As String

  

  sFind = ""

  sReplace = ""

  sPstr = ""

  sEstr = ""

  

  sOp = ThisDrawing.Utility.GetString(False, "<1>加前缀<2>加后缀<3>字符替换<4>前缀自动赋值")

  

  Select Case CInt(sOp)

    Case 1

      sPstr = ThisDrawing.Utility.GetString(False, "输入前缀 :" + vbCrLf)

    Case 2

      sEstr = ThisDrawing.Utility.GetString(False, vbCrLf & "输入后缀 :" + vbCrLf)

    Case 3

      sFind = ThisDrawing.Utility.GetString(False, vbCrLf & "请输入查找的字符 :" + vbCrLf)

      sReplace = ThisDrawing.Utility.GetString(True, vbCrLf & "请输入替换的字符 :" + vbCrLf)

    Case 4

    

        自动赋值代码？100开始递增？？？？？？？？？？

          

？？？？？？？？？？？？？？？？？？？？？？？



    Case Else

  End Select

    



  For Each aEnt In ThisDrawing.ModelSpace

    If getSouthBM(aEnt) = "300000" Then  '权属线

      sOld = getSouthX(aEnt, idx)



      If sReplace = " " Then sReplace = ""

      sNew = sPstr & Replace(sOld, sFind, sRepalce) & sEstr

      setSouthX aEnt, sNew, idx

      

    End If

  Next

  



End Sub



Public Sub modifyDJH()

BatchModify (2)

End Sub



Public Sub modifyQLR()

BatchModify (3)

End Sub

Public Sub modifyDLH()

BatchModify (4)

End Sub



大家好，请问CAD中这样子的修改属性，自动赋值怎么修改这段代码呢？谢谢！

    Case 4               自动赋值代码？100开始递增？？？？？？？？？？             ？？？？？？？？？？？？？？？？？？？？？？？

在case 4部分添加一句 count=count+1不就久可以了吗?
当然，count为一个模块级或全局变量，且初始值为100

补充：VB ,  VBA