【越飞越高讲堂15】用LISP论矩阵

阿然

先马克下，越学越发现算法的重要性

highflybir

根据狂刀兄的建议，现在增加一个样例：

2. 
   
3. ;;;-----------------------------------------------------------;;
   
4. ;;;镜像，旋转和缩放的变换矩阵的测试                           ;;
   
5. ;;;-----------------------------------------------------------;;
   
6. ;;;以下例子演示：                                              ;;
   
7. ;;;把选择集的所有物体，从指定的基点移动到目标点，并根据目标点 ;;
   
8. ;;;旋转45度，然后再以目标点放大2倍.固然，这个程序完全可以用命 ;;
   
9. ;;;令方式或者vla方式来完成。此处仅仅说明如何运用矩阵。        ;;
   
10. ;;;注意：CAD的矩阵和OpenGL或其他的语言的矩阵有区别:           ;;
    
11. ;;;      1.它们的矩阵是互为转置的。                           ;;
    
12. ;;;      2.它们的矩阵相乘也是顺序相反的。                     ;;
    
13. ;;;-----------------------------------------------------------;;
    
14. (defun c:test (/ ss p1 p2 mat1 mat2 mat3 i e o)
    
15.   (if (setq ss (ssget))                                                ;选择物体
    
16.     (progn
    
17.       (initget 1)
    
18.       (setq P1 (getpoint "\n基点:"))                                ;指定基点
    
19.       (initget 1)
    
20.       (setq P2 (getpoint P1 "\n目标点:"))                        ;指定目标点
    
21.       (grvecs (list 1 p1 p2))                                   ;红线标识位移
    
22.       (setq p1 (trans p1 1 0))                                  ;把输入得到的点转化为世界坐标系的点
    
23.       (setq p2 (trans p2 1 0))                                        ;把输入得到的点转化为世界坐标系的点
    
24. 
    
25.       (setq mat1 (MAT:TRANSLATEBY2P P1 p2))                            ;从P1位移到P2的位移矩阵
    
26.       (setq mat2 (MAT:ROTATION p2 (* pi 0.25)))                 ;以P2为基点旋转45度的变换矩阵
    
27.       (setq mat3 (MAT:SCALING p2 2.0))                           ;以P2为基点放大2倍变换矩阵
    
28.       (setq mat  (mat:mxm mat3 (mat:mxm mat2 mat1)))            ;须按照先后顺序从里到外这样相乘
    
29.       (setq mat  (vlax-tmatrix mat))                            ;用vlax-tmatrix把变换矩阵从表转化为ActiveX数组表达的矩阵
    
30.       (command "undo" "be")
    
31.       (setq i 0)
    
32.       (repeat (sslength ss)                                       
    
33.         (setq e (ssname ss i))                                        ;获得图元名
    
34.         (setq o (vlax-ename->vla-object e))                        ;获得ActiveX对象
    
35.         (vla-transformby o mat)                                        ;用vla-transformby函数对之变换
    
36.         (setq i (1+ i))
    
37.       )
    
38.       (command "undo" "e")
    
39.     )
    
40.   )
    
41.   (princ)
    
42. )

<br /> ;;;-----------------------------------------------------------;;<br /> ;;;镜像，旋转和缩放的变换矩阵的测试                           ;;<br /> ;;;-----------------------------------------------------------;;<br /> ;;;以下例子演示：                                              ;;<br /> ;;;把选择集的所有物体，从指定的基点移动到目标点，并根据目标点 ;;<br /> ;;;旋转45度，然后再以目标点放大2倍.固然，这个程序完全可以用命 ;;<br /> ;;;令方式或者vla方式来完成。此处仅仅说明如何运用矩阵。        ;;<br /> ;;;注意：CAD的矩阵和OpenGL或其他的语言的矩阵有区别:           ;;<br /> ;;;      1.它们的矩阵是互为转置的。                           ;;<br /> ;;;      2.它们的矩阵相乘也是顺序相反的。                     ;;<br /> ;;;-----------------------------------------------------------;;<br /> (defun c:test (/ ss p1 p2 mat1 mat2 mat3 i e o)<br />   (if (setq ss (ssget))                                                ;选择物体<br />     (progn<br />       (initget 1)<br />       (setq P1 (getpoint "\n基点:"))                                ;指定基点<br />       (initget 1)<br />       (setq P2 (getpoint P1 "\n目标点:"))                        ;指定目标点<br />       (grvecs (list 1 p1 p2))                                   ;红线标识位移<br />       (setq p1 (trans p1 1 0))                                  ;把输入得到的点转化为世界坐标系的点<br />       (setq p2 (trans p2 1 0))                                        ;把输入得到的点转化为世界坐标系的点<br /> <br />       (setq mat1 (MAT:TRANSLATEBY2P P1 p2))                            ;从P1位移到P2的位移矩阵<br />       (setq mat2 (MAT:ROTATION p2 (* pi 0.25)))                 ;以P2为基点旋转45度的变换矩阵<br />       (setq mat3 (MAT:SCALING p2 2.0))                           ;以P2为基点放大2倍变换矩阵<br />       (setq mat  (mat:mxm mat3 (mat:mxm mat2 mat1)))            ;须按照先后顺序从里到外这样相乘<br />       (setq mat  (vlax-tmatrix mat))                            ;用vlax-tmatrix把变换矩阵从表转化为ActiveX数组表达的矩阵<br />       (command "undo" "be")<br />       (setq i 0)<br />       (repeat (sslength ss)                                        <br />         (setq e (ssname ss i))                                        ;获得图元名<br />         (setq o (vlax-ename->vla-object e))                        ;获得ActiveX对象<br />         (vla-transformby o mat)                                        ;用vla-transformby函数对之变换<br />         (setq i (1+ i))<br />       )<br />       (command "undo" "e")<br />     )<br />   )<br />   (princ)<br /> )

