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 >
Text File  |  1989-09-10  |  6KB  |  167 lines
  1. ; ===========================================================
  2. ;    AutoLISP Concepts      June 1987    Matrices & Arrays
  3. ;    B.Kramer               Kramer Consulting, Inc.
  4. ;                           P.O. BOX 730  Hilliard, OH 43026
  5. ;
  6. ;    Listing 1.  Array Get and Put emulation.
  7. ;
  8. (defun aget (array index)
  9.    (nth (1- index) array))
  10. (defun aput (array index newdata)
  11.    (setq ii 0)
  12.    (setq array (mapcar
  13.      '(lambda (x) (cons (setq ii (1+ ii)) x)) array))
  14.    (setq array
  15.      (subst (cons 0 newdata) (assoc index array) array))
  16.    (mapcar 'cdr array))
  17. ; ===========================================================
  18. ;
  19. ;   Listing 2.    Matrix Manipulation Utilities
  20. ;
  21. ;  Reverse ordering of Rows and Columns in a matrix list.
  22. ;
  23. ;   ((A B C)              ((A D G J) 
  24. ;    (D E F)   Becomes     (B E H K)
  25. ;    (G H I)               (C F I L))
  26. ;    (J K L))
  27. ;
  28. (defun RowCol (Alist / Cnt Ret U)
  29.    (setq Cnt -1 Ret nil) 
  30.    (reverse
  31.      (repeat (length (car Alist)) 
  32.         (setq Cnt (1+ Cnt)
  33.               Ret (cons 
  34.                     (mapcar 
  35.                       '(lambda (U) 
  36.                          (nth Cnt U)) Alist) Ret)))))
  37. ;
  38. ;  Multiply a NxM array by a Mx1 array to get a Mx1 array.
  39. ;   <Useful for 3D transformation>
  40. ;
  41. (defun Mby1 (A B / U)
  42.   (mapcar '(lambda (U) (apply '+ (mapcar '* U B))) A))
  43. ;
  44. ;  Multiply a NxK array by a KxM array yielding a NxM array.
  45. ;   <Useful for building of composite transposition matrix.>
  46. ;
  47. (defun NbyM (A B / U V)
  48.    (mapcar
  49.      '(lambda (U) ;  Sublist of A.
  50.        (mapcar
  51.          '(lambda (V)  ;  Sublist of B.
  52.              (apply '+ (mapcar '* U V))) B)) (rowcol A)))
  53. ; ===========================================================
  54. ;
  55. ;  Listing 3.   AutoLISP Concepts Application
  56. ;  Author:  W.Kramer   for CADENCE 6-87
  57. ;  
  58. ;  3DCUBE     Draw a perspective view of a cube in AutoCAD 2D
  59. ;             Demonstrates use of matrix mathematics as well as
  60. ;             perspective computations.
  61. ;
  62. (defun c:3dcube ()
  63.   (setq Wdt (getreal "\nCube width:")
  64.         Hgt (getreal "\nCube length:")
  65.         Dpt (getreal "\nCube heigth:"))
  66.   (setq Vpoint (list
  67.         (getreal "\nView point: X:")
  68.         (getreal "  Y:")
  69.         (getreal "  Z:")))
  70.   (setq cube (list
  71.      (list 0.0 0.0 0.0)
  72.      (list Wdt 0.0 0.0)
  73.      (list Wdt Hgt 0.0)
  74.      (list 0.0 Hgt 0.0)
  75.      (list 0.0 0.0 Dpt)
  76.      (list Wdt 0.0 Dpt)
  77.      (list Wdt Hgt Dpt)
  78.      (list 0.0 Hgt Dpt))) 
  79.   (setq Theta (+ (atan (car Vpoint) (cadr Vpoint)) pi)
  80.         Phi (atan (caddr Vpoint) (sqrt
  81.               (+ (* (car Vpoint) (car Vpoint))
  82.                  (* (cadr Vpoint) (cadr Vpoint))))))
  83.   (if (< (caddr Vpoint) Dpt) (setq Phi (* -1.0 Phi)))
  84. ;
  85.   (prompt "\nTranspose cube in space.")
  86.   (setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "T" Vpoint)) Cube))
  87. ;
  88.   (prompt "\nRotate 90 about X axis.")
  89.   (setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "X" (/ pi 2.0))) Cube))
  90. ;
  91.   (prompt (strcat
  92.           "\nRotate " (rtos (* (/ Theta pi) 180.0) 2 0) " about Y axis."))
  93.   (setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "Y" Theta)) Cube))
  94. ;
  95.   (prompt (strcat
  96.           "\nRotate " (rtos (* (/ Phi pi) 180.0) 2 0) " about X axis."))
  97.   (setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "X" Phi)) Cube))
  98. ;
  99.   (prompt "\nReverse Z values.")
  100.   (setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "S" '(1.0 1.0 -1.0))) Cube)) 
  101. ;  Telephoto view adjustment.
  102. ;  (setq Cube (mapcar '(lambda (Pnt) (3dtrans Pnt "S" '(0.5 0.5 1.0))) Cube))
  103.    (command
  104.             "line" (3dto2d (car Cube))
  105.                    (3dto2d (cadr Cube))
  106.                    (3dto2d (caddr Cube))
  107.                    (3dto2d (cadddr Cube))
  108.                    "C"
  109.             "line" (3dto2d (nth 4 Cube))
  110.                    (3dto2d (nth 5 Cube))
  111.                    (3dto2d (nth 6 Cube))
  112.                    (3dto2d (nth 7 Cube))
  113.                    (3dto2d (nth 4 Cube))
  114.                    (3dto2d (nth 0 Cube)) ""
  115.             "line" (3dto2d (nth 2 Cube)) (3dto2d (nth 6 Cube)) ""
  116.             "line" (3dto2d (nth 5 Cube)) (3dto2d (nth 1 Cube)) ""
  117.             "line" (3dto2d (nth 7 Cube)) (3dto2d (nth 3 Cube)) ""
  118.             "zoom" "E")
  119. )
  120. ;
  121. ;  Reduce 3D point information to 2D perspective data.
  122. ;
  123. (defun 3dto2d (pnt)
  124.   (list
  125.     (if (zerop (caddr Pnt)) (car Pnt) (/ (car Pnt) (caddr Pnt))) 
  126.     (if (zerop (caddr Pnt)) (cadr Pnt) (/ (cadr Pnt) (caddr Pnt))))) 
  127. ;
  128. ;  Performs a 3D Transformation on the point PNT.
  129. ;  Transformation may be either:  Translation, X-Y-Z rotation or scaling.
  130. ;
  131. (defun 3dtrans (Pnt TT TVar / AA)
  132.   (cond
  133.    ((= TT "T")
  134.       (setq AA (list
  135.                 (list 1.0 0.0 0.0 (car Tvar))
  136.                 (list 0.0 1.0 0.0 (cadr Tvar))
  137.                 (list 0.0 0.0 1.0 (caddr TVar))
  138.                 (list 0.0 0.0 0.0 0.0))))
  139.    ((= TT "X")
  140.       (setq AA (list
  141.                  (list 1.0 0.0 0.0 0.0)
  142.                  (list 0.0 (cos Tvar) (sin Tvar) 0.0)
  143.                  (list 0.0 (* -1.0 (sin Tvar)) (cos Tvar) 0.0)
  144.                  (list 0.0 0.0 0.0 1.0))))
  145.     ((= TT "Y")
  146.       (setq AA (list
  147.                  (list (cos Tvar) 0.0 (sin Tvar) 0.0)
  148.                  (list 0.0 1.0 0.0 0.0)
  149.                  (list (* -1.0 (sin Tvar)) 0.0 (cos Tvar) 0.0)
  150.                  (list 0.0 0.0 0.0 1.0))))
  151.     ((= TT "Z")
  152.       (setq AA (list
  153.                  (list (cos Tvar) (sin Tvar) 0.0 0.0)
  154.                  (list (* -1.0 (sin Tvar)) (cos Tvar) 0.0 0.0)
  155.                  (list 0.0 0.0 1.0 0.0)
  156.                  (list 0.0 0.0 0.0 1.0))))
  157.     ((= TT "S")
  158.       (setq AA (list
  159.                  (list (car Tvar) 0.0 0.0 0.0)
  160.                  (list 0.0 (cadr Tvar) 0.0 0.0)
  161.                  (list 0.0 0.0 (caddr Tvar) 0.0)
  162.                  (list 0.0 0.0 0.0 1.0))))
  163.   )
  164.   (if (boundp 'AA)
  165.       (setq Pnt (reverse (cdr (reverse
  166.                  (mby1 AA (append Pnt (list 1.0)))))))))
  167. QUIKPLOTZIP t│æR!QUIKREADZIP ╙s│ûR┴┌QUIKSURFZIP t│▓R■    RAMFREE ZIP ë«╥ü~