TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ElpanovEvgeniy on February 05, 2008, 06:38:18 AM
-
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!
-
Hi,
Here's my contribution
(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))
)
-
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))
-
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...
-
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.
Command: _measure
Select object to measure:
Specify length of segment or [Block]: 1.
Command:
-
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! :)
-
So, another one, using the same way.
(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)
)
-
Or, using vlax-curve-*
(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)
)
-
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!
-
considering that repeat is slower than while, i changed gile's code.
do some benchmarking Евгений :)
(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)
)
-
considering that repeat is slower than while, i changed gile's code.
do some benchmarking Евгений :)
Good continuation! :-)
Benchmarking ..........Elapsed milliseconds / relative speed for 128 iteration(s):
(TEST4 PL).....1422 / 1.07 <fastest>
(TEST2 PL).....1516 / 1 <slowest>
-
Another
(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)
)
-
Length test lwpolyline 55000.
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>
-
A recursive one (may be slower)
(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)
)
-
A recursive one (may be slower)
It was necessary to reduce the size of a polyline - differently ":HARD-ERROR"
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>
-
How about a variant of gile's test3?
(defun test3A (pl / n p l)
(vl-load-com)
(setq n -1)
(reverse
(while (setq p (vlax-curve-getpointatdist pl (setq n (1+ n))))
(setq l (cons p l))
)
)
)
-
Cool code guys!