get ortho point via getpoint

[Rick_Ismael]

how can I get the orthographic point of a point. Just like when we use copy/move command and the ortho is on. Pick a base point and the entity will be copied/moved perpendicular to the point picked. Thank you.

[Lee Mac]

An old function of mine:

 

http://lee-mac.com/orthopoint.html

[Rick_Ismael]

I missed that one when I read your site. Thanks Lee.

[Lee Mac]

You're very welcome Rick.

 

For fun, I decided to write another version of that function using vector calculus instead of the trans function:

 

[color=GREEN];;---------------------=={ Ortho Point }==--------------------;;[/color]
[color=GREEN];;                                                            ;;[/color]
[color=GREEN];;  Returns a point transformed relative to a basepoint to    ;;[/color]
[color=GREEN];;  account for activation of Orthomode in the current UCS.   ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Arguments:                                                ;;[/color]
[color=GREEN];;  base  - basepoint for transformation (UCS)                ;;[/color]
[color=GREEN];;  point - point to be transformed (UCS)                     ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Returns:  Point (UCS) transformed to account for Ortho    ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]

([color=BLUE]defun[/color] LM:OrthoPoint ( base point [color=BLUE]/[/color] dx dy vp vx vy )
   ([color=BLUE]if[/color] ([color=BLUE]zerop[/color] ([color=BLUE]getvar[/color] 'ORTHOMODE))
       point
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] vx ([color=BLUE]trans[/color] ([color=BLUE]getvar[/color] 'UCSXDIR) 0 1 [color=BLUE]t[/color])
                 vy (v^v '(0.0 0.0 1.0) vx)
                 vp ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] point base)
                 dx (vxv vx vp)
                 dy (vxv vy vp)
           )
           ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] base
               ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]abs[/color] dx) ([color=BLUE]abs[/color] dy))
                   (vxs vy dy)
                   (vxs vx dx)
               )
           )
       )
   )
)


[color=GREEN];; Vector Dot Product  -  Lee Mac[/color]
[color=GREEN];; Args: u,v - vectors in R^n[/color]

([color=BLUE]defun[/color] vxv ( u v )
   ([color=BLUE]apply[/color] '[color=BLUE]+[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]*[/color] u v))
)

[color=GREEN];; Vector Cross Product  -  Lee Mac[/color]
[color=GREEN];; Args: u,v - vectors in R^3[/color]

([color=BLUE]defun[/color] v^v ( u v )
   ([color=BLUE]list[/color]
       ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]cadr[/color] u) ([color=BLUE]caddr[/color] v)) ([color=BLUE]*[/color] ([color=BLUE]cadr[/color] v) ([color=BLUE]caddr[/color] u)))
       ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]car[/color]  v) ([color=BLUE]caddr[/color] u)) ([color=BLUE]*[/color] ([color=BLUE]car[/color]  u) ([color=BLUE]caddr[/color] v)))
       ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]car[/color]  u) ([color=BLUE]cadr[/color]  v)) ([color=BLUE]*[/color] ([color=BLUE]car[/color]  v) ([color=BLUE]cadr[/color]  u)))
   )
)

[color=GREEN];; Vector x Scalar  -  Lee Mac[/color]
[color=GREEN];; Args: v - vector in R^n, s - real scalar[/color]

([color=BLUE]defun[/color] vxs ( v s )
   ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( n ) ([color=BLUE]*[/color] n s))) v)
)

 

An example:

 

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] p1 p2 )  
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] p1 ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify Basepoint: "[/color]))
       ([color=BLUE]while[/color] ([color=BLUE]member[/color] ([color=BLUE]car[/color] ([color=BLUE]setq[/color] p2 ([color=BLUE]grread[/color] [color=BLUE]t[/color] 15 0))) '(5 2)) ([color=BLUE]redraw[/color]) 
           ([color=BLUE]if[/color] ([color=BLUE]listp[/color] ([color=BLUE]setq[/color] p2 ([color=BLUE]cadr[/color] p2)))
               ([color=BLUE]grdraw[/color] p1 (LM:OrthoPoint p1 p2) -1 1)
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] 15 p2)
                   ([color=BLUE]setvar[/color] 'ORTHOMODE ([color=BLUE]-[/color] 1 ([color=BLUE]getvar[/color] 'ORTHOMODE)))
               )
           )
       )
   )
   ([color=BLUE]redraw[/color]) ([color=BLUE]princ[/color])
)

 

The vector functions are taken from my set of Matrix & Vector Functions.

 

Lee