怎么用矩阵实现拉伸旋转功能

zhangq_cai1 · 发表于 2016-12-7 13:49:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

用Highflybird的矩阵函数能实现放大旋转，谁能帮忙改一下或给个思路实现拉伸旋转的效果：

(defun c:tt (/ 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 mat3 (MAT:SCALING p1 2.0)) ;以P1为基点放大2倍变换矩阵
(setq mat2 (MAT:ROTATION p1 (* pi 0.25))) ;以P1为基点旋转45度的变换矩阵
(setq mat (MAT:mxm mat2 mat3)) ;须按照先后顺序从里到外这样相乘
(setq mat (vlax-tmatrix mat))
(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)
)
(defun MAT:TranslateBy2P ( p1 p2 )
(MAT:Translation (mapcar '- p2 p1))
)
(defun MAT:Translation ( v )
(list
(list 1. 0. 0. (car v))
(list 0. 1. 0. (cadr v))
(list 0. 0. 1. (caddr v))
(list 0. 0. 0. 1.)
)
)
(defun MAT:Rotation ( Cen ang / c s x y)
(setq c (cos ang) s (sin ang))
(setq x (car Cen) y (cadr Cen))
(list
(list c (- s) 0. (- x (- (* c x) (* s y))))
(list s c 0. (- y (+ (* s x) (* c y))))
'(0. 0. 1. 0.)
'(0. 0. 0. 1.)
)
)
(defun MAT:Scaling ( Cen scale / s)
(setq s (- 1 scale))
(list
(list scale 0. 0. (* s (car Cen)))
(list 0. scale 0. (* s (cadr Cen)))
(list 0. 0. scale (* s (caddr Cen)))
'(0. 0. 0. 1.)
)
)
;;;-----------------------------------------------------------;;
;;; 矩阵相乘 ;;
;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky- ;;
;;;-----------------------------------------------------------;;
(defun MAT:mxm (m q)
(mapcar (function (lambda (r) (MAT:mxv (MAT:trp q) r))) m)
)
;;;-----------------------------------------------------------;;
;;; 向量或点的矩阵变换(向量乘矩阵) ;;
;;; Matrix x Vector - Vladimir Nesterovsky ;;
;;; Args: m - nxn matrix, v - vector in R^n ;;
;;;-----------------------------------------------------------;;
(defun MAT:mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
;;;-----------------------------------------------------------;;
;;; 矩阵转置 ;;
;;; MAT:trp Transpose a matrix -Doug Wilson- ;;
;;; 输入：矩阵 ;;
;;; 输出：转置后的矩阵 ;;
;;;-----------------------------------------------------------;;
(defun MAT:trp (m)
(apply 'mapcar (cons 'list m))
)

(defun c:tt (/ 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 mat3 (MAT:SCALING p1 2.0))                          ;以P1为基点放大2倍变换矩阵 
      (setq mat2 (MAT:ROTATION p1 (* pi 0.25)))                 ;以P1为基点旋转45度的变换矩阵 
      (setq mat  (MAT:mxm mat2 mat3))                           ;须按照先后顺序从里到外这样相乘 
      (setq mat  (vlax-tmatrix mat))                            
      (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) 
) 
(defun MAT:TranslateBy2P ( p1 p2 ) 
  (MAT:Translation (mapcar '- p2 p1)) 
) 
(defun MAT:Translation ( v ) 
  (list 
    (list 1. 0. 0. (car v)) 
    (list 0. 1. 0. (cadr v)) 
    (list 0. 0. 1. (caddr v)) 
    (list 0. 0. 0. 1.) 
  ) 
) 
(defun MAT:Rotation ( Cen ang / c s x y) 
  (setq c (cos ang) s (sin ang)) 
  (setq x (car Cen) y (cadr Cen)) 
  (list 
    (list c (- s) 0. (- x (- (* c x) (* s y)))) 
    (list s    c  0. (- y (+ (* s x) (* c y)))) 
    '(0. 0. 1. 0.) 
    '(0. 0. 0. 1.) 
  ) 
) 
(defun MAT:Scaling ( Cen scale / s) 
  (setq s (- 1 scale)) 
  (list 
    (list scale 0. 0. (* s (car Cen))) 
    (list 0. scale 0. (* s (cadr Cen))) 
    (list 0. 0. scale (* s (caddr Cen))) 
    '(0. 0. 0. 1.) 
  ) 
) 
;;;-----------------------------------------------------------;; 
;;; 矩阵相乘                                                  ;; 
;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky-      ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:mxm (m q) 
  (mapcar (function (lambda (r) (MAT:mxv (MAT:trp q) r))) m) 
) 
;;;-----------------------------------------------------------;; 
;;; 向量或点的矩阵变换(向量乘矩阵)                            ;; 
;;; Matrix x Vector - Vladimir Nesterovsky                    ;; 
;;; Args: m - nxn matrix, v - vector in R^n                   ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:mxv (m v) 
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m) 
) 
;;;-----------------------------------------------------------;; 
;;; 矩阵转置                                                  ;; 
;;; MAT:trp Transpose a matrix -Doug Wilson-                  ;; 
;;; 输入：矩阵                                                ;; 
;;; 输出：转置后的矩阵                                        ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:trp (m) 
  (apply 'mapcar (cons 'list m)) 
)

newer · 发表于 2016-12-7 16:38:22

旋转构造旋转矩阵，拉伸就不是矩阵的TRANSFORM了，是拉伸点。

Lisphk · 发表于 2016-12-7 16:51:36

楼主，你这个图片是块还是多段线？

zhangq_cai1 · 发表于 2016-12-7 18:01:16

是直线加圆弧

newer · 发表于 2016-12-7 18:17:20

zhangq_cai1 发表于 2016-12-7 18:01

从你图片演示用窗口选顶点推断，这个不是矩阵变换，是拉伸顶点，STRETCH操作。

Lispboy · 发表于 2016-12-7 19:36:24

newer 发表于 2016-12-7 16:38

看图片，看描述，楼主说的这个应该不是矩阵，是拉伸点，用纯LISP的话，在GRREAD循环里面，改变多段线和弧线的顶点坐标即可

论坛以前帖子写过，用XDRX API的，道理一样。

http://bbs.xdcad.net/forum.php?m ... 08707&fromuid=1

增强拉伸-1.gif

账号		自动登录	找回密码
密码			立即注册

[求助] 怎么用矩阵实现拉伸旋转功能

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

浏览过的版块