Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Usage of the TRANS function

9 REPLIES 9
SOLVED
Reply
Message 1 of 10
doaiena
2334 Views, 9 Replies

Usage of the TRANS function

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.

9 REPLIES 9
Message 2 of 10
dlanorh
in reply to: doaiena

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)

 

I am not one of the robots you're looking for

Message 3 of 10
marko_ribar
in reply to: doaiena

; 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, d.i.a. (graduated engineer of architecture)
Message 4 of 10
_gile
in reply to: doaiena

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)

 



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 5 of 10
doaiena
in reply to: marko_ribar

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

Message 6 of 10
_gile
in reply to: doaiena

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



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 7 of 10
_gile
in reply to: _gile

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


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 8 of 10
juanraXSVE3
in reply to: _gile

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

Message 9 of 10
_gile
in reply to: juanraXSVE3

@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).



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 10 of 10
_gile
in reply to: juanraXSVE3

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

 



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost