Для моей настройки автокада мне нужно найти точку пересечения круга с линией. Ниже мой код, но он не возвращает мне точку пересечения.
Всегда найдется хотя бы одна точка пересечения из-за ограничений, налагаемых на мою проблему. Но, я действительно не могу получить точку пересечения. Может кто-нибудь помочь мне показать путь к достижению того, что я хочу сделать?найти точку пересечения круга с линией в настройке autocad с помощью vb.net
Imports System
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices.DocumentExtension
Namespace sweeping
Public Class intersecting
<CommandMethod("ITSSPS")>
Public Shared Sub SweepAlongPath()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using tr As Transaction = db.TransactionManager.StartTransaction()
'getting point1
Dim ppo1 As PromptPointOptions = New PromptPointOptions(vbLf & "choose/click the centre of the first circle:")
Dim ppr1 As PromptPointResult = doc.Editor.GetPoint(ppo1)
Dim pt1 As Point3d = ppr1.Value
If ppr1.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo11 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "The radius of the first cycle? Type 5 as 5.0")
Dim pdr11 As PromptDoubleResult = doc.Editor.GetDouble(pdo11)
Dim pd11 As Double = pdr11.Value
If pdr11.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo12 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "What about the height? Type 5 as 5.0")
Dim pdr12 As PromptDoubleResult = doc.Editor.GetDouble(pdo12)
Dim pd12 As Double = pdr12.Value
If pdr12.Status = PromptStatus.Cancel Then Exit Sub
'getting point2
Dim ppo2 As PromptPointOptions = New PromptPointOptions(vbLf & "choose/click the centre of the second circle:")
Dim ppr2 As PromptPointResult = doc.Editor.GetPoint(ppo2)
Dim pt2 As Point3d = ppr2.Value
If ppr2.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo21 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "The radius of the second cycle? Type 5 as 5.0")
Dim pdr21 As PromptDoubleResult = doc.Editor.GetDouble(pdo21)
Dim pd21 As Double = pdr21.Value
If pdr21.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo22 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "What about the height? Type 5 as 5.0")
Dim pdr22 As PromptDoubleResult = doc.Editor.GetDouble(pdo22)
Dim pd22 As Double = pdr22.Value
If pdr22.Status = PromptStatus.Cancel Then Exit Sub
Dim line12 As Line = New Line(pt1, pt2)
Dim Cir1, Cir2 As Circle
Cir1 = New Circle() : Cir1.Center = pt1 : Cir1.Normal = New Vector3d(0, 0, 1) : Cir1.Radius = pd11
Cir2 = New Circle() : Cir2.Center = pt2 : Cir2.Normal = New Vector3d(0, 0, 1) : Cir2.Radius = pd21
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim Cir11 As Entity = DirectCast(Cir1, Entity)
Dim line121 As Entity = DirectCast(line12, Entity)
btr.AppendEntity(Cir11)
tr.AddNewlyCreatedDBObject(Cir11, True)
btr.AppendEntity(line121)
tr.AddNewlyCreatedDBObject(line121, True)
Dim its3dpts As Point3dCollection = New Point3dCollection()
line121.IntersectWith(Cir11, Intersect.OnBothOperands, its3dpts, IntPtr.Zero, IntPtr.Zero)
For Each pt3d As Point3d In its3dpts
Dim ptt As Point3d = pt3d
Dim Cir3 As Circle = New Circle()
Cir3.Center = ptt : Cir3.Normal = New Vector3d(0, 0, 1) : Cir3.Radius = 450
ed.WriteMessage(pt3d.ToString)
btr.AppendEntity(Cir3)
tr.AddNewlyCreatedDBObject(Cir3, True)
Next
tr.Commit()
End Using
End Sub
End Class
End Namespace
Спасибо миллиону тому, кто мне помогает.
Спасибо. Это была моя ошибка. круг и линия в моем чертеже на самом деле не пересекались. проблема решена сейчас. – user5138182