Jump to content
PanHasan

Trace line .net

Recommended Posts

PanHasan

Hi

i wrote some code but it works only sometimes :? and I cant figure out why is that The code suppose to trace a line using rays and a small lines (if there is a need i can draw some file with my conception) the problem is strange when i draw two lines something like "/\" and i start the ray "->/\" it sometimes work and sometimes draw some stupids if anybody could look at the code with criticism thx

   <CommandMethod("src")> _
      Public Sub src()
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction

           Dim usrPtOp As PromptPointOptions = New PromptPointOptions("Wskarz srodek pomieszczenia" + vbCrLf)
           Dim usrPt As PromptPointResult = lCmd.GetPoint(usrPtOp)

           Dim prevPt As Point3d = usrPt.Value
           Dim nextPt As Point3d = usrPt.Value

           If usrPt.Status = PromptStatus.OK Then ' sprawdzenie czy poprawnie wpisano punkt poczatkowy
               Dim usrPtXmod As Point3d = New Point3d(usrPt.Value.X + 1, usrPt.Value.Y, usrPt.Value.Z)
               Dim ls3d As LineSegment3d = New LineSegment3d(usrPt.Value, usrPtXmod)

               'FILTRACJA LINII
               Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
               Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
               Dim selResult As PromptSelectionResult = lCmd.SelectAll(selFilter)
               Dim ssLinie As SelectionSet = selResult.Value
               Dim tabId() As ObjectId
               If selResult.Status = PromptStatus.OK Then ' sprawdzenie czy w rysunku znajduja sie jakies linie
                   If ssLinie.Count >= 1 Then
                       tabId = ssLinie.GetObjectIds

                       Dim oid As ObjectId
                       Dim tmpPt2 As Point3d
                       Dim przeciecia As Integer

                       Dim lnL1 As Line = New Line()
                       Dim promienSledzacy As Ray = New Ray()
                       Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                       'dodanie do rysunku lnL1 i promienia sledzacego bez parametrow jeszcze niewidoczne
                       btr.AppendEntity(lnL1)
                       trn.AddNewlyCreatedDBObject(lnL1, True)
                       btr.AppendEntity(promienSledzacy)
                       trn.AddNewlyCreatedDBObject(promienSledzacy, True)
                       ' rysowanie pierwszego promienia sledzacego
                       oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                       Dim lnNajblizsza As Line = CType(trn.GetObject(oid, OpenMode.ForRead), Line)

                       'Sprawdzenie ktory punkt jest nizej
                       Dim START As Point3d
                       Dim FIN As Point3d
                       Dim PunktyPomieszczenia As Point3dCollection = New Point3dCollection()
                       If lnNajblizsza.StartPoint.Y > lnNajblizsza.EndPoint.Y Then
                           START = lnNajblizsza.EndPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                       Else
                           START = lnNajblizsza.StartPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                       End If
                       Dim IloscWszystkichLinii As Integer = tabId.Count()
                       Dim licznik As Integer = 0
                       Dim bezpiecznik As Integer = 0
                       While (licznik < IloscWszystkichLinii) And (bezpiecznik < IloscWszystkichLinii * 6)
                           rysujOdPomocniczy(prevPt, nextPt, tmpPt2, lnL1)
                           szukajPrzecieciaPomocniczego(przeciecia, prevPt, nextPt, tmpPt2, tabId, lnL1)
                           If przeciecia = 0 Then
                               prevPt = tmpPt2
                           ElseIf przeciecia = 1 Then
                               licznik = licznik + 1
                               ls3d = New LineSegment3d(nextPt, prevPt)
                               Using trn1 As Transaction = acBaza.TransactionManager.StartTransaction
                                   Try
                                       Dim btr1 As BlockTableRecord = trn1.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                                       Dim ll As Line = CType(trn1.GetObject(lnNajblizsza.ObjectId, OpenMode.ForWrite), Line)
                                       ll.Erase()
                                       trn1.Commit()
                                   Catch ex As Exception
                                       lCmd.WriteMessage("Wyjatek w usowanie linii" + vbCrLf)
                                   Finally
                                       trn1.Dispose()
                                   End Try
                               End Using
                               'aktualizacja lini z rysunku
                               selResult = (lCmd.SelectAll(selFilter))
                               ssLinie = selResult.Value
                               tabId = ssLinie.GetObjectIds
                               'rysowanie promieni
                               oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                               przeciecia = 0
                               lnNajblizsza = CType(trn.GetObject(oid, OpenMode.ForRead), Line)
                           Else
                               lCmd.WriteMessage("WIECEJ NIZ JEDNO PRZECIECIE" + vbCrLf)
                           End If
                           bezpiecznik = bezpiecznik + 1
                       End While
                       If bezpiecznik = IloscWszystkichLinii * 4 Then
                           lCmd.WriteMessage("Linia nie zakonczona")
                       End If
                   Else
                       lCmd.WriteMessage("ERROR : Mniej niz 3 linie pomieszczenie nie moze byc domkniete")
                   End If
               Else
                   lCmd.WriteMessage("ERROR : Brak linii w rysunku")
               End If
               trn.Commit()
           End If
       End Using

   End Sub
   ' RYSUJE PROMIEN SLEDZACY
   ' DRAW A TRACING RAY
   ' SZUKA LINII NAJBLIZSZEJ DANEMU PUNKTOWI
   ' SEARCH FOR THE NEAREST LINE FOR THE POINT
   Public Function przecieciaPromienia(ByRef promienSledzacy As Ray, ByRef ls3d As LineSegment3d, ByRef tabID() As ObjectId, ByRef prevPt As Point3d, ByRef nextPt As Point3d) As ObjectId
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Database
       Dim lnNajblizsza As Line = Nothing
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction
           Try
               Dim btr As BlockTableRecord = CType(trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
               Dim objID As ObjectId
               Dim ra3d As Ray3d = New Ray3d(ls3d.StartPoint, ls3d.EndPoint)

               Dim odl As Single = 0.0
               Dim odlTmp As Single = 0.0
               For Each objID In tabID
                   Dim ln As Line = CType(trn.GetObject(objID, OpenMode.ForRead), Line)
                   Dim ls As LineSegment3d = New LineSegment3d(ln.StartPoint, ln.EndPoint)
                   Dim ptArray() As Point3d = ls.IntersectWith(ra3d)
                   If ptArray Is Nothing Then Continue For
                   Dim ptkPrzeciecia As Point3dCollection = New Point3dCollection(ptArray)
                   'SZUKANIE PIERWSZEJ NAJBLIZSZEJ LINII   
                   '   odl=sqrt ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)) 
                   odlTmp = Math.Sqrt((prevPt.X - ptkPrzeciecia.Item(0).X) * (prevPt.X - ptkPrzeciecia.Item(0).X) + (prevPt.Y - ptkPrzeciecia.Item(0).Y) * (prevPt.Y - ptkPrzeciecia.Item(0).Y))
                   If odl = 0.0 Then
                       odl = odlTmp
                       nextPt = ptkPrzeciecia.Item(0)
                       lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                       lnNajblizsza = ln
                   ElseIf odl >= odlTmp Then
                       nextPt = ptkPrzeciecia.Item(0)
                       lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                       lnNajblizsza = ln
                   End If
               Next
               promienSledzacy = CType(trn.GetObject(promienSledzacy.ObjectId, OpenMode.ForWrite), Ray)
               promienSledzacy.BasePoint = ls3d.StartPoint
               promienSledzacy.SecondPoint = ls3d.EndPoint
               trn.Commit()
           Catch ex As Exception
               lCmd.WriteMessage("Wyjatek w przecieciaPromienia" + ex.ToString + vbCrLf)
           End Try
           Return lnNajblizsza.ObjectId
       End Using
   End Function
   'RYSUJE MALE ODCINKI POMOCNICZE
   'DRAW A LITTLES HELP LINES
   Public Sub rysujOdPomocniczy(ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef tmpPt2 As Point3d, ByRef lnL1 As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
       Dim tmpPt1 As Point3d = prevPt
       tmpPt2 = nextPt
       ' WYZNACZANIE KATOW KTORE TRZEBA SPRAWDZIC NA PODSTWAIE POPRZEDNIEGO PUNKTU
       Try
           lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)
           'Wariant I
           If Math.Round(prevPt.X) = Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant II
           ElseIf Math.Round(prevPt.Y) = Math.Round(nextPt.Y) Then
               If nextPt.X > prevPt.X Then
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant III
           ElseIf Math.Round(prevPt.X) < Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0) ' poprawiono
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant IV
           ElseIf Math.Round(prevPt.X) > Math.Round(nextPt.X) Then
               If nextPt.Y < prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
           End If
           ' lCmd.WriteMessage(lnL1.StartPoint.ToString + "-" + lnL1.EndPoint.ToString + vbCrLf)
           trn.Commit()
       Catch ex As Exception
           lCmd.WriteMessage("Wyjatek w rysujOdPomocniczy" + vbCrLf)
       Finally
           trn.Dispose()
       End Try
   End Sub
   ' SEARCHES THE INTERS OF THE LITTLE HELP LINE
   Public Sub szukajPrzecieciaPomocniczego(ByRef przeciecia As Integer, ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef tmpPt2 As Point3d, ByRef tabID() As ObjectId, ByRef lnL1 As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim Cl_crsPt As Point3dCollection = New Point3dCollection()
       Dim intPomoc1 As Integer
       Dim intPomoc2 As Integer
       Try
           Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
           Dim obj As ObjectId
           For Each obj In tabID
               Dim ln As Line = CType(trn.GetObject(obj, OpenMode.ForRead), Line)
               ln.IntersectWith(lnL1, Intersect.OnBothOperands, lnL1.GetPlane(), Cl_crsPt, intPomoc1, intPomoc2)
           Next
           przeciecia = Cl_crsPt.Count
           If Cl_crsPt.Count = 1 Then
               prevPt = Cl_crsPt.Item(0)
           ElseIf Cl_crsPt.Count > 1 Then
               lCmd.WriteMessage("Wiecej niz jedno przeciecie:" + Cl_crsPt.Count.ToString)
               Dim tmpPunkt As Point3d
               Dim odlPtkTmp As Single
               Dim odlPtk As Single
               For Each tmpPunkt In Cl_crsPt
                   odlPtkTmp = Math.Sqrt((prevPt.X - Cl_crsPt.Item(0).X) * (prevPt.X - Cl_crsPt.Item(0).X) + (prevPt.Y - Cl_crsPt.Item(0).Y) * (prevPt.Y - Cl_crsPt.Item(0).Y))
                   If odlPtk = 0.0 Then
                       odlPtk = odlPtkTmp
                       nextPt = Cl_crsPt.Item(0)
                   ElseIf odlPtk >= odlPtkTmp Then
                       nextPt = Cl_crsPt.Item(0)
                   End If
                   przeciecia = 1
               Next
           End If
           trn.Commit()
       Catch ex As Exception
           lCmd.WriteMessage("Wyjatek w szukajPrzecieciaPomocniczego" + vbCrLf)
       Finally
           trn.Dispose()
       End Try
   End Sub

Share this post


Link to post
Share on other sites
SEANT

I think it would be helpful to post a drawing showing a setup which the routine is designed to address, and the same setup as it should appear after the routine has run successfully. This will help us offer useful debugging suggestions, especially given that some of us won’t understand many the variable names or comments.

 

I guess an example file where the routine fails (if it actually fails in a consistent fashion) will also help with debugging.

Share this post


Link to post
Share on other sites
PanHasan

Hi

i've added some english comments but if it still not clear i'll add it where you'll need to

    <CommandMethod("src")> _
      Public Sub src()
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction

           Dim usrPtOp As PromptPointOptions = New PromptPointOptions("Wskarz srodek pomieszczenia" + vbCrLf)
           Dim usrPt As PromptPointResult = lCmd.GetPoint(usrPtOp)

           Dim prevPt As Point3d = usrPt.Value
           Dim nextPt As Point3d = usrPt.Value

           If usrPt.Status = PromptStatus.OK Then ' sprawdzenie czy poprawnie wpisano punkt poczatkowy
               Dim usrPtXmod As Point3d = New Point3d(usrPt.Value.X + 1, usrPt.Value.Y, usrPt.Value.Z)
               Dim ls3d As LineSegment3d = New LineSegment3d(usrPt.Value, usrPtXmod)

               'FILTRACJA LINII
               Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
               Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
               Dim selResult As PromptSelectionResult = lCmd.SelectAll(selFilter)
               Dim ssLinie As SelectionSet = selResult.Value
               Dim tabId() As ObjectId
               If selResult.Status = PromptStatus.OK Then ' sprawdzenie czy w rysunku znajduja sie jakies linie
                   If ssLinie.Count >= 1 Then
                       tabId = ssLinie.GetObjectIds
                       Dim oid As ObjectId
                       Dim tmpPt2 As Point3d
                       Dim przeciecia As Integer

                       Dim lnL1 As Line = New Line()
                       Dim promienSledzacy As Ray = New Ray()
                       Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                       'dodanie do rysunku lnL1 i promienia sledzacego bez parametrow jeszcze niewidoczne
                       'adding an empty objects to drawing
                       btr.AppendEntity(lnL1)
                       trn.AddNewlyCreatedDBObject(lnL1, True)
                       btr.AppendEntity(promienSledzacy)
                       trn.AddNewlyCreatedDBObject(promienSledzacy, True)
                       ' rysowanie pierwszego promienia sledzacego
                       ' draw the first ray and returning the nearest line by its objId
                       oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                       Dim lnNajblizsza As Line = CType(trn.GetObject(oid, OpenMode.ForRead), Line)

                       'Sprawdzenie ktory punkt jest nizej
                       Dim START As Point3d ' it unused now
                       Dim FIN As Point3d ' it unused now
                       ' collection of important points in future to redraw a lines
                       Dim PunktyPomieszczenia As Point3dCollection = New Point3dCollection()
                       If lnNajblizsza.StartPoint.Y > lnNajblizsza.EndPoint.Y Then
                           START = lnNajblizsza.EndPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                       Else
                           START = lnNajblizsza.StartPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                       End If
                       Dim IloscWszystkichLinii As Integer = tabId.Count() ' tab of all lines
                       Dim licznik As Integer = 0
                       Dim bezpiecznik As Integer = 0
                       While (licznik < IloscWszystkichLinii) And (bezpiecznik < IloscWszystkichLinii * 6) And (START <> FIN)
                           rysujOdPomocniczy(prevPt, nextPt, tmpPt2, lnL1) ' draw the lnL1
                           szukajPrzecieciaPomocniczego(przeciecia, prevPt, nextPt, tmpPt2, tabId, lnL1) ' check if the lnL1 inters with something
                           If przeciecia = 0 Then
                               prevPt = tmpPt2
                           ElseIf przeciecia = 1 Then ' if inters = 1
                               licznik = licznik + 1
                               ls3d = New LineSegment3d(nextPt, prevPt)
                               Using trn1 As Transaction = acBaza.TransactionManager.StartTransaction
                                   Try
                                       ' deleting the last nearest line
                                       Dim btr1 As BlockTableRecord = trn1.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                                       Dim ll As Line = CType(trn1.GetObject(lnNajblizsza.ObjectId, OpenMode.ForWrite), Line)
                                       ll.Erase()
                                       trn1.Commit()
                                   Catch ex As Exception
                                       lCmd.WriteMessage("Wyjatek w usowanie linii" + vbCrLf)
                                   Finally
                                       trn1.Dispose()
                                   End Try
                               End Using
                               'aktualizacja lini z rysunku
                               ' update number of lines 
                               selResult = (lCmd.SelectAll(selFilter))
                               ssLinie = selResult.Value
                               tabId = ssLinie.GetObjectIds
                               'rysowanie promieni
                               ' draw the next rays and search the nearest lines
                               oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                               If licznik <> 1 Then ' not important yet
                                   PunktyPomieszczenia.Add(nextPt)
                               End If
                               FIN = nextPt
                               przeciecia = 0
                               lnNajblizsza = CType(trn.GetObject(oid, OpenMode.ForRead), Line)
                           Else
                               lCmd.WriteMessage("WIECEJ NIZ JEDNO PRZECIECIE" + vbCrLf)
                           End If
                           bezpiecznik = bezpiecznik + 1
                       End While
                       lCmd.WriteMessage(vbCrLf + "WSZYSTKIE PUNKTY: " + PunktyPomieszczenia.Count.ToString)
                       If bezpiecznik = IloscWszystkichLinii * 4 Then
                           lCmd.WriteMessage("Linia nie zakonczona")
                       End If
                   Else
                       lCmd.WriteMessage("ERROR : Mniej niz 3 linie pomieszczenie nie moze byc domkniete")
                   End If
               Else
                   lCmd.WriteMessage("ERROR : Brak linii w rysunku")
               End If
               trn.Commit()

           End If

       End Using

   End Sub
   ' RYSUJE PROMIEN SLEDZACY
   ' DRAW A TRACING RAY
   ' SZUKA LINII NAJBLIZSZEJ DANEMU PUNKTOWI
   ' SEARCH FOR THE NEAREST LINE FOR THE POINT
   Public Function przecieciaPromienia(ByRef promienSledzacy As Ray, ByRef ls3d As LineSegment3d, ByRef tabID() As ObjectId, ByRef prevPt As Point3d, ByRef nextPt As Point3d) As ObjectId
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Database
       Dim lnNajblizsza As Line = Nothing
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction
           Try
               Dim btr As BlockTableRecord = CType(trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
               Dim objID As ObjectId
               Dim ra3d As Ray3d = New Ray3d(ls3d.StartPoint, ls3d.EndPoint)

               Dim odl As Single = 0.0
               Dim odlTmp As Single = 0.0
               For Each objID In tabID
                   Dim ln As Line = CType(trn.GetObject(objID, OpenMode.ForRead), Line)
                   Dim ls As LineSegment3d = New LineSegment3d(ln.StartPoint, ln.EndPoint)
                   Dim ptArray() As Point3d = ls.IntersectWith(ra3d)
                   If ptArray Is Nothing Then Continue For
                   Dim ptkPrzeciecia As Point3dCollection = New Point3dCollection(ptArray)
                   'SZUKANIE PIERWSZEJ NAJBLIZSZEJ LINII   
                   '   odl=sqrt ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)) 
                   ' calculate the distance between the points
                   odlTmp = Math.Sqrt((prevPt.X - ptkPrzeciecia.Item(0).X) * (prevPt.X - ptkPrzeciecia.Item(0).X) + (prevPt.Y - ptkPrzeciecia.Item(0).Y) * (prevPt.Y - ptkPrzeciecia.Item(0).Y))
                   If odl = 0.0 Then
                       odl = odlTmp
                       nextPt = ptkPrzeciecia.Item(0)
                       lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                       lnNajblizsza = ln
                   ElseIf odl >= odlTmp Then
                       nextPt = ptkPrzeciecia.Item(0)
                       lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                       lnNajblizsza = ln
                   End If
               Next
               ' updating the ray
               promienSledzacy = CType(trn.GetObject(promienSledzacy.ObjectId, OpenMode.ForWrite), Ray)
               promienSledzacy.BasePoint = ls3d.StartPoint
               promienSledzacy.SecondPoint = ls3d.EndPoint
               trn.Commit()
           Catch ex As Exception
               lCmd.WriteMessage("Wyjatek w przecieciaPromienia" + ex.ToString + vbCrLf)
           End Try
           Return lnNajblizsza.ObjectId
       End Using
   End Function
   'RYSUJE MALE ODCINKI POMOCNICZE
   'DRAW A LITTLES HELP LINES (lnL1)
   Public Sub rysujOdPomocniczy(ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef tmpPt2 As Point3d, ByRef lnL1 As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
       Dim tmpPt1 As Point3d = prevPt ' temporary variable to carry coordinates of the prev point
       tmpPt2 = nextPt
       ' WYZNACZANIE KATOW KTORE TRZEBA SPRAWDZIC NA PODSTWAIE POPRZEDNIEGO PUNKTU
       Try
           ' checks the last and the next point to draw next lnL1 it designed to work in reverse clock
           lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)
           'Wariant I
           If Math.Round(prevPt.X) = Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant II
           ElseIf Math.Round(prevPt.Y) = Math.Round(nextPt.Y) Then
               If nextPt.X > prevPt.X Then
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant III
           ElseIf Math.Round(prevPt.X) < Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0) ' poprawiono
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant IV
           ElseIf Math.Round(prevPt.X) > Math.Round(nextPt.X) Then
               If nextPt.Y < prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
           End If
           ' lCmd.WriteMessage(lnL1.StartPoint.ToString + "-" + lnL1.EndPoint.ToString + vbCrLf)
           trn.Commit()
       Catch ex As Exception
           lCmd.WriteMessage("Wyjatek w rysujOdPomocniczy" + vbCrLf)
       Finally
           trn.Dispose()
       End Try
   End Sub
   ' SEARCHES THE INTERS OF THE LITTLE HELP LINE lnL1
   Public Sub szukajPrzecieciaPomocniczego
' the text was too long for post so paste it from that above
   End Sub

My conception

191.png191.png 191.png

 

Usage

192.png 192.png

 

192.png

Share this post


Link to post
Share on other sites
SEANT

I’m not sure I fully understand the process, but give me some time (I’m looking at this during breaks in my normal daily activities).

 

One early issue I’ve encountered, Visual Studio flags this line as an error:

Dim IloscWszystkichLinii As Integer = tabId.Count()

 

Is that part of another imported Namespace? Can I, perhaps, use either

 

Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) 

 

