VBA get StartPoint and EndPoint of lines at certain point?

[Anonymous]

I am new to VBA and AutoCAD, I want to get the coordinates of of yellow points on picture,
only if the lines have their startpoint or endpoint at certain point(red point on the picture).

Program input: red point coordinates
       if line(s) are there then:
Program output: yellow points coordinates

pseudocode:

redpoint = 0,0,0

	if a line at redpoint{
		MyArray = lines that have StartPoint or EndPoint
			   at redpoint

		for i in MyArray
			Print ("Line # " + MyArray[i] + " coordinates are " 
				+ MyArray[i]StartPoint + " and " +  MyArray[i]EndPoint);
	}

I know Im getting back the red point value again but thats ok; I am doing it
because I wont know if the redpoint is the StartPoint or EndPoint of the Lines.

I don't know if this is possible using vba in autocad, I've been looking at autodesk page but none of the
examples apply on this case, and I don't want to overdoit selecting by layer, bounding box etc,
What could be the simplest way to get my output as I need it to be.

Thank You,

[norman.yuan · Accepted solution]

It should not be hard to test each LINE to see whether its start- or end-point is at given point. If it is, then you know the other point of the LINE. Following code does this:

1. Ask user for a point;

2. Search the drawing (ModelSpace in this case) for AcadLine that has either start-point, or end-point at the picked point. 

3. If such a Line found, store the loose-end point of the LINE for later use.

Option Explicit

Public Sub GetLines()

    Dim centerPt As Variant
    centerPt = ThisDrawing.Utility.GetPoint(, vbCr & "Select center point:")
    
    Dim points() As Variant
    points = FindLinesOtherPoints(centerPt)
    
    If UBound(points) < 0 Then
        MsgBox "No line found with its start/end point being at picked point."
    Else
        MsgBox "Found lines: " & UBound(points) + 1
    End If
    
    Dim pt As Variant
    Dim i As Integer
    For i = 0 To UBound(points)
        pt = points(i)
        MsgBox "The Loose End Point of LINE " & i + 1 & ": " & vbCrLf & _
            "X=" & pt(0) & vbCrLf & _
            "Y=" & pt(1) & vbCrLf & _
            "Z=" & pt(2)
    Next

End Sub

Private Function FindLinesOtherPoints(center As Variant) As Variant()

    Dim points() As Variant
    
    Dim ent As AcadEntity
    Dim line As AcadLine
    Dim pt As Variant
    Dim found As Boolean
    Dim i As Integer
    
    For Each ent In ThisDrawing.ModelSpace
        If TypeOf ent Is AcadLine Then
            Set line = ent
            found = False
            If AtTheSamePoint(line.StartPoint, center) Then
                pt = line.EndPoint
                found = True
            ElseIf AtTheSamePoint(line.EndPoint, center) Then
                pt = line.StartPoint
                found = True
            End If
            If found Then
                ReDim Preserve points(i)
                points(i) = pt
                i = i + 1
            End If
        End If
    Next
    
    FindLinesOtherPoints = points

End Function

Private Function AtTheSamePoint(pt1 As Variant, pt2 As Variant) As Boolean
    
    Dim theSame As Boolean
    Dim dist As Double
    Dim x As Double
    Dim y As Double
    Dim z As Double
    
    x = pt2(0) - pt1(0): y = pt2(1) - pt1(1): z = pt2(2) - pt1(2)
    dist = Sqr(x * x + y * y + z * z)
    
    theSame = IIf(dist <= 0.01, True, False)
    
    AtTheSamePoint = theSame

End Function

HTH

[Anonymous]

Thank you Norman it does work, 

Yesterday after I left the forum I started playing with selection sets and I have something like this:

