PDA

View Full Version : Trace line .net



PanHasan
7th Sep 2009, 07:42 pm
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.Edit or
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.Edit or
Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Data base
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.Edit or
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.Edit or
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

SEANT
7th Sep 2009, 09:07 pm
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.

PanHasan
7th Sep 2009, 10:27 pm
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.Edit or
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.Edit or
Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Data base
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.Edit or
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
http://www.image-share.com/image.php?img=45/191.pnghttp://www.image-share.com/image.php?img=45/191.png http://www.image-share.com/upload/45/191.png (http://www.image-share.com)

Usage
http://www.image-share.com/image.php?img=45/192.png http://www.image-share.com/upload/45/192.png (http://www.image-share.com)

http://www.image-share.com/image.php?img=45/192.png

SEANT
8th Sep 2009, 08:30 am
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

SEANT
8th Sep 2009, 08:45 am
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.

PanHasan
8th Sep 2009, 09:23 am
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

PanHasan
8th Sep 2009, 09:53 am
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

SEANT
8th Sep 2009, 10:38 am
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?

PanHasan
8th Sep 2009, 10:55 am
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

SEANT
8th Sep 2009, 11:24 am
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

PanHasan
8th Sep 2009, 11:46 am
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()

SEANT
9th Sep 2009, 09:00 am
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.

PanHasan
9th Sep 2009, 11:47 pm
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.Edit or
Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Data base
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 Functionand 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 Whilebut 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

SEANT
10th Sep 2009, 10:03 am
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.

PanHasan
10th Sep 2009, 09:52 pm
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.

SEANT
10th Sep 2009, 11:25 pm
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.