+ Reply to Thread
Page 2 of 2 FirstFirst 1 2
Results 11 to 15 of 15
  1. #11
    Super Moderator SLW210's Avatar
    Computer Details
    SLW210's Computer Details
    Operating System:
    Windows 7 PRO 64-bit
    Computer:
    IBM Lenovo
    Motherboard:
    ACPI x64
    CPU:
    Pentium(R) i5 4570 @ 3.2GHz
    RAM:
    8 GB RAM
    Graphics:
    Nvidia Quadro 600 1GB
    Primary Storage:
    300 GB
    Secondary Storage:
    650GB
    Monitor:
    2x ThinkVision 24"
    Discipline
    Multi-disciplinary
    SLW210's Discipline Details
    Occupation
    Design Draftsman
    Discipline
    Multi-disciplinary
    Details
    Mostly do drafting related to manufacturing. From doing site layouts with proposed updates, additions and renovations to be budgeted and submitted for bid, to updating and changing existing drawings to reflect maintenance and repair/revision work done on site.
    Using
    AutoCAD 2011
    Join Date
    May 2007
    Location
    South Florida, USA
    Posts
    11,795

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by ursan View Post
    this code very good working. but I do not understand the autolisp. How to write this code in vb.net / vba or C#.net
    You have posted this thread in the AutoLISP, Visual LISP & DCL Forum.

    I have moved your thread to the .NET, ObjectARX & VBA Forum.
    “A narrow mind and a fat head invariably come on the same person” Zig Zigler



  2. #12
    Full Member
    Using
    AutoCAD 2010
    Join Date
    Oct 2013
    Posts
    78

    Default

    here's a possible code

    Code:
    Option Explicit
    
    Sub ListIntersectingLines()
        Dim linesSset As AcadSelectionSet
        Dim nIntersectingLines As Long
        Dim mainLine As AcadLine, acLine As AcadLine
        
        Set mainLine = GetALine
        
        If Not GetPossiblyCrossingLines(linesSset, mainLine) Then
            MsgBox "no possible intersecting lines with main line"
            Exit Sub
        End If
        
        If FilterActuallyIntersectingLines(linesSset, mainLine) Then
            For Each acLine In linesSset
                nIntersectingLines = nIntersectingLines + 1
                MsgBox "Intersecting line #" & nIntersectingLines & " ID=" & acLine.ObjectID
                acLine.color = acGreen
            Next
        Else
            MsgBox "no intersecting lines with main line"
        End If
    End Sub
    
    Function FilterActuallyIntersectingLines(linesSset As AcadSelectionSet, mainLine As AcadLine) As Boolean
        Dim nLines As Long
        Dim acLine As AcadLine
        Dim removeObjectsCounter As Long       
        ReDim removeObjects(0 To linesSset.Count - 1) As AcadEntity
    
        With mainLine
            For Each acLine In linesSset
                If UBound(.IntersectWith(acLine, acExtendNone)) = -1 Then
                    Set removeObjects(removeObjectsCounter) = acLine
                    removeObjectsCounter = removeObjectsCounter + 1
                End If
            Next
            If removeObjectsCounter > 0 Then
                ReDim Preserve removeObjects(0 To removeObjectsCounter - 1) As AcadEntity
                linesSset.RemoveItems removeObjects
                FilterActuallyIntersectingLines= linesSset.Count > 0
            End If
        End With
    End Function
    
    Function GetALine() As AcadLine
        Dim basePnt As Variant
        
        On Error Resume Next
        Do While GetALine Is Nothing
            ThisDrawing.Utility.GetEntity GetALine, basePnt, "Select a line"
        Loop
    End Function
    
    Function GetPossiblyCrossingLines(linesSset As AcadSelectionSet, mainLine As AcadLine) As Boolean
        Dim gpCode(0) As Integer
        Dim dataValue(0) As Variant
        
        gpCode(0) = 0
        dataValue(0) = "LINE"
        On Error Resume Next
        Set linesSset = ThisDrawing.SelectionSets.Add("Lines")
        On Error GoTo 0
        If linesSset Is Nothing Then Set linesSset = ThisDrawing.SelectionSets.Item("Lines")
        
        Dim corner1 As Variant, corner2 As Variant
        mainLine.GetBoundingBox corner1, corner2
        ZoomWindow corner1, corner2
        With linesSset
            .Clear
            .Select acSelectionSetCrossing, corner1, corner2, gpCode, dataValue
            If .Count > 1 Then
                Dim removeObjects(0 To 0) As AcadEntity
                Set removeObjects(0) = mainLine
                .RemoveItems removeObjects
                GetPossiblyCrossingLines= True
            End If
        End With
        ZoomPrevious
    End Function

  3. #13
    Luminous Being
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    9,815

    Default

    Lisp version, note the sneaky x-1 as the pick line is returned as the last object in the selection set, easier than doing a subtle offset and pick pts.

    Code:
    ; example of intersect with by Alan H Aug 2017
    ; to use on pline same code but need fence option to use co-ords
    ; need to add this option see pline co-ords code 
    
    (defun c:ByBIGAL ( / obj obj2 lst ss pt ans)
    (setq obj (vlax-ename->vla-object (car (entsel "\nPick object"))))
    (if (= "AcDbLine" (vla-get-objectname obj))
    (progn
    (setq lst (list 
    (vlax-safearray->list (vlax-variant-value(vla-get-startpoint obj)))
    (vlax-safearray->list (vlax-variant-value(vla-get-endpoint obj)))
    ))
    (setq ans "")
    (setq ss (ssget "F" lst (list (cons 0 "Line"))))
    (repeat (setq x (- (sslength ss)1))
    (setq obj2 (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq pt (vlax-invoke obj2 'intersectWith obj acExtendThisEntity))
    (setq ans (strcat ans "\nX=" (rtos (car pt) 2 3) " " "Y= " (rtos (cadr pt) 2 3) ))
    )
    )
    (alert "Object picked is not a line")
    )
    (alert ans)c 
    (princ)
    )
    A man who never made mistakes never made anything

  4. #14
    Forum Newbie
    Discipline
    Electrical
    Using
    AutoCAD 2018
    Join Date
    Aug 2017
    Posts
    7

    Default

    Quote Originally Posted by RICVBA View Post
    here's a possible code

    Code:
    Option Explicit
    
    Sub ListIntersectingLines()
        Dim linesSset As AcadSelectionSet
        Dim nIntersectingLines As Long
        Dim mainLine As AcadLine, acLine As AcadLine
        
        Set mainLine = GetALine
        
        If Not GetPossiblyCrossingLines(linesSset, mainLine) Then
            MsgBox "no possible intersecting lines with main line"
            Exit Sub
        End If
        
        If FilterActuallyIntersectingLines(linesSset, mainLine) Then
            For Each acLine In linesSset
                nIntersectingLines = nIntersectingLines + 1
                MsgBox "Intersecting line #" & nIntersectingLines & " ID=" & acLine.ObjectID
                acLine.color = acGreen
            Next
        Else
            MsgBox "no intersecting lines with main line"
        End If
    End Sub
    
    Function FilterActuallyIntersectingLines(linesSset As AcadSelectionSet, mainLine As AcadLine) As Boolean
        Dim nLines As Long
        Dim acLine As AcadLine
        Dim removeObjectsCounter As Long       
        ReDim removeObjects(0 To linesSset.Count - 1) As AcadEntity
    
        With mainLine
            For Each acLine In linesSset
                If UBound(.IntersectWith(acLine, acExtendNone)) = -1 Then
                    Set removeObjects(removeObjectsCounter) = acLine
                    removeObjectsCounter = removeObjectsCounter + 1
                End If
            Next
            If removeObjectsCounter > 0 Then
                ReDim Preserve removeObjects(0 To removeObjectsCounter - 1) As AcadEntity
                linesSset.RemoveItems removeObjects
                FilterActuallyIntersectingLines= linesSset.Count > 0
            End If
        End With
    End Function
    
    Function GetALine() As AcadLine
        Dim basePnt As Variant
        
        On Error Resume Next
        Do While GetALine Is Nothing
            ThisDrawing.Utility.GetEntity GetALine, basePnt, "Select a line"
        Loop
    End Function
    
    Function GetPossiblyCrossingLines(linesSset As AcadSelectionSet, mainLine As AcadLine) As Boolean
        Dim gpCode(0) As Integer
        Dim dataValue(0) As Variant
        
        gpCode(0) = 0
        dataValue(0) = "LINE"
        On Error Resume Next
        Set linesSset = ThisDrawing.SelectionSets.Add("Lines")
        On Error GoTo 0
        If linesSset Is Nothing Then Set linesSset = ThisDrawing.SelectionSets.Item("Lines")
        
        Dim corner1 As Variant, corner2 As Variant
        mainLine.GetBoundingBox corner1, corner2
        ZoomWindow corner1, corner2
        With linesSset
            .Clear
            .Select acSelectionSetCrossing, corner1, corner2, gpCode, dataValue
            If .Count > 1 Then
                Dim removeObjects(0 To 0) As AcadEntity
                Set removeObjects(0) = mainLine
                .RemoveItems removeObjects
                GetPossiblyCrossingLines= True
            End If
        End With
        ZoomPrevious
    End Function
    thank you for reply. when i change custom corner1 and corner2 perfect work program.
    But it does not work when two lines are back to back. I added sample pictures. line1 and line2 are two interlaced lines. After running the program line1 color again white. what command line1 will detect?
    Attached Images

  5. #15
    Full Member
    Using
    AutoCAD 2010
    Join Date
    Oct 2013
    Posts
    78

    Default

    Registered forum members do not see this ad.

    it 's because overlapping lines won't have
    Code:
    IntersectWith()
    method catch any intersection points

    you could handle this exception by trying and see if any line parallel to the main one is overlapping (hence intersecting) also in many ways

    here is one of them (only showing changed subs/function):

    Code:
    Function FilterActuallyIntersectingLines(linesSset As AcadSelectionSet, mainLine As AcadLine) As Boolean
        Dim acLine As AcadLine
        Dim removeObjectsCounter As Long
        ReDim removeObjects(0 To linesSset.Count - 1) As AcadEntity
    
        With mainLine
            For Each acLine In linesSset
                If Not DoesItIntersect(mainLine, acLine) Then '<--| have a specialized function detect "true" intersection
                    Set removeObjects(removeObjectsCounter) = acLine
                    removeObjectsCounter = removeObjectsCounter + 1
                End If
            Next
            If removeObjectsCounter > 0 Then
                ReDim Preserve removeObjects(0 To removeObjectsCounter - 1) As AcadEntity
                linesSset.RemoveItems removeObjects
            End If
        End With
        FilterActuallyIntersectingLines = linesSset.Count > 0 '<--| note I changed this line position
    End Function
    
    Function DoesItIntersect(mainLine As AcadLine, currentLine As AcadLine) As Boolean
        Const PI = 3.14159265358979
        If UBound(mainLine.IntersectWith(currentLine, acExtendNone)) = -1 Then
            If Round(mainLine.Angle - PI * (mainLine.Angle \ PI) - (currentLine.Angle - PI * (currentLine.Angle \ PI)), 4) = 0 Then ' if the passed line is parallel to the main one
                Dim endPoint As Variant
                endPoint = currentLine.endPoint
                endPoint(0) = endPoint(0) + 0.01 ' spot a point a little shifted from the current line end point
                With ThisDrawing.ModelSpace.AddLine(currentLine.StartPoint, endPoint) ' draw a line with current line start point and the "shifted" end point
                    DoesItIntersect = UBound(.IntersectWith(mainLine, acExtendNone)) >= 0 ' if it intersects the main line then the current line overlaps it
                    .Delete
                End With
            End If
        Else
            DoesItIntersect = True
        End If
    End Function

Similar Threads

  1. List of points of intersection of polygons area
    By qualitysof in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 31st Oct 2016, 02:10 am
  2. Points Inserts at intersection of Lines & at End of lines
    By structo in forum AutoLISP, Visual LISP & DCL
    Replies: 19
    Last Post: 21st Oct 2016, 10:26 am
  3. List of Intersection stations of a long polyline
    By sivapathasunderam in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 20th Feb 2016, 03:07 pm
  4. Cant get intersection between 2 lines
    By lufc100 in forum AutoCAD Beginners' Area
    Replies: 7
    Last Post: 12th Feb 2013, 08:05 pm
  5. find intersection of 3D lines
    By giskumar in forum AutoLISP, Visual LISP & DCL
    Replies: 8
    Last Post: 7th Jan 2013, 12:58 am

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