Find the nearest parallel line

[dirtyacc]

 

How can I find the nearest line which is parallel with the target entity.

 

As in the image, I want to find the green line in both case, notice the red line has a smaller distance to my target "abcedfg", but in the second case, the parallel part of the polyline has a longer distance than the green line. In fact,  I need to know the exact amount of the distance to the parallel line to get my lisp start working.

 

All white ones is for distraction test...

 

It's been a while since last time I wrote anything in English, please pardon my terrible description if you don't mind.

Edited April 15, 2019 by dirtyacc

[dlanorh]

are they all lines, or are some of them polylines?

[dirtyacc]

8 hours ago, dlanorh said:

are they all lines, or are some of them polylines?

some are polyline.

[Emmanuel Delay]

Try this.

 

Command FNP  (for Find Nearest Parallel)

 

It draws a few lines and XLines, looks for intersections, then picks the closest parallel line that has overlap. ... then it deletes these lines/Xlines

 

The part that overlaps is drawn on the nearest line/XLine, and gets selected (sssetfirst)

 

(vl-load-com)   

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawLine (p1 p2 / exv)
  ;;(setq exv (trans (list 0 0 1) 1 0 T))
  (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
                 ;;(cons 210 exv)
                 ))
)

(defun xLine (pt vec / exv)
  (setq exv (trans (list 0 0 1) 1 0 T))
  (entmakex (list (cons 0 "XLINE")
                  (cons 100 "AcDbEntity")
                  (cons 100 "AcDbXline")
                  (cons 10 pt)
                  (cons 11 vec)
                  (cons 210 exv)
                  ))
)
                 
                 
(defun c:test_xline ( / )
 
  (xLine
    (list 128.616 130.629 0.0)
    (polar (list 0.0 0.0 0.0) (+ (/ pi 2.0) 2.20327) 1)
  )  
 
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 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-8)
                (equal (+ b c) a 1e-8)
                (equal (+ c a) b 1e-8)
            )
        )
        (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; get Closest Point To
(defun gct (l1 c1 / p1 )
  ;; http://forums.augi.com/showthread.php?113595-vlax-curve-and-UCS
  (setq p1 (vlax-curve-getClosestPointTo
    (car l1)
    (trans c1 1 0)
    (mapcar '-
      (trans (getvar "VIEWDIR") 1 0)
      (trans '(0 0 0) 1 0)
    )
  ))
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; 2d-coord->pt-lst
;; Converts a 2d coordinates flat list into a 2d point list
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0))
(defun 2d-coord->pt-lst (lst)
  (if lst
    (cons (list (car lst) (cadr lst))
      (2d-coord->pt-lst (cddr lst))
    )
  )
)

;; user selects a polyline with nentsel, this function returns ( start and endpoint of ) the selected segment
(defun selected_vertex (pline pp / p1 vertexs i ps pe result)
  (setq p1 (gct pline pp))
  (setq    
    i 0
    ;; get vertices of the polyline
      vertexs (2d-coord->pt-lst (vlax-get (vlax-ename->vla-object (car pline)) 'coordinates))
  )
  (repeat (- (length vertexs) 1)
    (if
      (LM:Collinear-p
        (setq ps (nth i vertexs))
        p1
        (setq pe (nth (+ i 1) vertexs))
      )
      (setq result (list ps pe))
    )
    (setq i (+ i 1))
  )
  result
)

(defun is_parallel (ang1 ang2 / small_number result)
    (setq small_number 0.0001)
    ;; if angle 2 is 180° more than angle 1, both are parallel as well
    (while (>= ang1 pi)
      (setq ang1 (- ang1 pi))
    )
    (while (>= ang2 pi)
      (setq ang2 (- ang2 pi))
    )
  (if (< (abs (- ang1 ang2)) small_number)
    (setq result T)
    (setq result nil)
  )
  result
)

(defun same_line (a b c d / small_number)
  (setq small_number 0.0001)
  (if (and
      (< (distance a b) small_number)
      (< (distance c d) small_number)
    )
    T
    nil
  )
)

;; https://www.theswamp.org/index.php?topic=31737.0
;;  return a list of intersect points or nil
(defun get_interpts (obj1 obj2 / iplist)
  ;;(vl-load-com)
  (if (not (vl-catch-all-error-p
             (setq iplist (vl-catch-all-apply
                            'vlax-safearray->list
                            (list
                              (vlax-variant-value
                                (vla-intersectwith obj1 obj2 acextendnone)
                              ))))))
    iplist
  )
)

;; returns the first intersection point, or nil.
;; it disregards other insert points
(defun first_intersect (obj1 obj2 / a)
  (setq a (get_interpts (vlax-ename->vla-object obj1) (vlax-ename->vla-object obj2)))
  (if a
    a ;; (nth 0 a)
    nil
  )
)


(defun c:fnp ( / src data pp lines i j sp1 ep1 ang1 dst sp2 ep2 ang2 vertexs vtx ss typ temp_xlines tmp_cln tmp_ln tp1 tp2 tp3 tp4 pol1 pol2 pol3 pol4 is1 is2 is3 is4 overlap_data overlap_item dst_ ind)
  (setq temp_xlines (list))   ;; must be removed at the end
  (setq overlap_data (list))  ;; list of lists: (list (list overlap_point1 overlap_point2 distance) ... )
 
 
  ;; User selected line or polyline
    (setq src (nentsel "\nSource line or sub entity of polyline"))
    ;; it could be a line or a selected part of a polyline.  in any case let's find start and endpoint  
    (if (= "LINE" (cdr (assoc 0 (entget (car src)))))
      (progn
        (setq sp1 (cdr (assoc 10 (entget (car src)))))
        (setq ep1 (cdr (assoc 11 (entget (car src)))))
      )
      ;; else, it should be a polyline
      (progn
        (setq vtx (selected_vertex src (cadr src)))
        (setq sp1 (nth 0 vtx))
        (setq ep1 (nth 1 vtx))
      )
    )
    ;; angle
    (setq ang1 (angle sp1 ep1))
    ;; draw a temp line
    (setq tmp_cln (drawLine sp1 ep1))
 
  ;; now we select all lines and polylines in the dwg
    ;; and see if the angle is the same
    ;; of those lines with the same angle we calculate the distance
    ;; we skip lines without overlap
  (setq i 0)
  (setq data (list))  
  (setq ss (ssget "_X" (list (cons 0 "LINE,POLYLINE,LWPOLYLINE" ))))
  ;;(setq ss (ssget "_X" (list (cons 0 "LINE" ))))
  (repeat (sslength ss)
    (setq typ (cdr (assoc 0 (entget (ssname ss i)))))
    
    (if (= typ "LINE")
      (progn
        (setq ang2
          (angle    
            (setq sp2 (cdr (assoc 10 (entget (ssname ss i)))))
            (setq ep2 (cdr (assoc 11 (entget (ssname ss i)))))
          )
        )
        (setq data (append data (list (list sp2 ep2 ang2))))
      )
      ;; else, polyline
      (progn
        (setq dst (ssname ss i))
        (setq vertexs (2d-coord->pt-lst (vlax-get (vlax-ename->vla-object dst) 'coordinates)))
        (setq j 0)
        (repeat (- (length vertexs) 1)

          (setq ang2
            (angle
              (setq sp2 (nth j vertexs))
              (setq ep2 (nth (+ j 1) vertexs))
            )   
          )
          (setq data (append data (list (list sp2 ep2 ang2))))
          (setq j (+ j 1))
        )

      )
    )
    (setq i (+ i 1))
  )
 
  (setq i 0)
  (foreach line data
    (if (is_parallel ang1 (nth 2 line))
      (progn
        ;; see if there is overlap.  We draw an XLine perpendicular to both lines at the 4 endpoints.  
        ;; 2 of those XLines should intersect with the other line
        ;; the distance between these 2 XLines is the parallel overlap
        
        ;; skip, if the line = the user selected line
        (if (not (same_line sp1 (nth 0 line) ep1 (nth 1 line))) (progn
        
          ;; draw a temp line
          (setq tmp_ln (drawLine (nth 0 line) (nth 1 line)))
          
          (setq temp_xlines (append temp_xlines (list
            (setq tp1 (xLine
              sp1
              (setq pol1 (polar (list 0.0 0.0 0.0) (+ (/ pi 2.0) ang1) 1))
            ))
          )))
           (setq temp_xlines (append temp_xlines (list
            (setq tp2 (xLine
              ep1
              (setq pol2 (polar (list 0.0 0.0 0.0) (+ (/ pi 2.0) ang1) 1) )
            ))
          )))
          (setq temp_xlines (append temp_xlines (list
            (setq tp3 (xLine
              (nth 0 line)
              (setq pol3 (polar (list 0.0 0.0 0.0) (+ (/ pi 2.0) (nth 2 line)) 1) )
            ))
          )))
          (setq temp_xlines (append temp_xlines (list
            (setq tp4 (xLine
              (nth 1 line)
              (setq pol4 (polar (list 0.0 0.0 0.0) (+ (/ pi 2.0) (nth 2 line)) 1))
            ))
          )))
          
          ;;  now look for intersections
          (setq is1 (first_intersect tmp_ln tp1))
          (setq is2 (first_intersect tmp_ln tp2))
          (setq is3 (first_intersect tmp_cln tp3))
          (setq is4 (first_intersect tmp_cln tp4))  
          
          (setq overlap_item (list))  
          
          (if is1 (progn  
            (setq dst_ (distance is1 sp1))
            (setq overlap_item (append overlap_item (list is1)))
          ))
          (if is2 (progn  
            (setq dst_ (distance is2 ep1))
            (setq overlap_item (append overlap_item (list is2)))
          ))
          (if is3 (progn  
            (setq dst_ (distance is3 (nth 0 line)))
            (setq overlap_item (append overlap_item (list (nth 0 line))))
          ))
          (if is4 (progn  
            (setq dst_ (distance is4 (nth 1 line)))
            (setq overlap_item (append overlap_item (list (nth 1 line))))
          ))
          
          ;; only if there are 2 overlap points we have a valid line  
          (if (= (length overlap_item) 2) (progn
            ;; add distance
            (setq overlap_item (append overlap_item (list dst_)))
            ;; now add this item to the list of lists
            (setq overlap_data (append overlap_data (list overlap_item)))
          ))
          ;; delete temp line
          (entdel tmp_ln)
          
        ))  ;; / not same line ?
       
      )
    )
    (setq i (+ i 1))
  )
 
  (setq
    dst_ (nth 2 (nth 0 overlap_data))
    ind 0
    j 0
  )
  (foreach i overlap_data
    (if (< (nth 2 i) dst_) (progn
      (setq
        dst_ (nth 2 i)
        ind j
      )
    ))
    (setq j (+ j 1))
  )

  (foreach i temp_xlines
    (entdel i)
  )
  (entdel tmp_cln)
 
  (sssetfirst nil
    (ssadd (drawLine (nth 0 (nth ind overlap_data)) (nth 1 (nth ind overlap_data))))
  )
 
  (princ)
)

 

[Grrr]

If you have only LINEs and not polylines, in 2D then this should work -

; Grips the closest parallel line to the picked one
(defun C:test ( / extremum _PickLine GetLinePts )
  
  
  ; Lee Mac 
  ; https://www.cadtutor.net/forum/topic/63013-find-the-highest-and-lowest-mark-from-the-selected-quotpointsquot/?tab=comments#comment-519862
  ; _$ (extremum '(lambda ( a b ) (< (caddr a) (caddr b))) '((1.2 5.7 8.3) (9.4 2.6 0.3) (5.7 6.6 7.2))) >> (9.4 2.6 0.3)
  (defun extremum ( cmp lst / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn)) (setq rtn itm))
    )
    rtn
  )
  
  (setq _PickLine
    (lambda ( / e enx r ) (setvar 'errno 0)
      (while (/= 52 (getvar 'errno)) (setq e (car (entsel "\nPick a line: " )))
        (cond  
          ( (= 7 (getvar 'errno)) (setvar 'errno 0) ) ( (not e) )
          ( (not (member '(0 . "LINE") (setq enx (entget e)))) (prompt "\nInvalid object.") )
          ( (setvar 'errno 52) (setq r enx) ) 
        )
      )
      r
    )
  )
  
  (setq GetLinePts 
    (lambda ( e / pts enx r )
      (setq pts (apply 'append (mapcar '(lambda (x) (if (member (car x) '(10 11)) (list (cdr x)))) (setq enx (entget e)))))
      (setq r 
        (list
          (cdr (assoc 5 enx))
          (apply 'mapcar (cons '(lambda (a b) (* (+ a b) 0.5)) pts))
          (mapcar 'abs (apply 'mapcar (cons '- pts)))
          e
        )
      )
    )
  )
  
  ( ; Main
    (lambda ( / enx SS i L pts pt )
      (cond 
        ( (not (setq enx (_PickLine))) )
        ( (setq SS (ssget "_X" (list '(0 . "LINE") (assoc 410 enx))))
          (repeat (setq i (sslength SS))
            (setq L (cons (GetLinePts (ssname SS (setq i (1- i)))) L))
          ); repeat 
          (and
            (setq pts (GetLinePts (cdr (assoc -1 enx))))
            (setq L (vl-remove-if '(lambda (x) (or (apply '= (mapcar 'car (list pts x))) (not (equal (caddr pts) (caddr x) 1e-3)))) L))
            (setq pt (cadr pts))
            (sssetfirst nil 
              (ssadd  
                (last
                  (extremum 
                    '(lambda ( a b )
                      (< (distance pt (cadr a)) (distance pt (cadr b)))
                    ); lambda
                    L
                  )
                )
              )
            )
          ); and
        )
      ); cond
    ); lambda
  )
  (princ)
); defun 

 

Edited April 23, 2019 by Grrr

[piblepark]

I used this function but I don't required selected object, I need variable for object selection. how to do?

[pixlepark96@gmail.com]

I want to get the ssget variable of this selected line. how to do?