Author Topic: Determine quadrant - cursor  (Read 4379 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 812
Determine quadrant - cursor
« 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)
  )
)
vevo.bg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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))
        (prompt "\nQuadrant A...")
      )
      ( (and (< (car pt3n) 0) (> (cadr pt3n) 0))
        (prompt "\nQuadrant B...")
      )
      ( (and (< (car pt3n) 0) (< (cadr pt3n) 0))
        (prompt "\nQuadrant C...")
      )
      ( (and (> (car pt3n) 0) (< (cadr pt3n) 0))
        (prompt "\nQuadrant D...")
      )
    )
......

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

:)

M.R. on Youtube

Grrr1337

  • Swamp Rat
  • Posts: 812
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)
  )
)
vevo.bg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Grrr1337

  • Swamp Rat
  • Posts: 812
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)
  )
)
vevo.bg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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)))
  13.       (prompt "\nQuadrant A...")
  14.     )
  15.     ( (and (> (distance p p2) (distance p p1)) (< (distance p p3) (distance p p4)))
  16.       (prompt "\nQuadrant B...")
  17.     )
  18.     ( (and (> (distance p p2) (distance p p1)) (> (distance p p3) (distance p p4)))
  19.       (prompt "\nQuadrant C...")
  20.     )
  21.     ( (and (< (distance p p2) (distance p p1)) (> (distance p p3) (distance p p4)))
  22.       (prompt "\nQuadrant D...")
  23.     )
  24.   )
  25.   (princ)
  26. )
  27.  

HTH., M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
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))))
  9.             (princ (strcat "\rCursor is located in quadrant " (quad (- (angle m (cadr g)) a))))
  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: 812
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.  
  12. ); defun 3Pquadrant

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.         (progn
  6.           (vlax-put o 'XscaleFactor (- (abs (vlax-get o 'XscaleFactor))))
  7.           (vlax-put o 'YscaleFactor (abs (vlax-get o 'YscaleFactor)))
  8.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p2) ; (princ "\nA")
  9.         )
  10.         (progn
  11.           (vlax-put o 'XscaleFactor (abs (vlax-get o 'XscaleFactor)))
  12.           (vlax-put o 'YscaleFactor (abs (vlax-get o 'YscaleFactor)))
  13.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p1) ; (princ "\nB")
  14.         )
  15.         (progn
  16.           (vlax-put o 'XscaleFactor (- (abs (vlax-get o 'XscaleFactor))))
  17.           (vlax-put o 'YscaleFactor (- (abs (vlax-get o 'YscaleFactor))))
  18.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p2) ; (princ "\nC")
  19.         )
  20.         (progn
  21.           (vlax-put o 'XscaleFactor (abs (vlax-get o 'XscaleFactor)))
  22.           (vlax-put o 'YscaleFactor (- (abs (vlax-get o 'YscaleFactor))))
  23.           (vlax-invoke o 'Move (vlax-get o 'InsertionPoint) p1) ; (princ "\nD")
  24.         )
  25.       ); list
  26.     ); nth
  27.   ); eval
  28. ); (= 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)
  )
)
vevo.bg

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
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.     (apply
  3.        '(lambda ( x y p )
  4.             (vlax-put o 'xscalefactor (* x (abs (vlax-get o 'xscalefactor))))
  5.             (vlax-put o 'yscalefactor (* y (abs (vlax-get o 'yscalefactor))))
  6.             (vlax-put o 'insertionpoint p)
  7.         )
  8.         (nth (3Pquadrant p1 p2 v) (list (list -1 1 p2) (list 1 1 p1) (list -1 -1 p2) (list 1 -1 p1)))
  9.     )
  10. )

Such list could obviously be defined outside of the loop.

Grrr1337

  • Swamp Rat
  • Posts: 812
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  :rip:
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)
  )
)
vevo.bg

hanhphuc

  • Newt
  • Posts: 64
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.  
  28. ;;grrr's quadrant CCW
  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

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
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...