### Author Topic: Determine quadrant - cursor  (Read 411 times)

0 Members and 1 Guest are viewing this topic.

#### Grrr1337

• Swamp Rat
• Posts: 703 « on: November 01, 2019, 11:36:55 AM »
Hi everyone..
I have this math problem -
I'm trying to determine a 3rd point's location (from 4 quadrants) based on the vector of two specified points - 'p1' and 'p2', and the one perpendicular to it.
In simple code the task would look like:
Code - Auto/Visual Lisp: [Select]
1. (defun C:test ( / p1 p2 p3 )
2.   (redraw)
3.   (and
4.     (setq p1 (getpoint "\nSpecify first point: "))
5.     (setq p2 (getpoint p1 "\nSpecify second point: "))
6.     (progn (grdraw p1 p2 1) t)
7.     (setq p3 (getpoint "\nSpecify third point: "))
8.     (princ (strcat "\n'p3' is located at .. " ".. quadrant")) ; A B C or D ?
9.   ); and
10.   (princ)
11. ); defun

What exactly I'm trying to do:
Code - Auto/Visual Lisp: [Select]
1. (defun C:test ( / p1 p2 vec1 s k v )
2.   (if
3.     (and
4.       (setq p1 (getpoint "\nSpecify first point: "))
5.       (setq p2 (getpoint p1 "\nSpecify second point: "))
6.       (setq vec1 (mapcar '- p1 p2))
7.     ); and
8.     (while (not s)
9.       (mapcar 'set '(k v) (grread t))
10.       (and (or (= k 25) (equal '(2 13) (list k v))) (setq s t))
11.       (and
12.         (= 5 k)
13.         (prompt (strcat "\nCursor is located at: " (vl-prin1-to-string v)))
14.         ; how to determine the quadrant in the picture? - A B C or D
15.       )
16.     ); while
17.   ); if
18.   (princ)
19. ); defun

« Last Edit: November 01, 2019, 11:48:26 AM by Grrr1337 »
(apply ''((a b c)(a b c))
'(
(( f L ) (apply 'strcat (f L)))
(( L ) (if L (cons (chr (car L)) (f (cdr L)))))
(72 101 108 108 111 32 87 111 114 108 100)
)
)

#### ribarm ##### Re: Determine quadrant - cursor
« Reply #1 on: November 01, 2019, 12:22:25 PM »
Is allowed using of UCS ?

If so, then it's simple :
1. pick pt1 and pt2 in current UCS
2. calculate (setq mid (mapcar '(lambda ( a b )  (/ (+ a b) 2.0)) pt1 pt2))
3. pick pt3
4. (setq pt3w (trans pt3 1 0))
5. (command "_.UCS" "_3P" "_non" mid "_non" pt2 "")
6. (setq pt3n (trans pt3w 0 1))
7. (cond
( (and (> (car pt3n) 0) (> (cadr pt3n) 0))
)
( (and (< (car pt3n) 0) (> (cadr pt3n) 0))
)
( (and (< (car pt3n) 0) (< (cadr pt3n) 0))
)
( (and (> (car pt3n) 0) (< (cadr pt3n) 0))
)
)
......

HTH.
Marko Ribar, d.i.a. (graduated engineer of architecture) #### Grrr1337

• Swamp Rat
• Posts: 703 ##### Re: Determine quadrant - cursor
« Reply #2 on: November 01, 2019, 12:28:00 PM »
Hi Marko,
I was hoping to solve it without command calls.
(apply ''((a b c)(a b c))
'(
(( f L ) (apply 'strcat (f L)))
(( L ) (if L (cons (chr (car L)) (f (cdr L)))))
(72 101 108 108 111 32 87 111 114 108 100)
)
)

#### ribarm ##### Re: Determine quadrant - cursor
« Reply #3 on: November 01, 2019, 12:33:17 PM »
Hi Marko,
I was hoping to solve it without command calls.

Look into my (transptucs) and (transptwcs) functions I posted somewhere on www...

Give me a minute to find it...
Marko Ribar, d.i.a. (graduated engineer of architecture) #### ribarm ##### Re: Determine quadrant - cursor
« Reply #4 on: November 01, 2019, 12:34:49 PM »
Marko Ribar, d.i.a. (graduated engineer of architecture) #### Grrr1337

• Swamp Rat
• Posts: 703 ##### Re: Determine quadrant - cursor
« Reply #5 on: November 01, 2019, 01:15:46 PM »
Thanks Marko - working perfectly! (apply ''((a b c)(a b c))
'(
(( f L ) (apply 'strcat (f L)))
(( L ) (if L (cons (chr (car L)) (f (cdr L)))))
(72 101 108 108 111 32 87 111 114 108 100)
)
)

#### ribarm ##### Re: Determine quadrant - cursor
« Reply #6 on: November 01, 2019, 01:15:54 PM »
Or simply :

Code - Auto/Visual Lisp: [Select]
1. (defun c:whichquadrant ( / p1 p2 p3 p4 mp p )
2.   (initget 1)
3.   (setq p1 (getpoint "\nPick or specify p1 : "))
4.   (initget 1)
5.   (setq p2 (getpoint "\nPick or specify p2 : "))
6.   (setq mp (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
7.   (setq p3 (polar mp (+ (angle p1 p2) (* 0.5 pi)) 1.0))
8.   (setq p4 (polar mp (- (angle p2 p3) (* 0.5 pi)) 1.0))
9.   (initget 1)
10.   (setq p (getpoint "\nPick or specify p3 : "))
11.   (cond
12.     ( (and (< (distance p p2) (distance p p1)) (< (distance p p3) (distance p p4)))
14.     )
15.     ( (and (> (distance p p2) (distance p p1)) (< (distance p p3) (distance p p4)))
17.     )
18.     ( (and (> (distance p p2) (distance p p1)) (> (distance p p3) (distance p p4)))
20.     )
21.     ( (and (< (distance p p2) (distance p p1)) (> (distance p p3) (distance p p4)))
23.     )
24.   )
25.   (princ)
26. )
27.

HTH., M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)  ##### Re: Determine quadrant - cursor
« Reply #7 on: November 01, 2019, 07:29:48 PM »
Here's another method -
Code - Auto/Visual Lisp: [Select]
1. (defun c:test ( / a g m p q )
2.     (if (and (setq p (getpoint "\nP1: "))
3.              (setq q (getpoint "\rP2: " p))
4.              (setq m (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p q)
5.                    a (angle p q)
6.              )
7.         )
8.         (while (= 3 (car (setq g (grread nil 12 0))))
10.         )
11.     )
12.     (princ)
13. )
14.
15. (defun quad ( a )
16.     (if (< 0 (sin a))
17.         (if (< 0 (cos a)) "A" "B")
18.         (if (< 0 (cos a)) "D" "C")
19.     )
20. )

#### Grrr1337

• Swamp Rat
• Posts: 703 ##### Re: Determine quadrant - cursor
« Reply #8 on: November 03, 2019, 04:10:47 AM »
Thanks Lee - with your math skills, you make it so simple!

I've integrated it into the following sub -
Code - Auto/Visual Lisp: [Select]
1. (defun 3Pquadrant ( p1 p2 p3 )
2.   (
3.     (lambda ( a )
4.       (if (< 0.0 (sin a))
5.         (if (< 0.0 (cos a)) 0 1)
6.         (if (< 0.0 (cos a)) 2 3)
7.       )
8.     )
9.     (- (angle (mapcar (function (lambda ( a b ) (* 0.5 (+ a b)))) p1 p2) p3) (angle p1 p2))
10.   )
11.

So within my main its used like so -
Code - Auto/Visual Lisp: [Select]
1. ( (= 5 k) ; Determine the door's orientation via the cursor:
2.   (eval
3.     (nth (3Pquadrant p1 p2 v)
4.       '(
5.           (vlax-put o 'XscaleFactor (- (abs (vlax-get o 'XscaleFactor))))
6.           (vlax-put o 'YscaleFactor (abs (vlax-get o 'YscaleFactor)))
7.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p2) ; (princ "\nA")
8.         )
9.           (vlax-put o 'XscaleFactor (abs (vlax-get o 'XscaleFactor)))
10.           (vlax-put o 'YscaleFactor (abs (vlax-get o 'YscaleFactor)))
11.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p1) ; (princ "\nB")
12.         )
13.           (vlax-put o 'XscaleFactor (- (abs (vlax-get o 'XscaleFactor))))
14.           (vlax-put o 'YscaleFactor (- (abs (vlax-get o 'YscaleFactor))))
15.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p2) ; (princ "\nC")
16.         )
17.           (vlax-put o 'XscaleFactor (abs (vlax-get o 'XscaleFactor)))
18.           (vlax-put o 'YscaleFactor (- (abs (vlax-get o 'YscaleFactor))))
19.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p1) ; (princ "\nD")
20.         )
21.       ); list
22.     ); nth
23.   ); eval
24. ); (= 5 k)

