Point to Intersectiion VB.net

November 16, 2014

Hi Autocad Experts,

I am new to Autocad customization using VB.net.

We have a requirement to draw a horizontal line from a given co-ordinate to the point where it intersects with any other line. It's perhaps already discussed in the forum, but since I am new to vb.net, I am not able to put things together.

Appreciate any help I can get from this forum. Looking forward to replies.

Edited November 16, 2014 by vinayds
spelling mistake

November 16, 2014

Welcome to CADTutor.

Perhaps you can share a bit about your environment, and proficiencies that might help us to help you?

What versions are you developing for, what IDE you're using, are you using .NET Wizard or custom template, how are you distributing your app, are just a few questions.

Also, please post your code... It doesn't have to be working, or even well written; just something that shows you've put in the initial effort, and precludes another from having to code it all from scratch (which saves us time to help you).

Cheers

November 17, 2014

Some theory to help, pick pt, enter bearing, pick pt as limit of search, using this "new" line you can get all crossing objects, calculate the intersection point for each and compare so you get say the closest pt or longest. Like Blackbox post code.

November 17, 2014

BLACKBOX/BIGAL:

The version I am developing for is Autocad 2012. And IDE I use is Visual Studio 2012. I intend to use command method of execution for now. I have taken snippets of code from this very forum and made some minor changes to see how it works. Below is the code: This does some things more than what I actually need. My requirement is very simple. 1. User will provide a co-ordinate, 2. Should draw (ONLY) a horizontal line from the given co-ordinate until this horizontal line meets another line or object. I am pretty new to this and hence need your support in getting this worked out. Thanks.


Imports System.Collections.Generic


Imports Autodesk.AutoCAD.ApplicationServices


Imports Autodesk.AutoCAD.Runtime


Imports Autodesk.AutoCAD.EditorInput


Imports Autodesk.AutoCAD.Geometry


Imports Autodesk.AutoCAD.DatabaseServices


Imports Autodesk.AutoCAD.Interop


Imports System.Text.RegularExpressions
































Public Class Class1


   <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("Click on 
a Co-ordinate :")


       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


                           MsgBox(tempptc.Count)


                           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


                       MsgBox(tmpPt.ToString)


                       Dim s As String() = Regex.Split(tmpPt.ToString, 
",")


                       Dim value1 As Double


                       Dim value2 As Double


                       Double.TryParse(s(0).Substring(1), value1)


                       Double.TryParse(s(1), value2)


                       Dim rePoint3 As Point3d = New Point3d(value1, value2, 
0)


                       Dim prosta1 As Line = New Line()


                       prosta1.StartPoint = rePoint.Value


                       prosta1.EndPoint = rePoint3


                       btr.AppendEntity(prosta1)


                       trans.AddNewlyCreatedDBObject(prosta1, True)


                       MsgBox(value1)


                       MsgBox(value2)
































                       trans.Commit()


                       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("There is a problem" + ex.Message)


               MsgBox(ex.Message)


           Finally


               trans.Dispose()


           End Try




















       End If


   End Sub


End Class

Edited November 17, 2014 by vinayds
added code hashtag

November 17, 2014

Hi there,

I tried a set of code which seems to work to a certain extent. But, the horizontal line does not seem to stop at the first intersection. Also, there is a limitation that it only identifies another line for intersection point and not a curve or any other plane. Please help!


Imports System.Collections.Generic


Imports Autodesk.AutoCAD.ApplicationServices


Imports Autodesk.AutoCAD.Runtime


Imports Autodesk.AutoCAD.EditorInput


Imports Autodesk.AutoCAD.Geometry


Imports Autodesk.AutoCAD.DatabaseServices


Imports Autodesk.AutoCAD.Interop
































Public Class Class1


   <CommandMethod("dwl")> _


   Public Sub pts()


       Dim lineCmd As Editor = 
Application.DocumentManager.MdiActiveDocument.Editor


       Dim acadBaza As Database = lineCmd.Document.Database


       Dim opPoint As PromptPointOptions = New PromptPointOptions("Click on 
a Co-ordinate :")


       Dim rePoint As PromptPointResult = lineCmd.GetPoint(opPoint)


       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


           Using trans As Transaction = 
acadBaza.TransactionManager.StartTransaction()


               Try


                   Dim prosta As Line = New Line(New 
Point3d(rePoint.Value.X, rePoint.Value.Y, 0), New Point3d(rePoint.Value.X * 100, 
rePoint.Value.Y, 0))


                   prosta.SetDatabaseDefaults()


                   Dim btr As BlockTableRecord = 
trans.GetObject(acadBaza.CurrentSpaceId, OpenMode.ForWrite)


                   btr.AppendEntity(prosta)


                   trans.AddNewlyCreatedDBObject(prosta, True)


                   Dim ra As Line = CType(trans.GetObject(prosta.Id, 
OpenMode.ForWrite), Line)


                   If selectResult.Status = PromptStatus.OK Then


                       Dim ss As SelectionSet = selectResult.Value


                       Dim idTab() As ObjectId = ss.GetObjectIds()


                       Dim objId As ObjectId


                       Dim x As Double


                       Dim dl As Boolean = True


                       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, 0, 0)


                           If tempptc.Count > 0 And dl Then


                               For Each pt As Point3d In tempptc


                                   x = Math.Round(pt.X, 6)


                                   MsgBox("Second point" & x.ToString 
& ":", MsgBoxStyle.Information)


                                   Dim prosta2 As Line = New Line(New 
Point3d(rePoint.Value.X, rePoint.Value.Y, 0), New Point3d(x, rePoint.Value.Y, 
0))


                                   btr.AppendEntity(prosta2)


                                   trans.AddNewlyCreatedDBObject(prosta2, 
True)


                                   dl = False


                                   Exit For


                               Next


                           End If


                       Next


                   End If


                   ra.Erase(True)


                   trans.Commit()
































               Catch ex As Exception


                   lineCmd.WriteMessage("Error:" + ex.Message)


                   MsgBox(ex.Message)


               Finally


                   trans.Dispose()


               End Try


           End Using


       End If
































   End Sub


End Class

Edited November 17, 2014 by vinayds
added code hashtag

November 17, 2014

Please read the Code Posting Guidelines and edit your posts to include the Code in Code Tags.

Sign In

Point to Intersectiion VB.net

Recommended Posts

vinayds

BlackBox

BIGAL

vinayds

vinayds

SLW210

Join the conversation

Tutorials

Forums

Activity