Point to Line VB .NET

[PanHasan]

Hi

i have a simple problem i think but im new at vba so im asking

So i've got a line in drawing and i pick one point i would like to draw a horizontal line from my point to the line in the drawing but i have no idea how

to do it hope somebody could help

[PanHasan]

I figure out that I could use a ray to draw a line betwen point and a line but how could i find the point where it cros the other line ? in lisp where something like inters but in vb i dont know how

[SEANT]

Before potentially giving inappropriate advise: Which flavor of vb are you interested in, VBA/VB6 or VB.NET?

 

I suppose a example file (preferably in 2007 format) illustrating a before and after would also be helpful.

[PanHasan]

im trying to write in vb net (sorry for that vba) i have a line in drawing and i know how to draw a ray using macro but i dont know how could i find a point where it intersects if they intersect

thx for reply

[SEANT]

Both a Line and Ray derive from the Database CURVE class which, in turn, derives from database ENTITY. As entities, both can employ the Entity.IntersectWith method.

 

 

    <CommandMethod("LRInt")> _
Public Sub LineRayIntersect()
       Dim db As Database = HostApplicationServices.WorkingDatabase
       Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       db.Pdmode = 66 'just to make the points more visible

       Dim peo As PromptEntityOptions = New PromptEntityOptions("Select a Line: ")
       peo.SetRejectMessage("Select only a line!")
       peo.AddAllowedClass(GetType(Line), False)
       Dim tr As Transaction = db.TransactionManager.StartTransaction()
       Using tr
           Try
               Dim per As PromptEntityResult = ed.GetEntity(peo)
               If per.Status <> PromptStatus.OK Then Exit Sub
               Dim ln As Line = tr.GetObject(per.ObjectId, OpenMode.ForRead)
               peo.SetRejectMessage("Select only a Ray!")
               peo.Message = "Select a Ray: "
               peo.RemoveAllowedClass(GetType(Line))
               peo.AddAllowedClass(GetType(Ray), False)
               per = ed.GetEntity(peo)
               If per.Status <> PromptStatus.OK Then Exit Sub
               Dim ry As Ray = tr.GetObject(per.ObjectId, OpenMode.ForRead)
               Dim ptc As Point3dCollection = New Point3dCollection()
               Dim intthis As Integer
               Dim intThat As Integer
               ln.IntersectWith(ry, Intersect.OnBothOperands, ln.GetPlane(), ptc, intthis, intThat)
               If ptc.Count < 1 Then Exit Sub
               Dim ptAtInters As DBPoint = New DBPoint(ptc(0))
               Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
               btr.AppendEntity(ptAtInters)
               tr.AddNewlyCreatedDBObject(ptAtInters, True)
               tr.Commit()
           Catch
               ed.WriteMessage("Error during execution!")
               tr.Abort()
           End Try
       End Using
   End Sub

[PanHasan]

Thanks thats a great help from you but i wonder if there is a posibility to find that point by the ray itself without selecting the line by the user

[SEANT]

It is possible but the routine would have to be set up to iterate through all the curves in the active space that meet the desired criteria. See:

 

Editor.SelectAll Method (SelectionFilter)

 

 

 

Then the same process shown in my previous post would be used on all the filtered curves using the Ray as the base. i.e., ry.IntersectWith(curve, Intersect.OnBothOperands, ry.GetPlane(), ptc, intThis, intThat).

 

If you have problems setting that up, post your code and we’ll do our best to offer suggestions.

[PanHasan]

Ok thanks for all help but i'll try to do it by myself if i'll fail then i'll back ;]

[PanHasan]

Hi once again i made something like that the ray finds the first line(point on a line) on its way any suggestion how could i get the id of that line thats what i wrote

<CommandMethod("pts")> _
   Public Sub pts()
       Dim lineCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acadBaza As Database = lineCmd.Document.Database
       Dim trans As Transaction = acadBaza.TransactionManager.StartTransaction
       Dim opPoint As PromptPointOptions = New PromptPointOptions("Kliknij srodek pomieszczenia :")
       Dim rePoint As PromptPointResult = lineCmd.GetPoint(opPoint)

       ' confstruction of filter
       Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
       Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
       Dim selectResult As PromptSelectionResult = lineCmd.SelectAll(selFilter)
       If rePoint.Status = PromptStatus.OK Then
           Dim rePoint2 As Point3d = New Point3d(rePoint.Value.X + 10, rePoint.Value.Y, 0)
           Dim prosta As Ray = New Ray()
           prosta.BasePoint = rePoint.Value
           prosta.SecondPoint = rePoint2
           Try
               Dim btr As BlockTableRecord = trans.GetObject(acadBaza.CurrentSpaceId, OpenMode.ForWrite)
               btr.AppendEntity(prosta)
               trans.AddNewlyCreatedDBObject(prosta, True)
               If selectResult.Status = PromptStatus.OK Then
                   Dim ss As SelectionSet = selectResult.Value
                   Dim idTab() As ObjectId = ss.GetObjectIds()
                   Dim ra As Ray = CType(trans.GetObject(prosta.Id, OpenMode.ForRead), Ray)
                   Dim ptc As Point3dCollection = New Point3dCollection()
                   Dim intthis As Integer
                   Dim intThat As Integer
                   Dim objId As ObjectId

                   For Each objId In idTab
                       Dim ln As Line = CType(trans.GetObject(objId, OpenMode.ForRead), Line)
                       ln.IntersectWith(ra, Intersect.OnBothOperands, ln.GetPlane(), ptc, intthis, intThat)
                   Next
                   Dim pts As Point3d
                   Dim tmpPt As Point3d
                   tmpPt = ptc.Item(0)
                   Dim i As Integer
                   If ptc.Count > 1 Then
                       For i = 0 To ptc.Count - 1
                           pts = ptc(i)
                           If pts.X < tmpPt.X Then
                               tmpPt = pts
                           End If
                       Next
                   End If
                   lineCmd.WriteMessage(tmpPt.ToString)
               End If
               trans.Commit()
           Catch ex As Exception
               lineCmd.WriteMessage("Wywalilo sie jakis wyjatek" + ex.Message)
           Finally
               trans.Dispose()
           End Try
       End If

   End Sub

 