lisp爱好者

这个一定要顶起来

smartstar

纯支持！高飞鸟！

仲文玉

曾老大，这个必须支持

龙城飞将36

一定要顶，高版真乃神人

留个迹在这，日后已便查看学习

zdqwy19

矩阵求逆的网页没有帐号打不开，又无法注册。能否把代码贴出来。

杨如迁

chpmould

先支持一个，以后有时间再研究一下

Gu_xl

我也凑个热闹，给个图块转换矩阵应用实例：

1. ;;选择物体加入图块示例,非等比图块无效
   
2. (defun c:tt1  (/ BLKREF SS MAT TMAT N OBJLIST DOC)
   
3.   (if (and
   
4. (setq blkref (car (entsel "\n选择图块:")))
   
5. (= "INSERT" (cdr (assoc 0 (entget blkref))))
   
6. (progn
   
7.    (redraw blkref 3)
   
8.    (princ "\n选择要添加的物体:")
   
9.    (setq ss (ssget))
   
10.    )
    
11. )
    
12.     (progn
    
13.       (ssdel blkref ss)
    
14.       (if (> (sslength ss) 0)
    
15. (progn
    
16.    ;;计算图块的变换矩阵的逆矩阵
    
17.    (setq mat (MAT:RevRefGeom blkref))
    
18.    ;;计算VLA 方法可用的 4x4 转换矩阵
    
19.    (setq tmat
    
20.    (vlax-tMatrix
    
21.      (append
    
22.        (mapcar 'append
    
23.         (car Mat)
    
24.         (mapcar 'list (cadr mat)))
    
25.        '((0. 0. 0. 1.))
    
26.        )
    
27.      )
    
28.   )
    
29.    (repeat (setq n (sslength ss))
    
30.      (setq objlist (cons (vlax-ename->vla-object
    
31.       (ssname ss (setq n (1- n))))
    
32.     objlist))
    
33.      )
    
34.    ;;对选择的物体进行矩阵转换
    
35.    (mapcar '(lambda (obj) (vla-transformby obj tMat))
    
36.     objlist)
    
37.    ;;将转换后的实体复制到图块定义内
    
38.    (vlax-invoke
    
39.      (setq doc
    
40.      (vla-get-ActiveDocument (vlax-get-acad-object)))
    
41.      'CopyObjects
    
42.      objlist
    
43.      (vla-item (vla-get-blocks doc)
    
44.         (cdr (assoc 2 (entget blkref)))))
    
45.    ;;删除所选择物体
    
46.    (mapcar 'vla-delete ObjLst)
    
47.    ;;重显图形
    
48.    (vla-regen doc acActiveViewport)
    
49.    )
    
50. )
    
51.       )
    
52.     )
    
53.   (princ)
    
54.   )

;;选择物体加入图块示例,非等比图块无效<br /> (defun c:tt1  (/ BLKREF SS MAT TMAT N OBJLIST DOC)<br />   (if (and<br /> (setq blkref (car (entsel "\n选择图块:")))<br /> (= "INSERT" (cdr (assoc 0 (entget blkref))))<br /> (progn<br />    (redraw blkref 3)<br />    (princ "\n选择要添加的物体:")<br />    (setq ss (ssget))<br />    )<br /> )<br />     (progn<br />       (ssdel blkref ss)<br />       (if (> (sslength ss) 0)<br /> (progn<br />    ;;计算图块的变换矩阵的逆矩阵<br />    (setq mat (MAT:RevRefGeom blkref))<br />    ;;计算VLA 方法可用的 4x4 转换矩阵<br />    (setq tmat<br />    (vlax-tMatrix<br />      (append<br />        (mapcar 'append<br />         (car Mat)<br />         (mapcar 'list (cadr mat)))<br />        '((0. 0. 0. 1.))<br />        ) <br />      )<br />   )<br />    (repeat (setq n (sslength ss))<br />      (setq objlist (cons (vlax-ename->vla-object<br />       (ssname ss (setq n (1- n))))<br />     objlist))<br />      )<br />    ;;对选择的物体进行矩阵转换<br />    (mapcar '(lambda (obj) (vla-transformby obj tMat))<br />     objlist)<br />    ;;将转换后的实体复制到图块定义内<br />    (vlax-invoke<br />      (setq doc<br />      (vla-get-ActiveDocument (vlax-get-acad-object)))<br />      'CopyObjects<br />      objlist<br />      (vla-item (vla-get-blocks doc)<br />         (cdr (assoc 2 (entget blkref)))))<br />    ;;删除所选择物体<br />    (mapcar 'vla-delete ObjLst)<br />    ;;重显图形<br />    (vla-regen doc acActiveViewport)<br />    )<br /> )<br />       )<br />     )<br />   (princ)<br />   )

1. ;;拷贝块内物体,非等比图块无效
   
2. (defun c:tt2  (/ EN MAT TMAT DOC OBJ)
   
3.   (setq en (nentsel "\n选择块内物体:"))
   
4.   (if (> (length en) 2)
   
5.     (progn
   
6.       ;;计算图块的变换矩阵
   
7.       (setq mat (MAT:RefGeom (last (last en))))
   
8.       ;;计算VLA 方法可用的 4x4 转换矩阵
   
9.       (setq tmat
   
10.       (vlax-tMatrix
    
11.         (append
    
12.    (mapcar 'append
    
13.     (car Mat)
    
14.     (mapcar 'list (cadr mat)))
    
15.    '((0. 0. 0. 1.))
    
16.    )
    
17.         )
    
18.      )
    
19.       (vlax-invoke
    
20. (setq doc
    
21.         (vla-get-ActiveDocument (vlax-get-acad-object)))
    
22. 'CopyObjects
    
23. (list (vlax-ename->vla-object (car en)))
    
24. (vlax-get-property
    
25.    doc
    
26.    (if (= 1 (getvar 'CVPORT))
    
27.      'PaperSpace
    
28.      'ModelSpace))
    
29. )
    
30.       (if
    
31. (VL-CATCH-ALL-ERROR-P
    
32.    (VL-CATCH-ALL-APPLY
    
33.      'vla-TransformBy
    
34.      (list (setq obj (vlax-ename->vla-object (entlast)))
    
35.     tmat)))
    
36.   (vla-delete obj)
    
37.   obj)
    
38.       )
    
39.     )
    
40.   )

;;拷贝块内物体,非等比图块无效<br /> (defun c:tt2  (/ EN MAT TMAT DOC OBJ)<br />   (setq en (nentsel "\n选择块内物体:"))<br />   (if (> (length en) 2)<br />     (progn<br />       ;;计算图块的变换矩阵<br />       (setq mat (MAT:RefGeom (last (last en))))<br />       ;;计算VLA 方法可用的 4x4 转换矩阵<br />       (setq tmat<br />       (vlax-tMatrix<br />         (append<br />    (mapcar 'append<br />     (car Mat)<br />     (mapcar 'list (cadr mat)))<br />    '((0. 0. 0. 1.))<br />    )<br />         )<br />      )<br />       (vlax-invoke<br /> (setq doc<br />         (vla-get-ActiveDocument (vlax-get-acad-object)))<br /> 'CopyObjects<br /> (list (vlax-ename->vla-object (car en)))<br /> (vlax-get-property<br />    doc<br />    (if (= 1 (getvar 'CVPORT))<br />      'PaperSpace<br />      'ModelSpace))<br /> )<br />       (if<br /> (VL-CATCH-ALL-ERROR-P<br />    (VL-CATCH-ALL-APPLY<br />      'vla-TransformBy<br />      (list (setq obj (vlax-ename->vla-object (entlast)))<br />     tmat)))<br />   (vla-delete obj)<br />   obj)<br />       )<br />     )<br />   )