Finding 2 points along a pline

[Anonymous]

I have plines of circuits that sometimes have T's (line goes along, then T's out then back to T point and then continues).

Here is example line -

(setq List_Pline (list (list 0 0) (list 1 1) (list 0.5 1.5) (list 1 1) (list 2 2) (list 3 3) (list 3.5 2.5) (list 3 3) (list 4 4)))

nth 0 = (0 0)
nth 1 = (1 1)     - T point
nth 2 = (0.5 1.5)
nth 3 = (1 1)     - T return point
nth 4 = (2 2)
nth 5 = (3 3)     - T point
nth 6 = (3.5 2.5)
nth 7 = (3 3)     - T return point
nth 8 = (4 4)

I need to be able to pick 2 points along the line and find the shortest route.

Examples - 

1st point at 1,1 and 2nd point at 3,3 - new line is nth's 3,4,5

1st point at 0,0 and 2nd point at 1,1 - new line is nth's 0,1

1st point at 2,2 and 2nd point at 3,3 - new line is nth's 4,5

1st point at 3,3 and 2nd point at 4,4 - new line is nth's 7,8

1st point at 0,0 and 2nd point at 3,3 - new line is nth's 0,1,2,3,4,5

1st point is 1,1 and 2nd point is 1,1 - new line is nth's 1,2,3

I've tried using vlax-curve-getParamAtPoint, but it returns 1st T point.

Synopsis of program -

Select Pline

Pick 1st point

check if on line

Pick 2nd point

check if on line

check if 2nd point is before 1st point, if so swap locations

find last nth of 1st point

find 1st nth of 2nd point

return list

Thanks in advance!

Alan

[devitg]

Upload the dwg , in 2008  if possible

[Anonymous]

sorry...i can't seem to attach file.

I get the following message -

The file type doesn't match the type of its contents

[devitg]

send it to my email   , find attached

[hmsilva]

---

@Anonymous wrote:
...

I've tried using vlax-curve-getParamAtPoint, but it returns 1st T point.

 ...

---

Alan, using vlax-curve-getParamAtPoint will return the first parameter at given point, using your example and as a demo, maybe something like this

(setq par1 (vlax-curve-getParamAtPoint curve pt1));; parameter from the pt1
(setq par2 (vlax-curve-getParamAtPoint curve pt2));; parameter from the pt2
(if (equal (vlax-curve-getPointAtParam curve (+ par1 2.)) pt1);; test if the parameter par1 2+ has the same coordinates as par1
  (progn 
  (setq par1 (+ par1 2.));; if true, set the par1 2+
  ;; do your pline stuff
  );; progn
  (progn
     ;; do your pline stuff 
  );; progn
  );; if

hope that helps
Henrique

[marko_ribar]

Here, I've modified my code - it works in 3D too... No arcs (bulges), only straight sements LWPOLYLINE... New red LWPOLYLINE will be entmaked over existing one you picked... After that you can extract points list...

I had mistake in the code - it didn't find first occurence of 2nd point... Now it's fixed... I just don't know for what are you using computer and CAD if no ones check and test the code... Now this should have been done much, much earlier...