Or,

 

Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) + 1

Share this post


Link to post
Share on other sites
SEANT

As another bit of input that may help us understand the procedure, what is this geometry modeling in the real world?

 

I, personally, can’t determine if this is some aspect of Civil engineering, or a Mechanical issue. Is it Electrical/Electronic? It doesn’t seem related to anything Architectural, but I couldn’t say that that with certainty.

Share this post


Link to post
Share on other sites
PanHasan

Hi

hmm this line works fine for me a dont get any errors

it suppose to get how much lines are in the drawing

Dim IloscWszystkichLinii As Integer = tabId.count()

 

My idea is to use it when i have a blueprint of a house in 2d and there are plenty of rooms when i lunch my macro and click inside one room it would be nice if it returns me all walls of that particular room i don't know if i explained it correctly

Share this post


Link to post
Share on other sites
PanHasan

I think the problem is the tracing ray sometimes it simply dont inters with next line but why sometimes it work and sometimes not i dont know

and one important note this macro will search the walls in reverse clock orientation

Share this post


Link to post
Share on other sites
SEANT

Ah, so it is an architecturally based routine. That’s cool – it will help me understand the parameters. Unfortunately, I’m about to get a lot of worked tossed at me, so I won’t be able to examine it in depth until tonight.

 

With regard to the .Count issue, Visual Studio shows me the attached. What Imports are you using?

