【飞鸟集】UCS的变换矩阵及其逆变换矩阵

highflybird

这里提供一个函数，得到当前UCS下的变化矩阵和逆变换矩阵。

2. 
   
3. ;;;UCS到WCS的变换矩阵及其WCS到UCS的变换矩阵                             
   
4. ;;;the transformation matrix of UCS to WCS and WCS to UCS.              
   
5. (defun UCS2WCS (/ xdir ydir zdir UcsOrg WcsOrg matlst revlst matrix)
   
6.   (defun AppendMatrix (lst org)
   
7.     (append
   
8.       (mapcar 'append lst (mapcar 'list org))
   
9.       '((0. 0. 0. 1.))
   
10.     )
    
11.   )
    
12.   (if (zerop (getvar "WORLDUCS"))                    ;如果不同于WCS
    
13.     (setq xdir   (getvar "UCSXDIR")                     ;X方向
    
14.              ydir   (getvar "UCSYDIR")                     ;Y方向
    
15.              zdir   (G:CrossProductor xdir ydir)         ;Z方向等于X方向叉乘Y方向
    
16.              UcsOrg (getvar "UCSORG")                  ;UCS原点
    
17.              WcsOrg (trans '(0 0 0) 0 1)                   ;WCS原点相对于UCS的坐标
    
18.              matLst (list xdir ydir zdir)                        ;UCS的旋转矩阵
    
19.              RevLst (trp matLst)                               ;UCS的旋转矩阵的逆
    
20.              matrix (list
    
21.                       (AppendMatrix matlst WcsOrg)        ;UCS到WCS的变换矩阵
    
22.                       (AppendMatrix RevLst UcsOrg)        ;WCS到UCS的变换矩阵
    
23.                     )
    
24.     )
    
25.     (list
    
26.       '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))  ;世界坐标系下是单位矩阵
    
27.       '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))  ;世界坐标系下是单位矩阵
    
28.     )
    
29.   )
    
30. )
    
31. 
    
32. ;;; 矢量的点积                                                         
    
33. ;;; VXV Returns the dot product of 2 vectors                           
    
34. (defun vxv (v1 v2)
    
35.   (apply '+ (mapcar '* v1 v2))
    
36. )
    
37. ;;; 矢量转置                                                            
    
38. ;;; TRP Transpose a matrix -Doug Wilson-                                
    
39. (defun trp (m)
    
40.   (apply 'mapcar (cons 'list m))
    
41. )
    
42. ;;; 矢量的矩阵变换                                                      
    
43. ;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
    
44. (defun mxv (m v)
    
45.   (mapcar (function (lambda (r) (vxv r v))) m)
    
46. )
    
47. ;;; 矩阵相乘                                                            
    
48. ;;; MXM Multiply two matrices -Vladimir Nesterovsky-                    
    
49. (defun mxm (m q)
    
50.   (mapcar (function (lambda (r) (mxv (trp q) r))) m)
    
51. )
    
52. ;;;两矢量的叉积                                                         
    
53. ;;; CrossProductor --vec1 * vec2                                       
    
54. (defun G:CrossProductor (vec1 vec2 / a b c d e f)                 
    
55.   (setq a (car   vec1))
    
56.   (setq b (cadr  vec1))
    
57.   (setq c (caddr vec1))
    
58.   (setq d (car   vec2))
    
59.   (setq e (cadr  vec2))
    
60.   (setq f (caddr vec2))
    
61.   (list
    
62.     (- (* b f) (* c e))
    
63.     (- (* c d) (* a f))
    
64.     (- (* a e) (* b d))
    
65.   )
    
66. )
    

