topic Intersection coordinates exported to Excel using vba in VBA Forum

Intersection coordinates exported to Excel using vba

Anonymous — Wed, 15 Sep 2021 15:43:14 GMT

Dears,

I have some background with VBA for Excel, but almost zero with VBA for AutoCAD.

Is it possible using VBA for Excel to extract a list of intersection points of a opened CAD file?

Re: Intersection coordinates exported to Excel using vba

grobnik — Wed, 15 Sep 2021 17:02:23 GMT

Hi,
If I understood well you want to develope a macro inside Autocad for
exporting intersection points, to Excel?
But from what I know in order to check if two objects are intersecting you
have to select the first, then the second one, both selection could be
made by VBA, and apply a function always by VBA with thecsame procedure,
which check if the two objects are intersecting, if yes the function return
an array with 3 points coordinates, if not function will return a different
value.
I don't know how it's possibile apply to all objects in the drawing in the
same time.

Re: Intersection coordinates exported to Excel using vba

grobnik — Wed, 15 Sep 2021 17:54:20 GMT

Here below an example without the Excel Export side, but only msgbox with intersection points

If you select as first object the rectangle and as second object the intersecting line you will get 2 coordinates points inside the array intPoints variable (total 6 value X,Y,Z first intersection point, and X,Y,Z second intersection point).

Sub test_of_intersection() Dim Object_First As AcadObject Dim Object_Second As AcadObject Dim BasePnt1 As Variant Dim BasePnt2 As Variant ThisDrawing.Utility.GetEntity Object_First, BasePnt1, "Select First object" ThisDrawing.Utility.GetEntity Object_Second, BasePnt2, "Select Second object" ' Find the intersection points between the line and the rectangle Dim intPoints As Variant intPoints = Object_First.IntersectWith(Object_Second, acExtendNone) ' Print all the intersection points Dim I As Integer, j As Integer, k As Integer Dim str As String If VarType(intPoints) <> vbEmpty Then For I = LBound(intPoints) To UBound(intPoints) str = "Intersection Point[" & k & "] is: " & intPoints(j) & " , " & intPoints(j + 1) & " , " & intPoints(j + 2) MsgBox str, , "IntersectWith Example" str = "" I = I + 2 j = j + 3 k = k + 1 Next End If End Sub

Later I'll show you a code for exporting into Excel

Re: Intersection coordinates exported to Excel using vba

Anonymous — Wed, 15 Sep 2021 18:10:34 GMT

Thank you for yout attention, I got to find an answer.

Option Explicit
Sub findIntersect()
Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument
Dim acObject As AcadObject
Dim lineObj1, lineObj2 As AcadLine
Dim intPoints As Variant
Dim objss, ssetObj As AcadSelectionSet
Dim n, i, x, Lline As Integer
Dim intersection As Variant
Dim location(0 To 2) As Double

'get access to autocad application
Set acadApp = GetObject(, "AutoCAD.Application")
Set acadDoc = acadApp.ActiveDocument

On Error Resume Next
'try to create a new selectionset
'if it exists, delete it and recreate a new one
Set objss = acadDoc.SelectionSets("sset")
If Err Then Set objss = acadDoc.SelectionSets.Add("sset")
'if it exists, erase it's content
objss.Clear

Set objss = acadDoc.SelectionSets.Add("sset")
objss.Select acSelectionSetAll
x = objss.Count
Lline = 3
For i = 0 To x - 1
Set lineObj1 = objss.Item(i)
For n = i + 1 To x - 1
Set lineObj2 = objss.Item(n)
intersection = lineObj1.IntersectWith(lineObj2, acExtendNone)
location(0) = intersection(0): location(1) = intersection(1): location(2) = 0
If UBound(intersection) = 2 Then
Range("Xcoord").Cells(Lline, 1) = intersection(0)
Range("Ycoord").Cells(Lline, 1) = intersection(1)
Lline = Lline + 1
End If
Next
Next
End Sub

Re: Intersection coordinates exported to Excel using vba

info9ATN7 — Wed, 21 Aug 2024 13:24:30 GMT

did you ever show the code for exporting into excel?

Re: Intersection coordinates exported to Excel using vba

info9ATN7 — Wed, 21 Aug 2024 13:25:41 GMT

oops

Re: Intersection coordinates exported to Excel using vba

grobnik — Thu, 22 Aug 2024 17:17:38 GMT

@info9ATN7

Hi, if you look at code posted by Anonymous on last "09-15-2021 08:10 PM", such code shall be written into Excel VBA Module, in addition two names like "Xcoord" and "Ycoord" both at least by 3 rows and 1 column shall be defined, inside Excel workbook.

On Autocad side (see below image as test) two oblique lines, intersecting a vertical one, like picture below just to test the intersection.

Finally you will achieve your goal of get the intersection coordinates, after running the Excel procedure.

As suggestion replace this part of code, sometimes Excel require the Workbook, and sheet where cells shall be filled with results value.

ActiveWorkbook.Sheets("Foglio1").Range("Xcoord").Cells(Lline, 1) = intersection(0) ActiveWorkbook.Sheets("Foglio1").Range("Ycoord").Cells(Lline, 1) = intersection(1)

instead

Range("Xcoord").Cells(Lline, 1) = intersection(0) Range("Ycoord").Cells(Lline, 1) = intersection(1)

I'm sorry for Italian Excel Version with sheet name "Foglio1", but of course it's referenced to the Name of Sheet where the intersection coordinates shall be indicated.

Bye