Topic: Transforming point coordinates from UCS to another UCS using their names?

[@_Bilal]

Is there an autolisp routine to transform the point coordinates from one UCS to another UCS using UCS names?
The trans function (trans pt 0 1) transform 'pt' coordinates from WCS to current UCS, what if replacing
0 and 1 by UCS names, some thing like that.

[MP]

Deja 2.

[gile]

Hi,

You can try this.

Code - Auto/Visual Lisp: [Select]

1. ;; V^V
2. ;; Cross product of two vectors
3. (defun v^v (u v)
4.   (list (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
5.         (- (* (caddr u) (car v)) (* (car u) (caddr v)))
6.         (- (* (car u) (cadr v)) (* (cadr u) (car v)))
7.   )
8. )
9.  
10. ;; MXV
11. ;; Apply a matrix to a vector -Vladimir Nesterovsky-
12. (defun mxv (m v)
13.   (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
14.           m
15.   )
16. )
17.  
18. ;; TRP
19. ;; Transpose a matrix
20. (defun trp (m) (apply 'mapcar (cons 'list m)))
21.  
22. ;; NUCS2WCS
23. ;; Tranform a point from a named UCS to WCS
24. (defun nucs2wcs (pt name / ucs o x y z)
25.   (if (setq ucs (tblsearch "UCS" name))
26.     (progn
27.       (setq o (cdr (assoc 10 ucs))
28.             x (cdr (assoc 11 ucs))
29.             y (cdr (assoc 12 ucs))
30.             z (v^v x y)
31.       )
32.       (mapcar '+ (mxv (trp (list x y z)) pt) o)
33.     )
34.   )
35. )
36.  
37. ;; WCS2NUCS
38. ;; Tranform a point from WCS to a named UCS
39. (defun wcs2nucs (pt name / ucs o x y z)
40.   (if (setq ucs (tblsearch "UCS" name))
41.     (progn
42.       (setq o (cdr (assoc 10 ucs))
43.             x (cdr (assoc 11 ucs))
44.             y (cdr (assoc 12 ucs))
45.             z (v^v x y)
46.       )
47.       (mxv (list x y z) (mapcar '- pt o))
48.     )
49.   )
50. )

[gile]

Another way using a 4x4 matrix.
It has some overhead in case of transforming a point, but the 4x4 matrices returned by TmatrixFromNamedToWorld and TmatrixFromWorldToName can also be used with vla-TransformBy to transform entities.

Code - Auto/Visual Lisp: [Select]

1. ;; TmatrixFromNamedToWorld
2. ;; Returns the transformation matrix (4x4) from named UCS to WCS
3. (defun TmatrixFromNamedToWorld (name / ucs o x y z m)
4.   (if (setq ucs (tblsearch "UCS" name))
5.     (setq o (cdr (assoc 10 ucs))
6.           x (cdr (assoc 11 ucs))
7.           y (cdr (assoc 12 ucs))
8.           z (v^v x y)
9.           m (append
10.               (mapcar
11.                 (function (lambda (v x) (append v (list x))))
12.                 (trp (list x y z))
13.                 o
14.               )
15.               '((0.0 0.0 0.0 1.0))
16.             )
17.     )
18.   )
19. )
20.  
21. ;; TmatrixFromWorldToName
22. ;; Returns the transformation matrix (4x4) from WCS to named UCS
23. (defun TmatrixFromWorldToName (name / ucs o x y z m)
24.   (if (setq ucs (tblsearch "UCS" name))
25.     (setq o (cdr (assoc 10 ucs))
26.           x (cdr (assoc 11 ucs))
27.           y (cdr (assoc 12 ucs))
28.           z (v^v x y)
29.           m (list x y z)
30.           m (append
31.               (mapcar
32.                 (function (lambda (v x) (append v (list x))))
33.                 m
34.                 (mxv m (mapcar '- o))
35.               )
36.               '((0.0 0.0 0.0 1.0))
37.             )
38.     )
39.   )
40. )

To transform a point:

Code - Auto/Visual Lisp: [Select]

1. ;; gc:TransformBy
2. ;; Apply the transformation matrix (4x4) to a point
3. (defun gc:TransformBy (pt mat)
4.   ((lambda (m d)
5.      (mapcar '+ (mxv m pt) d)
6.    )
7.     (list
8.       (list (caar mat) (cadar mat) (caddar mat))
9.       (list (caadr mat) (cadadr mat) (caddr (cadr mat)))
10.       (list (caaddr mat) (cadr (caddr mat)) (caddr (caddr mat)))
11.     )
12.     (list (cadddr (car mat))
13.           (cadddr (cadr mat))
14.           (cadddr (caddr mat))
15.     )
16.   )
17. )

[@_Bilal]

Thank you Gile for your reply
I am trying to understand the two methods, and I will return back to you to clarify some issues.

Thanks again 

[@_Bilal]

Hi Seagul

I was trying to delete the last one but I have no permission to do delete my post even before any reply!

[kdub_nz]

Hi Seagul

I was trying to delete the last one but I have no permission to do delete my post even before any reply!

Done.

[Grrr1337]

Nice functions, Gile!

[@_Bilal]

Thank you Gile,

Before, I was little bit confused how TPR and mxv working, but now every things is clear
I tested all functions as below, and I got accurate results whatever the current UCS is.
 
(defun Transbynames ( pta ucsa ucsb / ptw )
(setq ptw (nucs2wcs pta ucsa))
(setq ptb (wcs2nucs ptw ucsb))
)

Bilal

[gile]

You're welcome.

you can simply do:

Code - Auto/Visual Lisp: [Select]

1. (defun Transbynames (pt ucsfrom ucsto)
2.   (wcs2nucs (nucs2wcs pta ucsa) ucsb)
3. )

[@_Bilal]

mmmh,  yes
Burning mind