[Help] How to get mirror point by Trans ?

[ketxu]

Good day all of you.

I'm trying to write a function to get mirror point (Return) of a point (P) through P1 & P2. Let me show Picture to help my poor English :

How can i do it with Trans function ^^

Thank you very much

[Tharwat]

This ... ?

 

(if
 (and
   (setq p1 (getpoint "\n First Point :"))
   (setq p2 (getpoint p1 "\n Second Point :"))
   (setq p (getpoint "\n Third Point :"))
 )
  (progn
    (setq return (polar p (+ (angle p1 p2) (/ pi 2.)) (distance p1 p2)))
    (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
    (entmake (list '(0 . "LINE") (cons 10 p) (cons 11 return)))
  )
)

[marko_ribar]

Tharwat, you didn't calculate distance correctly... Try this :

 

(defun nor ( v )
 (polar '(0 0 0) (+ (angle '(0 0 0) v) (/ PI 2)) 1.0)
)

(defun pld ( a b p / ab nab pp ppp d )
 (setq ab (mapcar '- b a))
 (setq nab (nor ab))
 (setq pp (mapcar '+ p nab))
 (setq ppp (inters a b p pp nil))
 (setq d (distance p ppp))
 d
)

(defun c:ptmirror ( / p1 p2 p return )
 (if
   (and
     (setq p1 (getpoint "\n First Point :"))
     (setq p2 (getpoint p1 "\n Second Point :"))
     (setq p (getpoint "\n Third Point :"))
   )
    (progn
      (setq return (polar p ([highlight]-[/highlight] (angle p1 p2) (/ pi 2.)) [highlight](* 2. (pld p1 p2 p))[/highlight]))
      (entmake (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p2 1 0))))
      (entmake (list '(0 . "LINE") (cons 10 (trans p 1 0)) (cons 11 (trans return 1 0))))
    )
 )
(princ)
)

M.R.

 

Note : Your third picked point must be on left side from drawn line - first point to second from bottom to top. Just like shown on picture only p1 and p2 should have opposite positions...

Edited November 28, 2011 by marko_ribar
read note

[marko_ribar]

Here is another one using my sub functions (transptucs) & (transptwcs)... Although all is based on trans function, I still had to use subfunction int-line-plane to obtain closest point to line from your point... Maybe there is even better and easier way, but this is also OK - works in 3D and code is in Vanilla ALISP :

 

; 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

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

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
 ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
 (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
 (sqrt (apply '+ (mapcar '* v v)))
)

(defun transptucs ( pt pt1 pt2 pt3 / u v n uu vv ptt pt1u ptx pty ptz )
 (setq u (mapcar '- pt2 pt1))
 (setq v (mapcar '- pt3 pt1))
 (setq n (unit (v^v u v)))
 (setq uu (unit u))
 (setq vv (unit v))
 (setq ptt (trans pt 0 n))
 (setq pt1u (trans pt1 0 n))
 (setq ptz (caddr (mapcar '- ptt pt1u)))
 (setq ptt (trans pt 0 uu))
 (setq pt1u (trans pt1 0 uu))
 (setq ptx (caddr (mapcar '- ptt pt1u)))
 (setq ptt (trans pt 0 vv))
 (setq pt1u (trans pt1 0 vv))
 (setq pty (caddr (mapcar '- ptt pt1u)))
 (list ptx pty ptz)
)

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

(defun int-line-plane ( pt1w pt2w pt3w ptl1w ptl2w / pt1w pt2w pt3w ptl1w ptl2w u v n ptl1n ptl2n pt1n pt4l1n pt4l2n pt4l1w pt4l2w ppw ppu )
 (if (and pt1w pt2w pt3w ptl1w ptl2w)
     (progn
       (setq u (mapcar '- pt2w pt1w))
       (setq v (mapcar '- pt3w pt1w))
       (setq n (unit (V^V u v)))
       (setq ptl1n (trans ptl1w 0 n))
       (setq ptl2n (trans ptl2w 0 n))
       (setq pt1n (trans pt1w 0 n))
       (setq pt4l1n (list (car ptl1n) (cadr ptl1n) (caddr pt1n)))
       (setq pt4l2n (list (car ptl2n) (cadr ptl2n) (caddr pt1n)))
       (setq pt4l1w (trans pt4l1n n 0))
       (setq pt4l2w (trans pt4l2n n 0))
       (setq ppw (inters ptl1w ptl2w pt4l1w pt4l2w nil))
       (setq ppu (trans ppw 0 1))
    )
 )
 ppw
)

(defun c:ptmirror ( / p1 p2 p po pu pret return )
 (if
   (and
     (setq p1 (getpoint "\n First Point on line : "))
     (setq p2 (getpoint p1 "\n Second Point on line : "))
     (setq p (getpoint "\n Third Point at dist from line : "))
   )
   (progn
     (setq p1 (trans p1 1 0))
     (setq p2 (trans p2 1 0))
     (setq p (trans p 1 0))
     (setq pp (trans p 0 (mapcar '- p1 p2)))
     (setq px (trans (mapcar '+ pp '(1.0 0.0 0.0)) (mapcar '- p1 p2) 0))
     (setq py (trans (mapcar '+ pp '(0.0 1.0 0.0)) (mapcar '- p1 p2) 0))      
     (setq po (int-line-plane p px py p1 p2))
     (setq pu (transptucs p po p p2))
     (setq pret (list (- (car pu)) (cadr pu) (caddr pu)))
     (setq return (transptwcs pret po p p2))
     (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
     (entmake (list '(0 . "LINE") (cons 10 p) (cons 11 return)))
   )
 )
(princ)
)

M.R.

Edited December 1, 2011 by marko_ribar
code changed

[pBe]

(Defun  c:test (/ p1 p2 p return )
 (if (not (member "geomcal.arx" (arx)))
   (arxload "geomcal")
   )
 (if (and
       (setq p1 (getpoint "\n First Point :"))
       (setq p2 (getpoint p1 "\n Second Point :"))
       (setq p (getpoint "\n Third Point :"))
       )
   (progn
     (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
     (setq
       return
        (polar
          p
          (+ (angle p1 p2)
             (if (> (c:cal "ang(p,p1,p2)") 180)
               (/ pi 2.)
               4.71238898
               )
             )
          (* (distance
               p
               (vlax-curve-getClosestPointTo
                 (vlax-ename->vla-object (entlast))
                 p
                 )
               )
             2.0
             )
          )
       )
     (entmake (list '(0 . "LINE") (cons 10 p) (cons 11 return)))
     )
   )
 )

[Lee Mac]

I would first refer you to my Matrix Transformation functions, which will transform an object or point list.

 

However, since you specifically asked:

 

How can i do it with Trans function ^^

 

Consider the following function:

 

;; Reflect  -  Lee Mac
;; Returns the point obtained by reflecting 'pt' in the axis defined by points p1 & p2.

(defun Reflect ( pt p1 p2 / nm )
   (setq nm (mapcar '- p1 p2)
         p1 (trans p1 0 nm)
         pt (trans pt 0 nm)
   )
   (trans (cons (- (+ (car p1) (car p1)) (car pt)) (cdr pt)) nm 0)
)

Note however, that since the trans function uses the Arbitrary Axis Algorithm to construct a Coordinate Frame from a supplied Normal Vector, the above function will return unexpected results if the UCS plane is not parallel to the WCS plane.

[pBe]

However, since you specifically asked:

 

is that what he meant by trans? silly me.. i jumped in without reading the first post

 

Nice Lee

[ketxu]

Thanks all ^^. Lee's code is what i'm looking for, but i've study more thing in all code ^^

@Lee : so i think right, trans is shoter (i work all in 2D ^^). Thank you for your link and informatioin

[Lee Mac]

Thanks all ^^. Lee's code is what i'm looking for, but i've study more thing in all code ^^

@Lee : so i think right, trans is shoter (i work all in 2D ^^). Thank you for your link and informatioin

 

You're welcome Ketxu - if you have any questions about the code, just ask

[marko_ribar]

Yes, Lee's code is surely what you're looking for... But I suggest you that you nevertheless use code that operates in 3D... Here are 2 simple examples... Much shorter than my one with transptucs and transptwcs functions... Again, Lee's sub function LM:Collinear-p is involved :

 

;; Collinear-p - Lee Mac
;; Returns T if p1,p2,p3 are collinear

(defun LM:Collinear-p ( p1 p2 p3 )
 (
   (lambda ( a b c )
     (or
       (equal (+ a b) c 1e-
       (equal (+ b c) a 1e-
       (equal (+ c a) b 1e-
     )
   )
   (distance p1 p2) (distance p2 p3) (distance p1 p3)
 )
)

(defun nor ( v )
 (polar '(0 0 0) (+ (angle '(0 0 0) v) (/ PI 2)) 1.0)
)

(defun pld ( a b p / ab nab pp ppp d )
 (setq ab (mapcar '- b a))
 (setq nab (nor ab))
 (setq pp (mapcar '+ p nab))
 (setq ppp (inters a b p pp nil))
 (setq d (distance p ppp))
 d
)

(defun c:ptmirror ( / pt1 pt2 pt pt1w pt2w ptw d pt3 pt4 )
 (if (setq pt1 (getpoint "\nFirst point on line : ")
           pt2 (getpoint "\nSecond point on line : " pt1)
           pt  (getpoint "\nPoint at dist from line : ")
     )
     (progn
       (setq pt1w (trans pt1 1 0)
             pt2w (trans pt2 1 0)
             ptw  (trans pt 1 0)
       )
       (vl-cmdf "_.UCS" "3p" pt pt1 pt2)
       (setq pt1 (trans pt1w 0 1)
             pt2 (trans pt2w 0 1)
             pt  (trans ptw 0 1)
       )
       (setq d (pld pt1 pt2 pt))
       (setq pt3 (polar pt (+ (angle pt1 pt2) (/ pi 2.0)) d))
       (if (null (LM:Collinear-p pt1 pt2 pt3))
         (setq pt3 (polar pt (- (angle pt1 pt2) (/ pi 2.0)) d))
       )
       (setq pt4 (polar pt3 (angle pt pt3) d))
       (entmakex (list '(0 . "LINE") (cons 10 pt1w) (cons 11 pt2w)))
       (entmakex (list '(0 . "LINE") (cons 10 ptw) (cons 11 (trans pt4 1 0))))
       (vl-cmdf "_.UCS" "p")
     )
 )
(princ)
)

And here is addition - c:projptonline

 

;; Collinear-p - Lee Mac
;; Returns T if p1,p2,p3 are collinear

(defun LM:Collinear-p ( p1 p2 p3 )
 (
   (lambda ( a b c )
     (or
       (equal (+ a b) c 1e-
       (equal (+ b c) a 1e-
       (equal (+ c a) b 1e-
     )
   )
   (distance p1 p2) (distance p2 p3) (distance p1 p3)
 )
)

(defun nor ( v )
 (polar '(0 0 0) (+ (angle '(0 0 0) v) (/ PI 2)) 1.0)
)

(defun pld ( a b p / ab nab pp ppp d )
 (setq ab (mapcar '- b a))
 (setq nab (nor ab))
 (setq pp (mapcar '+ p nab))
 (setq ppp (inters a b p pp nil))
 (setq d (distance p ppp))
 d
)

(defun c:projptonline ( / pt1 pt2 pt pt1w pt2w ptw d pt3 )
 (if (setq pt1 (getpoint "\nFirst point on line : ")
           pt2 (getpoint "\nSecond point on line : " pt1)
           pt  (getpoint "\nPoint at dist from line : ")
     )
     (progn
       (setq pt1w (trans pt1 1 0)
             pt2w (trans pt2 1 0)
             ptw  (trans pt 1 0)
       )
       (vl-cmdf "_.UCS" "3p" pt pt1 pt2)
       (setq pt1 (trans pt1w 0 1)
             pt2 (trans pt2w 0 1)
             pt  (trans ptw 0 1)
       )
       (setq d (pld pt1 pt2 pt))
       (setq pt3 (polar pt (+ (angle pt1 pt2) (/ pi 2.0)) d))
       (if (null (LM:Collinear-p pt1 pt2 pt3))
         (setq pt3 (polar pt (- (angle pt1 pt2) (/ pi 2.0)) d))
       )
       (entmakex (list '(0 . "LINE") (cons 10 pt1w) (cons 11 pt2w)))
       (entmakex (list '(0 . "LINE") (cons 10 ptw) (cons 11 (trans pt3 1 0))))
       (vl-cmdf "_.UCS" "p")
     )
 )
(princ)
)

Regards, M.R.

Edited November 29, 2011 by marko_ribar

[marko_ribar]

Here are more - this time pt and 3 points of a plane - mirror and project :

 

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

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
 ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
 (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
 (sqrt (apply '+ (mapcar '* v v)))
)

(defun c:ptmirroronplane ( / pt1 pt2 pt3 pt pt1w pt2w pt3w ptw u v n ptn pt1n pt4n )
 (if (setq pt1 (getpoint "\nFirst point on plane : ")
           pt2 (getpoint "\nSecond point on plane : " pt1)
           pt3 (getpoint "\nThird point on plane : " pt1)
           pt  (getpoint "\nPoint at dist from plane : ")
     )
     (progn
       (setq pt1w (trans pt1 1 0)
             pt2w (trans pt2 1 0)
             pt3w (trans pt3 1 0)
             ptw  (trans pt 1 0)
       )
       (setq u (mapcar '- pt2w pt1w))
       (setq v (mapcar '- pt3w pt1w))
       (setq n (unit (V^V u v)))
       (setq ptn (trans ptw 0 n))
       (setq pt1n (trans pt1w 0 n))
       (setq pt4n (list (car ptn) (cadr ptn) (- (+ (caddr pt1n) (caddr pt1n)) (caddr ptn))))
       (entmakex (list '(0 . "LINE") (cons 10 pt1w) (cons 11 pt2w)))
       (entmakex (list '(0 . "LINE") (cons 10 pt2w) (cons 11 pt3w)))
       (entmakex (list '(0 . "LINE") (cons 10 pt3w) (cons 11 pt1w)))
       (entmakex (list '(0 . "LINE") (cons 10 ptw) (cons 11 (trans pt4n n 0))))
     )
 )
(princ)
)

 

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

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
 ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
 (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
 (sqrt (apply '+ (mapcar '* v v)))
)

(defun c:projptonplane ( / pt1 pt2 pt3 pt pt1w pt2w pt3w ptw u v n ptn pt1n pt4n )
 (if (setq pt1 (getpoint "\nFirst point on plane : ")
           pt2 (getpoint "\nSecond point on plane : " pt1)
           pt3 (getpoint "\nThird point on plane : " pt1)
           pt  (getpoint "\nPoint at dist from plane : ")
     )
     (progn
       (setq pt1w (trans pt1 1 0)
             pt2w (trans pt2 1 0)
             pt3w (trans pt3 1 0)
             ptw  (trans pt 1 0)
       )
       (setq u (mapcar '- pt2w pt1w))
       (setq v (mapcar '- pt3w pt1w))
       (setq n (unit (V^V u v)))
       (setq ptn (trans ptw 0 n))
       (setq pt1n (trans pt1w 0 n))
       (setq pt4n (list (car ptn) (cadr ptn) (caddr pt1n)))
       (entmakex (list '(0 . "LINE") (cons 10 pt1w) (cons 11 pt2w)))
       (entmakex (list '(0 . "LINE") (cons 10 pt2w) (cons 11 pt3w)))
       (entmakex (list '(0 . "LINE") (cons 10 pt3w) (cons 11 pt1w)))
       (entmakex (list '(0 . "LINE") (cons 10 ptw) (cons 11 (trans pt4n n 0))))
     )
 )
(princ)
)

 

Regards, M.R. Again Lee's sub functions are involved...

[Lee Mac]

3D Transformations