阿然 发表于 2013-1-4 23:02:27

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

highflybir 发表于 2013-1-4 23:12:43

根据狂刀兄的建议,现在增加一个样例:
;;;-----------------------------------------------------------;;
;;;镜像,旋转和缩放的变换矩阵的测试                           ;;
;;;-----------------------------------------------------------;;
;;;以下例子演示:                                              ;;
;;;把选择集的所有物体,从指定的基点移动到目标点,并根据目标点 ;;
;;;旋转45度,然后再以目标点放大2倍.固然,这个程序完全可以用命 ;;
;;;令方式或者vla方式来完成。此处仅仅说明如何运用矩阵。      ;;
;;;注意:CAD的矩阵和OpenGL或其他的语言的矩阵有区别:         ;;
;;;      1.它们的矩阵是互为转置的。                           ;;
;;;      2.它们的矩阵相乘也是顺序相反的。                     ;;
;;;-----------------------------------------------------------;;
(defun c:test (/ ss p1 p2 mat1 mat2 mat3 i e o)
(if (setq ss (ssget))                                                ;选择物体
    (progn
      (initget 1)
      (setq P1 (getpoint "\n基点:"))                              ;指定基点
      (initget 1)
      (setq P2 (getpoint P1 "\n目标点:"))                        ;指定目标点
      (grvecs (list 1 p1 p2))                                   ;红线标识位移
      (setq p1 (trans p1 1 0))                                ;把输入得到的点转化为世界坐标系的点
      (setq p2 (trans p2 1 0))                                        ;把输入得到的点转化为世界坐标系的点

      (setq mat1 (MAT:TRANSLATEBY2P P1 p2))                            ;从P1位移到P2的位移矩阵
      (setq mat2 (MAT:ROTATION p2 (* pi 0.25)))                 ;以P2为基点旋转45度的变换矩阵
      (setq mat3 (MAT:SCALING p2 2.0))                           ;以P2为基点放大2倍变换矩阵
      (setq mat(mat:mxm mat3 (mat:mxm mat2 mat1)))            ;须按照先后顺序从里到外这样相乘
      (setq mat(vlax-tmatrix mat))                            ;用vlax-tmatrix把变换矩阵从表转化为ActiveX数组表达的矩阵
      (command "undo" "be")
      (setq i 0)
      (repeat (sslength ss)                                       
        (setq e (ssname ss i))                                        ;获得图元名
        (setq o (vlax-ename->vla-object e))                        ;获得ActiveX对象
        (vla-transformby o mat)                                        ;用vla-transformby函数对之变换
      (setq i (1+ i))
      )
      (command "undo" "e")
    )
)
(princ)
)







lisp爱好者 发表于 2013-1-5 07:38:55

这个一定要顶起来

smartstar 发表于 2013-1-5 07:39:02

纯支持!高飞鸟!

仲文玉 发表于 2013-1-5 07:45:22

曾老大,这个必须支持

龙城飞将36 发表于 2013-1-5 08:07:44

一定要顶,高版真乃神人

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

zdqwy19 发表于 2013-1-5 20:00:08

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

杨如迁 发表于 2013-1-5 22:01:02

chpmould 发表于 2013-1-5 23:32:49

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

Gu_xl 发表于 2013-1-6 09:47:28

本帖最后由 Gu_xl 于 2013-1-6 10:23 编辑

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

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


;;拷贝块内物体,非等比图块无效
(defun c:tt2(/ EN MAT TMAT DOC OBJ)
(setq en (nentsel "\n选择块内物体:"))
(if (> (length en) 2)
    (progn
      ;;计算图块的变换矩阵
      (setq mat (MAT:RefGeom (last (last en))))
      ;;计算VLA 方法可用的 4x4 转换矩阵
      (setq tmat
      (vlax-tMatrix
      (append
   (mapcar 'append
    (car Mat)
    (mapcar 'list (cadr mat)))
   '((0. 0. 0. 1.))
   )
      )
   )
      (vlax-invoke
(setq doc
      (vla-get-ActiveDocument (vlax-get-acad-object)))
'CopyObjects
(list (vlax-ename->vla-object (car en)))
(vlax-get-property
   doc
   (if (= 1 (getvar 'CVPORT))
   'PaperSpace
   'ModelSpace))
)
      (if
(VL-CATCH-ALL-ERROR-P
   (VL-CATCH-ALL-APPLY
   'vla-TransformBy
   (list (setq obj (vlax-ename->vla-object (entlast)))
    tmat)))
(vla-delete obj)
obj)
      )
    )
)
页: 1 [2] 3 4 5 6 7 8 9
查看完整版本: 【越飞越高讲堂15】用LISP论矩阵