Usage of the TRANS function

[doaiena]

Hello,

The last few days i've been searching through the forums, but couldn't find an answer, so i'm asking here.

I want to translate a point from a custom UCS to WCS, but i dont want to change the current UCS. I know this sounds stupid, so i'll give an example:

point= (10 10 0) /in WCS coords/

WCS = (1 0 0)(0 1 0)(0 0 1)
UCS = (0 1 0)(1 0 0)(0 0 -1)

I want to translate the point from WCS to a different UCS without changing the current UCS. Something like:
(trans point 0 '((0 0 -1)(1 0 0) (0 -1 0)))

For now i change the current UCS using (vl-cmdf "_.ucs" "_3p"), (trans point 0 1), then restore it using (vl-cmdf "_.ucs" "_p"). I want to skip the command calls and translate the point using another method, but i don't know how.

Can the TRANS function recieve a coordinate system written by me, instead of using UCS. Or can i translate the point by some other means.

Thank you in advance.

[doaiena]

Hello,

The last few days i've been searching through the forums, but couldn't find an answer, so i'm asking here.

I want to translate a point from a custom UCS to WCS, but i dont want to change the current UCS. I know this sounds stupid, so i'll give an example:

point= (10 10 0) /in WCS coords/

WCS = (1 0 0)(0 1 0)(0 0 1)
UCS = (0 1 0)(1 0 0)(0 0 -1)

I want to translate the point from WCS to a different UCS without changing the current UCS. Something like:
(trans point 0 '((0 0 -1)(1 0 0) (0 -1 0)))

For now i change the current UCS using (vl-cmdf "_.ucs" "_3p"), (trans point 0 1), then restore it using (vl-cmdf "_.ucs" "_p"). I want to skip the command calls and translate the point using another method, but i don't know how.

Can the TRANS function recieve a coordinate system written by me, instead of using UCS. Or can i translate the point by some other means.

Thank you in advance.

[dlanorh]

Hope this helps. UCS is what you set.

(setq w_pt '(10.0 10.0 0.0);pt in wcs (but can also be a vector)
      u_pt (trans w_pt 0 1);trans w_pt into ucs
      x_pt (trans u_pt 1 0);trans u_pt into wcs
)

; usage (trans pt from to)
; 0 = wcs ; 1 = ucs : 2 = Display (dcs used with 3) 3 = Paper Space dcs (used with 2)

[dlanorh]

Hope this helps. UCS is what you set.

(setq w_pt '(10.0 10.0 0.0);pt in wcs (but can also be a vector)
      u_pt (trans w_pt 0 1);trans w_pt into ucs
      x_pt (trans u_pt 1 0);trans u_pt into wcs
)

; usage (trans pt from to)
; 0 = wcs ; 1 = ucs : 2 = Display (dcs used with 3) 3 = Paper Space dcs (used with 2)

[marko_ribar · Accepted solution]

; defined global variables - *uo* - origin ; *ux* - x axis vector ; *uy* - y axis vector

(defun transpt ( p from to / unit mxv v^v transptucs transptwcs )

  ; transptucs & transptwcs by M.R. (Marko Ribar, d.i.a.)
  ; arguments : 
  ; pt - point to be transformed from WCS to imaginary UCS with transptucs and from imaginary UCS to WCS with transptwcs
  ; pt1 - origin of imaginary UCS
  ; pt2 - point to define X axis of imaginary UCS (vector pt1-pt2 represents X axis)
  ; pt3 - point to define Y axis of imaginary UCS (vector pt1-pt3 represents Y axis)
  ; important note : angle between X and Y axises of imaginary UCS must always be 90 degree for correct transformation calculation

  ;; Unit Vector - M.R.
  ;; Args: v - vector in R^n

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  ;; Matrix x Vector - Vladimir Nesterovsky
  ;; Args: m - nxn matrix, v - vector in R^n

  (defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  )

  ;; Vector Cross Product - Lee Mac
  ;; Args: u,v - vectors in R^3

  (defun v^v ( u v )
    (list
      (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
      (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
      (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
    )
  )

  (defun transptucs ( pt p1 p2 p3 / ux uy uz )
    (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
    (setq ux (unit (mapcar '- p2 p1)))
    (setq uy (unit (mapcar '- p3 p1)))
    
    (mxv (list ux uy uz) (mapcar '- pt p1))
  )

  (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
    (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
    (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
    (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
    (transptucs pt pt1n pt2n pt3n)
  )
  
  (cond
    ( (and (eq from 0) (eq to 1))
      (transptucs p *uo* (mapcar '+ *uo* *ux*) (mapcar '+ *uo* *uy*))
    )
    ( (and (eq from 1) (eq to 0))
      (transptwcs p *uo* (mapcar '+ *uo* *ux*) (mapcar '+ *uo* *uy*))
    )
  )
)

HTH., M.R.

[marko_ribar · Accepted solution]

; defined global variables - *uo* - origin ; *ux* - x axis vector ; *uy* - y axis vector

(defun transpt ( p from to / unit mxv v^v transptucs transptwcs )

  ; transptucs & transptwcs by M.R. (Marko Ribar, d.i.a.)
  ; arguments : 
  ; pt - point to be transformed from WCS to imaginary UCS with transptucs and from imaginary UCS to WCS with transptwcs
  ; pt1 - origin of imaginary UCS
  ; pt2 - point to define X axis of imaginary UCS (vector pt1-pt2 represents X axis)
  ; pt3 - point to define Y axis of imaginary UCS (vector pt1-pt3 represents Y axis)
  ; important note : angle between X and Y axises of imaginary UCS must always be 90 degree for correct transformation calculation

  ;; Unit Vector - M.R.
  ;; Args: v - vector in R^n

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  ;; Matrix x Vector - Vladimir Nesterovsky
  ;; Args: m - nxn matrix, v - vector in R^n

  (defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  )

  ;; Vector Cross Product - Lee Mac
  ;; Args: u,v - vectors in R^3

  (defun v^v ( u v )
    (list
      (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
      (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
      (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
    )
  )

  (defun transptucs ( pt p1 p2 p3 / ux uy uz )
    (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
    (setq ux (unit (mapcar '- p2 p1)))
    (setq uy (unit (mapcar '- p3 p1)))
    
    (mxv (list ux uy uz) (mapcar '- pt p1))
  )

  (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
    (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
    (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
    (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
    (transptucs pt pt1n pt2n pt3n)
  )
  
  (cond
    ( (and (eq from 0) (eq to 1))
      (transptucs p *uo* (mapcar '+ *uo* *ux*) (mapcar '+ *uo* *uy*))
    )
    ( (and (eq from 1) (eq to 0))
      (transptwcs p *uo* (mapcar '+ *uo* *ux*) (mapcar '+ *uo* *uy*))
    )
  )
)

HTH., M.R.

[_gile · Accepted solution]

Hi,

Assuming the origin of the coordinate system is (0 0 0), you can simply apply the matrix to the point as if it was a vector.

;; MXV
;; Applies a matrix to a vector -Vladimir Nesterovsky-
;;
;; Arguments-
;; m : matrix
;; v : vector
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)

Doing:

(mxv '((0 0 -1) (1 0 0) (0 -1 0)) '(10 10 0))

returns : (0 10 -10)

[_gile · Accepted solution]

Hi,

Assuming the origin of the coordinate system is (0 0 0), you can simply apply the matrix to the point as if it was a vector.

;; MXV
;; Applies a matrix to a vector -Vladimir Nesterovsky-
;;
;; Arguments-
;; m : matrix
;; v : vector
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)

Doing:

(mxv '((0 0 -1) (1 0 0) (0 -1 0)) '(10 10 0))

returns : (0 10 -10)

[doaiena]

Wow, such elegant solutions. Thank you very much @marko_ribar and @_gile . You both are true masters of the craft.

[doaiena]

Wow, such elegant solutions. Thank you very much @marko_ribar and @_gile . You both are true masters of the craft.

[_gile]

In this case all the credit goes to Vladimir Nesterovsky who wrote this 'mxv' function in the last century.

[_gile]

In this case all the credit goes to Vladimir Nesterovsky who wrote this 'mxv' function in the last century.

[_gile · Accepted solution]

If the UCS origin is different from (0 0 0), you can use these routines.

;; MXV
;; Applies a matrix to a vector -Vladimir Nesterovsky-
;;
;; Arguments-
;; m : matrix
;; v : vector
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
	  m
  )
)

;; TRP
;; Transposes a matrix -Doug Wilson-
;;
;; Argument
;; m : une matrice
(defun trp (m) (apply 'mapcar (cons 'list m)))

;; TRANSFROMWCS
;; Translates a point from WCS to a virtual UCS
;;
;; Arguments
;; pt  : point to translate
;; mat : transformation 3x3 matrix from WCS to of the virtual UCS
;; org : WCS coordinates of the origin of the virtual UCS
(defun transfromwcs (pt mat org)
  (mxv mat (mapcar '- pt org))
)

;; TRANSTOWCS
;; Translates a point from a virtual UCS to WCS
;;
;; Arguments
;; pt  : point to translate
;; mat : transformation 3x3 matrix from WCS to the virtual UCS
;; org : WCS coordinates of the origin of the virtual UCS
(defun transtowcs (pt mat org)
  (mapcar '+ (mxv (trp mat) pt) org)
)

[_gile · Accepted solution]

If the UCS origin is different from (0 0 0), you can use these routines.

;; MXV
;; Applies a matrix to a vector -Vladimir Nesterovsky-
;;
;; Arguments-
;; m : matrix
;; v : vector
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
	  m
  )
)

;; TRP
;; Transposes a matrix -Doug Wilson-
;;
;; Argument
;; m : une matrice
(defun trp (m) (apply 'mapcar (cons 'list m)))

;; TRANSFROMWCS
;; Translates a point from WCS to a virtual UCS
;;
;; Arguments
;; pt  : point to translate
;; mat : transformation 3x3 matrix from WCS to of the virtual UCS
;; org : WCS coordinates of the origin of the virtual UCS
(defun transfromwcs (pt mat org)
  (mxv mat (mapcar '- pt org))
)

;; TRANSTOWCS
;; Translates a point from a virtual UCS to WCS
;;
;; Arguments
;; pt  : point to translate
;; mat : transformation 3x3 matrix from WCS to the virtual UCS
;; org : WCS coordinates of the origin of the virtual UCS
(defun transtowcs (pt mat org)
  (mapcar '+ (mxv (trp mat) pt) org)
)

[juanraXSVE3]

Sorry Giles... Can you explain the matrix concept... I'm not sure understanding correctly this issue...

I have some arc's created in a different UCS, and I want to make a "Flatten" to all of them... So, I need to get start point, end point and middle point projected on WCS... to create a new arc with these 3 points...

I think that your functions works well from this issue... but I don't understand matrix concept...

Thanks

[juanraXSVE3]

Sorry Giles... Can you explain the matrix concept... I'm not sure understanding correctly this issue...

I have some arc's created in a different UCS, and I want to make a "Flatten" to all of them... So, I need to get start point, end point and middle point projected on WCS... to create a new arc with these 3 points...

I think that your functions works well from this issue... but I don't understand matrix concept...

Thanks

[_gile]

@juanraXSVE3 

You do not need a transformation matrix to project points on the WCS XY plane. Simply get the WCS coordinates of the points (the vlax-curve* functions always return WCS coordinates) and replace the Z coordinates with 0.

But you have to keep in mind that projecting a circle (or an arc) to a plane which is not parallel to the circle (or the arc) generates an ellipse (or an elliptical arc).

[_gile]

@juanraXSVE3 

You do not need a transformation matrix to project points on the WCS XY plane. Simply get the WCS coordinates of the points (the vlax-curve* functions always return WCS coordinates) and replace the Z coordinates with 0.

But you have to keep in mind that projecting a circle (or an arc) to a plane which is not parallel to the circle (or the arc) generates an ellipse (or an elliptical arc).

[_gile]

Here's a way to flatten a circle whatever the plane it lies on. It will be a little more complex with arcs.

(defun gc:VecLength (v) (distance '(0. 0. 0.) v))

(defun gc:ScaleVector (v s)
  (mapcar (function (lambda (x) (* x s))) v)
)

(defun gc:DotProduct (u v) (apply '+ (mapcar '* u v)))

(defun gc:CrossProduct (u v)
  (list	(- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
	(- (* (caddr u) (car v)) (* (car u) (caddr v)))
	(- (* (car u) (cadr v)) (* (cadr u) (car v)))
  )
)

(defun gc:GetNormal (v)
  ((lambda (l)
     (if (/= 0 l)
       (gc:ScaleVector v (/ 1. l))
     )
   )
    (gc:VecLength v)
  )
)

;; Projects a circle on XY plane
(defun flattenCircle (circle / elst center radius normal flatNormal ang majAxis)
  (setq	elst   (entget circle)
	normal (cdr (assoc 210 elst))
	center (trans (cdr (assoc 10 elst)) normal 0)
	center (list (car center) (cadr center) 0.)
	radius (cdr (assoc 40 elst))
  )
  (cond
    ((equal normal '(0. 0. 1.) 1e-9)
     (entmakex (list (assoc 0 elst)
		    (cons 10 center)
		    (cons 40 radius)
		    '(210 0. 0. 1.)
	      )
     )
    )
    ((equal normal '(0. 0. -1.) 1e-9)
     (entmakex (list (assoc 0 elst)
		    (cons 10 center)
		    (cons 10 radius)
		    '(210 0. 0. -1.)
	      )
     )
    )
    ((equal (caddr normal) 0. 1e-9)
      (setq ang (+ (* pi 0.5) (angle '(0. 0.) (list (car normal) (cadr normal)))))
      (entmakex
	(list
	  (cons 0 "LINE")
	  (cons 10 (polar center ang radius))
	  (cons 11 (polar center ang (- radius)))
	)
      )
    )
    (T
     (setq flatNormal (list (car normal) (cadr normal) 0.)
	   majAxis    (gc:ScaleVector
			(gc:GetNormal
			  (gc:CrossProduct normal flatNormal)
			)
			radius
		      )
	   ratio      (/ (gc:DotProduct normal '(0. 0. 1.))
			 (gc:VecLength normal)
		      )
     )
     (entmakex
       (list
	 (cons 0 "ELLIPSE")
	 (cons 100 "AcDbEntity")
	 (cons 100 "AcDbEllipse")
	 (cons 10 center)
	 (cons 11 majAxis)
	 (cons 40 ratio)
	 (cons 41 0.)
	 (cons 42 (* 2. pi))
       )
     )
    )
  )
)

[_gile]

Here's a way to flatten a circle whatever the plane it lies on. It will be a little more complex with arcs.

(defun gc:VecLength (v) (distance '(0. 0. 0.) v))

(defun gc:ScaleVector (v s)
  (mapcar (function (lambda (x) (* x s))) v)
)

(defun gc:DotProduct (u v) (apply '+ (mapcar '* u v)))

(defun gc:CrossProduct (u v)
  (list	(- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
	(- (* (caddr u) (car v)) (* (car u) (caddr v)))
	(- (* (car u) (cadr v)) (* (cadr u) (car v)))
  )
)

(defun gc:GetNormal (v)
  ((lambda (l)
     (if (/= 0 l)
       (gc:ScaleVector v (/ 1. l))
     )
   )
    (gc:VecLength v)
  )
)

;; Projects a circle on XY plane
(defun flattenCircle (circle / elst center radius normal flatNormal ang majAxis)
  (setq	elst   (entget circle)
	normal (cdr (assoc 210 elst))
	center (trans (cdr (assoc 10 elst)) normal 0)
	center (list (car center) (cadr center) 0.)
	radius (cdr (assoc 40 elst))
  )
  (cond
    ((equal normal '(0. 0. 1.) 1e-9)
     (entmakex (list (assoc 0 elst)
		    (cons 10 center)
		    (cons 40 radius)
		    '(210 0. 0. 1.)
	      )
     )
    )
    ((equal normal '(0. 0. -1.) 1e-9)
     (entmakex (list (assoc 0 elst)
		    (cons 10 center)
		    (cons 10 radius)
		    '(210 0. 0. -1.)
	      )
     )
    )
    ((equal (caddr normal) 0. 1e-9)
      (setq ang (+ (* pi 0.5) (angle '(0. 0.) (list (car normal) (cadr normal)))))
      (entmakex
	(list
	  (cons 0 "LINE")
	  (cons 10 (polar center ang radius))
	  (cons 11 (polar center ang (- radius)))
	)
      )
    )
    (T
     (setq flatNormal (list (car normal) (cadr normal) 0.)
	   majAxis    (gc:ScaleVector
			(gc:GetNormal
			  (gc:CrossProduct normal flatNormal)
			)
			radius
		      )
	   ratio      (/ (gc:DotProduct normal '(0. 0. 1.))
			 (gc:VecLength normal)
		      )
     )
     (entmakex
       (list
	 (cons 0 "ELLIPSE")
	 (cons 100 "AcDbEntity")
	 (cons 100 "AcDbEllipse")
	 (cons 10 center)
	 (cons 11 majAxis)
	 (cons 40 ratio)
	 (cons 41 0.)
	 (cons 42 (* 2. pi))
       )
     )
    )
  )
)