home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Share Gallery 1
/
share_gal_1.zip
/
share_gal_1
/
GR
/
GR505.ZIP
/
LSP.EXE
/
CDNC6-.LSP
< prev
next >
Wrap
Text File
|
1989-09-10
|
6KB
|
167 lines
; ===========================================================
; AutoLISP Concepts June 1987 Matrices & Arrays
; B.Kramer Kramer Consulting, Inc.
; P.O. BOX 730 Hilliard, OH 43026
;
; Listing 1. Array Get and Put emulation.
;
(defun aget (array index)
(nth (1- index) array))
(defun aput (array index newdata)
(setq ii 0)
(setq array (mapcar
'(lambda (x) (cons (setq ii (1+ ii)) x)) array))
(setq array
(subst (cons 0 newdata) (assoc index array) array))
(mapcar 'cdr array))
; ===========================================================
;
; Listing 2. Matrix Manipulation Utilities
;
; Reverse ordering of Rows and Columns in a matrix list.
;
; ((A B C) ((A D G J)
; (D E F) Becomes (B E H K)
; (G H I) (C F I L))
; (J K L))
;
(defun RowCol (Alist / Cnt Ret U)
(setq Cnt -1 Ret nil)
(reverse
(repeat (length (car Alist))
(setq Cnt (1+ Cnt)
Ret (cons
(mapcar
'(lambda (U)
(nth Cnt U)) Alist) Ret)))))
;
; Multiply a NxM array by a Mx1 array to get a Mx1 array.
; <Useful for 3D transformation>
;
(defun Mby1 (A B / U)
(mapcar '(lambda (U) (apply '+ (mapcar '* U B))) A))
;
; Multiply a NxK array by a KxM array yielding a NxM array.
; <Useful for building of composite transposition matrix.>
;
(defun NbyM (A B / U V)
(mapcar
'(lambda (U) ; Sublist of A.
(mapcar
'(lambda (V) ; Sublist of B.
(apply '+ (mapcar '* U V))) B)) (rowcol A)))
; ===========================================================
;
; Listing 3. AutoLISP Concepts Application
; Author: W.Kramer for CADENCE 6-87
;
; 3DCUBE Draw a perspective view of a cube in AutoCAD 2D
; Demonstrates use of matrix mathematics as well as
; perspective computations.
;
(defun c:3dcube ()
(setq Wdt (getreal "\nCube width:")
Hgt (getreal "\nCube length:")
Dpt (getreal "\nCube heigth:"))
(setq Vpoint (list
(getreal "\nView point: X:")
(getreal " Y:")
(getreal " Z:")))
(setq cube (list
(list 0.0 0.0 0.0)
(list Wdt 0.0 0.0)
(list Wdt Hgt 0.0)
(list 0.0 Hgt 0.0)
(list 0.0 0.0 Dpt)
(list Wdt 0.0 Dpt)
(list Wdt Hgt Dpt)
(list 0.0 Hgt Dpt)))
(setq Theta (+ (atan (car Vpoint) (cadr Vpoint)) pi)
Phi (atan (caddr Vpoint) (sqrt
(+ (* (car Vpoint) (car Vpoint))
(* (cadr Vpoint) (cadr Vpoint))))))
(if (< (caddr Vpoint) Dpt) (setq Phi (* -1.0 Phi)))
;
(prompt "\nTranspose cube in space.")
(setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "T" Vpoint)) Cube))
;
(prompt "\nRotate 90 about X axis.")
(setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "X" (/ pi 2.0))) Cube))
;
(prompt (strcat
"\nRotate " (rtos (* (/ Theta pi) 180.0) 2 0) " about Y axis."))
(setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "Y" Theta)) Cube))
;
(prompt (strcat
"\nRotate " (rtos (* (/ Phi pi) 180.0) 2 0) " about X axis."))
(setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "X" Phi)) Cube))
;
(prompt "\nReverse Z values.")
(setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "S" '(1.0 1.0 -1.0))) Cube))
; Telephoto view adjustment.
; (setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "S" '(0.5 0.5 1.0))) Cube))
(command
"line" (3dto2d (car Cube))
(3dto2d (cadr Cube))
(3dto2d (caddr Cube))
(3dto2d (cadddr Cube))
"C"
"line" (3dto2d (nth 4 Cube))
(3dto2d (nth 5 Cube))
(3dto2d (nth 6 Cube))
(3dto2d (nth 7 Cube))
(3dto2d (nth 4 Cube))
(3dto2d (nth 0 Cube)) ""
"line" (3dto2d (nth 2 Cube)) (3dto2d (nth 6 Cube)) ""
"line" (3dto2d (nth 5 Cube)) (3dto2d (nth 1 Cube)) ""
"line" (3dto2d (nth 7 Cube)) (3dto2d (nth 3 Cube)) ""
"zoom" "E")
)
;
; Reduce 3D point information to 2D perspective data.
;
(defun 3dto2d (pnt)
(list
(if (zerop (caddr Pnt)) (car Pnt) (/ (car Pnt) (caddr Pnt)))
(if (zerop (caddr Pnt)) (cadr Pnt) (/ (cadr Pnt) (caddr Pnt)))))
;
; Performs a 3D Transformation on the point PNT.
; Transformation may be either: Translation, X-Y-Z rotation or scaling.
;
(defun 3dtrans (Pnt TT TVar / AA)
(cond
((= TT "T")
(setq AA (list
(list 1.0 0.0 0.0 (car Tvar))
(list 0.0 1.0 0.0 (cadr Tvar))
(list 0.0 0.0 1.0 (caddr TVar))
(list 0.0 0.0 0.0 0.0))))
((= TT "X")
(setq AA (list
(list 1.0 0.0 0.0 0.0)
(list 0.0 (cos Tvar) (sin Tvar) 0.0)
(list 0.0 (* -1.0 (sin Tvar)) (cos Tvar) 0.0)
(list 0.0 0.0 0.0 1.0))))
((= TT "Y")
(setq AA (list
(list (cos Tvar) 0.0 (sin Tvar) 0.0)
(list 0.0 1.0 0.0 0.0)
(list (* -1.0 (sin Tvar)) 0.0 (cos Tvar) 0.0)
(list 0.0 0.0 0.0 1.0))))
((= TT "Z")
(setq AA (list
(list (cos Tvar) (sin Tvar) 0.0 0.0)
(list (* -1.0 (sin Tvar)) (cos Tvar) 0.0 0.0)
(list 0.0 0.0 1.0 0.0)
(list 0.0 0.0 0.0 1.0))))
((= TT "S")
(setq AA (list
(list (car Tvar) 0.0 0.0 0.0)
(list 0.0 (cadr Tvar) 0.0 0.0)
(list 0.0 0.0 (caddr Tvar) 0.0)
(list 0.0 0.0 0.0 1.0))))
)
(if (boundp 'AA)
(setq Pnt (reverse (cdr (reverse
(mby1 AA (append Pnt (list 1.0)))))))))
QUIKPLOTZIP