<br /> ;;;UCS到WCS的变换矩阵及其WCS到UCS的变换矩阵                             <br /> ;;;the transformation matrix of UCS to WCS and WCS to UCS.              <br /> (defun UCS2WCS (/ xdir ydir zdir UcsOrg WcsOrg matlst revlst matrix)<br />   (defun AppendMatrix (lst org)<br />     (append<br />       (mapcar 'append lst (mapcar 'list org))<br />       '((0. 0. 0. 1.))<br />     )<br />   )<br />   (if (zerop (getvar "WORLDUCS"))                    ;如果不同于WCS <br />     (setq xdir   (getvar "UCSXDIR")                     ;X方向 <br />              ydir   (getvar "UCSYDIR")                     ;Y方向 <br />              zdir   (G:CrossProductor xdir ydir)         ;Z方向等于X方向叉乘Y方向 <br />              UcsOrg (getvar "UCSORG")                  ;UCS原点 <br />              WcsOrg (trans '(0 0 0) 0 1)                   ;WCS原点相对于UCS的坐标 <br />              matLst (list xdir ydir zdir)                        ;UCS的旋转矩阵 <br />              RevLst (trp matLst)                               ;UCS的旋转矩阵的逆 <br />              matrix (list<br />                       (AppendMatrix matlst WcsOrg)        ;UCS到WCS的变换矩阵<br />                       (AppendMatrix RevLst UcsOrg)        ;WCS到UCS的变换矩阵<br />                     )<br />     )<br />     (list<br />       '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))  ;世界坐标系下是单位矩阵<br />       '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))  ;世界坐标系下是单位矩阵<br />     )<br />   )<br /> )<br /> <br /> ;;; 矢量的点积                                                          <br /> ;;; VXV Returns the dot product of 2 vectors                            <br /> (defun vxv (v1 v2)<br />   (apply '+ (mapcar '* v1 v2))<br /> )<br /> ;;; 矢量转置                                                            <br /> ;;; TRP Transpose a matrix -Doug Wilson-                                <br /> (defun trp (m)<br />   (apply 'mapcar (cons 'list m))<br /> )<br /> ;;; 矢量的矩阵变换                                                      <br /> ;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-<br /> (defun mxv (m v)<br />   (mapcar (function (lambda (r) (vxv r v))) m)<br /> )<br /> ;;; 矩阵相乘                                                            <br /> ;;; MXM Multiply two matrices -Vladimir Nesterovsky-                    <br /> (defun mxm (m q)<br />   (mapcar (function (lambda (r) (mxv (trp q) r))) m)<br /> )<br /> ;;;两矢量的叉积                                                         <br /> ;;; CrossProductor --vec1 * vec2                                        <br /> (defun G:CrossProductor (vec1 vec2 / a b c d e f)                 <br />   (setq a (car   vec1))<br />   (setq b (cadr  vec1))<br />   (setq c (caddr vec1))<br />   (setq d (car   vec2))<br />   (setq e (cadr  vec2))<br />   (setq f (caddr vec2))<br />   (list<br />     (- (* b f) (* c e))<br />     (- (* c d) (* a f))<br />     (- (* a e) (* b d))<br />   )<br /> )<br />

以下作为测试

2.                                                   
   
3. (defun c:test(/ ent obj mat)
   
4.   (if (setq ent (car (entsel)))
   
5.     (progn
   
6.       (setq obj (vlax-ename->vla-object ent))
   
7.       (setq mat (ucs2wcs))
   
8.       (vla-TransformBy obj (vlax-tmatrix (car  mat)))                   ;UCS->WCS
   
9.       (command ".select" ent pause)
   
10.       (vla-TransformBy obj (vlax-tmatrix (cadr mat)))                  ;WCS->UCS
    
11.     )
    
12.   )
    
13. )
    

                                                  <br /> (defun c:test(/ ent obj mat)<br />   (if (setq ent (car (entsel)))<br />     (progn<br />       (setq obj (vlax-ename->vla-object ent))<br />       (setq mat (ucs2wcs))<br />       (vla-TransformBy obj (vlax-tmatrix (car  mat)))                   ;UCS->WCS<br />       (command ".select" ent pause)<br />       (vla-TransformBy obj (vlax-tmatrix (cadr mat)))                  ;WCS->UCS<br />     )<br />   )<br /> )<br />

该贴已经同步到 highflybird的微博

树櫴希德

此帖乃神仙打架 凡人不懂

highflybird

Lee Mac 的，更简洁

1. 
   
2. 
   
3. (defun LM:UCS2WCS nil
   
4.   (append
   
5.     (mapcar 'append
   
6.       (mapcar
   
7.         (function
   
8.           (lambda ( v ) (trans v 1 0 t))
   
9.         )
   
10.        '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
    
11.       )
    
12.       (mapcar 'list (trans '(0. 0. 0.) 0 1))
    
13.     )
    
14.    '((0. 0. 0. 1.))
    
15.   )
    
16. )
    
17. 
    
