[编程交流] [帮助]如何获取镜像点

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

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

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

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