It would be nice if somebody could correct me if i'm wrong in some ways

[SEANT]

Nice code.

 

Here is one possible way of retrieving the appropriate line.

 

 

Include:

 

Imports System.Collections.Generic

 

    <CommandMethod("pts")> _
       Public Sub pts()
       Dim lineCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acadBaza As Database = lineCmd.Document.Database
       Dim trans As Transaction = acadBaza.TransactionManager.StartTransaction
       Dim opPoint As PromptPointOptions = New PromptPointOptions("Kliknij srodek pomieszczenia :")
       Dim rePoint As PromptPointResult = lineCmd.GetPoint(opPoint)
       Dim crvDict As Dictionary(Of Double, Line) = New Dictionary(Of Double, Line)()
       ' confstruction of filter
       Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
       Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
       Dim selectResult As PromptSelectionResult = lineCmd.SelectAll(selFilter)
       If rePoint.Status = PromptStatus.OK Then
           Dim rePoint2 As Point3d = New Point3d(rePoint.Value.X + 10, rePoint.Value.Y, 0)
           Dim prosta As Ray = New Ray()
           Dim tmpPt As Point3d
           prosta.BasePoint = rePoint.Value
           prosta.SecondPoint = rePoint2
           Try
               Dim btr As BlockTableRecord = trans.GetObject(acadBaza.CurrentSpaceId, OpenMode.ForWrite)
               btr.AppendEntity(prosta)
               trans.AddNewlyCreatedDBObject(prosta, True)
               If selectResult.Status = PromptStatus.OK Then
                   Dim ss As SelectionSet = selectResult.Value
                   Dim idTab() As ObjectId = ss.GetObjectIds()
                   Dim ra As Ray = CType(trans.GetObject(prosta.Id, OpenMode.ForRead), Ray)
                   Dim ptc As Point3dCollection = New Point3dCollection()
                   Dim intthis As Integer
                   Dim intThat As Integer
                   Dim objId As ObjectId
                   Dim x As Double
                   For Each objId In idTab
                       Dim tempptc As Point3dCollection = New Point3dCollection()
                       Dim ln As Line = CType(trans.GetObject(objId, OpenMode.ForRead), Line)
                       ln.IntersectWith(ra, Intersect.OnBothOperands, ln.GetPlane(), tempptc, intthis, intThat)
                       If tempptc.Count > 0 Then
                           For Each pt As Point3d In tempptc
                               x = Math.Round(pt.X, 6)
                               crvDict.Add(x, ln) 'add line to dictionary with X coordinate as Key
                               ptc.Add(pt)
                           Next

                       End If
                   Next
                   trans.Commit()
                   If crvDict.Count > 0 Then
                       Dim pts As Point3d

                       tmpPt = ptc.Item(0)
                       Dim i As Integer
                       If ptc.Count > 1 Then
                           For i = 0 To ptc.Count - 1
                               pts = ptc(i)
                               If pts.X < tmpPt.X Then
                                   tmpPt = pts
                               End If
                           Next
                       End If
                       lineCmd.WriteMessage(tmpPt.ToString)
                       crvDict(Math.Round(tmpPt.X, 6)).Highlight() 'Retrieve line based on X coordinate Key equal to tmpPt.X
                       lineCmd.WriteMessage(" ObjectId: " & crvDict(Math.Round(tmpPt.X, 6)).ObjectId.ToString())
                   Else
                       lineCmd.WriteMessage("No intersections")
                   End If
               End If


           Catch ex As Exception
               lineCmd.WriteMessage("Wywalilo sie jakis wyjatek" + ex.Message)
           Finally
               trans.Dispose()
           End Try

       End If

   End Sub

[PanHasan]

Thank you SEANT you are a great help i think that this thread is end i've get what i need