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

SLdesign V3.0 《矩阵函数》

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    c0. (- 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 s0. (- 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 发表于 21 分钟前

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

支持楼主,毕竟加入了自己的东西,这样才会进步!大佬的代码才体现价值不是吗!
页: [1]
查看完整版本: SLdesign V3.0 《矩阵函数》