2015-08-26 1 views
-1

Для моей настройки автокада мне нужно найти точку пересечения круга с линией. Ниже мой код, но он не возвращает мне точку пересечения.
Всегда найдется хотя бы одна точка пересечения из-за ограничений, налагаемых на мою проблему. Но, я действительно не могу получить точку пересечения. Может кто-нибудь помочь мне показать путь к достижению того, что я хочу сделать?найти точку пересечения круга с линией в настройке 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 

Спасибо миллиону тому, кто мне помогает.

ответ

0

Этот призыв к пересечениюWith должен работать. Я пробовал здесь, и все работает нормально. Вы уверены, что круг и линия действительно пересекаются?

Ниже мой код тестирования:

[CommandMethod("findIntersect")] 
public static void CmdFindIntersect() 
{ 
    Editor ed = Application.DocumentManager.MdiActiveDocument.Editor; 
    ObjectId lineId = ed.GetEntity("Select line: ").ObjectId; // not safe, test only 
    ObjectId circleId = ed.GetEntity("Select circle: ").ObjectId; // not safe, test only 

    Database db = Application.DocumentManager.MdiActiveDocument.Database; 
    using (Transaction trans = db.TransactionManager.StartTransaction()) 
    { 
    Line l = trans.GetObject(lineId, OpenMode.ForRead) as Line; 
    Circle c = trans.GetObject(circleId, OpenMode.ForRead) as Circle; 

    Point3dCollection intersectionPoints = new Point3dCollection(); 
    l.IntersectWith(c, Intersect.OnBothOperands, intersectionPoints, IntPtr.Zero, IntPtr.Zero); 

    trans.Commit(); 

    ed.WriteMessage("{0} intersection(s) found", intersectionPoints.Count); 
    } 
} 
+0

Спасибо. Это была моя ошибка. круг и линия в моем чертеже на самом деле не пересекались. проблема решена сейчас. – user5138182

Смежные вопросы