[帮助]如何获取镜像点
大家好。我试着写一个函数，通过P1和P2得到点（P）的镜像点（返回）。让我展示图片来帮助我的英语水平：
我如何使用Trans函数呢^^
非常感谢你 这
(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)))
)
)
Tharwat，你没有正确计算距离。。。试试这个：
(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 (- (angle p1 p2) (/ pi 2.)) (* 2. (pld p1 p2 p))))
(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。
注意：您的第三个拾取点必须位于绘制线的左侧-从下到上从第一个点到第二个点。正如图中所示，只有p1和p2应该具有相反的位置。。。 下面是另一个使用我的子函数（transptucs）&（transptwcs）。。。虽然所有的都是基于反函数的，但我仍然必须使用子函数int line plane来获得从点到线最近的点。。。也许还有更好更简单的方法，但这也没关系-在3D中工作，代码在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)))
(- (* (carv) (caddr u)) (* (caru) (caddr v)))
(- (* (caru) (cadrv)) (* (carv) (cadru)))
)
)
;; 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。 (Defunc: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)))
)
)
) 我首先让你们看看我的矩阵变换函数，它将变换一个对象或点列表。
然而，由于您明确要求：
考虑以下功能：
然而，请注意，由于trans函数使用任意轴算法从提供的法向量构建坐标系，如果UCS平面与WCS平面不平行，则上述函数将返回意外结果。
这就是他所说的trans吗？我真傻。。我没看第一篇帖子就跳了进去
很好，李 谢谢大家^^。李的代码是我想要的，但我在所有代码中学习了更多东西^^
@李：所以我想对了，trans是shoter（我都是2D ^^^）。谢谢你的链接和信息
不客气，如果你对代码有任何问题，尽管问 是的，李的密码肯定是你要找的。。。但我建议你还是使用3D操作的代码。。。这里有两个简单的例子。。。比我的transptucs和transptwcs函数要短得多。。。同样，涉及李的子函数LM：共线-p：
这里是加法-c:projptonline
尊敬的M.R。
页:
[1]
2