Author Topic: Challenge - Distance between parallel lines (Read 9028 times)

Keith™ · « **on:** October 31, 2006, 04:48:35 PM »

Ok, I think it is time for a challenge. This is an exercise in something that you may need from time to time.

Create a function that takes a point on a line then calculate the distance between that line and the closest parallel line on the same layer.

The function should accept two arguments, a point and a maximum distance to search away from the initial point, and should return a real number indicating the offset distance of the parallel line. Something extra would be to limit the search to only those items that intersect a perpendicular point to the original point.

example:

(findparallel basepnt 120)

Result would be nil for nothing within 120 units parallel to the point and the distance for the closest line within 120 units.

gile · « **Reply #1 on:** November 01, 2006, 05:37:48 AM »

Hi,

Here's my code, it works in WCS plane, "the search is limited to only those items that intersect a perpendicular point to the original point."

Edit : It works now in every UCS plane containing the line.

Code: [Select]

(defun findparallel
       (basept leng / ss elst lay start end ang p1 p2 linelst)
  (if
    (and (setq ss (ssget basept '((0 . "LINE"))))
	 (setq elst (entget (ssname ss 0)))
	 (setq basept (osnap basept "_nea"))
	 (setq lay (cdr (assoc 8 elst)))
	 (setq start (trans (cdr (assoc 10 elst)) 0 1))
	 (setq end (trans (cdr (assoc 11 elst)) 0 1))
	 (equal (caddr start) (caddr end) 1e-9)
	 (setq ang (angle start end))
	 (setq p1 (polar basept (+ ang (/ pi 2)) leng))
	 (setq p2 (polar basept (- ang (/ pi 2)) leng))
	 (setq
	   ss (ssdel (cdr (assoc -1 elst))
		     (ssget "_X" (list '(0 . "LINE") (cons 8 lay)))
	      )
	 )
	 (setq linelst
		(vl-remove-if
		  '(lambda (l)
		     (or
		       (not
			 (inters (trans (cdr (assoc 10 (entget l))) 0 1)
				 (trans (cdr (assoc 11 (entget l))) 0 1)
				 p1
				 p2
			 )
		       )
		       (inters (trans (cdr (assoc 10 (entget l))) 0 1)
			       (trans (cdr (assoc 11 (entget l))) 0 1)
			       start
			       end
			       nil
		       )
		     )
		   )
		  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		)
	 )
    )
     (apply
       'min
       (vl-remove-if
	 '(lambda (x) (< leng x))
	 (mapcar '(lambda (l)
		    (distance
		      basept
		      (inters (trans (cdr (assoc 10 (entget l))) 0 1)
			      (trans (cdr (assoc 11 (entget l))) 0 1)
			      p1
			      p2
		      )
		    )
		  )
		 linelst
	 )
       )
     )
  )
)


(defun c:test (/ pt sd dist)
  (setq	pt (getpoint "\nPick a point on a line: ")
	sd (getdist pt "\nSearch distance: ")
  )
  (if
    (setq dist (findparallel pt sd))
     (princ (strcat "\nClosest parallel line at: " (rtos dist)))
     (princ "\nNothing found.")
  )
  (princ)
)

CAB · « **Reply #2 on:** November 01, 2006, 10:11:26 AM »

gile
I am having trouble getting your routine to return other than 0.
Test: Draw a line 0,0 to 120,0 then a line 0,10 to 120,10 both on layer 0
(findparallel (setq pt (getpoint)) 200)
result 0
WCS
No other geometry in model space
osnaps set to end & mid
picked on end of line & another at mid point

FYI
Here are a couple of problems I have encountered in the past
Lines may be parallel but of different lengths
Lines may be parallel but drawn from opposite directions.

LE · « **Reply #3 on:** November 01, 2006, 10:22:11 AM »

Here is my contribution - warning: not fully tested -

Code: [Select]

 (defun parallelPts  (lst sp ep / p1 p2)
  (setq	p1 (car lst)
	p2 (cadr lst))
  (if (equal (angle sp ep) (angle p1 p2) 0.0001)
    (list p1 p2)
    (list p2 p1)))

(defun C:TST  (/ ss start ename	p10 p11	layer end ename2 pars da db
	       search_dist)
  (if (setq start (getpoint "\nStart from: "))
    (progn
      (if (not def)
	(setq def 1.0))
      (setq search_dist
	     (getdist start
		      (strcat "\nSearch distance <" (rtos def) ">: ")))
      (if (not search_dist)
	(setq search_dist def)
	(setq def search_dist))
      (setq ss (ssget start))
      (if (and ss (= (sslength ss) 1))
	(progn
	  (setq	ename (ssname ss 0)
		p10   (cdr (assoc 10 (entget ename)))
		p11   (cdr (assoc 11 (entget ename)))
		layer (cdr (assoc 8 (entget ename)))
		start (polar start
			     (+ (angle p10 p11) (* pi 1.5))
			     search_dist)
		end   (polar start
			     (+ (angle p10 p11) (* pi 0.5))
			     (* search_dist 2.0)))
	  (if (setq
		ss (ssget "f"
			  (list start end)
			  (list (cons 8 layer) (cons 0 "LINE"))))
	    (progn
	      (setq ss	   (ssdel ename ss)
		    ename2 (ssname ss (- (sslength ss) 1))
		    p1	   (cdr (assoc 10 (entget ename2)))
		    p2	   (cdr (assoc 11 (entget ename2)))
		    pars
			   (parallelPts (list p10 p11 p1 p2) p10 p11)
		    da	   (distance p10 (car pars))
		    db	   (distance p11 (cadr pars)))
	      (if (equal d1 d2 0.000001)
		(progn
		  (redraw ename2 3)
		  (getstring "\n<Enter> to unhighlight...")
		  (redraw ename2 4)))))))))
  (princ))
(princ)

And please, for these type of challenges, I would like to know/read/find out/etc. who won or what approach was better/close or have more potential.

In ALL the ones I have participated here - there is no final decision or a courtesy of saying "Hey that or that one was the algorithm or routine that was expected" - hope that this comment would help for future challenges.. I think.

Keith™ · « **Reply #4 on:** November 01, 2006, 10:29:40 AM »

Quote from: LE on November 01, 2006, 10:22:11 AM

And please, for these type of challenges, I would like to know/read/find out/etc. who won or what approach was better/close or have more potential.

In ALL the ones I have participated here - there is no final decision or a courtesy of saying "Hey that or that one was the algorithm or routine that was expected" - hope that this comment would help for future challenges.. I think.

That is a very good idea. Perhaps once the thread has run it's course, we can all come to a concensus of the good and bad, the most concise and perhaps the most unique method of solving the problem.

I'll give this particular thread about a week or so then we can discuss the particulars.

CAB · « **Reply #5 on:** November 01, 2006, 10:48:31 AM »

Luis,
I got this result on one of my test.

LE · « **Reply #6 on:** November 01, 2006, 11:07:03 AM »

Thanks, I look @ that in a while.... need to wash my car....

gile · « **Reply #7 on:** November 01, 2006, 11:13:17 AM »

CAB,

I'm sorry, "x" was missing in (< leng x). I think it works now.

Here's another way, working in 3D, whatever the plane of lines or UCS.Some little vector and angular calculus routines have to be loaded.
I post them separately rather than include them in the code because I think these routines might be useful.

Edit : I changed the code for more concision and to add the possibility of "extra" :

Quote

Something extra would be to limit the search to only those items that intersect a perpendicular point to the original point.

New Edit : The routine have a now 3 arguments : base point, search distance and an option : T or nil.
(findparallel basept dist T) to specify that only lines crossing the perpendicular plane to original line at picked point are searched ("extra")
(findparallel basept dist nil) overwise.

Sub routines :

Code: [Select]

;;; Returns the single unit vector from p1 to p2
(defun VEC1 (p1 p2)
  (if (not (equal p1 p2 1e-009))
    (mapcar
      '(lambda (x) (/ x (distance p1 p2)))
      (mapcar '- p2 p1)
    )
  )
)

;;; Returns an angle cosinus
(defun ACOS (num)
  (cond
    ((equal num 1 1e-9) 0.0)
    ((equal num -1 1e-9) pi)
    ((< -1 num 1)
     (atan (sqrt (- 1 (expt num 2))) num)
    )
  )
)

;;; Returns the 3D angle defined by 3 3D points
(defun ANGLE_3PTS (som p1 p2 / d1 d2 d3)
  (setq	d1 (distance som p1)
	d2 (distance som p2)
	d3 (distance p1 p2)
  )
  (if (and (< 0 d1) (< 0 d2))
    (ACOS (/ (+ (* d1 d1) (* d2 d2) (- (* d3 d3)))
	     (* 2 d1 d2)
	  )
    )
  )
)

;;; Returns the coordinates of a point's projection on a plane defined by its normal and origin
(defun PROJ_PT (pt org norm)
  (mapcar '-
	  pt
	  (mapcar
	    '(lambda (x)
	       (* x
		  (cos (ANGLE_3PTS org (mapcar '+ org norm) pt))
		  (distance org pt)
	       )
	     )
	    zdir
	  )
  )
)

Main function :

Code: [Select]

(defun findparallel
       (basept leng opt / ss elst lay zdir linelst intlst distlst)
  (vl-load-com)
  (if
    (and (setq ss (ssget basept '((0 . "LINE"))))
	 (setq elst (entget (ssname ss 0)))
	 (setq basept (trans (osnap basept "_nea") 1 0))
	 (setq lay (cdr (assoc 8 elst)))
	 (setq zdir (VEC1 (cdr (assoc 10 elst)) (cdr (assoc 11 elst))))
	 (setq
	   ss (ssdel (cdr (assoc -1 elst))
		     (ssget "_X" (list '(0 . "LINE") (cons 8 lay)))
	      )
	 )
	 (setq linelst
		(vl-remove-if-not
		  '(lambda (l / v)
		     (setq v (VEC1 (cdr (assoc 10 (entget l)))
				   (cdr (assoc 11 (entget l)))
			     )
		     )
		     (and
		       (or
			 (equal zdir v 1e-12)
			 (equal zdir (mapcar '- v) 1e-12)
		       )
		       (< (distance
			    basept
			    (vlax-curve-getClosestPointTo l basept)
			  )
			  leng
		       )
		     )
		   )
		  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		)
	 )
	 (setq
	   intlst
	    (vl-remove-if-not
	      'vl-consp
	      (mapcar
		'(lambda (l)
		   (if
		     (equal basept
			    (setq
			      proj (PROJ_PT
				     (if (equal	basept
						(cdr (assoc 10 (entget l)))
					 )
				       (cdr (assoc 11 (entget l)))
				       (cdr (assoc 10 (entget l)))
				     )
				     basept
				     zdir
				   )
			    )
		     )
		      basept
		      (inters (cdr (assoc 10 (entget l)))
			      (cdr (assoc 11 (entget l)))
			      basept
			      proj
			      opt	; T for "extra", nil overwise
		      )
		   )
		 )
		linelst
	      )
	    )
	 )
	 (setq
	   distlst
	    (mapcar
	      '(lambda (p)
		 (distance
		   basept
		   p
		 )
	       )
	      intlst
	    )
	 )
    )
     (apply 'min distlst)
  )
)



(defun c:test (/ pt sd dist)
  (setq	pt (getpoint "\nPick a point on a line: ")
	sd (getdist pt "\nSearch distance: ")
  )
  (print)
  (findparallel pt sd nil)		; or (findparallel pt sd nil)
)

LE · « **Reply #8 on:** November 01, 2006, 11:16:26 AM »

Quote from: CAB on November 01, 2006, 10:48:31 AM

Luis,
I got this result on one of my test.

I copied the code from an old routine of mine, and forgot to rename two variables.

Quote

(equal d1 d2 0.000001)

Should be:

Quote

(equal da db 0.000001)

Thanks.

CAB · « **Reply #9 on:** November 01, 2006, 02:14:01 PM »

OK, here is my offering.
Hope it works.

Code: [Select]

(defun c:getparallel (/ pt ent entss ss dis parlst elst elsts layfilter)

  ;;  CAB  02/05/06
  (defun parallel (ln1 ln2 pfuzz / ang1 ang2)
    (setq ang1 (angle (cdr (assoc 10 ln1)) (cdr (assoc 11 ln1))))
    (setq ang2 (angle (cdr (assoc 10 ln2)) (cdr (assoc 11 ln2))))
    (or
      (equal ang1 ang2 pfuzz)
      ;;  Check for lines drawn in opposite directions
      (equal (min ang1 ang2) (- (max ang1 ang2) pi) pfuzz)
    )
  )

  
  (while
    (progn
      (initget 1)
      (setq pt (getpoint "\nSelect a point on the a line to find parallels."))
      (setq pt (list (car pt) (cadr pt))) ; 2d point
      (cond
        ((null (setq entss (ssget pt '((0 . "LINE")))))
         (prompt "\nMissed line, try again.")
         t
        )

        ((> (sslength entss) 1)
         (prompt "\nToo many lines at that point, try again.")
         t
        )
        ((setq ent (ssname entss 0))
         nil
        )
      )
    )
  )

  (initget 7)
  (setq dis (getdist pt "\nEnter the search distance."))

  (setq elst (entget ent))
  (setq layfilter (assoc 8 elst))
  (setq ss (ssget "_C" (mapcar '(lambda (x) (+ x dis)) pt)
                       (mapcar '(lambda (x) (- x dis)) pt)
                       (list '(0 . "LINE") layfilter))
  )

  (if (and ss (> (sslength ss) 1))
    (progn
      (setq elsts
             (mapcar 'entget
                   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      )
      (foreach ent (vl-remove elst elsts)
        (if (parallel elst ent 0.0001)
          (setq parlst (cons (cdr (car ent)) parlst))
        )
      )
      (if parlst
        (progn
          (setq parlst (cons (cdr (car elst)) parlst))
          (mapcar '(lambda (x) (redraw x 3)) parlst)
          (getpoint "\n<Enter> to unhighlight...")
          (mapcar '(lambda (x) (redraw x 4)) parlst)
        )
        (prompt "\n***  No lines parallel, Bye.")
      )
    )
    (prompt "\n***  No lines matching Layer, Bye.")
  )
  (princ)
)

gile · « **Reply #10 on:** November 01, 2006, 02:46:36 PM »

Your routines works fine, but I thaught the routine should return the distance to the closest parallel line within the search distance or nil.

Did I misunderstand ?

CAB · « **Reply #11 on:** November 01, 2006, 03:12:33 PM »

Shoot, I was just happy to find the parallel lines.
Let me revise the code.

Keith™ · « **Reply #12 on:** November 01, 2006, 03:14:02 PM »

You are correct. The return value should be either nil or the distance to the closest parallel line on the same layer.

CAB · « **Reply #13 on:** November 01, 2006, 03:48:59 PM »

Here we go again.

Code: [Select]

(defun getparallel (pt dis / ent entss ss mdist parlst elst elsts layfilter)
  (vl-load-com)
  ;;  CAB  02/05/06
  (defun parallel (ln1 ln2 pfuzz / ang1 ang2)
    (setq ang1 (angle (cdr (assoc 10 ln1)) (cdr (assoc 11 ln1))))
    (setq ang2 (angle (cdr (assoc 10 ln2)) (cdr (assoc 11 ln2))))
    (or
      (equal ang1 ang2 pfuzz)
      ;;  Check for lines drawn in opposite directions
      (equal (min ang1 ang2) (- (max ang1 ang2) pi) pfuzz)
    )
  )

  (setq pt (list (car pt) (cadr pt))) ; 2d point
  (cond
    ((null (setq entss (ssget pt '((0 . "LINE"))))))
    ((> (sslength entss) 1))
    ((setq ent (ssname entss 0)))
  )

  (if ent
    (progn
      (setq elst (entget ent))
      (setq layfilter (assoc 8 elst))
      (setq ss (ssget "_C"
                      (mapcar '(lambda (x) (+ x dis)) pt)
                      (mapcar '(lambda (x) (- x dis)) pt)
                      (list '(0 . "LINE") layfilter))
      )
      (if (and ss (> (sslength ss) 1))
        (progn
          (setq elsts
                 (mapcar 'entget
                         (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                 )
          )
          (foreach ent (vl-remove elst elsts)
            (if (parallel elst ent 0.0001)
              (setq parlst (cons (cdr (car ent)) parlst))
            )
          )
          (if parlst
            (progn
              (setq pt (vlax-curve-getStartPoint ent))
              (setq mdist (apply 'min
                         (mapcar '(lambda(x)
                             (distance (vlax-curve-getClosestPointTo x pt t) pt))
                               parlst)))
            )
          )
        )
      )
    )
  )
  mdist
)

Test routine.

Code: [Select]

(defun c:test (/ pt entss ent)
  (while
    (progn
      (initget 1)
      (setq pt (getpoint "\nSelect a point on the a line to find parallels."))
      (setq pt (list (car pt) (cadr pt))) ; 2d point
      (cond
        ((null (setq entss (ssget pt '((0 . "LINE")))))
         (prompt "\nMissed line, try again.")
         t
        )

        ((> (sslength entss) 1)
         (prompt "\nToo many lines at that point, try again.")
         t
        )
        ((setq ent (ssname entss 0))
         nil
        )
      )
    )
  )

  (initget 7)
  (setq dis (getdist pt "\nEnter the search distance.\n"))
  (getparallel pt dis)
)

SomeCallMeDave · « **Reply #14 on:** November 01, 2006, 04:32:49 PM »

For what its worth, here is my attempt

Code: [Select]

(defun findParallel (pPoint pDistTol)
   (setq BaseLine (vlax-ename->vla-object (car (nentselp pPoint)))
         TestPoint (vlax-curve-getClosestPointTo BaseLine pPoint)
         TestAng (rem (vla-get-angle BaseLine ) pi)
         ss2 (ssget "X" (list (cons 0 "LINE") (cons 8 (vla-get-Layer BaseLine))))
         Count 0
         DistList nil
   );setq
   (ssdel (vlax-vla-object->ename BaseLine) ss2)
   (repeat (sslength ss2)
       (setq CurrEnt (ssname ss2 count)
             CurrAng (rem (vla-get-angle (vlax-ename->vla-object CurrEnt)) pi)
       );setq
       (if (equal CurrAng TestAng 0.001)
            (setq CurrDist (distance (vlax-curve-getClosestPointTo CurrEnt TestPoint T) TestPoint)
                  DistList (append DistList (list CurrDist))
            );setq
       );if
       (setq Count (+ Count 1))
   );repeat
   (setq MinDist (car (vl-sort DistList '<)))
   
   (if (<= MinDist pDistTol)
        MinDist
        nil
   )      

)

(defun c:TestFP()
  (findParallel (getPoint "\nPick Point on Line ") (getreal "\nEnter Distance Tolerance "))
)

CAB · « **Reply #15 on:** November 01, 2006, 11:56:19 PM »

Dave, i like you code. You overcame the ssget distance limit but that created a problem with the specifications.

Quote

a point and a maximum distance to search away from the initial point

Your code checks the spread between the lines, in the case in the picture it should return nil.

CAB · « **Reply #16 on:** November 02, 2006, 12:14:46 AM »

Well the adjustment was easy, hope you don't mind me messing with your code.

Code: [Select]

(defun findparallel (ppoint     pdisttol   /          baseline   currang
                      currdist   current    ename      idx        DistList
                      ss         testang    testpoint
                     )
  (setq baseline  (vlax-ename->vla-object (car (nentselp ppoint)))
        testpoint (vlax-curve-getclosestpointto baseline ppoint)
        testang   (rem (vla-get-angle baseline) pi)
        ss        (ssget "X" (list (cons 0 "LINE")
                                   (cons 8 (vla-get-layer baseline))
                                   (cons 410 (getvar "ctab")))
                  )
        idx       -1
  )
  (ssdel (vlax-vla-object->ename baseline) ss)
  (while (setq ename (ssname ss (setq idx (1+ idx))))
    (setq current (ssname ss idx)
          currang (rem (vla-get-angle (vlax-ename->vla-object current)) pi)
    )
    (if (equal currang testang 0.001)
      (if (>= pdisttol (distance
                         (vlax-curve-getclosestpointto current testpoint) testpoint))
        (setq currdist (distance
                         (vlax-curve-getclosestpointto current testpoint t)
                         testpoint)
            DistList (cons CurrDist DistList)
        )
      )
    )
  )
  (if (and DistList
           (setq MinDist (apply 'min DistList))
           (<= mindist pdisttol))
    mindist
    nil
  )
)

SomeCallMeDave · « **Reply #17 on:** November 02, 2006, 07:48:31 AM »

No CAB, I don't mind you changing my code. And I see your point about my mis-reading the specs.

I was blinded by

Quote

indicating the offset distance of the parallel line

Also, I didn't understand this requirement

Quote

Something extra would be to limit the search to only those items that intersect a perpendicular point to the original point.

CAB · « **Reply #18 on:** November 02, 2006, 08:33:21 AM »

Quote

Something extra would be to limit the search to only those items that intersect a perpendicular point to the original point.

I didn't understand that either.
Perhaps Keith will give us some more explanation.

gile · « **Reply #19 on:** November 02, 2006, 09:03:20 AM »

Quote

Something extra would be to limit the search to only those items that intersect a perpendicular point to the original point.

I'll try (in my poor English) to explain what I understood and and the way I tried to answer it in my codes.

The way is to search only lines parallel, on same layer, offseted within the search distance, and wich cross the perpendicular line (2D) or plane (3D) to the original line at original point.

Example : original line is from 0,0 to 120,0 original point is 90,0 search distance 20.0 a line from 100,10 to 200,10 should return 10.0 without "extra", nil with. If original point is 120,0 both should return 10.0

I edited my last code this way : replacing nil by T in the (inters ...) expression will retain only lines crossing the perpendicular plane to original line at picked point..

Keith™ · « **Reply #20 on:** November 02, 2006, 09:16:26 AM »

It was more like an "extra credit" thing ... not specifically required, but would show whether the object was parallel to the point picked as well.

I don't want to change the challenge midstream, but if the user had a way to return 2 parameters (list maybe) or send an additional configurable argument to the routine to specify the apposing line "must be located at a point perpendicular" to the point selected.

Example:
(isParallel frompoint maxdistance T)

CAB · « **Reply #21 on:** November 02, 2006, 09:32:16 AM »

Quote from: Keith™ on November 02, 2006, 09:16:26 AM

It was more like an "extra credit" thing ... not specifically required, but would show whether the object was parallel to the point picked as well.

I don't want to change the challenge midstream, but if the user had a way to return 2 parameters (list maybe) or send an additional configurable argument to the routine to specify the apposing line "must be located at a point perpendicular" to the point selected.

Example:
(isParallel frompoint maxdistance T)

Forgive my ignorance. What is "perpendicular to a point"?
I thought a point did not have a direction, so how can there be perpendicular?

gile · « **Reply #22 on:** November 02, 2006, 10:25:02 AM »

Quote

send an additional configurable argument to the routine

I edit (one more time) the routine I posted this way.

Keith™ · « **Reply #23 on:** November 02, 2006, 10:29:19 AM »

Ok .. let me see if I can explain it a bit better .. I know I have not done very well up to now, but give me a minute and I will try once again.

After several thoughts on how to best word this, I think the best way to explain it would be as follows:

The parallel line should be able to be selected within a radius of a circle located at the original point as is indicated in the pic below.

The top is to be understood that a parallel line must intersect an imaginary line drawn at 90 deg to the main line within the distance specified
The middle is that a parallel line may be located at any point within the specified distance
The bottom is the same as the top, but shows that it selects the second line and omits the middle line because it does not intersect the dashed line as indicated

I sure hope I was able to explain it a bit better now.

CAB · « **Reply #24 on:** November 02, 2006, 12:42:29 PM »

Keith,
Thanks for the clarification.
Here is a scenario where there are 3 lines within the search radius & all are the same distance from the target line.
Are there any rules in this condition?

Just kidding.

Keith™ · « **Reply #25 on:** November 02, 2006, 12:45:42 PM »

Uh .. well, since the objective is to determine the closest distance between 2 parallel lines, the result would be the same .. for example if the distance was 12 for each one the result would be 12

CAB · « **Reply #26 on:** November 03, 2006, 10:33:50 AM »

Yea, slap me for ignoring with the obvious.

I lost track of the challenge as I am upgrading my "2 pick wall hatch" routine to a "One Pick" thanks to you & the others who participated in this thread.

News:

Author Topic: Challenge - Distance between parallel lines (Read 9028 times)

LE

LE

LE

SomeCallMeDave

SomeCallMeDave