(平移、旋转、缩放)图形平面坐标变换

平移

(defun c:MyMove(/ bf-mat-translation ent mat n p0 p1 ss)
    ;;;name:BF-Mat-Translation
    ;;;desc:根据矢量计算平移矩阵
    ;;;arg:v:平移矢量
    ;;;return:4X4的平移矩阵
    ;;;example:(BF-Mat-Translation '(1 0 0))
    (defun BF-Mat-Translation (v)
        (list
            (list 1. 0. 0. (float (car v)))
            (list 0. 1. 0. (float (cadr v)))
            (list 0. 0. 1. (float (caddr v)))
            (list 0. 0. 0. 1.)
        )
    )
    (if (and (setq ss (ssget)) (setq p0 (getpoint "\n请指定基点：")) (setq p1 (getpoint p0 "指定第二点的位移: ")))
        (progn
            (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)) n -1)
            (vlax-safearray-fill mat (BF-Mat-Translation (mapcar '- p1 p0)))
            (while (setq ent (ssname ss (setq n (1+ n))))
                (vla-TransformBy (vlax-ename->vla-object ent) mat)
            )
        )
    )
)

旋转

(defun C:MyRotation(/ bf-mat-scaling ent mat n p0 ss)
    ;;;name:BF-Mat-Rotation
    ;;;desc:根据基点和旋转角度计算旋转矩阵
    ;;;arg:Cen:基点
    ;;;arg:ang:旋转角度(弧度值)
    ;;;return:4X4的旋转矩阵
    ;;;example:(BF-Mat-Rotation '(1 0 0) (/ pi 3))
    (defun BF-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.)
        )
    )
    (if (and (setq ss (ssget)) (setq p0 (getpoint "\n请指定基点：") ang (getangle p0 "\n请指定旋转角度：")))
        (progn
            (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)) n -1)
            (vlax-safearray-fill mat (BF-Mat-Rotation p0 ang))
            (while (setq ent (ssname ss (setq n (1+ n))))
                (vla-TransformBy (vlax-ename->vla-object ent) mat)
            )
        )
    )
)

缩放

(defun C:MyScaling(/ bf-mat-scaling ent mat n p0 ss)
    ;;;name:BF-Mat-Scaling
    ;;;desc:根据基点和缩放比例计算缩放矩阵
    ;;;arg:Cen:基点
    ;;;arg:scale:缩放比例
    ;;;return:4X4的缩放矩阵
    ;;;example:(BF-Mat-Scaling '(1 0 0) 2)
    (defun BF-Mat-Scaling (Cen scale / s)
        (setq s (- 1 (setq scale (float 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.)
        )
    )
    (if (and (setq ss (ssget)) (setq p0 (getpoint "\n请指定基点：")) sca (getdist "\n请指定缩放比例："))
        (progn
            (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)) n -1)
            (vlax-safearray-fill mat (BF-Mat-Scaling p0 sca))
            (while (setq ent (ssname ss (setq n (1+ n))))
                (vla-TransformBy (vlax-ename->vla-object ent) mat)
            )
        )
    )
)