Topic: (Challenge) polyline approximation

[ElpanovEvgeniy]

I suggest to continue entertainment with geometry.
The task:
There is a polyline (for simplicity without arc segments).
It is necessary to find all points along a polyline which of 1 mm along a contour are on distance.
Example:
lwpolyline 0,0 2,0 2,1 01
(defun test (ename)
  ....................
)
(test (car (entsel "\n Select lwpolyline")))
return
' ((0 0) (1 0) (2 0) (2 1) (1 1) (0 1))

PS. It is possible to think up a large quantity of algorithms, but I offer, at once to estimate job with long polylines, for example  length 10000 mm or bigger

PS. If you cannot understand the task - ask, I will try to explain in more details!

[gile]

Hi,

Here's my contribution

Code: [Select]

(defun vec1 (p1 p2 / d)
  (if (not (zerop (setq d (distance p1 p2))))
    (mapcar (function (lambda (x1 x2) (/ (- x2 x1) d))) p1 p2)
  )
)

(defun test (pl / l1 l2 v s e p)
  (setq l1 (mapcar 'cdr
   (vl-remove-if-not
     (function
       (lambda (x) (= (car x) 10))
     )
     (entget pl)
   )
   )
  )
  (if (= 1 (logand 1 (cdr (assoc 70 (entget pl)))))
    (setq l1 (append l1 (list (car l1))))
  )
  (while (setq e (cadr l1))
    (setq v  (vec1 (setq s (car l1)) e)
  l2 (cons s l2)
    )
    (while (< (distance s (setq p (mapcar '+ (car l2) v)))
      (distance s e)
   )
      (setq l2 (cons p l2))
    )
    (setq l1 (cdr l1))
  )
  (reverse (cons (car l1) l2))
)

[ElpanovEvgeniy]

My congratulations!
Very good code. 

There is one small discrepancy of my party...
lwpolyline ((0.0 0.0) (2.5 0.0) (2.5 1.0) (0.0 1.0))

[gile]

There is one small discrepancy of my party...

I don't understand what you mean. Does the routine have to return points like the coordinates of those created by the measure command ?
I thaught it was each 1 mm from each start vertex of each segment...

[ElpanovEvgeniy]

lwpolyline ((0.0 0.0) (2.5 0.0) (2.5 1.0) (0.0 1.0))
Example as autocad can create points on the necessary places.

Code: [Select]

Command: _measure
Select object to measure:
Specify length of segment or [Block]: 1.
Command:

[ElpanovEvgeniy]

Does the routine have to return points like the coordinates of those created by the measure command ?
I thaught it was each 1 mm from each start vertex of each segment...

Yes!

[gile]

So, another one, using the same way.

Code: [Select]

(defun vec1 (p1 p2 / d)
  (if (not (zerop (setq d (distance p1 p2))))
    (mapcar (function (lambda (x1 x2) (/ (- x2 x1) d))) p1 p2)
  )
)

(defun test (pl / l1 l2 v s e n r)
  (setq l1 (mapcar 'cdr
   (vl-remove-if-not
     (function
       (lambda (x) (= (car x) 10))
     )
     (entget pl)
   )
   )
  )
  (if (= 1 (logand 1 (cdr (assoc 70 (entget pl)))))
    (setq l1 (append l1 (list (car l1))))
  )
  (setq r 1)
  (while (setq e (cadr l1))
    (setq v  (vec1 (setq s (car l1)) e)
  l2 (cons (mapcar
     (function
       (lambda (x1 x2)
(+ (* x1 (- 1 r)) x2)
       )
     )
     v
     s
   )
   l2
     )
    )
    ((lambda (d)
       (setq n (fix d)
     r (if (zerop n)
d
(rem d n)
       )
       )
     )
      (distance (car l2) e)
    )
    (repeat n
      (setq l2 (cons (mapcar '+ (car l2) v) l2))
    )
    (setq l1 (cdr l1))
  )
  (reverse l2)
)

[gile]

Or, using vlax-curve-*

Code: [Select]

(defun test2 (pl / n l)
  (vl-load-com)
  (setq n 0)
  (repeat (1+ (fix (vlax-curve-getDistAtParam
     pl
     (vlax-curve-getEndParam pl)
   )
      )
  )
    (setq l (cons (vlax-curve-getPointAtDist pl n) l)
  n (1+ n)
    )
  )
  (reverse l)
)

[ElpanovEvgeniy]

Good code!
I have compared speed
Benchmarking.......... Elapsed milliseconds / relative speed for 128 iteration (s):

    (TEST2 PL)..... 1421 / 2.76 <fastest>
    (TEST PL)...... 3922 / 1 <slowest>
Difference big, but it is possible to achieve even more!

[VovKa]

considering that repeat is slower than while, i changed gile's code.
do some benchmarking Евгений

Code: [Select]

(defun test4 (pl / l End Dist)
  (setq End  (vlax-curve-getDistAtParam pl (vlax-curve-getEndParam pl))
Dist 0
  )
  (while (<= Dist End)
    (setq l    (cons (vlax-curve-getPointAtDist pl Dist) l)
  Dist (1+ Dist)
    )
  )
  (reverse l)
)


[ElpanovEvgeniy]

considering that repeat is slower than while, i changed gile's code.
do some benchmarking Евгений

Good continuation! 

Code: [Select]

Benchmarking ..........Elapsed milliseconds / relative speed for 128 iteration(s):

    (TEST4 PL).....1422 / 1.07 <fastest>
    (TEST2 PL).....1516 / 1 <slowest>

[gile]

Another

Code: [Select]

(defun test3 (pl / n p l)
  (vl-load-com)
  (setq n 0)
  (while (setq p (vlax-curve-getPointAtDist pl n))
    (setq l (cons p l)
  n (1+ n)
    )
  )
  (reverse l)
)

[ElpanovEvgeniy]

Length test lwpolyline 55000.

Code: [Select]

Benchmarking ......Elapsed milliseconds / relative speed for 8 iteration(s):

    (TEST3 PL).....1922 / 1.16 <fastest>
    (TEST4 PL).....2062 / 1.08
    (TEST2 PL).....2235 / 1 <slowest>

[gile]

A recursive one (may be slower)

Code: [Select]

(defun test5 (pl / sub)
  (vl-load-com)
  (defun sub (n / p)
    (if (setq p (vlax-curve-getPointAtDist pl n))
      (cons p (sub (1+ n)))
    )
  )
  (sub 0)
)

[ElpanovEvgeniy]

A recursive one (may be slower)

It was necessary to reduce the size of a polyline - differently ":HARD-ERROR"

Code: [Select]

Benchmarking ........Elapsed milliseconds / relative speed for 32 iteration(s):

    (TEST3 PL).....1203 / 1.16 <fastest>
    (TEST4 PL).....1359 / 1.02
    (TEST5 PL).....1359 / 1.02
    (TEST2 PL).....1391 / 1 <slowest>