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

XDSoft

Highflybird 发表于 2013-4-27 22:44

                               
登录/注册后可看大图

下面为我的函数。部分用到的函数请参见：用LISP论矩阵
;;;--------------------------------------------- ...

飞鸟，建议你修改下 Mat:mxm 函数，到这样的：Mat:mxm(mat1 mat2 mat3 mat4 ....matn)

要不多个矩阵，Mat:mxm 这个要写很多次。

牢固

XDSoft 发表于 2013-4-27 23:05

                               
登录/注册后可看大图

飞鸟，建议你修改下 Mat:mxm 函数，到这样的：Mat:mxm(mat1 mat2 mat3 mat4 ....matn)

要不多个矩阵， ...

[pcode=lisp,true];;函数递归即可:
;;(Mat:mxmxm (list m0 m1 ... mn))
(defun Mat:mxmxm (MatLst)
  (if (car MatLst)
    (if (cdr MatLst)
      (Mat:mxm
        (car MatLst)
        (Mat:mxmxm (cdr MatLst))
        )
      (car MatLst)
      )
    )
  )[/pcode]

Lispboy

我贴个迭代的

[pcode=lisp,true]
(defun Mat:mxmm (matL / _m1 _m2)
  (if (> (length matl) 2)
    (progn
      (setq _m1 (reverse matL)
            _m2 (car _m1)
      )
      (while (setq _m1 (cdr _m1))
        (setq _m2 (Mat:mxm (car _m1) _m2))
      )
      _m2
    )
  )
)
[/pcode]

kwok

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 ...

用了一个，冒似不行.
提示:
是否缩放<N>: n
; 错误: no function definition: MAT:SCALING

Lispboy

kwok 发表于 2013-4-29 10:30

                               
登录/注册后可看大图

用了一个，冒似不行.
提示:
是否缩放: n

你没有加载高飞鸟的矩阵函数。

梦断江南

发一个以前写的，仅支持2d ucs，但是简单实用，操作步骤少
[pcode=lisp,true];| xal(简单对齐)------------------ by lxx.2007.9
功能: 取两点即可模拟align进行旋转对齐(不缩放).
      支持3种选集构成模式:
      1.有预选，自动取预选，不提示选取实体
      2.有夹点选集，自动取夹点选集，不提示选取实体
      3.提示选择实体.
      支持ucs下操作.
版本:
v1.1-2007.9.23 用矩阵变换代替输入命令.(仅支持2d平移，旋转变换);
|;
(defun c:xal (/ E1 E2 EL1 EL2 OS P01 P02 P1 P2 SS # E EE ESS I MAN MVP PT1 PT2)
  (princ "\n 简单对齐(支持ucs,支持选集及块内对齐)v1.3---by lxx.2007.9")
  (vl-load-com)
  (cond
    (T (or (setq ss (ssget "I"))
           (setq ss (ssget))))
  )
  (command ".undo" "be")
  (if (and ss
           (setq pt1 (getpoint "\n 选参照点:")
                 el1 (nentselp pt1)
           )
           (setq pt2 (getpoint "\n 选对齐点:")
                 el2 (nentselp pt2)
           )
      )
    (progn
      (setq os (getvar "osmode"))
      (setq e1        (if (= (length el1) 2)
                  (car el1)
                  (progn (entmake(entget(car el1)))
                    (setq ee (entlast))
                    (vla-transformby (vlax-ename->vla-object ee) (vlax-tmatrix (caddr el1)))
                    (setq ess (cons  ee ess))
                    ee
                    )
                )
            p1        (vlax-curve-getclosestpointto e1 (trans (cadr el1) 1 0))
            e2        (if (= (length el2) 2)
                  (car el2)
                  (progn (entmake(entget(car el2)))
                    (setq ee (entlast))
                    (vla-transformby (vlax-ename->vla-object ee) (vlax-tmatrix (caddr el2)))
                    (setq ess (cons  ee ess))
                    ee
                    )
                )
            p2        (vlax-curve-getclosestpointto e2 (trans (cadr el2) 1 0))
            p01        (xxneavx e1 p1)
            p02        (xxneavx e2 p2)
      )
      (setq man (- (angle p02 p2)(angle p01 p1)))
      (setq # (xxm** (list(xxmvv (mapcar '- p01))(xxmrz man)(xxmvv p02))))
      (setq i -1)
      (while (setq e (ssname ss (setq i(1+ i))))
        (vla-transformby (vlax-ename->vla-object e) (vlax-tmatrix #))
      )
      (if ess (mapcar 'entdel ess))
    )
  )
  (command ".undo" "e")
  (princ)
)
(defun xxneavx (e p / D DD OTYP PAR1)
  (setq par1 (vlax-curve-getparamatpoint e p))
  (setq otyp (cdr(assoc 0 (entget e))))
  (cond
    ((WCMATCH otyp "*POLYLINE")
     (vlax-curve-getpointatparam e (fix(+ par1 0.5))))
    (T (setq d (* 2. (vlax-curve-getdistatparam e par1))
             dd(vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
       (if(< d dd)
         (vlax-curve-getstartpoint e)
         (vlax-curve-getendpoint e)
       )
    )
  )
)
(defun xxmvv (p)
  (list        (list 1. 0. 0. (car p))
        (list 0. 1. 0. (cadr p))
        (list 0. 0. 1. (caddr p))
        '(    0. 0. 0. 1.)
  )
)
(defun xxmrz (an) ;an = angle.
  (list        (list (cos an) (- (sin an)) 0. 0.)
        (list (sin an) (cos an)     0. 0.)
        (list   0.        0.        1. 0.)
        (list   0.        0.        0. 1.)
  )
)
(defun xxm** (#lst / #)
  (setq #lst (reverse #lst)
        #    (car #lst)
        #lst (cdr #lst))
  (mapcar '(lambda(x)(setq # (xxm*  x #))) #lst)
  #
)
(defun xxm* (#nj #mn)
  (setq >#nj (apply 'mapcar (cons 'list #nj)));;转置.
  (mapcar '(lambda(m) (mapcar '(lambda(j) (apply '+ (mapcar '* m j))) >#nj)) #mn)
)
[/pcode]

梦断江南

补充：操作的时候，自动识别参照点实体，取端点为第1点，参照实体最近点为第3点；目标点端点为第2点，目标点最近点为第4点。（以上点位对应align命令）

/db_自贡黄明儒_

Free-Lancer 发表于 2013-4-27 18:22
这样
;;p1 第一源点 p11 第一目标点
;;p2 第二源点 p22 第二目标点

你的注释很不错，有助于学习，但有两点疑问:
1 p    (mat:mxp mat p1) ;_基点变换   是不是该写成p    (mat:mxp matr p1)
2 你是先用缩放+旋转+基点变换+平移，其顺序是否可以改变?