18. (defun LM:WCS2UCS nil
    
19.   (append
    
20.     (mapcar 'append
    
21.       (mapcar
    
22.         (function
    
23.           (lambda ( v ) (trans v 0 1 t))
    
24.         )
    
25.        '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
    
26.       )
    
27.       (mapcar 'list (trans '(0. 0. 0.) 1 0))
    
28.     )
    
29.    '((0. 0. 0. 1.))
    
30.   )
    
31. )
    

<br /> <br /> (defun LM:UCS2WCS nil<br />   (append<br />     (mapcar 'append<br />       (mapcar<br />         (function<br />           (lambda ( v ) (trans v 1 0 t))<br />         )<br />        '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))<br />       )<br />       (mapcar 'list (trans '(0. 0. 0.) 0 1))<br />     )<br />    '((0. 0. 0. 1.))<br />   )<br /> )<br /> <br /> (defun LM:WCS2UCS nil<br />   (append<br />     (mapcar 'append<br />       (mapcar<br />         (function<br />           (lambda ( v ) (trans v 0 1 t))<br />         )<br />        '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))<br />       )<br />       (mapcar 'list (trans '(0. 0. 0.) 1 0))<br />     )<br />    '((0. 0. 0. 1.))<br />   )<br /> )<br />

狂刀lxx

不错，我再帮简化一下

2. ；|ucs-wcs转换矩阵 by LEE MAC  简化by dreamsky 2011.6|；
   
3. (defun tranx (x y)
   
4.   (append
   
5.     (mapcar 'append
   
6.    (mapcar (function(lambda(v)(trans v x y t)))
   
7.     '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
   
8.     )
   
9.           (mapcar 'list (trans '(0. 0. 0.) y x))
   
10.     )
    
11.   '((0. 0. 0. 1.))
    
12.   )
    
13. )
    
14. (defun u2w ()(tranx 1 0)) ;;ucs转wcs矩阵
    
15. (defun w2u ()(tranx 0 1));;wcs转ucs矩阵

；|ucs-wcs转换矩阵 by LEE MAC  简化by dreamsky 2011.6|；<br /> (defun tranx (x y)<br />   (append<br />     (mapcar 'append<br />    (mapcar (function(lambda(v)(trans v x y t)))<br />     '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))<br />     )<br />           (mapcar 'list (trans '(0. 0. 0.) y x))<br />     )<br />   '((0. 0. 0. 1.))<br />   )<br /> )<br /> (defun u2w ()(tranx 1 0)) ;;ucs转wcs矩阵<br /> (defun w2u ()(tranx 0 1));;wcs转ucs矩阵

skynoon

高 实在高  

highflybird

其实可以更简单的。

1. (vla-GetUCSMatrix
   
2.   (vla-item
   
3.     (vla-get-UserCoordinateSystems
   
4.       (vla-get-ActiveDocument
   
5.         (vlax-get-acad-object))) i))    ;;;i --->第i个ucs
   

(vla-GetUCSMatrix <br />   (vla-item <br />     (vla-get-UserCoordinateSystems <br />       (vla-get-ActiveDocument <br />         (vlax-get-acad-object))) i))    ;;;i --->第i个ucs<br />

highflybir

回复 狂刀lxx 的帖子

2. 
   
3. 
   
4. 
   
5. ;;;Hence the code would only be able to create a transformation matrix to transfrom from WCS to
   
6. ;;;a coordinate system with origin, normal and rotation as supplied.
   
7. 下面的代码可以创建一个变换矩阵，这个矩阵定义了原点，法线，和旋转角度。
   
