<CommandMethod("FindNearestCurve", CommandFlags.Redraw)> _
Public Sub FindNearestCurve()
Dim doc = Application.DocumentManager.MdiActiveDocument
Dim db = doc.Database
Dim ed = doc.Editor
Dim ppr = ed.GetPoint(vbLf & "Pick a point: ")
If ppr.Status <> PromptStatus.OK Then
Return
End If
Dim pt = ppr.Value.TransformBy(ed.CurrentUserCoordinateSystem)
Dim curveClass = RXObject.GetClass(GetType(Curve))
Dim closestId As ObjectId = ObjectId.Null
Using tr = New OpenCloseTransaction()
Dim space = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForRead), BlockTableRecord)
Dim dist As Double = Double.MaxValue
For Each id As ObjectId In space
If id.ObjectClass.IsDerivedFrom(curveClass) Then
Dim curve = CType(tr.GetObject(id, OpenMode.ForRead), Curve)
Dim d As Double = curve.GetClosestPointTo(pt, False).DistanceTo(pt)
If d < dist Then
closestId = id
dist = d
End If
End If
Next
End Using
If Not closestId.IsNull Then
'ed.SetImpliedSelection(closestId)
EntErase(closestId)
End If
End Sub
Public Sub FindNearestCurve()
Dim doc = Application.DocumentManager.MdiActiveDocument
Dim db = doc.Database
Dim ed = doc.Editor
Dim ppr = ed.GetPoint(vbLf & "Pick a point: ")
If ppr.Status <> PromptStatus.OK Then
Return
End If
Dim pt = ppr.Value.TransformBy(ed.CurrentUserCoordinateSystem)
Dim curveClass = RXObject.GetClass(GetType(Curve))
Dim closestId As ObjectId = ObjectId.Null
Using tr = New OpenCloseTransaction()
Dim space = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForRead), BlockTableRecord)
Dim dist As Double = Double.MaxValue
For Each id As ObjectId In space
If id.ObjectClass.IsDerivedFrom(curveClass) Then
Dim curve = CType(tr.GetObject(id, OpenMode.ForRead), Curve)
Dim d As Double = curve.GetClosestPointTo(pt, False).DistanceTo(pt)
If d < dist Then
closestId = id
dist = d
End If
End If
Next
End Using
If Not closestId.IsNull Then
'ed.SetImpliedSelection(closestId)
EntErase(closestId)
End If
End Sub
[本日志由 tiancao1001 于 2018-05-29 09:57 PM 编辑]
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |