Topic: Determine Nth Sector {Challenge}

[Grrr1337]

Hi guys,
This thread is an extension to my previous one (Determine quadrant - cursor),
Its very similar to it, but the current task is more like of a challenge - so I've decided a separate thread is worth for it -

---{Challenge}---

Write a (foo p1 p2 p3 n), where:
p1 - first specified point
p2 - second specified point
p3 - point to determine its sector location (assuming p3 its the cursor location)
n - amount of quadrants, their origin is (mid p1 p2), and oriented from p1-p2 vector

Exprected return rtn would be an integer that specifies the position of the nth sector the p3 is located at.
i.e.:
for n=2, rtn will have 2 possibilities (0, 1)
for n=3, rtn will have 3 possibilities (0, 1, 2)
for n=4, rtn will have 4 possibilities (0, 1, 2, 3)
...
for n=12, rtn will have 12 possibilities (0, 1, 2, 3... 11)

To clarify the above I wrote - check the demo .gif below.

Heres my try at it (although its very buggy) -

Code - Auto/Visual Lisp: [Select]

1. (defun C:test ( / findrange GetQuadrants p1 p2 a n m spc mtxt textviewsize aL rL )
2.  
3.  
4.   ;|
5.   (findrange 34
6.     '(
7.       ( (1 10) "A")
8.       ( (10 20) "B")
9.       ( (20 30) "C")
10.       (nil "D")
11.     )
12.   )
13.   >> "D"
14.  
15.   _$ (findrange -15
16.     '(
17.       ((nil 30) "I'm below or equal to thirty")
18.       ((40 nil) "I'm above or equal to forty")
19.       (nil "I'm something else, in this case between 30-40 (exclusive)")
20.     )
21.   )
22.   >> "I'm below or equal to thirty"
23.   |;
24.   (setq findrange
25.     (lambda (v L)
26.       (if (and (numberp v) (listp L))
27.         (vl-some
28.           '(lambda (x / mn mx)
29.             (setq mn (caar x))
30.             (setq mx (cadar x))
31.             (if (apply '<= (append (if mn (list mn)) (list v) (if mx (list mx)) ))
32.               (cadr x)
33.             ); if
34.           ); lambda
35.           L
36.         ); vl-some
37.       ); if
38.     ); lambda (v L)
39.   ); setq findrange
40.  
41.   (setq GetQuadrants
42.     (lambda ( p1 p2 n / a ainc tmp L )
43.       (setq a (angle p1 p2))
44.       (setq a (rem a PI))
45.       (setq ainc (/ (* 2. PI) n))
46.       (setq tmp ainc)
47.       (while (<= tmp (* 2. PI))
48.         (setq L (cons tmp L))
49.         (setq tmp (+ tmp ainc))
50.       )
51.       (mapcar '(lambda (x) (+ x a)) (reverse L))
52.     )
53.   ); setq GetQuadrants
54.  
55.  
56.  
57.   (if
58.     (and
59.       (setq p1 (getpoint "\nSpecify first point: "))
60.       (setq p2 (getpoint p1 "\nSpecify second point: "))
61.       (setq a (angle p1 p2))
62.       (setq n
63.         (
64.           (lambda ( f ) (f nil))
65.           (lambda ( n )
66.             (initget (+ 2 4))
67.             (cond
68.               ( (= 1 (setq n (getint "\nSpecify amount of quadrants <2>: ")))
69.                 (prompt "\n*Atleast 2 quadrants are allowed*") (f nil)
70.               )
71.               (n)(2)
72.             )
73.           )
74.         )
75.       )
76.       (setq m (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2 ))
77.       (setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))
78.       (setq aL (GetQuadrants p1 p2 n))
79.      
80.     ); and
81.     (progn
82.       (setq textviewsize (lambda nil (* (getvar 'textsize) (getvar 'viewsize) 0.005)))
83.       (setq mtxt (vlax-invoke spc 'AddMtext '(0. 0. 0.) (textviewsize) "X"))
84.       (vlax-put mtxt 'AttachmentPoint acAttachmentPointMiddleCenter)
85.       (foreach x aL
86.         (setq rL (cons (vlax-invoke spc 'AddRay m (polar m x (distance p1 p2))) rL))
87.       )
88.      
89.       (
90.         (lambda ( / s k v )
91.           (while (not s)
92.             (mapcar 'set '(k v) (grread t))
93.             (and (or (= k 25) (equal '(2 13) (list k v))) (setq s t))
94.             (and
95.               (= 5 k)
96.               (progn
97.                 (vlax-put mtxt 'InsertionPoint v)
98.                 (vlax-put mtxt 'Height (textviewsize))
99.                 (vlax-put mtxt 'TextString
100.                   (vl-prin1-to-string
101.                     (findrange
102.                       (angle m v)  
103.                       (
104.                         (lambda ( L / i r )
105.                           (setq i -1)
106.                           (setq r
107.                             (mapcar '(lambda (a b) (list (list a b) (setq i (1+ i)))) (cons nil L) (cons (car L) (cdr L)))
108.                           )
109.                           (setq r (cons (list (list nil (car L)) (last (last r))) r))
110.                           (setq r (append r '((nil ?))))
111.                         )
112.                         (cons a aL)
113.                       )
114.                     )
115.                   )
116.                 )
117.                 t
118.               ); progn
119.             )      
120.           ); while
121.         ); lambda
122.       )
123.       (foreach x (cons mtxt rL)
124.         (vl-catch-all-apply (function vla-Delete) (list x))
125.       )
126.      
127.     ); progn
128.   ); if
129.   (princ)
130. ); defun

[VovKa]

Code: [Select]

(1+ (fix (/ (vk_GetLeftAngle p3 (vk_GetMidPoint p1 p2) p2) (/ pi 0.5 n))))


[ribarm]

Code: [Select]

(1+ (fix (/ (vk_GetLeftAngle p3 (vk_GetMidPoint p1 p2) p2) (/ pi 0.5 n))))


Very nice and fast...
I widen your expression :

Code - Auto/Visual Lisp: [Select]

1. (defun c:sectors ( / 3pang p1 p2 m n a k gr p3 el txt txte txtel f )
2.  
3.   (defun 3pang ( ps po pe / a1 a2 )
4.     (setq a1 (angle po ps))
5.     (setq a2 (angle po pe))
6.     (if (> a1 a2)
7.       (+ (- (* 2 pi) a1) a2)
8.       (- a2 a1)
9.     )
10.   )
11.  
12.   (initget 1)
13.   (setq p1 (getpoint "\nStart direction point : "))
14.   (initget 1)
15.   (setq p2 (getpoint p1 "\nEnd direction point : "))
16.   (setq m (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
17.   (initget 1)
18.   (setq n (getint "\nNumber of sectors : "))
19.   (setq a (/ pi 0.5 n))
20.   (setq k -1)
21.   (repeat n
22.     (setq el (cons (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 m) (cons 11 (polar '(0.0 0.0 0.0) (+ (* (setq k (1+ k)) a) (angle m p2)) 1.0)))) el))
23.   )
24.   (while (= 5 (car (setq gr (grread t))))
25.     (setq f nil)
26.     (setq p3 (cadr gr))
27.     (setq txt (1+ (fix (/ (3pang p2 m p3) a))))
28.     (if (null txte)
29.       (setq txte (entmakex (list '(0 . "TEXT") (cons 10 p3) (cons 40 (* 50 (/ (getvar 'viewsize) (cadr (getvar 'screensize))))) (cons 1 (itoa txt)))))
30.       (progn
31.         (if (not (equal p3 (cdr (assoc 10 txtel)) 1e-15))
32.           (setq txtel (subst (cons 10 p3) (assoc 10 txtel) txtel) f t)
33.         )
34.         (if (/= txt (atoi (cdr (assoc 1 txtel))))
35.           (setq txtel (subst (cons 1 (itoa txt)) (assoc 1 txtel) txtel) f t)
36.         )
37.         (if f
38.           (entupd (cdr (assoc -1 (entmod txtel))))
39.         )
40.       )
41.     )
42.     (if (null txtel)
43.       (setq txtel (entget txte))
44.     )
45.   )
46.   (foreach e el
47.     (if (and e (not (vlax-erased-p e)))
48.       (entdel e)
49.     )
50.   )
51.   (if (and txte (not (vlax-erased-p txte)))
52.     (entdel txte)
53.   )
54.   (princ)
55. )
56.  

[Grrr1337]

Code: [Select]

(1+ (fix (/ (vk_GetLeftAngle p3 (vk_GetMidPoint p1 p2) p2) (/ pi 0.5 n))))


Looks like you've won this one, VoVka! 



I've also wrapped it into a sub:

Code - Auto/Visual Lisp: [Select]

1. ; https://www.theswamp.org/index.php?topic=55573.msg597194#msg597194
2. ; VoVka
3. (defun foo ( p1 p2 p3 n )
4.   (1+
5.     (fix
6.       (/
7.         (
8.           (lambda (p1 p2 p3 / Ang) ; vk_GetLeftAngle
9.             (if (minusp (setq Ang (rem (+ pi (angle p2 p1) (- (angle p3 p2))) (* pi 2.0))))
10.               (+ pi pi Ang)
11.               Ang
12.             )
13.           )
14.           p3
15.           (mapcar '(lambda (a b) (* 0.5 (+ a b))) p1 p2)
16.           p2
17.         )
18.         (/ PI 0.5 n)
19.       )
20.     )
21.   )
22. ); defun foo
23.  
24.  
25. ; Test function
26. (defun C:test ( / p1 p2 n spc )
27.   (if
28.     (and
29.       (setq p1 (getpoint "\nSpecify first point: "))
30.       (setq p2 (getpoint p1 "\nSpecify second point: "))
31.       (setq n
32.         ( (lambda ( f ) (f nil))
33.           (lambda ( n )
34.             (initget (+ 2 4))
35.             (cond
36.               ( (= 1 (setq n (getint "\nSpecify amount of quadrants <2>: ")))
37.                 (prompt "\n*Atleast 2 quadrants are allowed*") (f nil)
38.               )
39.               (n)(2)
40.             )
41.           )
42.         )
43.       ); setq n
44.     ); and
45.     (
46.       (lambda ( / m GetQuadrants spc textviewsize mtxt aL rL s k v )
47.        
48.         (setq m (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2 ))
49.  
50.         (setq GetQuadrants
51.           (lambda ( p1 p2 n / a ainc tmp L )
52.             (setq a (abs (angle p1 p2)))
53.             (setq ainc (/ (* 2.0 PI) n))
54.             (setq tmp ainc)
55.             (repeat n
56.               (setq L (cons (setq tmp (+ tmp ainc)) L))
57.             )
58.             (mapcar '(lambda (x) (+ x a)) (reverse L))
59.           )
60.         ); setq GetQuadrants
61.        
62.         (setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))
63.         (setq textviewsize (lambda nil (* (getvar 'textsize) (getvar 'viewsize) 0.005)))
64.         (setq mtxt (vlax-invoke spc 'AddMtext '(0. 0. 0.) (textviewsize) "X"))
65.         (vlax-put mtxt 'AttachmentPoint acAttachmentPointMiddleCenter)
66.         (foreach x (setq aL (GetQuadrants p1 p2 n))
67.           (setq rL (cons (vlax-invoke spc 'AddRay m (polar m x (distance p1 p2))) rL))
68.         )
69.         (while (not s)
70.           (mapcar 'set '(k v) (grread t))
71.           (and (or (= k 25) (equal '(2 13) (list k v))) (setq s t))
72.           (and
73.             (= 5 k)
74.             (progn
75.               (vlax-put mtxt 'InsertionPoint v)
76.               (vlax-put mtxt 'Height (textviewsize))
77.               (vlax-put mtxt 'TextString (vl-prin1-to-string (foo p1 p2 v n)))
78.               t
79.             ); progn
80.           )      
81.         ); while
82.         (foreach x (cons mtxt rL)
83.           (vl-catch-all-apply (function vla-Delete) (list x))
84.         )
85.       ); lambda
86.     )
87.    
88.   ); if
89.   (princ)
90. ); defun

[ribarm]

I just wanted to say that rather than term "quadrant" which express 4 areas of Decart cartesian coordinate system, better word is "sector" - area of plane between 2 rays described with some angle that those rays form with their origin as center of that planar coordinate system (plane)...

[Grrr1337]

@Marko you are right -
I misled myself from my previous thread, by thinking about this even more generic modification to the sub.
Corrected the thread's title.
:thumbsup:

[VovKa]

Looks like you've won this one, VoVka! 

looks like i was the only one who participated
yeah, i took first places from both the top and the bottom 

[Grrr1337]

looks like i was the only one who participated
yeah, i took first places from both the top and the bottom 

It got me confused  - I find this task too difficult for me (although my math lacks), hence considered it as a challenge..
.. but your fast and short reply make it seem like answering to a request. 

[VovKa]

.. but your fast and short reply

if i knew English better i'd definitely have written much longer posts

[martinle]

Hello Mr. Ribarm,

Impressive example! To apply this example in everyday life I had the following idea assuming that Lisp would work in UCS:
A reactor that does the following:

When starting the command:

- Save the sector number globally
- save a separate UCS in each sector.
Result: As soon as one leaves the sector with the mouse the UCS is changed over.
That would be a great Lisp and would benefit many!

Greetings Martin