SLdesign V3.0 《矩阵函数》

尘缘一生 · 发表于昨天 14:18

SLdesign V3.0 集成的矩阵函数发布下

;;SLdesign V3.0 三领矩阵函数------[开始]---------
;;Modify by 尘缘一生 QQ：15290049
;;点的矩阵(4x4 matrix) 变换
;;输入:矩阵m和一个三维点p
;;输出:点变换后的位置
(defun mat:mxp (m p)
(reverse (cdr (reverse (mat:mxv m (append (pt->3d p) '(1.0))))))
)
;;----------------------
;; wcs到ucs矩阵，也可称ucs的变换矩阵
(defun mat:w2u () (mat:trans 0 1))
;;-----------------------
;; ucs到wcs矩阵，也可称ucs的逆变换矩阵
(defun mat:u2w () (mat:trans 1 0))
;;从一个坐标系统到另一个坐标系统的变换矩阵
;;输入:from - 源坐标系；to - 目的坐标系
;;输出:一个4X4的CAD变换矩阵
(defun mat:trans (from to)
(append
(mat:trp
(list
(trans '(1 0 0) from to t)
(trans '(0 1 0) from to t)
(trans '(0 0 1) from to t)
(trans '(0 0 0) from to nil)
)
)
'((0. 0. 0. 1.))
)
)
;; 向量或点的矩阵变换(向量乘矩阵)
(defun mat:mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
;;平齐实体的变换矩阵
;;输入:ent - 实体名
;;输出:平齐这个实体的变换矩阵和它的逆矩阵
(defun mat:entitymatrix (ent / z dxf cen obj an m1 mat inv org)
(setq dxf (entget ent))
(if (setq cen (cdr (assoc 10 dxf)))
(if (null (caddr cen))
(setq cen (append cen '(0.0)))
)
(setq cen '(0 0 0))
)
(setq obj (vlax-ename->vla-object ent))
(if (and (vlax-property-available-p obj 'elevation)
(wcmatch (vla-get-objectname obj) "*Polyline")
)
(setq z (vla-get-elevation obj)
cen (list (car cen) (cadr cen) (+ (caddr cen) z))
)
)
(if (vlax-property-available-p obj 'rotation)
(setq an (vla-get-rotation obj))
(setq an 0)
)
(mat:trans1 0 ent cen an)
)
;;通用变换矩阵 ------------
;;from - 原坐标系，to - 目的坐标系
;;org - 目的坐标系的原点相对原坐标系的位置
;;ang - 相对于原坐标系的旋转角度
;;输出:两个矩阵，一个是从原坐标系变换到目的坐标系的变换矩阵一个是从目的坐标系变换到原坐标系的变换矩阵
(defun mat:trans1 (from to org ang / mat rot inv cen)
(setq mat (mapcar (function (lambda (v) (trans v from to t))) '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))))
(if (not (equal ang 0 1e-14))
(setq rot (list (list (cos ang) (- (sin ang)) 0.) (list (sin ang) (cos ang) 0.) (list 0. 0. 1.))
mat (mat:mxm mat rot)
)
)
(setq cen (trans org to from))
(setq inv (mat:trp mat))
(list
(mat:disptomatrix inv (mat:mxv inv (mapcar '- cen)))
(mat:disptomatrix mat cen)
)
)
;;把位移矢量添加到矩阵中
;;输入:mat -- 矩阵(3x3)，disp -- 位移矢量
;;输出:一个4x4的变换cad的标准变换矩阵
(defun mat:disptomatrix (mat disp)
(append
(mapcar 'append mat (mapcar 'list disp))
'((0. 0. 0. 1.))
)
)
;;矩阵相乘
(defun mat:mxm (m q)
(mapcar (function (lambda (r) (mat:mxv (mat:trp q) r))) m)
)
;;矩阵转置
;;输入:矩阵
;;输出:转置后的矩阵
(defun mat:trp (m)
(apply 'mapcar (cons 'list m))
)
;;缩放矩阵----
(defun mat:scaling (p0 scale / s)
(setq s (- 1 scale))
(list
(list scale 0. 0. (* s (car p0)))
(list 0. scale 0. (* s (cadr p0)))
(list 0. 0. scale (* s (caddr p0)))
'(0. 0. 0. 1.)
)
)
;;旋转矩阵----
(defun mat:rotation (p0 ang / c s x y)
(setq c (cos ang) s (sin ang))
(setq x (car p0) y (cadr p0))
(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.)
)
)
;平移变换矩阵v 位移矢量---(一级)---
(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.)
)
)
;平移变换矩阵---(一级)---
;p1基点 p2目标点
(defun mat:translateby2p (p1 p2 / mat)
(if (and p1 p2 (is_pt p1) (is_pt p2) (> (distance p1 p2) 0.01))
(setq mat (mat:translation (mapcar '- p2 p1)))
)
mat
)
;;二维镜像变换矩阵
;;p1 镜像向量第一点 p2 镜像向量第二点
(defun mat:reflect (p1 p2 / a c s x y)
(setq a (angle p1 p2) a (+ a a))
(setq c (cos a) s (sin a))
(setq x (car p1) y (cadr p1))
(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.)
)
)
;平移+旋转变换矩阵---(一级)---
;p1 基点 p2 目标点并旋转ang(nil 仅平移)度
;(mat:translateby2pang p1 p2 nil) 平移
;(mat:translateby2pang p1 p1 ang) 旋转
;(mat:translateby2pang p1 p2 ang) 平移+旋转
(defun mat:translateby2pang (p1 p2 ang / q mat)
(setq mat (mat:translateby2p p1 p2))
(if ang
(progn
(cond
((and p1 (is_pt p1))
(setq q (mat:rotation (trans p1 1 0) ang))
)
((and p2 (is_pt p2))
(setq q (mat:rotation (trans p2 1 0) ang))
)
)
(setq mat (mat:mxm mat q)) ;转动矩阵;矩阵相乘:移动+转动
)
)
mat
)
;平移+缩放变换矩阵---(一级)---
;p1 基点 p2 目标点并缩放sc倍(nil 仅平移)度
;(mat:translateby2psc p1 p2 nil) 平移
;(mat:translateby2psc p1 p1 sc) 旋转
;(mat:translateby2psc p1 p2 sc) 平移+旋转
(defun mat:translateby2psc (p1 p2 sc / q mat)
(setq mat (mat:translateby2p p1 p2))
(if sc
(progn
(cond
((and p1 (is_pt p1))
(setq q (mat:scaling (trans p1 1 0) sc))
)
((and p2 (is_pt p2))
(setq q (mat:scaling (trans p2 1 0) sc))
)
)
(setq mat (mat:mxm mat q)) ;缩放矩阵;矩阵相乘:移动+缩放
)
)
mat
)
;选择集!!矩阵变换!!-----(一级)----
;返回变换后本集
(defun sl:sstransformby (mat ss / i e)
(setq mat (vlax-tmatrix mat))
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(vla-transformby (vlax-ename->vla-object e) mat)
)
ss
)
;选择集ss 以基点p0 旋转ang(弧度)---(一级)-----
;(sl-rot (ssget) (getpoint) (* pi 0.25))
;;返回变换后选择集
(defun sl-ssrot (ss p0 ang / mat)
(setq mat (mat:rotation (trans p0 1 0) ang))
(sl:sstransformby mat ss)
(setq ss (sl-wzgz ss)) ;文字归正
ss
)
;;实体,选择集,实体表->矩阵从p1到p2移动并旋转ang度-----(一级)------
(defun sl:mov-ang (ss p1 p2 ang / mat)
(if (setq mat (mat:translateby2pang p1 p2 ang))
(cond
((= (type ss) 'ENAME) (vla-transformby (vlax-ename->vla-object ss) (vlax-tmatrix mat))) ;图元
((= (type ss) 'PICKSET) (sl:sstransformby mat ss)) ;集
((= (type ss) 'LIST) (sl:sstransformby mat (sl:pickset-fromlist ss))) ;实体表
)
)
(if ang (setq ss (sl-wzgz ss)));文字归正
ss
)
;;实体,选择集,实体表->矩阵从p1到p2移动并缩放sc倍-----(一级)------
(defun sl:mov-sc (ss p1 p2 sc / mat)
(if (setq mat (mat:translateby2psc p1 p2 sc))
(cond
((= (type ss) 'ENAME) (vla-transformby (vlax-ename->vla-object ss) (vlax-tmatrix mat))) ;图元
((= (type ss) 'PICKSET) (sl:sstransformby mat ss)) ;集
((= (type ss) 'LIST) (sl:sstransformby mat (sl:pickset-fromlist ss))) ;实体表
)
)
)
;;实体,选择集,实体表->矩阵以p1到p2为轴镜像-----(一级)------
;;返回处理后本集
(defun sl:mir (ss p1 p2 / mat s)
(if ss
(progn
(setq mat (mat:reflect p1 p2))
(cond
((= (type ss) 'PICKSET) (sl:sstransformby mat ss)) ;集
((= (type ss) 'ENAME) (vla-transformby (vlax-ename->vla-object ss) (vlax-tmatrix mat))) ;图元
((= (type ss) 'LIST) (sl:sstransformby mat (sl:pickset-fromlist ss))) ;实体表
)
(setq s (sl-wzgz ss));文字归正
)
)
s
)
;实体,选择集,实体表->缩放---(一级)---
(defun sl:scale (ss p0 sc)
(if (not p0) (setq p0 (e-mid ss)))
(sl:mov-sc ss p0 p0 sc)
)
;实体,选择集,实体表->移动---(一级)---
(defun sl:move (ss p1 p2)
(sl:mov-ang ss p1 p2 nil)
)
;;三领矩阵---------[结束]-----------

;;SLdesign V3.0 三领矩阵函数------[开始]--------- 
;;Modify by 尘缘一生   QQ：15290049 
;;点的矩阵(4x4 matrix) 变换 
;;输入:矩阵m和一个三维点p 
;;输出:点变换后的位置 
(defun mat:mxp (m p) 
  (reverse (cdr (reverse (mat:mxv m (append (pt->3d p) '(1.0)))))) 
) 
;;---------------------- 
;; wcs到ucs矩阵，也可称ucs的变换矩阵 
(defun mat:w2u () (mat:trans 0 1)) 
;;----------------------- 
;; ucs到wcs矩阵，也可称ucs的逆变换矩阵 
(defun mat:u2w () (mat:trans 1 0)) 
;;从一个坐标系统到另一个坐标系统的变换矩阵 
;;输入:from - 源坐标系；to - 目的坐标系 
;;输出:一个4X4的CAD变换矩阵 
(defun mat:trans (from to) 
  (append 
    (mat:trp 
      (list 
        (trans '(1 0 0) from to t) 
        (trans '(0 1 0) from to t) 
        (trans '(0 0 1) from to t) 
        (trans '(0 0 0) from to nil) 
      ) 
    ) 
    '((0. 0. 0. 1.)) 
  ) 
) 
;; 向量或点的矩阵变换(向量乘矩阵) 
(defun mat:mxv (m v) 
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m) 
) 
;;平齐实体的变换矩阵 
;;输入:ent - 实体名 
;;输出:平齐这个实体的变换矩阵和它的逆矩阵 
(defun mat:entitymatrix (ent / z dxf cen obj an m1 mat inv org) 
  (setq dxf (entget ent)) 
  (if (setq cen (cdr (assoc 10 dxf))) 
    (if (null (caddr cen)) 
      (setq cen (append cen '(0.0))) 
    ) 
    (setq cen '(0 0 0)) 
  ) 
  (setq obj (vlax-ename->vla-object ent)) 
  (if (and (vlax-property-available-p obj 'elevation) 
        (wcmatch (vla-get-objectname obj) "*Polyline") 
      ) 
    (setq z (vla-get-elevation obj) 
      cen (list (car cen) (cadr cen) (+ (caddr cen) z)) 
    ) 
  ) 
  (if (vlax-property-available-p obj 'rotation) 
    (setq an (vla-get-rotation obj)) 
    (setq an 0) 
  ) 
  (mat:trans1 0 ent cen an) 
) 
;;通用变换矩阵 ------------ 
;;from - 原坐标系，to   - 目的坐标系 
;;org  - 目的坐标系的原点相对原坐标系的位置 
;;ang  - 相对于原坐标系的旋转角度 
;;输出:两个矩阵，一个是从原坐标系变换到目的坐标系的变换矩阵 一个是从目的坐标系变换到原坐标系的变换矩阵 
(defun mat:trans1 (from to org ang / mat rot inv cen) 
  (setq mat (mapcar (function (lambda (v) (trans v from to t))) '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.)))) 
  (if (not (equal ang 0 1e-14)) 
    (setq rot (list (list (cos ang) (- (sin ang)) 0.) (list (sin ang) (cos ang) 0.) (list 0. 0. 1.)) 
      mat (mat:mxm mat rot) 
    ) 
  ) 
  (setq cen (trans org to from)) 
  (setq inv (mat:trp mat)) 
  (list 
    (mat:disptomatrix inv (mat:mxv inv (mapcar '- cen))) 
    (mat:disptomatrix mat cen) 
  ) 
) 
;;把位移矢量添加到矩阵中 
;;输入:mat -- 矩阵(3x3)，disp -- 位移矢量 
;;输出:一个4x4的变换cad的标准变换矩阵 
(defun mat:disptomatrix  (mat disp) 
  (append 
    (mapcar 'append mat (mapcar 'list disp)) 
    '((0. 0. 0. 1.)) 
  ) 
) 
;;矩阵相乘 
(defun mat:mxm (m q) 
  (mapcar (function (lambda (r) (mat:mxv (mat:trp q) r))) m) 
) 
;;矩阵转置 
;;输入:矩阵 
;;输出:转置后的矩阵 
(defun mat:trp (m) 
  (apply 'mapcar (cons 'list m)) 
) 
;;缩放矩阵---- 
(defun mat:scaling (p0 scale / s) 
  (setq s (- 1 scale)) 
  (list 
    (list scale 0. 0. (* s (car p0))) 
    (list 0. scale 0. (* s (cadr p0))) 
    (list 0. 0. scale (* s (caddr p0))) 
    '(0. 0. 0. 1.) 
  ) 
) 
;;旋转矩阵---- 
(defun mat:rotation (p0 ang / c s x y) 
  (setq c (cos ang) s (sin ang)) 
  (setq x (car p0) y (cadr p0)) 
  (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.) 
  ) 
) 
;平移变换矩阵v 位移矢量---(一级)--- 
(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.) 
  ) 
) 
;平移变换矩阵---(一级)--- 
;p1基点 p2目标点 
(defun mat:translateby2p (p1 p2 / mat) 
  (if (and p1 p2 (is_pt p1) (is_pt p2) (> (distance p1 p2) 0.01)) 
    (setq mat (mat:translation (mapcar '- p2 p1))) 
  ) 
  mat 
) 
;;二维镜像变换矩阵 
;;p1 镜像向量第一点 p2 镜像向量第二点 
(defun mat:reflect (p1 p2 / a c s x y) 
  (setq a (angle p1 p2) a (+ a a)) 
  (setq c (cos a) s (sin a)) 
  (setq x (car p1) y (cadr p1)) 
  (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.) 
  ) 
) 
;平移+旋转变换矩阵---(一级)--- 
;p1 基点 p2 目标点 并旋转ang(nil 仅平移)度 
;(mat:translateby2pang p1 p2 nil) 平移 
;(mat:translateby2pang p1 p1 ang) 旋转 
;(mat:translateby2pang p1 p2 ang) 平移+旋转 
(defun mat:translateby2pang (p1 p2 ang / q mat) 
  (setq mat (mat:translateby2p p1 p2)) 
  (if ang 
    (progn 
      (cond 
        ((and p1 (is_pt p1)) 
          (setq q (mat:rotation (trans p1 1 0) ang)) 
        ) 
        ((and p2 (is_pt p2)) 
          (setq q (mat:rotation (trans p2 1 0) ang)) 
        ) 
      ) 
      (setq mat (mat:mxm mat q)) ;转动矩阵;矩阵相乘:移动+转动 
    ) 
  )   
  mat   
) 
;平移+缩放变换矩阵---(一级)--- 
;p1 基点 p2 目标点 并缩放sc倍(nil 仅平移)度 
;(mat:translateby2psc p1 p2 nil) 平移 
;(mat:translateby2psc p1 p1 sc) 旋转 
;(mat:translateby2psc p1 p2 sc) 平移+旋转 
(defun mat:translateby2psc (p1 p2 sc / q mat) 
  (setq mat (mat:translateby2p p1 p2)) 
  (if sc 
    (progn 
      (cond 
        ((and p1 (is_pt p1)) 
          (setq q (mat:scaling (trans p1 1 0) sc)) 
        ) 
        ((and p2 (is_pt p2)) 
          (setq q (mat:scaling (trans p2 1 0) sc)) 
        ) 
      ) 
      (setq mat (mat:mxm mat q)) ;缩放矩阵;矩阵相乘:移动+缩放 
    ) 
  )   
  mat   
) 
;选择集!!矩阵变换!!-----(一级)---- 
;返回变换后本集 
(defun sl:sstransformby (mat ss / i e) 
  (setq mat (vlax-tmatrix mat)) 
  (setq i -1) 
  (while (setq e (ssname ss (setq i (1+ i)))) 
    (vla-transformby (vlax-ename->vla-object e) mat) 
  ) 
  ss 
) 
;选择集ss 以基点p0 旋转ang(弧度)---(一级)----- 
;(sl-rot (ssget) (getpoint) (* pi 0.25)) 
;;返回变换后选择集 
(defun sl-ssrot (ss p0 ang / mat) 
  (setq mat (mat:rotation (trans p0 1 0) ang)) 
  (sl:sstransformby mat ss) 
  (setq ss (sl-wzgz ss)) ;文字归正 
  ss 
) 
;;实体,选择集,实体表->矩阵从p1到p2移动并旋转ang度-----(一级)------ 
(defun sl:mov-ang (ss p1 p2 ang / mat) 
  (if (setq mat (mat:translateby2pang p1 p2 ang)) 
    (cond 
      ((= (type ss) 'ENAME) (vla-transformby (vlax-ename->vla-object ss) (vlax-tmatrix mat))) ;图元 
      ((= (type ss) 'PICKSET) (sl:sstransformby mat ss)) ;集 
      ((= (type ss) 'LIST) (sl:sstransformby mat (sl:pickset-fromlist ss))) ;实体表 
    ) 
  ) 
  (if ang (setq ss (sl-wzgz ss)));文字归正 
  ss 
) 
;;实体,选择集,实体表->矩阵从p1到p2移动并缩放sc倍-----(一级)------ 
(defun sl:mov-sc (ss p1 p2 sc / mat) 
  (if (setq mat (mat:translateby2psc p1 p2 sc)) 
    (cond 
      ((= (type ss) 'ENAME) (vla-transformby (vlax-ename->vla-object ss) (vlax-tmatrix mat))) ;图元 
      ((= (type ss) 'PICKSET) (sl:sstransformby mat ss)) ;集 
      ((= (type ss) 'LIST) (sl:sstransformby mat (sl:pickset-fromlist ss))) ;实体表 
    ) 
  ) 
) 
;;实体,选择集,实体表->矩阵以p1到p2为轴镜像-----(一级)------ 
;;返回处理后本集 
(defun sl:mir (ss p1 p2 / mat s) 
  (if ss 
    (progn 
      (setq mat (mat:reflect p1 p2)) 
      (cond 
        ((= (type ss) 'PICKSET) (sl:sstransformby mat ss)) ;集 
        ((= (type ss) 'ENAME) (vla-transformby (vlax-ename->vla-object ss) (vlax-tmatrix mat))) ;图元 
        ((= (type ss) 'LIST) (sl:sstransformby mat (sl:pickset-fromlist ss))) ;实体表 
      ) 
      (setq s (sl-wzgz ss));文字归正 
    ) 
  ) 
  s 
) 
;实体,选择集,实体表->缩放---(一级)--- 
(defun sl:scale (ss p0 sc) 
  (if (not p0) (setq p0 (e-mid ss))) 
  (sl:mov-sc ss p0 p0 sc) 
) 
;实体,选择集,实体表->移动---(一级)--- 
(defun sl:move (ss p1 p2) 
  (sl:mov-ang ss p1 p2 nil) 
) 
;;三领矩阵---------[结束]-----------

hubeiwdlue · 发表于昨天 14:36

老陈厉害了，数学函数还是非常必要的。

烟盒迷唇 · 发表于昨天 14:39

别人的函数，他拿来用的

自贡黄明儒 · 发表于昨天 15:42

本帖最后由自贡黄明儒于 2025-4-29 15:43 编辑

烟盒迷唇发表于 2025-4-29 14:39
别人的函数，他拿来用的

嗯，可以写明出处，像是highflybird大师写的

lxl217114 · 发表于昨天 16:32

自贡黄明儒发表于 2025-4-29 15:42
嗯，可以写明出处，像是highflybird大师写的

三领可能觉得英雄不问出处

但，这是英雄的作品。

pizi158545086 · 发表于昨天 17:44

谢谢分享

yaojing38 · 发表于 3 小时前

烟盒迷唇发表于 2025-4-29 14:39
别人的函数，他拿来用的

支持楼主，毕竟加入了自己的东西，这样才会进步！大佬的代码才体现价值不是吗！

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

SLdesign V3.0 《矩阵函数》

本帖子中包含更多资源

评分

点评

点评

浏览过的版块