Identify intersections of several lines

[ofcarvajall]

Hello,

I have the need to identify the intersection of several lines. I explain my self better:

1. I have many lines on a drawing
2. I draw some guidelines lines, that indicates me some areas
3. I need to know which line of item 1 intersects with lines in item 2
4. I need to list the summary which line intersect wich each other and list them in Excel (after item 3 is solve I can do this item by myself).

I appreciate any guess or idea to solve the problem, specially item 3.

Thanks in advance!!!

[Ray-Sync]

If you provide me with images of the ones you want, I will be happy to help you.

[ofcarvajall]

Hello Jefferson,

I attach an image and try to explain myself better:

1. I have some white lines, numbered from 1 to 7
2. I have some arbitrary lines named Sections, represented by color lines.
3. I need to list that Line 1 and Line 2 intersect with section 1, and get the intersection coordinates and so on, i.e., Line 2 intersects with Section 2, Line 3 intersects with Line 3, and …

For the moment I don’t know how to do that intersecting recognition in AutoCad.

Please let me know if the explanation is ok or if more details are needed.

Regards,

[Ray-Sync · Accepted solution]

I hope this can help you:

Sub IntersectAndExportToExcel()

    Dim lineWHITE As AcadLine, lineCOLOR As AcadLine
    Dim intPoints As Variant, pt As Variant, filterData(0) As Variant
    Dim answer As String
    Dim ss As AcadSelectionSet
    Dim filterType(0) As Integer
    Dim ent As AcadEntity
    
    ' Create an instance of Excel
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    
    ' Open a new Excel workbook
    Dim xlWorkbook As Object
    Set xlWorkbook = xlApp.Workbooks.Add
    
    ' Select the first Excel sheet
    Dim xlSheet As Object
    Set xlSheet = xlWorkbook.Sheets(1)
    
    ' Initial row to write data in Excel
    Dim rowNum As Integer
    rowNum = 1
    
    answer = "TRUE"
    
    Do While UCase(answer) = "TRUE"
    
        ThisDrawing.Utility.GetEntity lineCOLOR, pt, "Select a line of color"
        
        filterType(0) = 0: filterData(0) = "line"
        Set ss = ThisDrawing.SelectionSets.Add("sl")
        
        ss.SelectOnScreen filterType, filterData
        
        For Each ent In ss
            If TypeOf ent Is AcadLine Then
                Set lineWHITE = ent
                intPoints = lineCOLOR.IntersectWith(lineWHITE, acExtendNone)
                xlSheet.Cells(rowNum, 1).Value = Round(intPoints(0), 3)
                xlSheet.Cells(rowNum, 2).Value = Round(intPoints(1), 3)
                rowNum = rowNum + 1
            End If
        Next ent
        
        ss.Delete
        answer = UCase(InputBox("Continue? (TRUE/FALSE)", , "TRUE"))
    
    Loop
    
    ' Save the Excel workbook to a file
    xlWorkbook.SaveAs "Path/to/save/the/file.xlsx"
    
    ' Close Excel
    xlApp.Quit
    
    ' Release Excel resources
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing

End Sub

[ofcarvajall]

Thank you very much!!!