模拟ALIGN命令的操作....

XDSoft

不要使用ACAD的命令，ALIGN函数。写代码模拟ALIGN命令和ALIGN函数的操作，把图中红色的实体参照直线左端点，对齐到斜线上，要考虑UCS。

如果无法播放，请点击此处在新窗口打开

附件是测试图。

Free-Lancer

又是 Transform，条条道路通罗马，过程可以学习，结果最重要
可以用 ALign 函数，呵呵

XDSoft

Free-Lancer 发表于 2013-4-26 23:05

                               
登录/注册后可看大图

又是 Transform，条条道路通罗马，过程可以学习，结果最重要
可以用 ALign 函数，呵呵

那我改内容了，不许用ACAD命令，不许用ALIGN函数;P

Free-Lancer

vla-move vla-rotate 既不能算命令也不能算 ALign 函数吧

XDSoft

Free-Lancer 发表于 2013-4-26 23:38

                               
登录/注册后可看大图

vla-move vla-rotate 既不能算命令也不能算 ALign 函数吧

可以啊，写上代码贴出来吧。

Free-Lancer

模拟 2D align，没有测试 3D，非矩阵方法
这里面角度可以看作矢量，不管UCS还是WCS，角度差是一样的，仅在Move的时候要用WCS
[pcode=lisp,true](defun c:tt (/ ss sl i p1 p11 p2 p22 obj an kw scl)
  (if (and (setq ss (ssget))
           (setq p1 (getpoint "\n第一源点: "))
           (setq p11 (getpoint p1 "\n第一目标点: "))
           (progn
             (grdraw p1 p11 1 1)
             t
           )
           (setq p2 (getpoint "\n第二源点: "))
           (setq p22 (getpoint p2 "\n第二目标点: "))
           (progn
             (grdraw p1 p11 1 1)
             t
           )
           (progn
             (initget "Y N")
             (if (not (setq kw (getkword "\n是否缩放<N>: ")))
               (setq kw "N")
               (setq kw "Y")
             )
             t
           )
      )
    (progn
      (setq sl        (sslength ss)
            i        -1
            scl        (/ (distance p11 p22) (distance p1 p2))
            an        (- (angle p11 p22) (angle p1 p2))
            p1        (vlax-3d-point (trans p1 1 0))
            p11        (vlax-3d-point (trans p11 1 0))
      )
      (repeat sl
        (setq obj (vlax-ename->vla-object
                    (ssname ss
                            (setq i (1+ i))
                    )
                  )
        )
        (if (= kw "Y")
          (vla-scaleentity obj p1 scl)
        )
        (vla-rotate obj p1 an)
        (vla-move obj p1 p11)
      )
    )
  )
  (princ)
)[/pcode]

Free-Lancer

