Ortho Point

Function Syntax (LM:OrthoPoint <base> <point>)
Current Version 1.0
Arguments
Symbol Type Description
base List Basepoint for transformation (UCS)
point List Point to be transformed (UCS)
Returns
Type Description
List Point (UCS) transformed to account for setting of Orthomode

Program Description

This subfunction will return a point defined relative to the current UCS, transformed relative to a supplied basepoint to account for the setting of the Orthomode System Variable in the current UCS.

The program will furthermore work in all UCS/Views.

Vector Calculus Version

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

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

;; Vector Dot Product  -  Lee Mac
;; Args: u,v - vectors in R^n

(defun vxv ( u v )
    (apply '+ (mapcar '* u v))
)

;; Vector Cross Product  -  Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
    (list
        (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
        (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
    )
)

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
    (mapcar (function (lambda ( n ) (* n s))) v)
)

trans Version

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

(defun LM:OrthoPoint ( base point )
    (if (zerop (getvar 'ORTHOMODE))
        point
        (apply 'polar
            (cons base
                (
                    (lambda ( n / a x z )
                        (setq x (- (car   (trans point 0 n)) (car   (trans base 0 n)))
                              z (- (caddr (trans point 0 n)) (caddr (trans base 0 n)))
                              a (angle '(0. 0. 0.) n)
                        )
                        (if (< (abs z) (abs x))
                            (list (+ a (/ pi 2.)) x)
                            (list a z)
                        )
                    )
                    (trans (getvar 'UCSXDIR) 0 1)
                )
            )
        )
    )
)

Example Program

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

Demonstration of Example Program

OrthoPoint.gif

textsize

increase · reset · decrease

Designed & Created by Lee Mac © 2010