刚找了一段VBA程序不能编译，大侠给修改一下吧

fengxue007

本人新手，刚在本版找了一段VBA程序编译不了，请大侠帮忙解决！谢谢

本段程序是关于求解多个不规则封闭图形的总面积、总周长、个数的

Public Sub GetTolArea()
     ThisDrawing.SendCommand "(vl-load-com)" & vbCr
     Dim CurveObj As cruve
     Set CurveObj = New cruve
     Dim VlaxObj As VLAX
     Set VlaxObj = New VLAX
     Dim OutEnt As AcadEntity
     Dim Pnt As Variant
     ThisDrawing.Utility.GetEntity OutEnt, Pnt, "选择外框："
     Dim MinBox As Variant
     Dim MaxBox As Variant
     Dim OutArea As Double
     Dim OutLeng As Double
     OutEnt.GetBoundingBox MinBox, MaxBox
     If OutEnt.ObjectName = "AcDbRegion" Then
         OutArea = OutEnt.Area
         OutLeng = OutEnt.Perimeter
     Else
         Set CurveObj.Entity = OutEnt
         OutArea = CurveObj.Area
         OutLeng = CurveObj.Length
     End If
     'Set CurveObj.Entity = OutEnt
     Dim ss As AcadSelectionSet
     Set ss = CreatSSet
     Dim FType(0)  As Integer
     Dim FData(0)  As Variant
     FType(0) = 0
     FData(0) = "SPLINE"
     ss.Select acSelectionSetWindow, MinBox, MaxBox, FType, FData
     'Debug.Print ss.Count
     Dim i As Integer
     Dim InArea()  As Double
     Dim InLeng()  As Double
     Dim j As Integer
     Dim Ent As AcadEntity
     ReDim Preserve InArea(0) As Double
     ReDim Preserve InLeng(0) As Double
     For i = 0 To ss.Count - 1
         If ss.Item(i).ObjectID > OutEnt.ObjectID Then
             Set Ent = ss(i)
             Set CurveObj.Entity = Ent
             VlaxObj.EvalLispExpression "(gc)"
             If i > 0 Then
                 j = UBound(InArea) + 1
                 ReDim Preserve InArea(j) As Double
                 ReDim Preserve InLeng(j) As Double
                 InArea(j) = CurveObj.Area
                 InLeng(j) = CurveObj.Length
             Else
                 InArea(0) = CurveObj.Area
                 InLeng(0) = CurveObj.Length
             End If
         End If
     Next
     Dim TolArea As Double
     Dim TolLeng As Double
     Dim AreaPer As Double
     Dim dispMsg As String
     dispMsg = "外框的面积为:" & OutArea & "，周长为：" & OutLeng & vbCrLf & vbCrLf
     dispMsg = dispMsg & "内部曲线的面积及周长如下：" & vbCrLf
     For i = 0 To UBound(InArea)
         dispMsg = dispMsg & "曲线" & i & "面积：" & InArea(i) & "，周长：" & InLeng(i) & vbCrLf
        
         TolArea = TolArea + InArea(i)
         TolLeng = TolLeng + InLeng(i)
     Next
     dispMsg = dispMsg & vbCrLf
     dispMsg = dispMsg & "总面积为:" & TolArea & " 总周长为：" & TolLeng & vbCrLf & vbCrLf
     AreaPer = TolArea / OutArea * 100
     dispMsg = dispMsg & "内部曲线面积总各占外框面积的百分比:" & AreaPer & "%"
     'MsgBox dispMsg
     ThisDrawing.Utility.Prompt dispMsg
End Sub
Function CreatSSet()
     Dim ss As AcadSelectionSet
     On Error Resume Next
     Set ss = ThisDrawing.SelectionSets.Add("mccad")
     If Err Then
         Err.Clear
         Set ss = ThisDrawing.SelectionSets("mccad")
         ss.Clear
     End If
     Set CreatSSet = ss
End Function