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) )