[求助]请问下面的算法可以优化吗？
一张地质图，有上万个图元（AcadObject类型），下面的函数执行时For Each循环能否优化，使之执行速度加快。以下是代码：
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 = ThisDrawing.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
用过滤器及选择集筛选出多行文字和文字
谢谢明总，我试试，另外可考虑以PickPoint为中心的一个范围内构造选择集
页:
[1]