Jump to content

Find the nearest parallel line

dirtyacc

By dirtyacc
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

dirtyacc Apprentice

dirtyacc

Posted
Posted (edited)

950212823_.jpg.5f50897cf974e900acb7a3c3a7eb6ddd.jpg

 

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 by dirtyacc
dlanorh Mentor

dlanorh

Posted
Posted

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

dirtyacc Apprentice

dirtyacc

Posted
  • Author
Posted
8 hours ago, dlanorh said:

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

some are polyline.

Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

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 Veteran

Grrr

Posted
Posted (edited)

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 by Grrr
  • 2 years later...
piblepark Newbie

piblepark

Posted
Posted

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

  • 1 month later...
pixlepark96@gmail.com Rookie

pixlepark96@gmail.com

Posted
Posted

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...