Topic: How do I get the transformation Matrix of the block without "nentsel(p)"?

[highflyingbird]

1.
How do I get the transformation Matrix of the block?
We know, “nentsel” returns the model to World Transformation Matrix.,
But if I wan’t to use “nentselp,nentsel”(maybe a lot of selections, or no why),how do I get the same matrix?

2.
Actually,when the block isn’t in 3D status,in another word,its normal is（0 0 1），I can get the Transformation Matrix,because the Transformation Matrix is a little simple,but when its normal isn’t  (0 0 1), e.g. (-0.8 0.5 0.4),I don’t know the formula,I searched a lot, but I didn’t find any formula about this Normal.

3.
If a block has a 3d normal,e.g,(-0.8 0.5 0.4), When I turn on the properties of the block,I can’t change the Rotation Angle,it’s always the same value,and every change of value,it changes its Transformation Matrix and its look.
It has confused me a long time.

[mkweaver]

Take a look at this thread:http://www.theswamp.org/index.php?topic=26591.0.  The last post in the thread has a link to ObjMatrix v2.lsp which has proven very helpful for me (thanks go to Joe Burke).  Specifically, take a look at the ObjMatrix procedure:
;; Argument: a block reference ename or vla-object.
;; Returns: a 4x4 transformation matrix like nentselp.

Hope that helps.
Mike Weaver

[T.Willey]

Here is another one that gile did.  I still find it helpful.  Thanks again gile.

[ http://www.theswamp.org/index.php?topic=13526.0 ]

[highflyingbird]

Thanks a lot.Thanks everybody.
It's very useful.Especially,Joe Burke's and gile's are very helpful.
I need more time to understand their algorithm.
Thanks again.

[highflyingbird]

In gile's routine,I found a problem.
It'll get a wrong result when the origin (not insert point) of the block isn't '(0 0 0).
otherwise,it works correctly.
Thanks for help.

[gile]

Hi,

I tried to correct this bug.
Please, let me know if it works fine now.

Code: [Select]

;; 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)))
       )
     )
   )
    )
    (mapcar
      '-
      (trans (cdr (assoc 10 elst)) norm 0)
      (mxv mat
   (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
      )
    )
  )
)

;; 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)
)

[highflyingbird]

Thank you,gile!
Now it's OK. I get the same result as Joe Burke's.
In some places,the Transformation Matrix with yours or Joe Burke's  is different from Nentselp,for example,
this dwg file includes a block reference ,and you can test it.
But if a point transformed by your Matrix ,it will run correctly.

by the way ,I found an another,it's same as yours.

Code: [Select]

;; THE FOLLOWING CODES ARE MODIFIED FROM JON FLEMING'S FAMOUS BIXform.lsp
;;; to get the 4X4 Transformation matrix from OCS of Block Reference to WCS
;;; Modified by AIDraft 16/9/2004
(defun InsertMat (InsertEname / InsertEList ZAxis NCSXAxis InsertAngle tmp1 tmp2)
  (setq ZAxis     (cdr (assoc 210 (setq InsertEList (entget InsertEName))))
InsertAngle (cdr (assoc 50 InsertEList))
NCSXAxis    (trans (list (cos InsertAngle) (- (sin InsertAngle)) 0.0)
   ZAxis;;(cdr (assoc 210 InsertEList))
   0
    )
  )
  ;; 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))
     )
  )
  (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)
  )
)

;;; Vector cross product function

;;; Argument: Two lists, each of three real numbers defining
;;; a vector in 3-space

;;; Return value: A list of three real numbers containing
;;; the first argument crossed with the second argument.

(defun VectorCrossProduct (InputVector1 InputVector2)
  (list (- (* (cadr InputVector1) (caddr InputVector2))
   (* (cadr InputVector2) (caddr InputVector1))
)
(- (* (caddr InputVector1) (car InputVector2))
   (* (caddr InputVector2) (car InputVector1))
)
(- (* (car InputVector1) (cadr InputVector2))
   (* (car InputVector2) (cadr InputVector1))
)
  )
)

[highflyingbird]

I attached a lisp file,a dwg file,some places have been revised.gile,I hope you wouldn't mind it.
Thank you very much.

[gile]

To get the same transormation matrix as this returned by nentselp, you can use this routine:

Code: [Select]

;;; Get-TMatrix (gile)
;;; Returns a transformation matrix (4X4) as this returned by nentselp
;;;
;;; Argument : the parents entities list from the deepest nested to the one inserted in
;;                  current space -same as (last (nentsel)) or (last (nentselp))