Sub Example_SelectAtPoint()
    Dim j As Integer
    Dim x As Object
    
    Dim startPoint As Variant
    Dim endPoint As Variant
    
    
    Dim a As AcadSelectionSet
    Set a = ThisDrawing.SelectionSets.Add("MySelectionSet")
   
    
    Dim point(0 To 2) As Double
    point(0) = 0: point(1) = 0: point(2) = 0
    a.SelectAtPoint point
    
    MsgBox ("Selection set " & a.Name & " contains " & _
    a.Count & " items")
    
    j = 0
    For Each x In a
       MsgBox "Item " & CStr(j + 1) & " in " & a.Name _
         & "is: " & x.EntityName
         
         startPoint = x.startPoint
         endPoint = x.endPoint
         
        MsgBox "this is " & startPoint(0) & " " & startPoint(1) & " " & startPoint(1) & "  " & endPoint(0) & "  " & endPoint(1) & " " & endPoint(2)
          
       j = j + 1
    Next
    
     ' Delete selectionset
       ThisDrawing.SelectionSets.Item("MySelectionSet").Delete
    
End Sub

however it only returns the value of one line.

How can I make it to loop through all the lines selected by the selection set?

Do I need to get the values of the selectionSet into an Array? I would appreciate if you could guide me or tell me whats wrong with my code?

Sorry I forgot to say I wanted to use a Selection set on the first Post.

Thank You,

[norman.yuan]

There is not much difference between looping through entire ModelSpace (or PaperSpace) to find all AcadLine entities in interest and creating a SelectionSet, and select all possible AcadLine entities in interest (with selection filter). Because of your output requirement (the coordinates of the loose end of those AcadLines, it could be either StartPoint, or EndPoint, which you cannot know until actually test it with code), you still need to run code against each selected (in SelectionSet), or found (by looping through ModelSpace) AcadLine to get the coordinates of loose end. But more importantly, SelectAtPoint() ONLY select 1 entity if one or more entities are located at the point. Here is what the VBA document says (pay attention to the bold in red words)

<QUOTE>

SelectAtPoint Method (ActiveX)

Selects an object passing through a given point and places it into a selection set.

</QUOTE>

So, the issue you have is that you should not use AcadSelectionSet.GetAtPoint(), which may not select all the AcadLines as you thought, how SelectAtPoint() works is affected by system variable "PICKBOX", and also, in your code, there is no guarantee that all the AcadLines are connected to a point accurately.

If you insist to use SelectionSet, in stead of looping through ModelSpace/PaperSpace, you should use AcadSelectionSet.Select([filter]) to only select AcadLines. Then you still need to loop though the SelectionSet, as my code does by looping through the ModelSpace.

[SEANT61]

This would be a way to utilize a Selection Set to retrieve more than just one entity:

Public Sub GetLines()

    Dim centerPt As Variant
    Dim intCode(9) As Integer
    Dim varData(9) As Variant
    Dim lngCount As Long
    Dim entLine As AcadLine
    
    With ThisDrawing.Utility
    centerPt = .GetPoint(, vbCr & "Select center point:")
    
    intCode(0) = -4: varData(0) = "<Or"
       intCode(1) = -4: varData(1) = "<And"
          intCode(2) = 0: varData(2) = "Line"
          intCode(3) = 10: varData(3) = centerPt
       intCode(4) = -4: varData(4) = "And>"
       intCode(5) = -4: varData(5) = "<And"
          intCode(6) = 0: varData(6) = "Line"
          intCode(7) = 11: varData(7) = centerPt
       intCode(8) = -4: varData(8) = "And>"
    intCode(9) = -4: varData(9) = "Or>"
    
    lngCount = SelAllSS(intCode, varData)
    
    .Prompt (lngCount & " line(s) meet at that point.")
    
    End With

End Sub

Function SelAllSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
   Dim TempObjSS As AcadSelectionSet
   On Error Resume Next
   ThisDrawing.SelectionSets.Item("TempSSet").Delete
   On Error GoTo 0
   Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
   If IsMissing(grpCode) Then
      TempObjSS.Select acSelectionSetAll
   Else
      TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal
   End If
   SelAllSS = TempObjSS.Count
End Function