[求助]请问下面的算法可以优化吗？

leeyeafu

一张地质图，有上万个图元（AcadObject类型），下面的函数在VBA中执行速度还行，我想在VB6中编译成exe文件，执行时For Each循环就太慢了，请各位看看能否优化，使之执行速度加快。
以下是代码：　　　'MyDocument是全局变量

Private Function NearestEntAttrib(ByVal PickPoint As Variant) As String
'函数接收一个Variant类型的三维坐标点参数，返回该点附近的地质编号
Dim objModelSpace As Object, objEntity As AcadObject, objText As AcadText
Dim strTag As String
strTag = ""
Dim MinDis, Distance As ACAD_DISTANCE
MinDis = 9999999
Set objModelSpace = MyDocument.ModelSpace()  '获取当前图形的模型空间句柄
For Each objEntity In objModelSpace  '扫描模型空间的所有AcadObject对象
  With objEntity
     If StrComp(.EntityName, "AcDbMText", 1) = 0 Or StrComp(.EntityName, "AcDbText") = 0 Then
     '若objEntity为AcDbMText多行文字或AcDbText文本类型
       If IsNumeric(.TextString) And Int(Val(.TextString)) = Val(.TextString) Then
         '复制objEntity为AcadText类型，以获取文本插入点坐标
         Set objText = objModelSpace.AddText(.TextString, .InsertionPoint, 2)
         '文本插入点与PickPoint点之间的距离，因只要比较距离大小，此处不作开方运算
          Distance = (objText.InsertionPoint(0) - PickPoint(0)) _
                   * (objText.InsertionPoint(0) - PickPoint(0)) _
                   + (objText.InsertionPoint(1) - PickPoint(1)) _
                   * (objText.InsertionPoint(1) - PickPoint(1))
           If Distance < MinDis Then
             MinDis = Distance  'MinDis为与PickPoint最近文本的距离值的平方
             strTag = .TextString  '获取文本内容
           End If
           objText.Delete  '删除复制文本
         End If
      End If
  End With
Next objEntity
NearestEntAttrib = strTag
End Function

leeyeafu

我在以上代码中For Each循环前添加了一段代码，增加一个选择集，但运行时出错。
Dim SSel As AcadSelectionSet
Dim pt1(0 To 2), pt2(0 To 2)  As Double
Set SSel = MyDocument.SelectionSets.Add("ss")
pt1(0) = PickPoint(0) - 100: pt1(1) = PickPoint(1) - 100: pt1(2) = PickPoint(2)
pt2(0) = PickPoint(0) + 100: pt2(1) = PickPoint(1) + 100: pt2(2) = PickPoint(2)
SSel.Select acSelectionSetCrossing, pt1, pt2
'程序运行到这出错,错误为“对象'Select'的方法'IAcadSelectionSets'失败”
'这是怎么回事望指教
For Each objEntity In SSel
　　　.........
Next objEntity

[此贴子已经被作者于2002-8-5 11:51:03编辑过]