阿然
发表于 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)
)
)
)