Count.jpg

Share this post


Link to post
Share on other sites
PanHasan

Im from the other part of the globe so Tonight its fine :P

 

Imports Autodesk.AutoCAD.Runtime

Imports Autodesk.AutoCAD.Geometry

Imports Autodesk.AutoCAD.ApplicationServices

Imports Autodesk.AutoCAD.EditorInput

Imports Autodesk.AutoCAD.DatabaseServices

Imports System.Windows

Imports System.Collections.Generic

 

I'm using vs2008

Share this post


Link to post
Share on other sites
SEANT

This is quite bizarre. I’ve included the same Imports list as posted above, and that line still reports an error (I’m also using Visual Studio 2008 - Standard edition). As interesting as that situation may be, I’m going to ignore it for now, and use the best alternative to allow me to run the program.

 

I’m assuming the suggestion I posted above:

 

Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) + 1

 

should work. Or, maybe:

 

Dim IloscWszystkichLinii As Integer = ssLinie.Count

 

I think both of them would effectively get the same integer as you get with

 

Dim IloscWszystkichLinii As Integer = tabId.Count()

 

If you get a chance, test to see if my assumption is correct. Thanks

Share this post


Link to post
Share on other sites
PanHasan

Both of your options works the same as mine so you can pick the better one maybe try

 

Dim IloscWszystkichLinii As Integer = tabId.Count

