Author Topic: Translate points about Centerline  (Read 1674 times)

0 Members and 1 Guest are viewing this topic.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Translate points about Centerline
« on: June 17, 2010, 11:43:07 PM »
Thought I'd share this 'cause  I needed it today.

Had 3dPoints and a list of 3dPoints I needed to mirror around an axis.

assume the axis is the X vector of the current UCS.
Code: [Select]
 (setq flip_Y   (list 1. -1. 1.)
        ptList   (list 10. 20. 0.)
        vertList (list '(1 2 3) '(4 5 6) '(7 8 9))
  )
  (setq tst (mapcar '* ptList flip_Y))
  (setq tst2 (mapcar '(lambda (p) (mapcar '* p flip_Y) ) vertList))

  ;;=>> (10.0 -20.0 0.0)
  ;;=>> ((1.0 -2.0 3.0) (4.0 -5.0 6.0) (7.0 -8.0 9.0))


There are probably several ways t do this, but this worked on the fly for me ...

the data was a little more complicated and dynamic than shown here :)
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Lee Mac

  • Seagull
  • Posts: 12924
  • London, England
Re: Translate points about Centerline
« Reply #1 on: June 18, 2010, 06:51:09 AM »
Nice one Kerry  :-)

There's perhaps a better way to do this, but this should reflect any vector about any line through the origin:

Code: [Select]
;; Returns the reflection of a vector about a line
;; through the origin.
(defun LM:ReflectVector ( vec mir / m )
  ;; © Lee Mac  ~  18.06.10
  (setq m
    (* 2.
      (apply '/
        (mapcar 'LM:DotProd (list vec mir) (list mir mir))
      )
    )
  )
  (mapcar '- (mapcar '* (list m m m) mir) vec)
)

;; Returns the Dot Product (Inner Product) of two vectors
(defun LM:DotProd ( v1 v2 ) (apply '+ (mapcar '* v1 v2)))

With a little more work, to reflect a point about a line defined by two arbitrary points:

Code: [Select]
;; Reflect Point (Lee Mac)
;; Returns the reflection of a point p1 about a line
;; defined by p2 and p3
(defun LM:ReflectPoint ( p1 p2 p3 / m )
  (setq n (LM:Unit (mapcar '- p3 p2)))

  (apply 'mapcar
    (cons '+
      (mapcar 'LM:VxS       
        (list p1 p2  (LM:VxS n 2.))
        (list -1. 2. (LM:DotProd (mapcar '- p1 p2) n))
      )
    )
  )
)

;; Unit Vector (Lee Mac)
;; Returns v expressed as a unit vector
(defun LM:Unit ( v / norm )
  (setq norm
    (sqrt
      (apply '+
        (mapcar '(lambda ( x ) (* x x)) v)
      )
    )
  )
  (mapcar '(lambda ( x ) (/ x norm)) v)
)

;; Dot Product (Lee Mac)
;; Returns the Dot Product (Inner Product) of two vectors
(defun LM:DotProd ( v1 v2 ) (apply '+ (mapcar '* v1 v2)))

;; Scaled Vector (Lee Mac)
;; Multiplies each component of a vector by a scalar
(defun LM:VxS ( v s ) (mapcar '(lambda ( x ) (* x s)) v))
« Last Edit: June 18, 2010, 07:29:18 AM by Lee Mac »

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Translate points about Centerline
« Reply #2 on: June 18, 2010, 08:56:15 AM »
My old program to create a matrix of reflection, an arbitrary plane.
You may need... 

Code: [Select]
(defun v_norm_2v (v1 v2)
 ;; ElpanovEvgeniy
 ;; 10.01.07
 ;; Функция вычисления вектора нормали по двум векторам
 ;; The function calculating the normal vector of two vectors
 ;; (v_norm_2v v1 v2)
 ;; (v_norm_2v '(5. 10. 0.) '(1. 2. 3.))
 ((lambda (a b)
   (mapcar (function (lambda (a1 b1 a2 b2) (- (* a1 b1) (* a2 b2)))) a (cdr b) b (cdr a))
  ) ;_  lambda
  (list (cadr v1) (caddr v1) (car v1) (cadr v1))
  (list (cadr v2) (caddr v2) (car v2) (cadr v2))
 )
)
(defun vxv (v1 v2) (apply (function +) (mapcar (function *) v1 v2)))
(defun mxv (m v) (mapcar (function (lambda (r) (vxv r v))) m))
(defun Matrix-Symmetry-Plane (vpt v / P V1)
                             ;|
 ;; ElpanovEvgeniy
 ;; 08.10.06
;; Вычисление матрицы (4*4) симметрии точки, относительно плоскости
;; заданной точкой и вектором нормали
vpt - точка на плоскости для симметрии
v - вектор нормали к плоскости для симметрии

 ;; ElpanovEvgeniy
 ;; 08.10.06
,; Calculation of the matrix (4 * 4) symmetry points in the plane
,; Given point and normal vector
vpt - a point on the plane for symmetry
v - vector normal to the plane of symmetry for


(setq vpt '(1. 2. 3.)
      v   '(1. 1. 0.)
)
(Matrix-Symmetry-Plane vpt v)
(Matrix-Symmetry-Plane '(-1. 0. 0.) '(1. 1. 0.))

     
 |;
 (setq v1 (vxv v v))
 (mxm (list (list 1. 0. 0. (car vpt))
            (list 0. 1. 0. (cadr vpt))
            (list 0. 0. 1. (caddr vpt))
            '(0. 0. 0. 1.)
      ) ;_  list
      (mxm (list (list (/ (apply (function +) (mapcar (function *) v v '(-1. 1. 1.))) v1)
                       (/ (* -2. (car v) (cadr v)) v1)
                       (/ (* -2. (car v) (caddr v)) v1)
                       0.
                 ) ;_  list
                 (list (/ (* -2. (car v) (cadr v)) v1)
                       (/ (apply (function +) (mapcar (function *) v v '(1. -1. 1.))) v1)
                       (/ (* -2. (cadr v) (caddr v)) v1)
                       0.
                 ) ;_  list
                 (list (/ (* -2. (car v) (caddr v)) v1)
                       (/ (* -2. (cadr v) (caddr v)) v1)
                       (/ (apply (function +) (mapcar (function *) v v '(1. 1. -1.))) v1)
                       0.
                 ) ;_  list
                 '(0. 0. 0. 1.)
           ) ;_  list
           (list (list 1. 0. 0. (- (car vpt)))
                 (list 0. 1. 0. (- (cadr vpt)))
                 (list 0. 0. 1. (- (caddr vpt)))
                 '(0. 0. 0. 1.)
           ) ;_  list
      ) ;_  multiply-matrix
 ) ;_  multiply-matrix
) ;_  defun

 test:
Code: [Select]
(defun test-mirror (/ L M P1 P2 P3)
 ;;(test-mirror)
 (setq l  (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex (ssget))))
       p1 (getpoint "\n specify the first point on the mirror plane")
       p2 (getpoint "\n specify the second point on the mirror plane")
       p3 (getpoint "\n specify the third point on the mirror plane")
       m  (vlax-tmatrix (Matrix-Symmetry-Plane
                         p1
                         (v_norm_2v (mapcar (function -) p1 p2) (mapcar (function -) p1 p3))
                        ) ;_  Matrix-Symmetry-Plane
          ) ;_  vlax-tmatrix
 ) ;_  setq
 (foreach a l (vla-TransformBy (vlax-ename->vla-object a) m))
 (princ)
) ;_  defun

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Translate points about Centerline
« Reply #3 on: June 18, 2010, 09:35:40 AM »
find another program that makes the reflection list of points on an arbitrary plane...  :-)

Code: [Select]
(defun mirror-lst-Plane (vpt v l)
                             ;|
 ;; ElpanovEvgeniy
 ;; 08.10.06
 ;; отражение облака точек относительно плоскости
vpt - точка на плоскости для симметрии
v - вектор нормали к плоскости для симметрии

 ;; ElpanovEvgeniy
 ;; 08.10.06
 ;; reflection of the cloud of points relative to the plane
vpt - a point on the plane for symmetry
v - vector normal to the plane of symmetry for


(setq vpt '(1. 2. 3.)
      v   '(1. 1. 0.)
      l   '((0 0 0) (1 0 0) (2 0 0) (3 0 0) (4 0 0))
)
(mirror-lst-Plane vpt v l)
 |;
 (mapcar
  (function
   (lambda (a)
    (mapcar
     (function +)
     (trans (mapcar (function *) '(1 1 -1) (trans (mapcar (function -) a vpt) 0 v)) v 0)
     vpt
    ) ;_  mapcar
   ) ;_  lambda
  ) ;_  function
  l
 ) ;_  mapcar
)

test:
Code: [Select]
(defun test-mirror-lst-Plane (/ L P1 P2 P3 V)
 ;;(test-mirror-lst-Plane)
 (setq l  (mapcar (function (lambda (a) (cdr (assoc 10 (entget a)))))
                  (vl-remove-if (function listp)
                                (mapcar (function cadr) (ssnamex (ssget "_x" '((0 . "point")))))
                  ) ;_  vl-remove-if
          ) ;_  mapcar
       p1 (getpoint "\n specify the first point on the mirror plane")
       p2 (getpoint "\n specify the second point on the mirror plane")
       p3 (getpoint "\n specify the third point on the mirror plane")
       v  (v_norm_2v (mapcar (function -) p1 p2) (mapcar (function -) p1 p3))
 ) ;_  setq
 (foreach a (mirror-lst-Plane p1 v l) (entmakex (list '(0 . "point") (cons 10 a))))
 (princ)
)
« Last Edit: June 18, 2010, 09:59:38 AM by ElpanovEvgeniy »

fixo

  • Guest
Re: Translate points about Centerline
« Reply #4 on: June 19, 2010, 08:32:03 AM »
You're a genius (based on Eugeny :)
That's satisfied my needs completely
Keep sharing your algorithms
Many regards,
Oleg

~'J'~