And heres a demo of some practical usage of this quadrant sub you guys provided..
Cheers!
(apply ''((a b c)(a b c))
'(
(( f L ) (apply 'strcat (f L)))
(( L ) (if L (cons (chr (car L)) (f (cdr L)))))
(72 101 108 108 111 32 87 111 114 108 100)
)
) ##### Re: Determine quadrant - cursor
« Reply #9 on: November 03, 2019, 07:00:25 PM »
Looking good Grrr1337, well done. Note that this -
Code - Auto/Visual Lisp: [Select]
1. (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p2)

Is equivalent to:
Code - Auto/Visual Lisp: [Select]
1. (vlax-put o 'insertionpoint p2)

I would also avoid eval within a loop, as it is unnecessarily slow.

You could alternatively condense the code to something like:
Code - Auto/Visual Lisp: [Select]
1. (   (= 5 k)
2.        '(lambda ( x y p )
3.             (vlax-put o 'xscalefactor (* x (abs (vlax-get o 'xscalefactor))))
4.             (vlax-put o 'yscalefactor (* y (abs (vlax-get o 'yscalefactor))))
5.             (vlax-put o 'insertionpoint p)
6.         )
7.         (nth (3Pquadrant p1 p2 v) (list (list -1 1 p2) (list 1 1 p1) (list -1 -1 p2) (list 1 -1 p1)))
8.     )
9. )