in my code there is no difference

Dim IloscWszystkichLinii As Integer = tabId.Count()

Share this post


Link to post
Share on other sites
SEANT

PanHansen, I did look at the routine last night but could not find the reason for the improper results. I have to admit, however, that it is still very difficult for me to understand the full scope of the routine and reasons for the various functions. Certainly the task you have undertaken is complex, so the complexity of the code is to be expected. I’ll look at it some more over the next day or two.

 

But. . . .

 

If you create a basic setup in AutoCAD, and step through the code: Where is the first indication of incorrect result? I’m suspect it may be near this line in szukajPrzecieciaPomocniczego:

 

ln.IntersectWith(lnL1, Intersect.OnBothOperands, lnL1.GetPlane(), Cl_crsPt, intPomoc1, intPomoc2)

 

 

 

One other suggestion I would make to help with debugging in general is to isolate discrete bits of functionality into separate subs/functions. One of the precepts of Object Oriented Programming is that no function should be more than about 12 – 15 lines. If it is, there is a good possibility for further isolation.

 

It appears that the routine will eventually need some looping structure to process the entire perimeter (Some of the comments you included with the code seems to suggest this). The ability to selectively choose from a library of discrete functions will be useful during that looping process.

Share this post


Link to post
Share on other sites
PanHasan