(defun c:shortestplpath ( / lw3dpts member-fuzz rev-member-fuzz 
                            pl pldxfdata plvertlst p pt1 pt2 plvertlstpath plvlpathocs pldxfdatapre pldxfdatasuf 
                        )

  (defun lw3dpts ( lwpol / unit mxv v^v transptucs transptwcs lwdxf lwptl lwel ux uy uz ptlst )

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

    (defun mxv ( m v )
      (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
    )

    (defun v^v ( u v )
      (mapcar '(lambda ( n ) (- (* (nth (car n) u) (nth (cadr n) v)) (* (nth (cadr n) u) (nth (car n) v)))) '((1 2) (2 0) (0 1)))
    )

    (defun transptucs ( pt p1 p2 p3 / ux uy uz )
      (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
      (setq ux (unit (mapcar '- p2 p1)))
      (setq uy (unit (mapcar '- p3 p1)))
      
      (mxv (list ux uy uz) (mapcar '- pt p1))
    )

    (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
      (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
      (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
      (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
      (transptucs pt pt1n pt2n pt3n)
    )

    (if (and lwpol (= (cdr (assoc 0 (setq lwdxf (entget lwpol)))) "LWPOLYLINE"))
      (progn
        (setq lwptl (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) lwdxf))
        (setq lwptl (mapcar '(lambda ( x ) (cdr x)) lwptl))
        (setq lwel (cdr (assoc 38 lwdxf)))
        (setq lwptl (mapcar '(lambda ( x ) (list (car x) (cadr x) lwel)) lwptl))
        (setq uz (cdr (assoc 210 lwdxf)))
        (setq ux (if (equal uz '(0.0 0.0 1.0) 1e-8) '(1.0 0.0 0.0) (unit (v^v '(0.0 0.0 1.0) uz))))
        (setq uy (unit (v^v uz ux)))
        (setq ptlst (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) lwptl))
      )
      (prompt "\nNo lwpolyline picked")
    )
    ptlst
  )

  (defun member-fuzz ( el lst fuzz )
    (foreach e lst
      (if (equal e el fuzz) (setq el e))
    )
    (member el lst)
  )

  (defun rev-member-fuzz ( el lst fuzz / _reml )

    (defun _reml (l1 l2 / a n ls)
      (while 
        (setq n nil 
              a (car l2)
        )
        (while (and l1 (null n))
          (if (equal a (car l1) 1e-8)
            (setq l1 (cdr l1) 
                  n t
            )
            (setq ls (append ls (list (car l1)))
                  l1 (cdr l1)
            )
          )
        )
        (setq l2 (cdr l2))
      )
      (append ls l1)
    )
    
    (append (_reml lst (member-fuzz el lst fuzz)) (list el))
  )

  (setq pl (car (entsel "\nPick LWPOLYLINE for finding shortest path between 2 picked points")))
  (setq pldxfdata (entget pl))
  (setq plvertlst (lw3dpts pl))
  (while (not (member-fuzz (setq pt1 (getpoint "\nPick first vertex : ")) plvertlst 1e-6)))
  (while (not (member-fuzz (setq pt2 (getpoint "\nPick second vertex : ")) plvertlst 1e-6)))
  (if (not (member-fuzz pt2 (member-fuzz pt1 plvertlst 1e-6) 1e-6)) (setq p pt1 pt1 pt2 pt2 p))
  (setq plvertlstpath (reverse (rev-member-fuzz pt1 (reverse (rev-member-fuzz pt2 plvertlst 1e-6)) 1e-6)))
  (setq plvlpathocs (mapcar '(lambda ( p ) (trans p 0 pl)) plvertlstpath))
  (setq pldxfdatapre (reverse (cdr (reverse (rev-member-fuzz (assoc 10 pldxfdata) pldxfdata 1e-6)))))
  (setq pldxfdatasuf (member-fuzz (assoc 210 pldxfdata) pldxfdata 1e-6))
  (entmake 
    (append 
      (subst (cons 70 0) (assoc 70 pldxfdatapre) pldxfdatapre) 
      (list (cons 62 1)) 
      (mapcar '(lambda ( p ) (list 10 (car p) (cadr p))) plvlpathocs)
      pldxfdatasuf
    )
  )
  (sssetfirst nil (ssadd (entlast)))
  (princ)
)

 M.R.

[Kent1Cooper]

---

@hmsilva wrote:

.... 

....
(if (equal (vlax-curve-getPointAtParam curve (+ par1 2.)) pt1);; test if the parameter par1 2+ has the same coordinates as par1
....

....

---

Interesting idea, which raises questions in my mind for mracad:

Would the "T" situation always be just one vertex out and the next one back to the location of the previous one, so that coinciding vertices would always be two apart?

Would you always be looking at locations at vertices, or might you sometimes pick locations in mid-segment?

One way to make it not matter what the answers to those question are:  make a reversed-direction copy of the Polyline [there are routines out there to reverse entity direction, such as mine here, which unlike any others I found preserves even varying widths, and unlike most others does arc segments correctly], and check for that point on the reversed one, where it should "see" the parameter value closer to its beginning end, rather than the value closer to the beginning end of the non-reversed one.