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

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的。贴此共享。

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