Hi

i found the mistake :D it was located in przecieciaPromienia i correct two things and it works for now :P the function found the inters with the help line and not with the real next line here's the correct function

    Public Function przecieciaPromienia(ByRef promienSledzacy As Ray, ByRef ls3d As LineSegment3d, ByRef tabID() As ObjectId, ByRef prevPt As Point3d, ByRef nextPt As Point3d) As ObjectId

       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Database
       Dim lnNajblizsza As Line = Nothing
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction
           Try
               Dim btr As BlockTableRecord = CType(trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
               Dim objID As ObjectId
               Dim ra3d As Ray3d = New Ray3d(ls3d.StartPoint, ls3d.EndPoint)

               Dim odl As Single = 0.0
               Dim odlTmp As Single = 0.0
               Dim ilprzet As Integer = 0
               For Each objID In tabID

                   Dim ln As Line = CType(trn.GetObject(objID, OpenMode.ForRead), Line)
                   Dim ls As LineSegment3d = New LineSegment3d(ln.StartPoint, ln.EndPoint)
                   Dim ptArray() As Point3d = ls.IntersectWith(ra3d)
                   If ptArray Is Nothing Then Continue For
                   Dim ptkPrzeciecia As Point3dCollection = New Point3dCollection(ptArray)
                   'SZUKANIE PIERWSZEJ NAJBLIZSZEJ LINII   
                   ' odl=sqrt ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)) 
                   ' calculate the distance between the points
                   ilprzet = ilprzet + 1
                   odlTmp = Math.Sqrt((prevPt.X - ptkPrzeciecia.Item(0).X) * (prevPt.X - ptkPrzeciecia.Item(0).X) + (prevPt.Y - ptkPrzeciecia.Item(0).Y) * (prevPt.Y - ptkPrzeciecia.Item(0).Y))
                   If ptkPrzeciecia.Item(0) <> prevPt Then
                       If odl = 0.0 Then
                           odl = odlTmp
                           nextPt = ptkPrzeciecia.Item(0)
                           '    lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                           lnNajblizsza = ln
                       ElseIf odl >= odlTmp Then
                           nextPt = ptkPrzeciecia.Item(0)
                           '  lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                           lnNajblizsza = ln
                       End If
                   End If
               Next
               lCmd.WriteMessage("ile przeciec :" + ilprzet.ToString)
               ' updating the ray
               promienSledzacy = CType(trn.GetObject(promienSledzacy.ObjectId, OpenMode.ForWrite), Ray)
               promienSledzacy.BasePoint = ls3d.StartPoint
               promienSledzacy.SecondPoint = ls3d.EndPoint
               trn.Commit()
           Catch ex As Exception
               lCmd.WriteMessage("Wyjatek w przecieciaPromienia" + ex.ToString + vbCrLf)
           End Try
           If lnNajblizsza <> Nothing Then
               Return lnNajblizsza.ObjectId
           Else
               Return Nothing
           End If
       End Using
   End Function

and the corrected while in main function src

 

                  While (licznik < IloscWszystkichLinii) And (bezpiecznik < IloscWszystkichLinii * 6) And (START <> FIN)
                           rysujOdPomocniczy(prevPt, nextPt, tmpPt2, lnL1) ' draw the lnL1
                           szukajPrzecieciaPomocniczego(przeciecia, prevPt, nextPt, tmpPt2, tabId, lnL1) ' check if the lnL1 inters with something
                           If przeciecia = 0 Then
                               prevPt = tmpPt2
                           ElseIf przeciecia = 1 Then ' if inters = 1
                               usun1 = nextPt.X
                               usun2 = prevPt.X
                               licznik = licznik + 1
                               ls3d = New LineSegment3d(nextPt, prevPt)
                               Using trn1 As Transaction = acBaza.TransactionManager.StartTransaction
                                   Try
                                       ' deleting the last nearest line
                                       Dim btr1 As BlockTableRecord = trn1.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                                       Dim ll As Line = CType(trn1.GetObject(lnNajblizsza.ObjectId, OpenMode.ForWrite), Line)
                                       ll.Erase()
                                       trn1.Commit()
                                   Catch ex As Exception
                                       lCmd.WriteMessage("Wyjatek w usowanie linii" + vbCrLf)
                                   Finally
                                       trn1.Dispose()
                                   End Try
                               End Using
                               'aktualizacja lini z rysunku
                               ' update number of lines 
                               selResult = (lCmd.SelectAll(selFilter))
                               ssLinie = selResult.Value
                               tabId = ssLinie.GetObjectIds
                               'rysowanie promieni
                               ' draw the next rays and search the nearest lines
                               oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                               If oid <> Nothing Then
                                   If licznik <> 1 Then ' not important yet
                                       PunktyPomieszczenia.Add(nextPt)
                                   End If
                                   FIN = nextPt
                                   przeciecia = 0
                                   lnNajblizsza = CType(trn.GetObject(oid, OpenMode.ForRead), Line)
                               Else
                                   bezpiecznik = (IloscWszystkichLinii * 4) - 1
                               End If
                           Else
                               lCmd.WriteMessage("WIECEJ NIZ JEDNO PRZECIECIE" + vbCrLf)
                           End If
                           bezpiecznik = bezpiecznik + 1
                       End While

but now i'll tra to apply my code to yours advices but what about that looping and the discrete functions i dont get it ;p is there better way to do it than using simple while ? :) thanks fr bother saint ;p

Share this post


Link to post
Share on other sites
SEANT

Cool. :wink: It is good to hear the routine is on course. I’m sorry I was not that much help. The process is interesting; I will substitute the new functions into the routine and test it later today.

 

 

Actually, I also think “While” is the way to go. You could use some kind of “Recursive” setup, but I am not sure how practical that would be.

Share this post


Link to post
Share on other sites
PanHasan

Hi

maybe you have some idea how and for what can i change the erase mechanism. Would be better if the macro don't charm the original drawing. I've try to copy that lines to the new layer and then hide it but id wont work, they intersects even while they are hidden.

Share this post


Link to post
Share on other sites
SEANT
Hi

maybe you have some idea how and for what can i change the erase mechanism. Would be better if the macro don't charm the original drawing. I've try to copy that lines to the new layer and then hide it but id wont work, they intersects even while they are hidden.

 

The sentence in red, I do think that is true.

 

For the most part, all Autodesk.AutoCAD.DatabaseServices Curve entities have a Autodesk.AutoCAD.Geometry.Curve2d/ Autodesk.AutoCAD.Geometry.Curve3d counterpart. So if there is no intention to permanently add the geometry to the drawing’s database, I feel it best to use the Autodesk.AutoCAD.Geometry version.

 

This has the added benefit of only requiring objects (BlockTableRecords, Database Resident Entities, etc.) set at OpenMode.ForWrite for the shortest duration possible.

 

All the geometric computations can be performed with the Autodesk.AutoCAD.Geometry, the useful geometry can be used in the constructors of the relevant Autodesk.AutoCAD.DatabaseServices.Entities and only added to an open database at the very last moment.

 

The Autodesk.AutoCAD.Geometry objects created for the computations do not require further attention as they will automatically be disposed by the Garbage Collector.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×