用矩阵转换，平移好像不对！
关于矩阵转换函数移步 http://bbs.xdcad.net/thread-667494-1-1.html
[pcode=lisp,true](defun c:tt (/ ss sl i e p1 p11 p2 p22 kw  mat0 mat1 mat2 mat3 scl)
  (if (and (setq ss (ssget))
           (setq p1 (getpoint "\n第一源点: "))
           (setq p11 (getpoint p1 "\n第一目标点: "))
           (progn
             (grdraw p1 p11 1 1)
             t
           )
           (setq p2 (getpoint "\n第二源点: "))
           (setq p22 (getpoint p2 "\n第二目标点: "))
           (progn
             (grdraw p1 p11 1 1)
             t
           )
           (progn
             (initget "Y N")
             (if (not (setq kw (getkword "\n是否缩放<N>: ")))
               (setq kw "N")
               (setq kw "Y")
             )
             t
           )
      )
    (progn
      (setq sl         (sslength ss)
            i         -1
            scl         (/ (distance p11 p22) (distance p1 p2))
            an         (- (angle p11 p22) (angle p1 p2))
            mat1 (mat:scaling '(0. 0. 0.) scl) ;_缩放矩阵
            mat2 (mat:rotation '(0. 0. 0.) an) ;_旋转矩阵
            mat3 (MAT:Translation
                   (mapcar '- (trans p11 1 0) (trans p1 1 0))
                 ) ;_平移矩阵
      )
      (repeat sl
        (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
        (if (= kw "Y")
          (setq        mat0 (mat:mxm mat1 mat2)
                mat0 (mat:mxm mat0 mat3)
          )
          (setq mat0 (mat:mxm mat3 mat2))
        )
        (vla-transformby obj (vlax-tmatrix mat0))
      )
    )
  )
  (princ)
)[/pcode]

XDSoft

Free-Lancer 发表于 2013-4-27 11:25

                               
登录/注册后可看大图

用矩阵转换，平移好像不对！
关于矩阵转换函数移步 http://bbs.xdcad.net/thread-667494-1-1.html
(defun ...

在琢磨琢磨，这道题如果用矩阵做，就是如何得到 “对齐变换矩阵”。要矩阵做的优点就是效率高，代码短，逻辑清楚。平移、旋转矩阵要组合运算。

夜来风语声

[pcode=lisp,true](defun c:tt (/ SS P1 P2 P3 P4 N L MOVE ANG MAT)
  (setq ss (ssget))
  (setq p1 (getpoint "\n对齐基点:")
        p2 (getpoint p1 "\n对齐基准方向点:")
        p3 (getpoint "\n目标基点:")
        p4 (getpoint p3 "\n目标基准方向点:")
        )
  (if (and ss p1 p2 p3 p4)
    (progn
      (setq p1 (trans p1 1 0)
            p2 (trans p2 1 0)
            p3 (trans p3 1 0)
             p4 (trans p4 1 0)
            )
  (repeat (setq n (sslength ss))
    (setq l (cons (vlax-ename->vla-object (ssname ss (setq n (1- n))))
                  l
                  )
          )
    )
  (setq move (mapcar '- p3 p1)
        ang  (- (angle p1 p2) (angle p3 p4))
        )
  (mapcar '(lambda (X)
             (vla-move x
                       (vlax-3d-point p1)
                       (vlax-3d-point '(0 0 0))
                       )
             )
          l
          )
  (setq mat
         (vlax-tmatrix
           (append
             (mapcar 'append
                     (list
                       (list (cos ang) (sin ang) 0.)
                       (list (sin (- ang)) (cos ang) 0.)
                       (list 0. 0. 1.)
                       )
                     (mapcar 'list move)
                     )
             '((0. 0. 0. 1.))
             )
           )
        )

  (mapcar
    (function (lambda (x)
                (vla-TransformBy x mat)
                (vla-move x
                          (vlax-3d-point '(0 0 0))
                          (vlax-3d-point p1)
                          )
                )
              )
    l
    )
  )
    )
  (princ)
  )[/pcode]

Free-Lancer

终于明白了些组合变换[pcode=lisp,true](defun c:tt (/ ss sl i e p1 p11 p2 p22 kw mat0 mat1 mat2 mat3 scl p)
  (if (and (setq ss (ssget))
           (setq p1 (getpoint "\n第一源点: "))
           (setq p11 (getpoint p1 "\n第一目标点: "))
           (progn
             (grdraw p1 p11 1 1)
             t
           )
           (setq p2 (getpoint "\n第二源点: "))
           (setq p22 (getpoint p2 "\n第二目标点: "))
           (progn
             (grdraw p2 p22 1 1)
             t
           )
           (progn
             (initget "Y N")
             (if (not (setq kw (getkword "\n是否缩放<N>: ")))
               (setq kw "N")
               (setq kw "Y")
             )
             t
           )
      )
    (progn
      (setq sl         (sslength ss)
            i         -1
            scl         (/ (distance p11 p22) (distance p1 p2))
            an         (- (angle p11 p22) (angle p1 p2))
            mat1 (mat:scaling '(0. 0. 0.) scl) ;_缩放矩阵
            mat2 (mat:rotation '(0. 0. 0.) an) ;_旋转矩阵
      )
      (redraw)
      (repeat sl
        (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
        (if (= kw "Y")
          (setq        mat0 (mat:mxm mat2 mat1) ;_不可交换顺序
                p    (mat:mxp mat0 p1);_经过矩阵变换，P点也要变换后得到平移矩阵的向量
                mat3 (MAT:Translation (mapcar '- p11 p)) ;_平移矩阵
                mat0 (mat:mxm mat3 mat0)               
          )
          (setq        p    (mat:mxp mat2 p1);_经过矩阵变换，P点也要变换后得到平移矩阵的向量
                mat3 (MAT:Translation (mapcar '- p11 p)) ;_平移矩阵
                mat0 (mat:mxm mat3 mat2)
          )
        )
        (vla-transformby obj (vlax-tmatrix mat0))
      )
    )
  )
  (princ)
)[/pcode]

XDSoft

Free-Lancer 发表于 2013-4-27 16:13

                               
登录/注册后可看大图

终于明白了些组合变换(defun c:tt (/ ss sl i e p1 p11 p2 p22 kw mat0 mat1 mat2 mat3 scl p)
  (if (and ...

恭喜啊，给大家说说应该怎么组合变换？怎么写那个“对齐变换矩阵”？ 应该专门归纳写一个求对齐变换矩阵的函数。

如：

[pcode=lisp,true]
(defun mat:align(基点 原点1 目标点1 原点2 目标点2）
  ...
  mat_align
)
[/pcode]
     

Free-Lancer

这样
[pcode=lisp,true];;p1 第一源点 p11 第一目标点
;;p2 第二源点 p22 第二目标点
;;tf 缩放选项 t - 缩放 nil - 不缩放
(defun MAT:Align2D (p1 p11 p2 p22 tf / por an matr mats matv p)
  (setq        por  '(0. 0. 0.)
        an   (- (angle p11 p22) (angle p1 p2)) ;_旋转角
        matr (mat:rotation por an) ;_旋转矩阵
  )
  (if tf
    (setq mats (mat:scaling
                 por
                 (/ (distance p11 p22) (distance p1 p2))
               ) ;_缩放矩阵
          matr (mat:mxm matr mats) ;_缩放+旋转
          p    (mat:mxp mat p1) ;_基点变换
    )
    (setq p (mat:mxp matr p1)) ;_基点变换
  )
  (setq matv (mat:translation (mapcar '- p11 p))) ;_平移矩阵
  (mat:mxm matv matr)                        ;缩放+旋转+平移
)[/pcode]

XDSoft

Free-Lancer 发表于 2013-4-27 18:22

                               
登录/注册后可看大图

这样
;;p1 第一源点 p11 第一目标点
;;p2 第二源点 p22 第二目标点

为什么叫2D？

夜来风语声

矩阵函数见【越飞越高讲堂2】用LISP论矩阵
[pcode=lisp,true];;计算平移旋转缩放变换4X4矩阵;; Orign = 源移动基准点
;;BASEPOINT1 = 第一原点 BASEPOINT2 = 第二原点
;;TARGERPOINT1 = 第一目标点 TARGERPOINT2 = 第二目标点
;; SCALE： 是否缩放  t = 缩放  nil = 不缩放 Real = 实际缩放尺度
(defun TransFormmatrix (Orign BASEPOINT1 BASEPOINT2 TARGERPOINT1
                        TARGERPOINT2              SCALE         /
                        M0           ROT              M1         M2
                        M3           MAT
                       )
  (cond        ((null scale)
         (setq scale 1.0)
        )
        ((or (= 'real (type scale)) (= 'int (type Scale))))
        (t
         (setq scale (/        (distance TargerPoint1 TargerPoint2)
                        (distance BasePoint1 BasePoint2)
                     )
         )
        )
  )
  (if (null Orign) (setq Orign BASEPOINT1))
  (setq        m0  (MAT:Scaling scale) ;_ 缩放矩阵
        Rot (- (angle TargerPoint1 TargerPoint2)
               (angle BasePoint1 BasePoint2)
            )
        m1  (apply 'MAT:Translation (mapcar '- '(0 0 0) Orign)) ;_ 平移到原点矩阵
        m2  (MAT:Rotation Rot) ;_ 绕Z轴旋转到对齐方向矩阵
        m3  (apply 'MAT:Translation TargerPoint1) ;_ 平移到目标基点矩阵
        ;; 矩阵连续变换，变换顺序从右向左，即经过m1平移、m0缩放、m2旋转、m3平移
        mat (mat:mxm  m3 (mat:mxm m2 (mat:mxm m0 m1)))
  )
)[/pcode]

Highflybird

下面为我的函数。部分用到的函数请参见：用LISP论矩阵
[pcode=lisp,true];;;-----------------------------------------------------------;;
;;; To simulate the command: "align"                          ;;
;;; Command:Align3d                                           ;;
;;; Use in some cases: command can't be applied or you don't  ;;
;;; want to use them; or improve the efficiency,etc.and here  ;;
;;; are some useful functions,e.g. "Mat:Get3PMatrix";Or even  ;;
;;; you can customize "align" command.                        ;;
;;; Author: Highflybird, Date:2012-8-6.                       ;;
;;; All copyrights reserved.                                  ;;
;;;-----------------------------------------------------------;;
(defun C:Align3d (/ sel sP1 sP2 sP3 dP1 dP2 dP3 sclp scl
                    mat0 mat1 mat2 mat i ent obj app doc)
  ;;input
  (setq sel (ssget))
  (initget 9)
  (setq sP1 (getpoint "\nSpecify first source point:"))
  (initget 9)
  (setq dP1 (getpoint "\nSpecify first destination point:"))
  (initget 9)
  (setq sP2 (getpoint "\nSpecify second source point:"))
  (initget 9)
  (setq dP2 (getpoint "\nSpecify second destination point:"))
  (initget 8)
  (setq sP3 (getpoint "\nSpecify third source point or <continue>:"))
  (initget 9)
  (if (null sP3)
    (setq sP3 (Mat:Rotate90 sP2 sP1)
          dP3 (Mat:Rotate90 dP2 dP1)
    )   
    (setq dP3 (getpoint "\nSpecify third destination point:"))
  )
  (foreach x '(sP1 sP2 sP3 dP1 dP2 dP3)
    (set x (trans (eval x) 1 0))
  )
  (initget "Yes No")
  (setq sclp (getkword "\nScale objects based on alignment points? [Yes/No] <N>:"))

  ;;Get the transformation matrix
  (setq mat1 (Mat:3PMatrix sP1 sP2 sP3 nil))
  (setq mat2 (Mat:3PMatrix dP1 dP2 dP3 T))
  (if (= "Yes" sclp)
    (setq scl (/ (distance dP1 dP2) (distance sP2 sP1))
          mat0 (list (list scl 0 0 0)(list 0 scl 0 0) (list 0 0 scl 0) '(0 0 0 1))
          mat (Mat:mxm mat2 (Mat:mxm mat0 mat1))
    )   
    (setq mat (Mat:mxm mat2 mat1))
  )

  ;;Apply the transformation.
  (setq app (vlax-get-acad-object))
  (setq doc (vla-get-ActiveDocument app))
  (vla-StartUndoMark doc)
  (setq i 0)
  (if sel
    (repeat (sslength sel)
      (setq ent (ssname sel i))
      (setq obj (vlax-ename->vla-object ent))
      (vla-transformby obj (vlax-tmatrix mat))
      (setq i (1+ i))
    )
  )
  (vla-EndUndoMark doc)
  (vlax-release-object doc)
  (vlax-release-object app)
  (princ)
)

;;;-----------------------------------------------------------;;
;;; Mat:Rotate90 Rotate a point 90 degree by a basepoint      ;;
;;;-----------------------------------------------------------;;
(defun Mat:Rotate90 (Pt BasePt / a)
  (setq a (+ (/ pi 2) (angle BasePt Pt)))
  (polar BasePt a (distance pt basePt))
)
(prompt "Command is: Align3d")
(princ)
[/pcode]
其中最主要的代码如下：
此处变换是3d的，意味着能适用UCS，只需要把前面输入的点换到WCS即可。
[pcode=lisp,true]  (setq mat1 (Mat:3PMatrix sP1 sP2 sP3 nil))
  (setq mat2 (Mat:3PMatrix dP1 dP2 dP3 T))
  (if (= "Yes" sclp)
    (setq scl (/ (distance dP1 dP2) (distance sP2 sP1))
          mat0 (list (list scl 0 0 0)(list 0 scl 0 0) (list 0 0 scl 0) '(0 0 0 1))
          mat (Mat:mxm mat2 (Mat:mxm mat0 mat1))
    )   
    (setq mat (Mat:mxm mat2 mat1))
  )[/pcode]