Topic: Calculate the overlap length in two polylines

[Marc'Antonio Alessi]

Code: [Select]

;; Collinear-p  -  Lee Mac
;; Returns T if p1,p2,p3 are collinear
(defun LM:Collinear-p ( p1 p2 p3 )
    (
        (lambda ( a b c )
            (or
                (equal (+ a b) c 1e-4)
                (equal (+ b c) a 1e-4)
                (equal (+ c a) b 1e-4)
            )
        )
        (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
)
(defun Ale_Pline_LwVertices (EntObj / VrtIdx VrtInf OutLst) ; EntObj = VLA-OBJECT or ENAME
  (setq VrtIdx (1+ (vlax-curve-getEndParam EntObj)))         
  (while (> VrtIdx 0)
    (setq
      VrtInf (vlax-curve-getPointAtParam EntObj (setq VrtIdx (1- VrtIdx)))
      OutLst (cons VrtInf OutLst)
    )
  )
)

Code: [Select]

(defun C:test ( / VtxLst VtxLs1 VtxLs2 OutLen)
  (setq
    VtxLs1 (Ale_Pline_LwVertices (car (entsel "Poly perimeter: ")))
    VtxLs2 (Ale_Pline_LwVertices (car (entsel "Poly rectangle: ")))
    VtxLst VtxLs1
  )
  (while (cdr VtxLs2)
    (while (cdr VtxLs1)
      (if
        (and
          (LM:Collinear-p (car VtxLs1) (cadr VtxLs1) (car  VtxLs2))
          (LM:Collinear-p (car VtxLs1) (cadr VtxLs1) (cadr VtxLs2))
        )
        (setq OutLen (distance (car  VtxLs2) (cadr  VtxLs2))  VtxLs1 nil  VtxLs2 nil)
        (setq VtxLs1 (cdr VtxLs1))
      )
    )
    (setq VtxLs2 (cdr VtxLs2)   VtxLs1 VtxLst)
  )
  OutLen
) With the "test" function I can calculate the length of the gray segments, how can I calculate the length of the green segments?

[ribarm]

Triple overlapping?
I am guessing right?

[Marc'Antonio Alessi]

Triple overlapping?
I am guessing right?

The green segments are to show the partial overlap of White and Red...

[domenicomaria]

I believe that you should add
to the list of points of each polyline
all the possible intersections
with the other polylines. 

and then check, in two directions,
if each list of points contains
some sequence of points contained
in some other list of points ...

[Marc'Antonio Alessi]

Grazie Domenico, this is my elementary and brutal code which seems to work:

Code: [Select]

(defun C:test ( / FuzFac VtxOr1 VtxLs1 VtxLs2 OutLen Pt1a Pt1b Pt2a Pt2b Pt2aOn Pt2bOn)
  (setq
    VtxLs1 (Ale_Pline_LwVertices (car (entsel "Poly perimeter: ")))
    VtxLs2 (Ale_Pline_LwVertices (car (entsel "Poly rectangle: ")))
    VtxOr1 VtxLs1  OutLen 0  FuzFac 0.01
  )
  (while (cdr VtxLs2)
    (while (cdr VtxLs1)
      (setq
        Pt1a   (car VtxLs1)  Pt1b (cadr VtxLs1)         Pt2a   (car VtxLs2)  Pt2b (cadr VtxLs2)
        Pt2aOn (ALE_Geom_OnSeg Pt2a Pt1a Pt1b FuzFac)   Pt2bOn (ALE_Geom_OnSeg Pt2b Pt1a Pt1b FuzFac)
      )
      (cond
        ( (and Pt2aOn Pt2bOn)                                                                (setq OutLen (+ OutLen (distance Pt2a Pt2b))) )
        ( (and Pt2aOn (not (equal Pt2a Pt1a FuzFac)) (ALE_Geom_OnSeg Pt1a Pt2a Pt2b FuzFac)) (setq OutLen (+ OutLen (distance Pt2a Pt1a))) )
        ( (and Pt2aOn (not (equal Pt2a Pt1b FuzFac)) (ALE_Geom_OnSeg Pt1b Pt2a Pt2b FuzFac)) (setq OutLen (+ OutLen (distance Pt2a Pt1b))) )
        ( (and Pt2bOn (not (equal Pt2b Pt1a FuzFac)) (ALE_Geom_OnSeg Pt1a Pt2a Pt2b FuzFac)) (setq OutLen (+ OutLen (distance Pt2b Pt1a))) )
        ( (and Pt2bOn (not (equal Pt2b Pt1b FuzFac)) (ALE_Geom_OnSeg Pt1b Pt2a Pt2b FuzFac)) (setq OutLen (+ OutLen (distance Pt2b Pt1b))) )
      )
      (setq VtxLs1 (cdr VtxLs1))
    )
    (setq VtxLs2 (cdr VtxLs2)  VtxLs1 VtxOr1)
  )
  OutLen
)
(defun ALE_Geom_OnSeg (Pnt000 Pnt001 Pnt002 FuzFac)
  (equal (distance Pnt001 Pnt002) (+ (distance Pnt000 Pnt001) (distance Pnt000 Pnt002)) FuzFac)
)


[Marc'Antonio Alessi]

Some improvement...

Code: [Select]

(defun C:Test2 ( / FuzFac VtxOr1 VtxLs1 VtxLs2 OutLen Pt1a Pt1b Pt2a Pt2b Pt1aOn Pt1bOn Pt2aOn Pt2bOn)
  (setq
    VtxLs1 (Ale_Pline_LwVertices (car (entsel "Poly perimeter: ")))
    VtxLs2 (Ale_Pline_LwVertices (car (entsel "Poly rectangle: ")))
    VtxOr1 VtxLs1  OutLen 0  FuzFac 0.01
  )
  (while (cdr VtxLs2)
    (while (cdr VtxLs1)
      (setq
        Pt1a   (car VtxLs1)    Pt1b (cadr VtxLs1)       Pt2a   (car VtxLs2)    Pt2b (cadr VtxLs2)
        Pt1aOn (ALE_Geom_OnSeg Pt1a Pt2a Pt2b FuzFac)   Pt1bOn (ALE_Geom_OnSeg Pt1b Pt2a Pt2b FuzFac)
        Pt2aOn (ALE_Geom_OnSeg Pt2a Pt1a Pt1b FuzFac)   Pt2bOn (ALE_Geom_OnSeg Pt2b Pt1a Pt1b FuzFac)
      )
      (cond
        ( (and Pt1aOn Pt1bOn)                                (setq OutLen (+ OutLen (distance Pt1a Pt1b))) )
        ( (and Pt2aOn Pt2bOn)                                (setq OutLen (+ OutLen (distance Pt2a Pt2b))) )
        ( (and Pt2aOn Pt1aOn (not (equal Pt2a Pt1a FuzFac))) (setq OutLen (+ OutLen (distance Pt2a Pt1a))) )
        ( (and Pt2aOn Pt1bOn (not (equal Pt2a Pt1b FuzFac))) (setq OutLen (+ OutLen (distance Pt2a Pt1b))) )
        ( (and Pt2bOn Pt1aOn (not (equal Pt2b Pt1a FuzFac))) (setq OutLen (+ OutLen (distance Pt2b Pt1a))) )
        ( (and Pt2bOn Pt1bOn (not (equal Pt2b Pt1b FuzFac))) (setq OutLen (+ OutLen (distance Pt2b Pt1b))) )
      )
      (setq VtxLs1 (cdr VtxLs1))
    )
    (setq VtxLs2 (cdr VtxLs2)  VtxLs1 VtxOr1)
  )
  OutLen
)