+ Reply to Thread
Page 1 of 2 1 2 LastLast
Results 1 to 10 of 16

Thread: Trace line .net

  1. #1
    Full Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2009
    Posts
    47

    Laughing Trace line .net

    Registered forum members do not see this ad.

    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
    Code:
        <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

  2. #2
    Forum Deity SEANT's Avatar
    Using
    AutoCAD 2014
    Join Date
    Aug 2005
    Location
    Rhode Island
    Posts
    2,453

    Default

    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.

  3. #3
    Full Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2009
    Posts
    47

    Default

    Hi
    i've added some english comments but if it still not clear i'll add it where you'll need to
    Code:
        <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


    Last edited by PanHasan; 7th Sep 2009 at 10:29 pm. Reason: Learn how to add pics ;p

  4. #4
    Forum Deity SEANT's Avatar
    Using
    AutoCAD 2014
    Join Date
    Aug 2005
    Location
    Rhode Island
    Posts
    2,453

    Default

    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

    Code:
    Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0)
    Or,

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

  5. #5
    Forum Deity SEANT's Avatar
    Using
    AutoCAD 2014
    Join Date
    Aug 2005
    Location
    Rhode Island
    Posts
    2,453

    Default

    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.

  6. #6
    Full Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2009
    Posts
    47

    Default

    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

  7. #7
    Full Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2009
    Posts
    47

    Default

    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

  8. #8
    Forum Deity SEANT's Avatar
    Using
    AutoCAD 2014
    Join Date
    Aug 2005
    Location
    Rhode Island
    Posts
    2,453

    Default

    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?
    Attached Images

  9. #9
    Full Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2009
    Posts
    47

    Default

    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

  10. #10
    Forum Deity SEANT's Avatar
    Using
    AutoCAD 2014
    Join Date
    Aug 2005
    Location
    Rhode Island
    Posts
    2,453

    Default

    Registered forum members do not see this ad.

    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:

    Code:
    Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) + 1
    should work. Or, maybe:

    Code:
    Dim IloscWszystkichLinii As Integer = ssLinie.Count
    I think both of them would effectively get the same integer as you get with

    Code:
    Dim IloscWszystkichLinii As Integer = tabId.Count()
    If you get a chance, test to see if my assumption is correct. Thanks

Similar Threads

  1. How can I trace a raw image
    By Meglesniak323 in forum AutoCAD General
    Replies: 1
    Last Post: 23rd May 2009, 10:06 pm
  2. How Do I Trace An Image?
    By Meglesniak323 in forum AutoCAD General
    Replies: 10
    Last Post: 10th May 2009, 07:28 pm
  3. Trace Tool?
    By jopton in forum AutoCAD Beginners' Area
    Replies: 3
    Last Post: 10th Oct 2007, 10:07 pm
  4. How to trace a Drawing?
    By Leech in forum AutoCAD Beginners' Area
    Replies: 5
    Last Post: 25th Oct 2006, 11:41 pm
  5. We need a script to automate a line trace
    By LBogus in forum AutoCAD General
    Replies: 10
    Last Post: 9th Feb 2006, 04:45 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts