Civil 3D表面处理帮助！

Sub test()
Dim oApp As AeccApplication
Dim oDoc As AeccDocument
Dim oSurfs As AeccSurfaces
Set oApp = Application.GetInterfaceObject("AeccXUiLand.AeccApplication.7.0")
Set oDoc = oApp.ActiveDocument
Set oSurfs = oDoc.Surfaces
Dim Tindata As New AeccTinCreationData
Tindata.Description = "Building Surface from CPP Building datum" 'SET SURFACE DESCRIPTION
Tindata.Layer = "Surface Bldgs"                 'SET SURFACE LAYER
Tindata.BaseLayer = "Surface Bldgs"             'NOT SURE WHAT THIS DOES
Tindata.Style = "Building Surfaces"             'SET SURFACE STYLE
Dim osurf As AeccSurface
Dim iCount As Integer
For Each osurf In oSurfs
    If osurf.Name Like "BLDG ###" Then
        Dim iTmp As Integer
        iTmp = CInt(Right(osurf.Name, 3))
        If iTmp > iCount Then iCount = iTmp
    End If
Next
Dim sCurName As String
Dim oEnt1 As AcadEntity
Dim oEnt2 As AcadEntity
Dim vPick As Variant
Dim oEnts(0) As AcadEntity
Do Until Err.Number  0
    iCount = iCount + 1
    sCurName = "BLDG " & Format(iCount, "000")
    On Error GoTo ResumeHere
    ThisDrawing.Utility.GetEntity oEnt1, vPick, vbCr & "Select inside pline: "
    Dim sOtype As String
    sOtype = UCase(oEnt1.ObjectName)
    If Not ((sOtype Like "*POLY*") Or (sOtype Like "*FEATURE*")) Then
        Err.Raise -4444444, , "Incorrect object type selected!"
        GoTo ResumeHere
    ''Remove the ElseIf section when the API allows Featurelines
    ElseIf sOtype Like "*FEATURE*" Then
        Err.Raise -4444445, , "Featurelines not currently supported, explode and try again!"
        GoTo ResumeHere
    End If
    ThisDrawing.Utility.GetEntity oEnt2, vPick, vbCr & "Select outside pline: "
    sOtype = UCase(oEnt2.ObjectName)
    If Not ((sOtype Like "*POLY*") Or (sOtype Like "*FEATURE*")) Then
        Err.Raise -4444444, , "Incorrect object type selected!"
        GoTo ResumeHere
    ''Remove the ElseIf section when the API allows Featurelines
    ElseIf sOtype Like "*FEATURE*" Then
        Err.Raise -4444445, , "Featurelines not currently supported, explode and try again!"
        GoTo ResumeHere
    End If
    Tindata.Name = sCurName
    Dim oTinSurf As AeccTinSurface
    Set oTinSurf = oSurfs.AddTinSurface(Tindata)
    Set oEnts(0) = oEnt1
    oTinSurf.Breaklines.AddStandardBreakline oEnts, "Interior Breakline", 0.5
    Set oEnts(0) = oEnt2
    oTinSurf.Breaklines.AddStandardBreakline oEnts, "Exterior Breakline", 0.5
    oTinSurf.Boundaries.Add oEnt2, "Exterior Boundary", aeccBoundaryOuter, True, 0.5
ResumeHere:
Select Case Err.Number
    Case Is = -4444444
        MsgBox Err.Description
    Case Is = -4444445
        MsgBox Err.Description
    Case Else
'        MsgBox Err.Description ''uncomment to test for the error thrown, comment out to run normally
End Select
Loop
End Sub