【求助】如何:获得图块的矩阵

jxphklibin · 发表于 2009-2-3 13:02:00

本帖最后由作者于 2009-2-4 19:56:18 编辑

下面这段函数获取普通一般块的矩阵没有问题，对于嵌套、旋转、不等比例缩放、镜像的块，取得的矩阵好像不正确，与 nentselp 返回的矩阵不同，请问怎么才能修改为更为通用的函数，附件为一个较复杂的嵌套块，可供测试！
该函数是正确的，没有问题，参数必须保证是图块图元名！唯一不足之处是：对于不等比例缩放的块和镜像后的块，获得的矩阵不准确！此两种情况再加上选装，就更不准了！

;|功能:获得块的矩阵----支持三维-----------------
(blkmat (vlax-ename->vla-object(car(entsel))))
|;
(defun blkmat (vobj / mxm origin ang inspt zdir xdir ydir rmat movmatrix resmatrix)
(defun mxm (m q / qt)
(setq qt (apply 'mapcar (cons 'list q)))
(mapcar '(lambda (x) (mapcar '(lambda (y) (apply '+ (mapcar '* y x))) qt)) m)
)
(and
(setq origin(vlax-get (vlax-invoke (vlax-get (vlax-get (vlax-get-acad-object) "Activedocument") "blocks")
"item" (vlax-get vobj "name")) "origin"))
(setq ang (vlax-get vobj "Rotation"))
(setq inspt (mapcar '- (vlax-get vobj "InsertionPoint") origin));需要增加块定义原点的判断~~~~
(setq zdir (vlax-get vobj "Normal"))
(setq xdir(trans (list (cos ang)(sin ang) 0) zdir 0))
(setq ydir(list (- (* (cadr zdir)(caddr xdir)) (* (caddr zdir)(cadr xdir)));叉乘得到Y轴方向-------
(- (* (caddr zdir)(car xdir)) (* (car zdir)(caddr xdir)))
(- (* (car zdir)(cadr xdir)) (* (cadr zdir)(car xdir)))))
(setq rmat(list (list (car xdir)(car ydir) (car zdir) 0)
(list (cadr xdir)(cadr ydir)(cadr zdir) 0)
(list (caddr xdir)(caddr ydir)(caddr zdir) 0)))
(setq rmat(mapcar '(lambda(x y)(mapcar '(lambda(m)(* m y)) x))
rmat
(list (vlax-get vobj "XScaleFactor")
(vlax-get vobj "YScaleFactor")
(vlax-get vobj "ZScaleFactor")
)))
(setq rmat(list (car rmat) (cadr rmat) (caddr rmat) '(0 0 0 1)))
(setq movmatrix(list (list 1 0 0 (car inspt))(list 0 1 0 (cadr inspt))(list 0 0 1 (caddr inspt))
'(0 0 0 1)))
(setq rmat (mxm movmatrix rmat))
)
rmat
)

;|功能:获得块的矩阵----支持三维-----------------
(blkmat (vlax-ename->vla-object(car(entsel))))
|;
(defun blkmat (vobj / mxm origin ang inspt zdir xdir ydir rmat movmatrix resmatrix)
  (defun mxm (m q / qt)
    (setq qt (apply 'mapcar (cons 'list q)))
    (mapcar '(lambda (x) (mapcar '(lambda (y) (apply '+ (mapcar '* y x))) qt)) m)
  )
  (and
    (setq origin(vlax-get (vlax-invoke (vlax-get (vlax-get (vlax-get-acad-object) "Activedocument") "blocks")
                "item"  (vlax-get vobj "name")) "origin"))
    (setq ang (vlax-get vobj "Rotation"))
    (setq inspt (mapcar '- (vlax-get vobj "InsertionPoint") origin));需要增加块定义原点的判断~~~~
    (setq zdir (vlax-get vobj "Normal"))
    (setq xdir(trans (list (cos ang)(sin ang) 0) zdir 0))
    (setq ydir(list (- (* (cadr zdir)(caddr xdir)) (* (caddr zdir)(cadr xdir)));叉乘得到Y轴方向-------
            (- (* (caddr zdir)(car xdir)) (* (car zdir)(caddr xdir)))
            (- (* (car zdir)(cadr xdir)) (* (cadr zdir)(car xdir)))))
    (setq rmat(list (list (car xdir)(car ydir) (car zdir) 0)
            (list (cadr xdir)(cadr ydir)(cadr zdir) 0)
            (list (caddr xdir)(caddr ydir)(caddr zdir) 0)))
    (setq rmat(mapcar '(lambda(x y)(mapcar '(lambda(m)(* m y)) x))
                 rmat
                 (list (vlax-get vobj "XScaleFactor")
                       (vlax-get vobj "YScaleFactor")
                       (vlax-get vobj "ZScaleFactor")
                       )))
    (setq rmat(list (car rmat) (cadr rmat) (caddr rmat) '(0 0 0 1)))
    (setq movmatrix(list (list 1 0 0 (car inspt))(list 0 1 0 (cadr inspt))(list 0 0 1 (caddr inspt))
                     '(0 0 0 1)))
    (setq rmat (mxm movmatrix rmat))
  )
  rmat
)

jxphklibin · 发表于 2009-2-21 22:18:00

我贴一个我修改后的函数，和ObjMatrix得出来的应该是一样的：

(defun InsertMat (InsertEname / InsertEList ZAxis
NCSXAxis InsertAngle tmp1 tmp2
Orig
)
(setq ZAxis (cdr (assoc 210 (setq InsertEList (entget InsertEName))))
InsertAngle (cdr (assoc 50 InsertEList))
NCSXAxis (trans (list (cos InsertAngle) (- (sin InsertAngle)) 0.0)
(cdr (assoc 210 InsertEList))
0
)
Orig (mapcar
'-
(vlax-get
(vla-item
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-get (vlax-ename->vla-object InsertEName) 'Name)
)
'Origin
)
)
)
;; Set up the return value
;; The insertion point of the insert
(setq tmp1 (trans (cdr (assoc 10 InsertEList)) ZAxis 0))
;; The scale factors
(setq tmp2 (list (cdr (assoc 41 InsertEList))
(cdr (assoc 42 InsertEList))
(cdr (assoc 43 InsertEList))
)
)
(mxm
(list (append (mapcar '* NCSXAxis tmp2) (list (nth 0 tmp1)))
(append (mapcar '* (VectorCrossProduct ZAxis NCSXAxis) tmp2)
(list (nth 1 tmp1))
)
(append (mapcar '* ZAxis tmp2) (list (nth 2 tmp1)))
'(0.0 0.0 0.0 1.0)
)
(list (list 1.0 0.0 0.0 (car Orig))
(list 0.0 1.0 0.0 (cadr Orig))
(list 0.0 0.0 1.0 (caddr Orig))
'(0.0 0.0 0.0 1.0)
)
)
)

(defun InsertMat (InsertEname /    InsertEList ZAxis
    NCSXAxis    InsertAngle tmp1       tmp2
    Orig
   )
  (setq ZAxis     (cdr (assoc 210 (setq InsertEList (entget InsertEName))))
 InsertAngle (cdr (assoc 50 InsertEList))
 NCSXAxis    (trans (list (cos InsertAngle) (- (sin InsertAngle)) 0.0)
      (cdr (assoc 210 InsertEList))
      0
      )
 Orig     (mapcar
        '-
        (vlax-get
   (vla-item
     (vla-get-blocks
       (vla-get-activedocument (vlax-get-acad-object))
     )
     (vlax-get (vlax-ename->vla-object InsertEName) 'Name)
   )
   'Origin
        )
      )
  )
  ;; Set up the return value
  ;; The insertion point of the insert
  (setq tmp1 (trans (cdr (assoc 10 InsertEList)) ZAxis 0))
  ;; The scale factors
  (setq tmp2 (list (cdr (assoc 41 InsertEList))
     (cdr (assoc 42 InsertEList))
     (cdr (assoc 43 InsertEList))
      )
  )
  (mxm
    (list (append (mapcar '* NCSXAxis tmp2) (list (nth 0 tmp1)))
   (append (mapcar '* (VectorCrossProduct ZAxis NCSXAxis) tmp2)
    (list (nth 1 tmp1))
   )
   (append (mapcar '* ZAxis tmp2) (list (nth 2 tmp1)))
   '(0.0 0.0 0.0 1.0)
    )
    (list (list 1.0 0.0 0.0 (car Orig))
   (list 0.0 1.0 0.0 (cadr Orig))
   (list 0.0 0.0 1.0 (caddr Orig))
   '(0.0 0.0 0.0 1.0)
    )
  )
)

highflybir · 发表于 2009-2-22 12:50:00

本帖最后由作者于 2009-2-22 12:56:10 编辑

;; TransNested (gile)
;; Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
;; reference (xref or block) whatever its nested level-
;;
;; Arguments
;; pt : the point to translate
;; rlst : the parents entities list from the deepest nested to the one inserted in
;; current space -same as (last (nentsel)) or (last (nentselp))
;; from to : as with trans function: 0 for WCS, 1 for current UCS, 2 for RCS
(defun TransNested (pt rlst from to)
(and (= 1 from) (setq pt (trans pt 1 0)))
(and (= 2 to) (setq rlst (reverse rlst)))
(and (or (= 2 from) (= 2 to))
(while rlst
(setq geom (if (= 2 to)
(RevRefGeom (car rlst))
(RefGeom (car rlst))
)
rlst (cdr rlst)
pt (mapcar '+ (mxv (car geom) pt) (cadr geom))
)
)
)
(if (= 1 to)
(trans pt 0 1)
pt
)
)
;; RefGeom (gile)
;; Returns a list which first item is a 3x3 transformation matrix (rotation,
;; scales, normal) and second item the object insertion point in its parent
;; (xref, bloc or space)
;;
;; Argument : an ename
(defun RefGeom (ename / elst ang norm mat)
(setq elst (entget ename)
ang (cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
)
(list
(setq mat
(mxm
(mapcar (function (lambda (v) (trans v 0 norm T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list (list (cdr (assoc 41 elst)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 elst)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 elst)))
)
)
)
)
(trans
(mapcar
'-
(cdr (assoc 10 elst))
(mxv mat
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
)
)
norm
0
)
)
)
;; RevRefGeom (gile)
;; RefGeom inverse function
(defun RevRefGeom (ename / entData ang norm mat)
(setq entData (entget ename)
ang (- (cdr (assoc 50 entData)))
norm (cdr (assoc 210 entData))
)
(list
(setq mat
(mxm
(list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
(list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
(list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar (function (lambda (v) (trans v norm 0 T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
)
)
)
(mapcar '-
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
(mxv mat (trans (cdr (assoc 10 entData)) norm 0))
)
)
)
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
(apply '+ (mapcar '* v1 v2))
)
;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
(mapcar '(lambda (r) (vxv r v)) m)
)
;; MXM Multiply two matrices -Vladimir Nesterovsky-
(defun mxm (m q)
(mapcar '(lambda (r) (mxv (trp q) r)) m)
)

;; TransNested (gile)
;; Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
;; reference (xref or block) whatever its nested level-
;;
;; Arguments
;; pt : the point to translate
;; rlst : the parents entities list from the deepest nested to the one inserted in
;;        current space -same as (last (nentsel)) or (last (nentselp))
;; from to : as with trans function: 0 for WCS, 1 for current UCS, 2 for RCS

(defun TransNested (pt rlst from to)
  (and (= 1 from) (setq pt (trans pt 1 0)))
  (and (= 2 to) (setq rlst (reverse rlst)))
  (and (or (= 2 from) (= 2 to))
       (while rlst
(setq geom (if    (= 2 to)
      (RevRefGeom (car rlst))
      (RefGeom (car rlst))
    )
       rlst (cdr rlst)
       pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
)
       )
  )
  (if (= 1 to)
    (trans pt 0 1)
    pt
  )
)

;; RefGeom (gile)
;; Returns a list which first item is a 3x3 transformation matrix (rotation,
;; scales, normal) and second item the object insertion point in its parent
;; (xref, bloc or space)
;;
;; Argument : an ename

(defun RefGeom (ename / elst ang norm mat)
  (setq    elst (entget ename)
ang  (cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
  )
  (list
    (setq mat
   (mxm
     (mapcar (function (lambda (v) (trans v 0 norm T)))
     '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
     )
     (mxm
       (list (list (cos ang) (- (sin ang)) 0.0)
     (list (sin ang) (cos ang) 0.0)
     '(0.0 0.0 1.0)
       )
       (list (list (cdr (assoc 41 elst)) 0.0 0.0)
     (list 0.0 (cdr (assoc 42 elst)) 0.0)
     (list 0.0 0.0 (cdr (assoc 43 elst)))
       )
     )
   )
    )
    (trans
      (mapcar
'-
(cdr (assoc 10 elst))
(mxv mat
     (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
)
      )
      norm
      0
    )
  )
)

;; RevRefGeom (gile)
;; RefGeom inverse function

(defun RevRefGeom (ename / entData ang norm mat)
  (setq    entData    (entget ename)
ang    (- (cdr (assoc 50 entData)))
norm    (cdr (assoc 210 entData))
  )
  (list
    (setq mat
   (mxm
     (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
   (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
   (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
     )
     (mxm
       (list (list (cos ang) (- (sin ang)) 0.0)
     (list (sin ang) (cos ang) 0.0)
     '(0.0 0.0 1.0)
       )
       (mapcar (function (lambda (v) (trans v norm 0 T)))
       '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
       )
     )
   )
    )
    (mapcar '-
    (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
    (mxv mat (trans (cdr (assoc 10 entData)) norm 0))
    )
  )
)

;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
  (apply '+ (mapcar '* v1 v2))
)

;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
  (mapcar '(lambda (r) (vxv r v)) m)
)

;; MXM Multiply two matrices -Vladimir Nesterovsky-
(defun mxm (m q)
  (mapcar '(lambda (r) (mxv (trp q) r)) m)
)

这个是gile的。贴此共享。

caoyin · 发表于 2009-2-4 16:00:00

对于不等比例的块矩阵好像是无法完成的

jxphklibin · 发表于 2009-2-4 18:08:00

最近我也发现，ET工具里面的块内实体复制Ncopy，也同样存在这个问题，还有就是这个 Ncopy 不单止可以复制块内的实体，几乎所有不是快的也可以复制，另外我在修改这个程序的时候发现 Ncopy 程序有一个 Bug:

若是当前坐标原点出有实体，如直线等经过原点时，在没有关闭捕捉的情况下，执行程序有时会出现错误：

点重合 ; 错误: 函数被取消

这个问题，略加修改就可以避免了。

caoyin · 发表于 2009-2-4 19:28:00

楼主可以参考以下链接的28楼，程序写得不好

http://www.mjtd.com/bbs/dispbbs.asp?boardid=3&replyid=118821&id=72404&page=1&skin=0&landlord=0&Star=3

jxphklibin · 发表于 2009-2-4 21:05:00

本帖最后由作者于 2009-2-4 21:25:03 编辑

caoyin发表于2009-2-4 19:28:00楼主可以参考以下链接的28楼，程序写得不好http://www.mjtd.com/bbs/dispbbs.asp?boardid=3&replyid=118821&id=72404&page=1&skin=0&landlord=0&Star=3

楼上提供的 Ncopy 缺少函数如下：

缺少函数 (LTAX:DOC) BLKS (LTAX:BLKS)

狂刀无痕 · 发表于 2009-2-5 18:53:00

cadd矩阵是不能直接处理不等比例缩放的

caoyin · 发表于 2009-2-6 09:16:00

代码已经修正

highflybir · 发表于 2009-2-20 10:49:00

这里有两个很实用的程序以供参考，来自国外。

如果楼主要在深入理解，不妨到www.theswamp.org中去搜索。

jxphklibin · 发表于 2009-2-20 17:02:00

highflybir:

你贴的函数很好，可以适用于任何类型的图块，获取的转换矩阵是正确的！非常感谢！虽然程序较难读懂，但方法正确。

按你新想出来的方法编写的函数，企盼早点出来，呵呵！！！！

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

【求助】如何:获得图块的矩阵

回复：（jxphklibin）以下是引用caoyin在2009-2-4 19:...