(defun get-tmatrix (lst / mat pt geom)
    (setq geom (refgeom (car lst))
  mat  (car geom)
  pt   (cadr geom)
  lst  (cdr lst)
    )
  (while lst
    (setq geom (refgeom (car lst))
  mat  (mxm (car geom) mat)
  pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
  lst  (cdr lst)
    )
  )
  (append
    (mapcar '(lambda (v x) (append v (list x))) mat pt)
    (list '(0.0 0.0 0.0 1.0))
  )
)

[highflyingbird]

To get the same transormation matrix as this returned by nentselp, you can use this routine:

Now everything is OK.Thanks a lot.
Actually, I want it better,because there are a lot of matrix multiplications and some "trans" functions,it will take a long time if we select many inserts.--This is another topic.

[jxphklibin]

Hi,gile:

To get the same transormation matrix as this returned by nentselp, you can use this routine:

Code: [Select]

;;; Get-TMatrix (gile)
;;; Returns a transformation matrix (4X4) as this returned by nentselp
;;;
;;; Argument : the parents entities list from the deepest nested to the one inserted in
;;                  current space -same as (last (nentsel)) or (last (nentselp))

(defun get-tmatrix (lst / mat pt geom)
    (setq geom (refgeom (car lst))
  mat  (car geom)
  pt   (cadr geom)
  lst  (cdr lst)
    )
  (while lst
    (setq geom (refgeom (car lst))
  mat  (mxm (car geom) mat)
  pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
  lst  (cdr lst)
    )
  )
  (append
    (mapcar '(lambda (v x) (append v (list x))) mat pt)
    (list '(0.0 0.0 0.0 1.0))
  )
)

Function looks very good, only do not understand is that the parameters of "lst" structure are what kind of set up?
It's appears to be somewhat similar as the returns structure of my function, but are actually different.

Code: [Select]

;;Using recursive to traversal nested block
(defun AllEntityInBlkdef (blk / bn blkdef e typ el e-l)
  (setq bn     (cdr (assoc 2 (entget blk)))
blkdef (tblobjname "block" bn)
  )
  (while (setq e (entnext blkdef))
    (setq typ (cdr (assoc 0 (entget e))))
    (if (= typ "INSERT")
      ;;(setq el (append (AllEntityInBlkdef e) el));Return results①
      ;;(setq el (append (list (list (cons e (length (setq e-l (AllEntityInBlkdef e)))) e-l)) el));2009-1-14 modified by libin Return results②
      (setq el (append (list (list e (AllEntityInBlkdef e))) el));Return results③
      (setq el (cons e el))
    )
    (setq blkdef e)
  )
  el
;;;  (setq ABentlst (append (list (list (cons blk (length el)) el)) ABentlst))
)

(defun c:AentinBl (/ i en ss entlst ABentlst) ;bn) if while repeat Trigonometric functions foreach
  (setq ss (ssget '((0 . "INSERT")))
ABentlst '()
  )
  (if ss
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
    entlst (AllEntityInBlkdef  en)
    ;;ABentlst (append entlst ABentlst);Return results①
    ;;ABentlst (append (list (list (cons en (length entlst)) entlst)) ABentlst);Return results②
    ABentlst (append (list (list en entlst)) ABentlst);Return results③
      )
    )
    (princ "*** You haven't select any block ***")
  )
)
(princ)

The following is an example of the results back:
Return results③:
((<Element name: 7ef66088>
      (<Element name: 7ef64fa8> <Element name:   7ef64fa0> <Element name: 7ef64f98>)
 )
  (<Element name: 7ef66168>
       ((<Element name: 7ef66160>
             (<Element name: 7ef66108> <Element name: 7ef66100> <Element name: 7ef660f8> <Element name: 7ef660f0>)
        )
         (<Element name:   7ef66158>
         (<Element name: 7ef66020> <Element name: 7ef66018>
              (<Element name: 7ef66010>
                   (<Element name: 7ef64fa8> <Element name: 7ef64fa0> <Element name: 7ef64f98>)
              )
         )
         )
       )
  )
  (<Element name: 7ef64f70>
       (<Element name: 7ef64f68> <Element name: 7ef64f60> <Element name: 7ef64f58> <Element name: 7ef64f50> <Element name: 7ef64f48>)
  )
)

I want to realize in this way as 7 # X4.lsp the same procedure to obtain all round the center coordinates of all circles in all blocks.

gile,Would like to have your help, thank you!

Here I am attaching the DWG drawing file for testing:

[gile]

Hi,

Assuming ins1 is a block reference nested in ins2 after a rotation and ins2 is nested in ins3 after scaling, ins3 is inserted in model space.
The argument for Get-TMatrix routine is a list of insert enames: (ins1 ins2 ins3).
This list is the same as this returned by (last (nentsel)) or (last (nentselp)) and selecting an entity which owns to ins1.
The matrix returned by Get-TMatrix should be the same as this returned by (caddr (nenselp)). This matrix describes the combination of all transformations.

If I understand, you want to process from the model space and going deeper and deeper in the insert to find WCS coordinates of circles.
You can see this thread for a similar problem or the following routine (adapted to your request)

EDIT corrected a bug (see below)

Code: [Select]

;; RefGeom
;; Returns a list which first item is the 3X3 tranformation matrix and second item is
;; the insertion point of a block reference in its owner (space or block definition)
(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)))
       )
     )
   )
    )
    (mapcar
      '-
      (trans (cdr (assoc 10 elst)) norm 0)
      (mxv mat
   (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
      )
    )
  )
)

