PanHasan Posted September 7, 2009 Share Posted September 7, 2009 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 Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 7, 2009 Share Posted September 7, 2009 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. Quote Link to comment Share on other sites More sharing options...
PanHasan Posted September 7, 2009 Author Share Posted September 7, 2009 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 Usage Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 8, 2009 Share Posted September 8, 2009 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 Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 8, 2009 Share Posted September 8, 2009 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. Quote Link to comment Share on other sites More sharing options...
PanHasan Posted September 8, 2009 Author Share Posted September 8, 2009 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 Quote Link to comment Share on other sites More sharing options...
PanHasan Posted September 8, 2009 Author Share Posted September 8, 2009 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 Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 8, 2009 Share Posted September 8, 2009 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? Quote Link to comment Share on other sites More sharing options...
PanHasan Posted September 8, 2009 Author Share Posted September 8, 2009 Im from the other part of the globe so Tonight its fine 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 Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 8, 2009 Share Posted September 8, 2009 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 Quote Link to comment Share on other sites More sharing options...
PanHasan Posted September 8, 2009 Author Share Posted September 8, 2009 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() Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 9, 2009 Share Posted September 9, 2009 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. Quote Link to comment Share on other sites More sharing options...
PanHasan Posted September 9, 2009 Author Share Posted September 9, 2009 Hi i found the mistake it was located in przecieciaPromienia i correct two things and it works for now 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 Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 10, 2009 Share Posted September 10, 2009 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. Quote Link to comment Share on other sites More sharing options...
PanHasan Posted September 10, 2009 Author Share Posted September 10, 2009 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. Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 10, 2009 Share Posted September 10, 2009 Himaybe 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. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.