Topic: Transforming point from a nested block insertion

[mkweaver]

I am having trouble transforming a point from inside a block to the current ucs.  Ultimately my block insertion will be nested several levels deep, but to get my head wrapped around what I need to do I have simplified it to a single block, but still can't get it to work.

Given a simple block insertion with a nested circle. If I use nentsel to select the block I get the circle entity.  I then get the center of the circle (assoc 10) and want to translate that point back to the current ucs.  Help, on the lisp trans function, tells me: "If you use an entity name for the "from" or "to" argument, it must be passed in the format returned by the entnext, entlast, entsel, nentsel, and ssname functions."  When I try to do this I get an error, thus:

Code: [Select]

(setq ent (nentsel))
(<Entity name: 7ed08660> (13.8573 10.5027 0.0) ((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0) (13.8074 10.3804 0.0)) (<Entity name: 7ed0a978>))
_$ (setq elist (entget (car ent)))
((-1 . <Entity name: 7ed08660>) (0 . "CIRCLE") (330 . <Entity name: 7ed08620>) (5 . "237B0590C") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbCircle") (10 2.08167e-017 -4.16334e-017 0.0) (40 . 0.125) (210 0.0 0.0 1.0))
_$ (setq p0 (cdr (assoc 10 elist)))
(2.08167e-017 -4.16334e-017 0.0)
_$ (trans p0 ent 1)
; error: bad argument type: coordinate system specification: (<Entity name: 7ed08660> (13.8573 10.5027 0.0) ((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0) (13.8074 10.3804 0.0)) (<Entity name: 7ed0a978>))
When I reduce the from argument to a simple entity name, trans returns nil:

Code: [Select]

(trans p0 (car ent) 1)
nilUsing a simple entity name doesn't make sense to me since all insertions of this block will have the same entity name for the circle and I don't see how the trans function will know which insertion I'm translating from.

I have used the trans function before without problem, but can't seem to get it to work now.

Suggestions are welcome.

[T.Willey]

See if this thread helps you.
[ http://www.theswamp.org/index.php?topic=14771.0 ]

[gile]

Hi,

The coodinates returned by (cdr (assoc 10 (entget (car (nentsel))))) on a nested entity are the entity coordinates in the 'parent' block definition.
The nentsel function (as nentselp) provides also a transformation matrix which describes all the transformations of the entity whatever the nesting level.
This matrix can be used to get the coordinates transformation to WCS (and then to current UCS using trans).

The following routine do this stuff.
To get the UCS coordinates :

(setq ent (nentsel))
(trans (Rcs2Wcs (cdr (assoc 10 (entget (car ent)))) (caddr ent)) 0 1)

Code: [Select]

;; RCS2WCS (gile)
;; Translates coordinates from Reference (block or xref) Coordinate System to WCS
;; Arguments :
;; pt : a point in RCS, got by (cdr (assoc 10 (entget (car (nentsel))))) i.e.
;; mat : a transformation matrix as those returned either by (caddr (nentsel)) or (caddr (nentselp))

(defun RCS2WCS (pt mat)
  (if (= 3 (length (car mat)))
    (mapcar '+ (mxv (trp (butlast mat)) pt) (last mat))
    (mapcar '+
    (mxv (mapcar 'butlast (butlast mat)) pt)
    (butlast (mapcar 'last mat))
    )
  )
)

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

;; BUTLAST Returns a list but last item
(defun butlast (l) (reverse (cdr (reverse l))))
The inverse function needs to inverse the matrix, so some more sub routines are needed

<EDIT: updated the inverseMatrix routine>

Code: [Select]

;; WCS2RCS (gile)
;; Translates coordinates from WCS to Reference (block or xref) Coordinate System
;; pt : a point in WCS
;; mat : a transformation matrix as those returned either by (caddr (nentsel)) or (caddr (nentselp))

(defun WCS2RCS (pt mat)
  (setq pt (trans pt 0 0))
  (if (= 3 (length (car mat)))
    (setq mat (append (trp mat) (list '(0.0 0.0 0.0 1.0))))
  )
  (setq mat (InverseMatrix mat))
  (mapcar '+ (mxv mat pt) (butlast (mapcar 'last mat)))
)

;; InverseMatrix (gile) 2009/03/17
;; Uses the Gauss-Jordan elimination method to calculate the inverse
;; matrix of any dimension square matrix
;;
;; Argument : a square matrix
;; Return : the inverse matrix (or nil if singular)

(defun InverseMatrix (mat / col piv row res)
  (setq mat (mapcar '(lambda (x1 x2) (append x1 x2)) mat (Imat (length mat))))
  (while mat
    (setq col (mapcar '(lambda (x) (abs (car x))) mat))
    (repeat (vl-position (apply 'max col) col)
      (setq mat (append (cdr mat) (list (car mat))))
    )
    (if (equal (setq piv (caar mat)) 0.0 1e-14)
      (setq mat nil
    res nil
      )
      (setq piv (/ 1.0 piv)
    row (mapcar '(lambda (x) (* x piv)) (car mat))
    mat (mapcar
  '(lambda (r / e)
     (setq e (car r))
     (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
   )
  (cdr mat)
)
    res (cons
  (cdr row)
  (mapcar
    '(lambda (r / e)
       (setq e (car r))
       (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
     )
    res
  )
)
      )
    )
  )
  (reverse res)
)

;; IMAT (gile)
;; Returns the specified dimension identity matrix
;;
;; Argument
;; d : the matrix dimension (positive integer)

(defun Imat (d / i n r m)
  (setq i d)
  (while (<= 0 (setq i (1- i)))
    (setq n d r nil)
    (while (<= 0 (setq n (1- n)))
      (setq r (cons (if (= i n) 1.0 0.0) r))
    )
    (setq m (cons r m))
  )
)

[mkweaver]

Thanks for all the great code and links.  I've solved my imediate problem, though I will still have to spend some time with this before I can say I "understand" the concepts and procedures.

thanks, again.
Mike