Such list could obviously be defined outside of the loop.

#### Grrr1337

• Swamp Rat
• Posts: 703 ##### Re: Determine quadrant - cursor
« Reply #10 on: November 05, 2019, 04:40:00 PM »
Thanks Lee! -
I really don't have the time to think for some refactoring, too busy with too many different stuff.. even they are non-lisp related Just didn't wanted to threw another good idea into my trash bin for "later"...
(apply ''((a b c)(a b c))
'(
(( f L ) (apply 'strcat (f L)))
(( L ) (if L (cons (chr (car L)) (f (cdr L)))))
(72 101 108 108 111 32 87 111 114 108 100)
)
)

#### hanhphuc ##### Re: Determine quadrant - cursor
« Reply #11 on: November 07, 2019, 09:02:00 AM »
;;;grrr another idea \$0.02 round the nearest (0.5*pi) assoc list of quadrant (n*pi), n=0.0, 0.5, 1.0, 1.5
(round ang (* 0.5 pi))

Here's another method -
Code - Auto/Visual Lisp: [Select]
1. (defun quad ( a )
2.     (if (< 0 (sin a))
3.         (if (< 0 (cos a)) "A" "B")
4.         (if (< 0 (cos a)) "D" "C")
5.     )
6. )

hi Lee neat idea! It reminds my school old times math trigonometry
quadrant ASTC {All++ Sin-+ Tan-- Cos+-} Or simply :

Code - Auto/Visual Lisp: [Select]
1. (defun c:whichquadrant ( / p1 p2 p3 p4 mp p )
2. ...
3. ...
4.

HTH., M.R.

hi Marko i think your code can be simplified.
This is logical idea from boolean AND,XOR,OR,NOR

Code - Auto/Visual Lisp: [Select]
1. (defun foo '((x) (apply '+ (mapcar ''((x y) (if x y 0)) x '(2 1) ))) )
2. ;;;(mapcar '<= p1 p2)
3. ;;;(foo '(nil T)) ;1
4. ;;;(foo '(T T))   ;3
5.
6. ;;;returns in CW
7. ;;;  3 = 1 1
8. ;;;  2 = 1 0
9. ;;;  0 = 0 0
10. ;;;  1 = 0 1
11.
12. ;;; or assoc method?
13. (defun bar (x) (cdr (assoc (foo x ) (mapcar 'cons '(3 2 0 1) '("A" "D" "C" "B")))))
14. ;;; (bar '(T T)) ;3
15.
16. ;;;i prefer quadrant by index method
17. (defun quad (p1 p2) (vl-position (foo (mapcar '<= p1 p2) )
18.             '(3 2 0 1)
19.             )
20.           )
21.
22. ;;;returns in CW
23. ;;;  0 = ++
24. ;;;  1 = +-
25. ;;;  2 = --
26. ;;;  3 = -+
27.
29. (defun c:test ( / p1 p2 )
30.   (setq p1 (getpoint "\nSpecify base point "))
31.   (while (setq p2 (getpoint p1 "\nNext.. "))
32.     (princ (nth (quad p1 p2) '("A" "D" "C" "B"))) ;; CCW
33.      ;; '("A" "B" "C" "D") clock wise
34.     )
35.   )
36.   (princ)
37.
38.   )
39.
40.

« Last Edit: November 07, 2019, 09:51:28 AM by hanhphuc »
( apply 'equal "hp" "happy" "hạnh phúc" "ハッピー" "幸福" "행복" ) ; error: too many arguments ##### Re: Determine quadrant - cursor
« Reply #12 on: November 07, 2019, 12:42:19 PM »
Here's another method -
Code - Auto/Visual Lisp: [Select]
1. (defun quad ( a )
2.     (if (< 0 (sin a))
3.         (if (< 0 (cos a)) "A" "B")
4.         (if (< 0 (cos a)) "D" "C")
5.     )
6. )

hi Lee neat idea! It reminds my school old times math trigonometry
quadrant ASTC {All++ Sin-+ Tan-- Cos+-} Thanks Code - Auto/Visual Lisp: [Select]
1. (defun quad (p1 p2) (vl-position (foo (mapcar '<= p1 p2) )
2.             '(3 2 0 1)
3.             )
4.           )
5.

Note that this method will only work if the UCS is aligned with the axis about which the points are to be tested...