VB。net getclosestpoint问题
im使用以下代码沿给定向量获取曲线上的最近点EndPt1 = Curve1.GetClosestPointTo(StartPt1, vector1perp, False)
但是，如果该向量与曲线有多个相交，则无法获得曲线上的最近点。代码似乎只是沿着向量扩展，直到到达curve1和vector1Perp的最后一个交点
我认为这个代码中的“False”是为了阻止扩展。
我如何解决这个问题？
我快疯了 你正在使用
曲线GetClosestPointTo方法（Point3d，Vector3d，bool）？
如果是这样，则该向量用于创建投影“曲线”的平面。然后对投影的几何体进行处理，以找到其接近“Point3d”的点。
我认为找到数据库驻留曲线（DBCurve）和非驻留有界向量之间最近点的最佳选择是：
1.创建Autodesk。AutoCAD。几何学基于DBCurve的Curve3d*
2.创建Autodesk。AutoCAD。几何学LineSegment3d使用所需的向量属性。
3.然后使用Curve3d。GetClosestPointTo方法（Curve3d），其中LineSegment3d作为传入参数。返回的数组PointOnCurve3d[]将包含一个或多个对象，可以根据原始DBCurve查询这些对象的点位置。
*我在这个线程的Post#22上发布了DBCurve到Geometry Curve类的开始（有一些曲线类型尚未实现）。
http://www.cadtutor.net/forum/showthread.php?t=33523
它似乎工作得很好，但仍需要大量测试。 谢谢你的快速回复肖特-我一直在努力做你告诉我的事情，但我一直无法使它工作。
这是我写的测试代码，你能看一下并给我一些提示吗。
这将是非常感谢-因为正如你们所知，我只是最近新的vb。net，我试图利用有限的可用资源进行学习。
'
OptionExplicitOn
'Microsoft Namespaces
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices.Marshal
'AutoCad Namespaces - pure NET based
Imports AcadNet = Autodesk.AutoCAD
Imports AcadNetRuntime = Autodesk.AutoCAD.Runtime
Imports AcadNetAppServices = Autodesk.AutoCAD.ApplicationServices
Imports AcadNetDbServices = Autodesk.AutoCAD.DatabaseServices
Imports AcadNetDBTransman = Autodesk.AutoCAD.DatabaseServices.TransactionManager
Imports AcadNetGeometry = Autodesk.AutoCAD.Geometry
Imports AcadNetEditorInput = Autodesk.AutoCAD.EditorInput
'Civil 3D (related) Namespaces - COM based
'Imports AcadCom = Autodesk.AutoCAD.interop
'Imports AcadComCommon = autodesk.AutoCAD.interop.common
Imports Civil3DCom = Autodesk.AECC.Interop.Land
Imports Civil3DComUI = Autodesk.AECC.Interop.UiLand
PublicClass NewClass
<acadnetruntime.CommandMethodAttribute("test")> _
PublicSub test()
Dim DB As AcadNetDbServices.Database = AcadNetDbServices.HostApplicationServices.WorkingDatabase
Dim ED As AcadNetEditorInput.Editor = AcadNetAppServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim ActiveDoc As AcadNetAppServices.Document = AcadNetAppServices.Application.DocumentManager.MdiActiveDocument
Dim Trans2 As AcadNetDbServices.Transaction = DB.TransactionManager.StartTransaction()
Dim TopCurve As AcadNetDbServices.Curve
Dim BottomCurve As AcadNetDbServices.Curve
Try
Dim PDO As AcadNetEditorInput.PromptDoubleOptions = New AcadNetEditorInput.PromptDoubleOptions(vbCr & "Specify distance between lines: ")
PDO.AllowNegative = False
PDO.AllowZero = False
PDO.AllowArbitraryInput = False
PDO.AllowNone = False
PDO.DefaultValue = 5
Dim PDR As AcadNetEditorInput.PromptDoubleResult = ED.GetDouble(PDO)
If PDR.Status <> AcadNetEditorInput.PromptStatus.OK ThenExitSub
Dim PEO1 As AcadNetEditorInput.PromptEntityOptions = New AcadNetEditorInput.PromptEntityOptions(vbCr & "Select top Curve: ")
PEO1.SetRejectMessage(" Invalid entity! Select LWPoly, 2DPoly, 3DPoly, Line, Arc, Circle or Spline only!")
PEO1.AddAllowedClass(GetType(AcadNetDbServices.Curve), False)
Dim PER1 As AcadNetEditorInput.PromptEntityResult = ED.GetEntity(PEO1)
If PER1.Status <> AcadNetEditorInput.PromptStatus.OK ThenExitSub
TopCurve = Trans2.GetObject(PER1.ObjectId, AcadNetDbServices.OpenMode.ForRead)
正如您将看到的那样，如果您测试代码，直线不会得到曲线上最近的交点。你能告诉我你在编码方面的意思吗？？
非常感谢你 上面代码的第二部分
Dim PEO2 As AcadNetEditorInput.PromptEntityOptions = New AcadNetEditorInput.PromptEntityOptions(vbCr & "Select bottom Curve: ")
PEO2.SetRejectMessage(" Invalid entity! Select LWPoly, 2DPoly, 3DPoly, Line, Arc, Circle or Spline only!")
PEO2.AddAllowedClass(GetType(AcadNetDbServices.Curve), False)
Dim PER2 As AcadNetEditorInput.PromptEntityResult = ED.GetEntity(PEO2)
If PER2.Status <> AcadNetEditorInput.PromptStatus.OK ThenExitSub
BottomCurve = Trans2.GetObject(PER2.ObjectId, AcadNetDbServices.OpenMode.ForRead)
Dim TopCurveLen AsDouble = TopCurve.GetDistanceAtParameter(TopCurve.EndParam)
Dim DistBetween AsDouble = PDR.Value
Dim Divstep AsDouble = PDR.Value
Dim StepLength1 AsDouble = 0
Dim Toolong1 AsBoolean = False
While Toolong1 = False
Dim Trans3 As AcadNetDbServices.Transaction = DB.TransactionManager.StartTransaction()
Dim AcadBT As AcadNetDbServices.BlockTable
AcadBT = Trans3.GetObject(DB.BlockTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead)
Dim BTRSpace As AcadNetDbServices.BlockTableRecord = Trans3.GetObject(DB.CurrentSpaceId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite)
Dim AcadBTR As AcadNetDbServices.BlockTableRecord
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If StepLength1 <= TopCurveLen Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim StartPt1 As AcadNetGeometry.Point3d = TopCurve.GetPointAtDist(StepLength1)
Dim Vector1 As AcadNetGeometry.Vector3d = TopCurve.GetFirstDerivative(StartPt1)
Dim Vector1Perp As AcadNetGeometry.Vector3d = Vector1.GetPerpendicularVector()
Dim Vector1PerpNeg As AcadNetGeometry.Vector3d = Vector1Perp.Negate()
Dim EndPt1 As AcadNetGeometry.Point3d = BottomCurve.GetClosestPointTo(StartPt1, Vector1Perp, False)
Dim Line1 As AcadNetDbServices.Line = New AcadNetDbServices.Line()
Line1.StartPoint = StartPt1
Line1.EndPoint = EndPt1
BTRSpace.AppendEntity(Line1)
Trans3.AddNewlyCreatedDBObject(Line1, True)
StepLength1 = StepLength1 + Divstep
Line1.Dispose()
Else
Toolong1 = True
EndIf
Trans3.Commit()
EndWhile
Trans2.Commit()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
MsgBox("error")
MsgBox("Error during execution! " & ex.Message)
Finally
EndTry
EndSub
EndClass
“未来用户友好性”很棒。
这真的很好。谢谢。
获得最近的perp点无疑是一项常见任务在那之后我欠你一些啤酒哈哈
不需要对代码进行注释-我一眼就知道你做了什么，但我会进一步检查，如果我卡住了，我会大喊一声
一旦我完成了，我也会把我完成的代码转发给你，所以如果你觉得它出于任何原因都有用，我会感觉更好
好的课堂——我认为应该是一个标准的课堂——但我想这就是了。
谢谢 我很高兴这有帮助。是的，请上传完整的代码。由于相对稀缺。NET的例子，这个新闻组和我将感谢每一个我们可以得到的。 No enjoy your weekend mate - im in no rush with this - its just something that i want to get done eventually.
When ever you can.
Cheers Here is an example routine that draws a line perpendicular to a “Top Curve” from the closest point on a “Bottom Curve”.
The need to find an intersection of two curves, closest to a particular point, seemed common enough to warrant an extended “Code Reuse” effort.Consequently, I made a ClosestIntersToPt class to make the process more user friendly.This “future user friendliness” does add a bit of complexity to the code as it stands.Let me know if some additional code commenting would make the code more decipherable.
Incidentally, the class still needs to implement a “Projected Intersection” method to stay in line with the current Entity.IntersectWith method.
Importing:
Imports Autodesk.AutoCAD.Runtime
Imports AcadNetAppServices = Autodesk.AutoCAD.ApplicationServices
Imports AcadNetDbServices = Autodesk.AutoCAD.DatabaseServices
Imports AcadNetDBTransman = Autodesk.AutoCAD.DatabaseServices.TransactionManager
Imports AcadNetGeometry = Autodesk.AutoCAD.Geometry
Imports AcadNetEditorInput = Autodesk.AutoCAD.EditorInput
Imports System.Collections.Generic
_ Public Sub Perp2Curve() Dim DB As AcadNetDbServices.Database = AcadNetDbServices.HostApplicationServices.WorkingDatabase Dim ED As AcadNetEditorInput.Editor = AcadNetAppServices.Application.DocumentManager.MdiActiveDocument.Editor Dim ActiveDoc As AcadNetAppServices.Document = AcadNetAppServices.Application.DocumentManager.MdiActiveDocument Dim Trans2 As AcadNetDbServices.Transaction = DB.TransactionManager.StartTransaction() Dim TopCurve As AcadNetDbServices.Curve Dim VectZ As AcadNetGeometry.Vector3d = New AcadNetGeometry.Vector3d(0.0, 0.0, 1.0) Dim pln As AcadNetGeometry.Plane = New AcadNetGeometry.Plane() Dim lnList As List(Of AcadNetDbServices.Line) = New List(Of AcadNetDbServices.Line) Dim Line1 As AcadNetDbServices.Line = New AcadNetDbServices.Line() Try Dim PDO As AcadNetEditorInput.PromptDoubleOptions = New AcadNetEditorInput.PromptDoubleOptions(vbCr & "Specify distance between lines: ") PDO.AllowNegative = False PDO.AllowZero = False PDO.AllowArbitraryInput = False PDO.AllowNone = False PDO.DefaultValue = 5 Dim PDR As AcadNetEditorInput.PromptDoubleResult = ED.GetDouble(PDO) If PDR.StatusAcadNetEditorInput.PromptStatus.OK Then Exit Sub Dim PEO1 As AcadNetEditorInput.PromptEntityOptions = New AcadNetEditorInput.PromptEntityOptions(vbCr & "Select top Curve: ") PEO1.SetRejectMessage(" Invalid entity! Select LWPoly, 2DPoly, 3DPoly, Line, Arc, Circle or Spline only!") PEO1.AddAllowedClass(GetType(AcadNetDbServices.Curve), False) Dim PER1 As AcadNetEditorInput.PromptEntityResult = ED.GetEntity(PEO1) If PER1.StatusAcadNetEditorInput.PromptStatus.OK Then Exit Sub TopCurve = Trans2.GetObject(PER1.ObjectId, AcadNetDbServices.OpenMode.ForRead) PEO1.Message = vbCr & "Select bottom curve: " PER1 = ED.GetEntity(PEO1) If PER1.StatusAcadNetEditorInput.PromptStatus.OK Then Exit Sub Dim objCloseInt As ClosestIntersToPt = New ClosestIntersToPt() objCloseInt.ArgumentCurve = CType(Trans2.GetObject(PER1.ObjectId, AcadNetDbServices.OpenMode.ForRead), AcadNetDbServices.Curve) Dim TopCurveLen As Double = TopCurve.GetDistanceAtParameter(TopCurve.EndParam) Dim DistBetween As Double = PDR.Value Dim Divstep As Double = PDR.Value Dim StepLength1 As Double = 0 Dim StartPt1 As AcadNetGeometry.Point3d Dim Vector1 As AcadNetGeometry.Vector3d While StepLength10 Then lstPt = p3dc(0) Dim minLen As Double = p3dc(0).DistanceTo(BasePoint) Dim tempLen As Double ClosestPt = p3dc(0) If Ubound > 1 Then For i = 1 To p3dc.Count - 1 tempLen = p3dc(i).DistanceTo(BasePoint) If tempLen < minLen Then ClosestPt = p3dc(i) minLen = tempLen End If Next End If Intersects = True Else Intersects = False End If End Sub 'future user friendliness' is great.
That actually works perfect thank you.
It is definatly a common task to get the closest perp point.- i owe you some beers after that one haha
No need for the commenting for the code - i do understand what you have done basically at a glance but i will go over it further and if i get stuck i will give you a yell
I'll also forward on my completed code to you once i finish so if you find it useful for any reason what so ever i'll feel better
Good class - should have been a standard class really i think - but here it is i suppose.
Thanks
页:
[1]
2