;; Blk2Coord
;; Returns a list of a block reference entities coordinates
(defun Blk2Coord (ref mat ins tab / name blk ent elst typ lst)
  (setq name (cdr (assoc 2 (entget ref)))
blk (tblsearch "BLOCK" name)
ent (cdr (assoc -2 blk))
  )
  (princ (strcat tab "\"" name "\"\n"))
  (setq tab (strcat "   " tab))
  (while ent
    (setq elst (entget ent)
  typ  (cdr (assoc 0 elst))
    )
    (cond
      ((= typ "CIRCLE")
       (setq lst (cons (mapcar '+ ins (mxv mat (cdr (assoc 10 elst)))) lst))
       (princ
(strcat tab typ (vl-princ-to-string (car lst)) "\n")
       )
      )
      ((= "INSERT" typ)
(setq nent (RefGeom ent)
      lst  (append
     (Blk2Coord ent
(mxm mat (car nent))
(mapcar '+ ins (mxv mat (cadr nent)))
tab
     )
     lst
   )
)
      )
      (T nil)
    )
    (setq ent (entnext ent))
  )
  lst
)

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

;; Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
  m
  )
)

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

;; Testing function

(defun c:test (/ sub ss n ent mtx lst)

  (defun sub (lst)
    (if lst
      (cond
((numberp (caar lst))
(entmake (list '(0 . "POINT") (cons 10 (car lst))))
(sub (cdr lst))
)
(T
(sub (car lst))
(sub (cdr lst))
)
      )
    )
  )

  (if (setq ss (ssget "_X" '((0 . "INSERT"))))
    (repeat (setq n (sslength ss))
      (terpri)
      (setq ent (ssname ss (setq n (1- n)))
    mtx (RefGeom ent)
    lst (cons (Blk2Coord ent (car mtx) (cadr mtx) "- ") lst)
      )
    )
  )
  (sub lst)
  (textscr)
  (princ)
)
With the last drawing you upload :

Commande: test

- "a"
   - CIRCLE(-11.8027 39.3523 0.0)
   - CIRCLE(-18.6402 40.0004 0.0)
   - CIRCLE(-3.56785 42.7921 0.0)
   - CIRCLE(-12.3517 45.5839 0.0)

- "b"
   - CIRCLE(135.525 3.38275 0.0)
   - CIRCLE(118.83 11.5808 0.0)
   - CIRCLE(108.331 7.70183 0.0)

- "c"
   - CIRCLE(93.3055 56.1015 0.0)
   - CIRCLE(79.2249 78.264 0.0)

- "gg"
   - "e"
      - "c"
         - CIRCLE(-48.5442 -51.8403 0.0)
         - CIRCLE(-62.6248 -29.6778 0.0)
      - CIRCLE(-76.492 -42.4639 0.0)
   - "dad"
      - CIRCLE(-97.7734 23.104 0.0)
      - CIRCLE(-129.775 34.8246 0.0)

[highflyingbird]

Gile,now I  found a new bug ?

The normal of this insert is '(0 0 -1),so it maybe works correctly.

Here is the dwg for test.

[Joe Burke]

Just to say I'm following this topic when I have time and I admire gile's programming prowess.

My ObjMatrix v2.lsp set of functions are well tested often used in various rotines I've written. Odd conditions, like the insertion point of a block definition is not 0,0, are taken into account.

[gile]

Thank's Joe

Gile,now I  found a new bug ?

Sorry, a trans was misplaced, I think it works now.

[highflyingbird]

It's great!Now it's perfect!
I learned a lot from this topic.
Now I am going to write a routine  about how to get the boundingBox  of  a insert.
Because just use "vla-GetBoundingBox" simply,it will get a wrong result,sometimes badly.

[jxphklibin]

Hi,gile

    Your program meets the requirements of me so much, very grateful!
    Thank!