Check how much of 2 lines are overlapping

[LSElite]

Hey All

I've been wracking my brain trying to figure out a way to find if 2 lines overlap and if so, the distance they overlap.
So assuming they do overlap and travel in the same axis then how much of their lines overlap before one of the lines end.

Anyone have any ideas because I am tapped out.

Cheers

[remi678731]

Try di (distance) between end points. might iso layers first make sure you only have the correct layers on

[LSElite]

Sorry, I should have been clearer.
The information I have is this:
Line 1:
(point1, point2)
Line 2:
(point1, point2)

What I want to find is the distance that these 2 lines overlap.
I am have attached an image of some of the scenarios that it may encounter.
Please Help!

[remi678731]

I guess I'm not sure what you what, It looks like you got them dimensioned

[marko_ribar]

If no other entities interfere those lines, than try this :

(defun c:overlaplinesdist ( / unit chkoverlap collinear-p ss li1 li2 p1 p2 p3 p4 )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun chkoverlap ( li1 li2 / p1 p2 p3 p4 )
    (setq p1 (cdr (assoc 10 (entget li1))) p2 (cdr (assoc 11 (entget li1))) p3 (cdr (assoc 10 (entget li2))) p4 (cdr (assoc 11 (entget li2))))
    (if (and (= (sslength (ssget "_C" p1 p2)) 2) (or (equal (unit (mapcar '- p2 p1)) (unit (mapcar '- p4 p3)) 1e-6) (equal (unit (mapcar '- p2 p1)) (unit (mapcar '- p3 p4)) 1e-6)))
      t
      nil
    )
  )

  (defun collinear-p ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )

  (prompt "\nSelect 2 lines that overlap each other...")
  (setq ss (ssget '((0 . "LINE"))))
  (while (or (not ss) (and ss (/= (sslength ss) 2)) (and ss (= (sslength ss) 2) (not (chkoverlap (ssname ss 0) (ssname ss 1)))))
    (prompt "\nEmpty sel.set or selected more or less than 2 line entities or 2 selected lines don't overlap... Please select 2 overlapping lines again...")
    (setq ss (ssget '((0 . "LINE"))))
  )
  (setq li1 (ssname ss 0) li2 (ssname ss 1))
  (setq p1 (cdr (assoc 10 (entget li1))) p2 (cdr (assoc 11 (entget li1))) p3 (cdr (assoc 10 (entget li2))) p4 (cdr (assoc 11 (entget li2))))
  (cond
    ( (and (collinear-p p3 p1 p4) (collinear-p p3 p2 p4))
      (princ (rtos (distance p1 p2) 2 50))
      (grdraw p1 p2 1 1)
    )
    ( (and (collinear-p p1 p3 p2) (collinear-p p1 p4 p2))
      (princ (rtos (distance p3 p4) 2 50))
      (grdraw p3 p4 1 1)
    )
    ( (and (collinear-p p3 p1 p4) (collinear-p p1 p3 p2))
      (princ (rtos (distance p1 p3) 2 50))
      (grdraw p1 p3 1 1)
    )
    ( (and (collinear-p p3 p1 p4) (collinear-p p1 p4 p2))
      (princ (rtos (distance p1 p4) 2 50))
      (grdraw p1 p4 1 1)
    )
    ( (and (collinear-p p3 p2 p4) (collinear-p p1 p3 p2))
      (princ (rtos (distance p2 p3) 2 50))
      (grdraw p2 p3 1 1)
    )
    ( (and (collinear-p p3 p2 p4) (collinear-p p1 p4 p2))
      (princ (rtos (distance p2 p4) 2 50))
      (grdraw p2 p4 1 1)
    )
  ) 
  (princ)
)

(defun c:old nil (c:overlaplinesdist))

HTH, M.R.

[LSElite]

Thanks for the quick feedback.
your idea of using a selection set marko is a good idea.
however I need to process a large amount of lines, none of which are actually drawn, they only consist as data.
eg: ((pt1 pt2) (pt1 pt2))

so I think making the lines and deleting them to acquire the data will slow down the program too much.

I have had an idea that looks like this:
(pt1 pt2) (pt3 pt4)
(if (and (>= pt3.x pt1.x) (<= pt3.x pt2.x))
(and (>= pt3.y pt1.y) (<= pt3.y pt2.y))
(and (= (angle pt1 pt2) (angle pt1 pt3))
)

this basically finds if the point is in the square area between the 2 points of the line.
it then checks to see if the angle between start of the line and the point being checked are equal to the angle of the line.
if so then you know it resides on the line.
What I cant figure out is how to implement this with the 4 points of data.

[peter]

Using the vlax-curve functions.

(defun C:OverlapLines (/ lstPoints objLine1 objLine2 )
 (if (and
      (setq objLine1   (selectone "line" "\nSelect Line #1: "))
      (setq objLine2   (selectone "line" "\nSelect Line #2: "))
      (setq lstPoints  (list
                        (closestpoint objLine2 (vlax-get objLine1 "startpoint"))
                        (closestpoint objLine2 (vlax-get objLine1 "endpoint")) 
                        (closestpoint objLine1 (vlax-get objLine2 "startpoint"))
                        (closestpoint objLine1 (vlax-get objLine2 "endpoint")) 
                       )
      )
      (setq lstPoints  (NilRemove lstPoints))
     )
  (apply 'distance lstPoints)
 )
)

; Function to select a single object with a entitiy type filter and prompt

(defun SelectOne (strWCType strPrompt / entSelection ssSelections)
 (if (and
      (princ strPrompt)
      (setq ssSelections (ssget ":S:E" (list (cons 0 strWCType))))
      (setq entSelection (ssname ssSelections 0))
     )
  (vlax-ename->vla-object entSelection)
 )
)

; Determines closest point to a curve from a point and the curve object (includes a distance fuzz factor)

(defun ClosestPoint (objCurve lstPoint1 / lstPoint2)
 (if (and (setq lstPoint2 (vlax-curve-getclosestpointto objCurve lstPoint1))
          (< (distance lstPoint1 lstPoint2) 0.001) ;<- Fuzz Factor
     )
  lstPoint2
 )
)

; Remove Nil entries in a list.

(defun NilRemove (lstOfPoints / lstOfPoints2 lstPoint)
 (foreach lstPoint lstOfPoints
  (if lstPoint
   (setq lstOfPoints2 (cons lstPoint lstOfPoints2))
  )
 )
 (reverse lstOfPoints2)
)

(vl-load-com)

[LSElite]

Thanks for the help everyone.
Although these solutions involve interacting with drawn lines.
Is there anyway of achieving this outcome without the line entities?
I only possess the coordinate locations of these theoretical lines, the lines do not exist in the database.
The line data is stored as below:
line 1 = ((1,1,1) (2,2,1))
line 2 = ((3,3,1) (4,4,1))

I could have the lines drawn, checked and then deleted however I anticipate this will slow the process down dramatically.

[peter]

Quick and dirty...

P=

(defun OverLapVectors (lstLine1 lstLine2 / sngLength1 sngLength2)
 (if (and
      (setq sngLength1 (apply 'vectorlength lstLine1))
      (setq sngLength2 (apply 'vectorlength lstLine2)) 
      (setq lstItems   (midpointcheck))
      (setq lstItems   (NilRemove lstItems))
      (> (length lstItems) 1)
     )
  (vectorlength (car lstItems)(cadr lstItems))
 )
)

(defun NilRemove (lstItems / Atom1 lstItems2)
 (foreach Atom1 lstItems
  (if (and Atom1
           (not (member Atom1 lstItems2))
      )
   (setq lstItems2 (cons Atom1 lstItems2))
  )
 )
 lstItems2
)

(defun VectorLength (lstPoint1 lstPoint2)
 (sqrt (apply '+ (mapcar '(lambda (X Y) (expt (- Y X) 2.0)) lstPoint2 lstPoint1)))
)

(defun MidpointCheck ()
 (list (ismidpoint (car  lstLine1) lstLine2)
       (ismidpoint (cadr lstLine1) lstLine2)
       (ismidpoint (car  lstLine2) lstLine1)
       (ismidpoint (cadr lstLine2) lstLine1)
 )
)

(defun IsMidpoint (lstPoint lstLine)
 (if (equal (apply 'vectorlength lstLine) 
            (+ (vectorlength lstPoint (car  lstLine))
               (vectorlength lstPoint (cadr lstLine))
            )
            0.001
     )
  lstPoint
 )
)

; Example test
(setq lstLine1 (list (list 0.0 0.0 0.0)(list 2.0 2.0 0.0)))
(setq lstLine2 (list (list 1.0 1.0 0.0)(list 3.0 3.0 0.0)))
(princ (overlapvectors lstLine1 lstLine2))


(princ)

[GHarvey]

A somewhat different approach, for what it's worth:

(defun overlaps (pts fuzz / LN-OLAPS PTS-LN PTS-REM PTS-TMP PTX X)
  (defun uniq (i / )
    (if i
      (cons (car i) (uniq (vl-remove (car i) (cdr i))))
      ); if
    ); defun
  (defun olap (ln1 ln2 / OPTS)
    (foreach n ln1
      (if (equal (distance (car ln2) (cadr ln2))
		 (+ (distance n (car ln2))
		    (distance n (cadr ln2))
		    ); plus
		 fuzz
		 ); equal
	(setq opts (append opts (list n)))
	); if
      ); foreach
    opts
    ); defun
  (setq x 0
	pts-ln (length pts)
	); setq
  (while (< 1 (- pts-ln x))
    (setq ptx (nth x pts)
	  pts-rem (cdr (member ptx pts))
	  ); setq
    (foreach y pts-rem
      (setq pts-tmp (uniq
		      (append nil
			      (olap ptx y)
			      (olap y ptx)
			      ); append
		      ); uniq
	    ln-olaps (append ln-olaps
			     (list
			       (cons
				 (strcat
				   (itoa x)
				   "x"
				   (itoa (vl-position y pts))
				   ); strcat
				 (if (> 2 (length pts-tmp))
				   0.0
				   (distance (car pts-tmp)
					     (cadr pts-tmp)
					     ); distance
				   ); if
				 ); cons
			       ); list
			     ); append
	    ); setq
      ); foreach
    (setq x (1+ x))
    ); while
  ln-olaps
  ); defun

Supply a list of (lines) lists of two points each, and a numerical "fuzz" factor (as per the "Equal" lisp function) to receive a list of overlap lengths for every combination of the supplied lines. Each of these lengths is associated with a string derived from

(position of a line in the list) "x" (position of another line in the list).

Thus, for example:

(setq lins '(((1.0 1.0 0.0) (3.0 3.0 0.0)) ((2.0 2.0 0.0) (4.0 4.0 0.0)) ((0.0 0.0 0.0) (5.0 5.0 2.0)) ((2.5 2.5 1.0) (15.0 15.0 6.0))))

(setq fnew (overlaps lins 0.000))

returns

(("0x1" . 1.41421) ("0x2" . 0.0) ("0x3" . 0.0) ("1x2" . 0.0) ("1x3" . 0.0) ("2x3" . 3.67423))

If you wanted to retrieve the overlap of lines 0 [i.e. ((1.0 1.0 0.0) (3.0 3.0 0.0))] and 3 [i.e. ((2.5 2.5 1.0) (15.0 15.0 6.0))], for instance:

(cdr (assoc "0x3" fnew))

returns

0.0