8. (defun LM:UCSMatrix ( org norm ang )
   
9.   (append
   
10.     (mapcar 'append
    
11.       (mxm
    
12.         (mapcar
    
13.           (function
    
14.             (lambda ( v ) (trans v 0 norm t))
    
15.           )
    
16.          '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
    
17.         )
    
18.         (list
    
19.           (list (cos ang) (- (sin ang)) 0.)
    
20.           (list (sin ang)    (cos ang)  0.)
    
21.           (list    0.            0.     1.)
    
22.         )
    
23.       )
    
24.       (mapcar 'list (trans org norm 0))
    
25.     )
    
26.    '((0. 0. 0. 1.))
    
27.   )
    
28. )
    
29. 
    
30. ;; Matrix x Vector  ~  Vladimir Nesterovsky
    
31. (defun mxv ( mat vec )
    
32.   (mapcar '(lambda ( row ) (apply '+ (mapcar '* row vec))) mat)
    
33. )
    
34. 
    
35. ;; Matrix x Matrix  ~  Vladimir Nesterovsky
    
36. (defun mxm ( m q )
    
37.   (mapcar (function (lambda ( r ) (mxv (trp q) r))) m)
    
38. )
    
39. 
    
40. ;; Matrix Transpose  ~  Doug Wilson
    
41. (defun trp ( m )
    
42.   (apply 'mapcar (cons 'list m))
    
43. )
    

<br /> <br /> <br /> ;;;Hence the code would only be able to create a transformation matrix to transfrom from WCS to <br /> ;;;a coordinate system with origin, normal and rotation as supplied.<br /> 下面的代码可以创建一个变换矩阵，这个矩阵定义了原点，法线，和旋转角度。<br /> (defun LM:UCSMatrix ( org norm ang )<br />   (append<br />     (mapcar 'append<br />       (mxm<br />         (mapcar<br />           (function<br />             (lambda ( v ) (trans v 0 norm t))<br />           )<br />          '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))<br />         )<br />         (list<br />           (list (cos ang) (- (sin ang)) 0.)<br />           (list (sin ang)    (cos ang)  0.)<br />           (list    0.            0.     1.)<br />         )<br />       )<br />       (mapcar 'list (trans org norm 0))<br />     )<br />    '((0. 0. 0. 1.))<br />   )<br /> )<br /> <br /> ;; Matrix x Vector  ~  Vladimir Nesterovsky<br /> (defun mxv ( mat vec )<br />   (mapcar '(lambda ( row ) (apply '+ (mapcar '* row vec))) mat)<br /> )<br /> <br /> ;; Matrix x Matrix  ~  Vladimir Nesterovsky<br /> (defun mxm ( m q )<br />   (mapcar (function (lambda ( r ) (mxv (trp q) r))) m)<br /> )<br /> <br /> ;; Matrix Transpose  ~  Doug Wilson<br /> (defun trp ( m )<br />   (apply 'mapcar (cons 'list m))<br /> )<br />

mj0000

高手好多，发帖做记号

highflybird

顺便说一下：
我开始的矩阵变换还是有用的：

如果一个坐标系统是定义成(UCSorg UCSXDir UCSYDir) -->CAD中UCS定义的方法
那么可按照下面的函数得到转换矩阵和逆转换矩阵。

1. ;;;UCS变换矩阵
   
2. (defun UCSMatrix (Org xAxis yAxis / d1 d2 xNrm yNrm zNrm RotMat InvMat
   
3.                       WcsOrg UCS->WCS WCS->UCS matrix)
   
4.   (setq d1 (distance '(0 0 0) xAxis))
   
5.   (setq d2 (distance '(0 0 0) yAxis))
   
6.   (if (or (zerop d1) (zerop d2))
   
7.     '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))
   
8.     (setq xNrm    (mapcar '/ xAxis (list d1 d1 d1))    ;X Axis
   
9.    yNrm    (mapcar '/ yAxis (list d2 d2 d2))    ;Y Axis
   
10.    zNrm    (G:CrossProductor xNrm yNrm)    ;Z Axis
    
11.    RotMat   (list xNrm yNrm zNrm)     ;Rotation matrix
    
12.    InvMat   (trp RotMat)      ;Inverse Rotation matrix
    
13.    WcsOrg   (mxv RotMat (mapcar '- Org))    ;The coordinate of WCS origin relate to UCS
    
14.    UCS->WCS (append (mapcar 'append RotMat (mapcar 'list WcsOrg))  '((0. 0. 0. 1.)))         
    
15.    WCS->UCS (append (mapcar 'append InvMat (mapcar 'list Org)) '((0. 0. 0. 1.)))
    
16.    matrix   (list UCS->WCS WCS->UCS)    ;return two matrices
    
17.     )
    
18.   )
    
19. )
    

;;;UCS变换矩阵<br /> (defun UCSMatrix (Org xAxis yAxis / d1 d2 xNrm yNrm zNrm RotMat InvMat<br />                       WcsOrg UCS->WCS WCS->UCS matrix)<br />   (setq d1 (distance '(0 0 0) xAxis))<br />   (setq d2 (distance '(0 0 0) yAxis))<br />   (if (or (zerop d1) (zerop d2))<br />     '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))<br />     (setq xNrm    (mapcar '/ xAxis (list d1 d1 d1))    ;X Axis<br />    yNrm    (mapcar '/ yAxis (list d2 d2 d2))    ;Y Axis<br />    zNrm    (G:CrossProductor xNrm yNrm)    ;Z Axis<br />    RotMat   (list xNrm yNrm zNrm)     ;Rotation matrix<br />    InvMat   (trp RotMat)      ;Inverse Rotation matrix<br />    WcsOrg   (mxv RotMat (mapcar '- Org))    ;The coordinate of WCS origin relate to UCS<br />    UCS->WCS (append (mapcar 'append RotMat (mapcar 'list WcsOrg))  '((0. 0. 0. 1.)))         <br />    WCS->UCS (append (mapcar 'append InvMat (mapcar 'list Org)) '((0. 0. 0. 1.)))<br />    matrix   (list UCS->WCS WCS->UCS)    ;return two matrices<br />     )<br />   )<br /> )<br />

例如下面的测试：

1. (defun c:test()
   
2.   (if (setq Ent (car (entsel)))
   
3.     (progn
   
4.       (setq Org (getvar "ucsorg"))
   
5.       (setq XDr (getvar "ucsxdir"))
   
6.       (setq ydr (getvar "ucsydir"))
   
7.       (setq Obj (vlax-ename->vla-object Ent))
   
8.       (setq Mat (UCSMatrix Org xdr ydr))
   
9.       (vla-TransformBy Obj (vlax-tmatrix (car  Mat)))                   ;UCS->WCS
   
10.       (command ".select" ent pause)
    
11.       (vla-TransformBy Obj (vlax-tmatrix (cadr Mat)))                   ;WCS->UCS
    
12.     )
    
13.   )
    
14. )

(defun c:test()<br />   (if (setq Ent (car (entsel)))<br />     (progn<br />       (setq Org (getvar "ucsorg"))<br />       (setq XDr (getvar "ucsxdir"))<br />       (setq ydr (getvar "ucsydir"))<br />       (setq Obj (vlax-ename->vla-object Ent))<br />       (setq Mat (UCSMatrix Org xdr ydr))<br />       (vla-TransformBy Obj (vlax-tmatrix (car  Mat)))                   ;UCS->WCS<br />       (command ".select" ent pause)<br />       (vla-TransformBy Obj (vlax-tmatrix (cadr Mat)))                   ;WCS->UCS<br />     )<br />   )<br /> )

highflybird

回复 highflybird 的帖子

另外附上旋转矩阵函数：
这个旋转矩阵的参数是（旋转角度，旋转轴，旋转基点)

2. 
   
3. ;;;Ang ---旋转角度
   
4. ;;;Nrm ---旋转轴（矢量）(WCS下的)
   
5. ;;;Org ---旋转基点 (WCS下的)
   
6. (defun RotationMatrix (Ang Nrm Org / A B C dist M N PT WX WY WZ)
   
7.   (setq dist (distance '(0 0 0) Nrm))
   
8.   (if (> dist 1e-8)
   
9.     (setq N  (mapcar '/ nrm (list dist dist dist))
   
10.    wx (car N)
    
11.    wy (cadr N)
    
12.    wz (caddr N)
    
13.    A  (cos Ang)
    
14.    B  (sin Ang)
    
15.    C  (- 1 A)
    
16.    M  (list (list (+ A (* wx wx C))
    
17.     (- (* wx wy C) (* wz B))
    
18.     (+ (* wy B) (* wx wz C))
    
19.      )
    
20.      (list (+ (* wz B) (* wx wy C))
    
21.     (+ A (* wy wy C))
    
22.     (- (* wy wz C) (* wx B))
    
23.      )
    
24.      (list (- (* wx wz C) (* wy B))
    
25.     (+ (* wx B) (* wy wz C))
    
26.     (+ A (* wz wz C))
    
27.      )
    
28.       )
    
29.    pt (mapcar '- org (mxv M org))
    
30.    M  (append (mapcar 'append M (mapcar 'list pt))
    
31.        '((0. 0. 0. 1.))
    
32.       )
    
33.     )
    
34.     '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))
    
35.   )
    
36. )
    

<br /> ;;;Ang ---旋转角度<br /> ;;;Nrm ---旋转轴（矢量）(WCS下的)<br /> ;;;Org ---旋转基点 (WCS下的)<br /> (defun RotationMatrix (Ang Nrm Org / A B C dist M N PT WX WY WZ)<br />   (setq dist (distance '(0 0 0) Nrm))<br />   (if (> dist 1e-8)<br />     (setq N  (mapcar '/ nrm (list dist dist dist))<br />    wx (car N)<br />    wy (cadr N)<br />    wz (caddr N)<br />    A  (cos Ang)<br />    B  (sin Ang)<br />    C  (- 1 A)<br />    M  (list (list (+ A (* wx wx C))<br />     (- (* wx wy C) (* wz B))<br />     (+ (* wy B) (* wx wz C))<br />      )<br />      (list (+ (* wz B) (* wx wy C))<br />     (+ A (* wy wy C))<br />     (- (* wy wz C) (* wx B))<br />      )<br />      (list (- (* wx wz C) (* wy B))<br />     (+ (* wx B) (* wy wz C))<br />     (+ A (* wz wz C))<br />      )<br />       )<br />    pt (mapcar '- org (mxv M org))<br />    M  (append (mapcar 'append M (mapcar 'list pt))<br />        '((0. 0. 0. 1.))<br />       )<br />     )<br />     '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))<br />   )<br /> )<br />

例如下面的测试例子:

2. 
   
3. (defun c:ttt (/ Ent Obj Mat Org Vec Ang Nrm)
   
4.   (setq app (vlax-get-acad-object))
   
5.   (setq doc (vla-get-ActiveDocument app))
   
6.   (setq ucs (vla-get-UserCoordinateSystems doc))
   
7.   (setq i 0)
   
8.   (repeat (vla-get-Count ucs)
   
9.     (setq u (vla-item ucs i))
   
10.     (vlax-dump-object u  T)
    
11.     (setq i (1+ i))   
    
12.   )
    
13.   (if (and (setq Ent (car (entsel)))
    
14.     (setq Org (getpoint "\nInput origin point of rotation:"))
    
15.     (setq Vec (getpoint Org "\nInput the Axis vector of rotation:"))
    
16.     (setq Ang (getangle "\nInput the angle of rotation:"))
    
17.       )
    
18.     (progn
    
19.       (setq Org (trans Org 1 0))
    
20.       (setq Vec (trans Vec 1 0))
    
21.       (setq Nrm (mapcar '- Vec Org))
    
22.       (setq Obj (vlax-ename->vla-object Ent))
    
23.       (setq Mat (RotationMatrix Ang Nrm Org))
    
24.       (vla-TransformBy Obj (vlax-tmatrix Mat))                   ;旋转矩阵
    
25.     )
    
26.   )
    
27. )
    

<br /> (defun c:ttt (/ Ent Obj Mat Org Vec Ang Nrm)<br />   (setq app (vlax-get-acad-object))<br />   (setq doc (vla-get-ActiveDocument app))<br />   (setq ucs (vla-get-UserCoordinateSystems doc))<br />   (setq i 0)<br />   (repeat (vla-get-Count ucs)<br />     (setq u (vla-item ucs i))<br />     (vlax-dump-object u  T)<br />     (setq i (1+ i))   <br />   )<br />   (if (and (setq Ent (car (entsel)))<br />     (setq Org (getpoint "\nInput origin point of rotation:"))<br />     (setq Vec (getpoint Org "\nInput the Axis vector of rotation:"))<br />     (setq Ang (getangle "\nInput the angle of rotation:"))<br />       )<br />     (progn<br />       (setq Org (trans Org 1 0))<br />       (setq Vec (trans Vec 1 0))<br />       (setq Nrm (mapcar '- Vec Org))<br />       (setq Obj (vlax-ename->vla-object Ent))<br />       (setq Mat (RotationMatrix Ang Nrm Org))<br />       (vla-TransformBy Obj (vlax-tmatrix Mat))                   ;旋转矩阵<br />     )<br />   )<br /> )<br />

highflybir

回复 highflybird 的帖子

用户稍加修改，就可以用这个函数替代rotate3d，