Vector mathematics Lisp library

type: note | domain: technology | topic: mathematics | lang: en | pub: 2025-12-09

Copy this code in a file "lib-vector.lsp".

;; Small library with functions for vector mathematics.
;; License: Creative Commons By (NedCAD) and SA, Share Alike
; Wiebe van der Worp, 2025, for educational use.
; For more see https://nedcad.nl/coordinate-mathematics-for-cad/
(setq lib-vector-loaded T) ; for testing, (if (not lib-vector-loaded) (load "lib-vector.lsp"))
;; Some additional variables pim2, pid2...
(setq pim2 (* pi 2) fr2d (/ 180.0 pi) fd2r (/ 1 fr2d) nx '(1 0 0) ny '(0 1 0) nz '(0 0 1))
(mapcar '(lambda (a) (set (read (strcat "pid" (itoa a))) (/ pi a))) '(2 3 4 6 12))
;; Core Functions...
(if (not acos)(defun acos (r / ) (atan (sqrt (- 1 (expt r 2))) r))) ; for acad only
(if (not asin)(defun asin (r / ) (atan r (sqrt (- 1 (expt r 2)))))) ; for acad only
(defun ** (a /) (* a a))
(defun v:- (a b / ) (mapcar '(lambda (c d) (- c d)) a b))
(defun v:. (a b / ) (apply '+ (mapcar '(lambda (k l) (* k l)) a b)))
(defun v:* (a b / ) (mapcar '(lambda (c) (* c b)) a))
(defun v:/ (a b / ) (mapcar '(lambda (c) (/ c b)) a))
(defun v:+ (a b / ) (mapcar '(lambda (c d) (+ c d)) a b))
(defun v:<90p (a b / ) (if (> (v:. a b) 0.0) T))
(defun v:ang (a b / ) (acos (/ (v:. a b) (* (v:len a) (v:len b)))))
(defun v:ang2d (a / ) (angle '(0 0) a))
(defun v:arop (a b / dp)
  (setq dp (v:. a b))
  (cond ((> dp 0.0) "a") ((< dp 0.0) "o") ("r")))
(defun v:avg (a / ) (v:/ (v:sum a) (length a)))
(defun v:bisect (a b c / v1 v2)
  (setq v1 (v:- b a) v2 (v:- c a))
  (v:+ b (v:* (v:- v2 v1) (expt (+ 1 (/ (v:len v2) (v:len v1))) -1.0))))
(defun v:d2r (a / ) (* (/ a 180.0) pi))
(defun v:dist (a b / )
  (sqrt (apply '+ (mapcar '(lambda (k l) (** (- l k))) a b))))
(defun v:flip (a / ) (mapcar '- a))
(defun v:intp (a / ) (if (= (vl-symbol-name (type a)) "INT") a ))
(defun v:len (a / ) (sqrt (apply '+ (mapcar '(lambda (b) (** b)) a))))
(defun v:loc (p q r / ) (acos (/ (+ (** r) (** p) (- (** q))) (* 2 r p))))
(defun v:lst+p (ls p / ) (mapcar '(lambda (a) (v:+ a p)) ls))
(defun v:r2d (a / ) (* a (/ 180.0 pi)))
(defun v:realp (a / ) (if (= (vl-symbol-name (type a)) "REAL") a ))
(defun v:rot (a g / sg cg xa ya)
   (setq sg (sin g) cg (cos g) xa (car a) ya (cadr a))
   (list (- (* xa cg) (* ya sg)) (+ (* ya cg) (* xa sg))))
(defun v:rot-q (q xy / )
  (if (<= 1 q 3)
    (cond
      ((= 1 q) (list (- (cadr xy)) (car xy)))
      ((= 2 q) (list (- (car xy)) (- (cadr xy))))
      ((= 3 q) (list (cadr xy) (- (car xy))))
      T nil)))
(defun v:rot90 (a / ) (list (- (cadr a)) (car a)))
(defun v:rot180 (a / ) (list (- (car a)) (- (cadr a))))
(defun v:rot270 (a / ) (list (cadr a) (- (car a))))
(defun v:sum (a / ) (apply 'mapcar (cons '+ a)))
(defun v:unit (a / ) (v:/ a (v:len a)))
(defun v:vec (a b / ) (v:- b a ))
(defun v:x (a b / xa xb ya yb za zb)
  (setq xa (car a) ya (cadr a) za (caddr a) xb (car b) yb (cadr b) zb (caddr b))
  (list (- (* ya zb) (* za yb)) (- (* za xb) (* xa zb)) (- (* xa yb) (* ya xb))))
(princ "\nVector Library loaded. See https://nedcad.nl/coordinate-mathematics-for-cad/ ")
(princ)