有函数可以求点在直线上的垂足吗？

greatvictory

如果用数学来算那么会有误差，怎么能做到每误差？
另外我想问一下，在下面这个循环中为什么point_x会随着e2的改变而改变，即使没有重复执行赋值的语句？
(repeat (sslength test)
                  (setq e2 (entget (ssname test l)))
                  (setq e2_x1 (cadr (assoc 10 e2)))
                  (setq e2_x2 (cadr (assoc 11 e2)))
                  (setq e2_y1 (caddr (assoc 10 e2)))
                  (setq e2_y2 (caddr (assoc 11 e2)))
                  (if (= e2_x1 e2_x2)
                    (if (= point_x nil)
                      (setq point_x (list (cadr (assoc 10 e2)) centre_y))
                    )
                  )
                  (if (= e2_y1 e2_y2)
                    (if (= point_y nil)
                      (setq point_y (list centre_x (caddr (assoc 10 e2))))
                    )
                  )
                  (setq l (+ l 1))
                )
            )          

cabinsummer

1. (defun c:per(/ el obj cp ep)
   
2.   (if (and (setq el (car (entsel "\n请选择直线:")))(= (cdr (assoc 0 (entget el))) "LINE"))
   
3.     (progn
   
4.       (setq obj (vlax-ename->vla-object el))
   
5.       (if (setq ep (getpoint "\n请选择点:"))
   
6.         (setq cp (vlax-curve-getClosestPointTo obj ep T));;;就是这一句求垂足
   
7.       )
   
8.     )
   
9.   )
   
10.   (princ cp)
    
11.   (princ)
    
12. )

(defun c:per(/ el obj cp ep)<br />   (if (and (setq el (car (entsel "\n请选择直线:")))(= (cdr (assoc 0 (entget el))) "LINE"))<br />     (progn<br />       (setq obj (vlax-ename->vla-object el))<br />       (if (setq ep (getpoint "\n请选择点:"))<br />         (setq cp (vlax-curve-getClosestPointTo obj ep T));;;就是这一句求垂足<br />       )<br />     )<br />   )<br />   (princ cp)<br />   (princ)<br /> )

Gu_xl

1. ;;;计算cp到p1 p2的垂足点
   
2. (defun PerToLine  (cp p1 p2 / norm)
   
3. 
   
4.   (setq        norm (mapcar '- p2 p1)
   
5. 
   
6.         p1   (trans p1 0 norm)
   
7. 
   
8.         cp   (trans cp 0 norm)
   
9. 
   
10.         )
    
11. 
    
12.   (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
    
13. 
    
14.   )
    

;;;计算cp到p1 p2的垂足点<br /> (defun PerToLine  (cp p1 p2 / norm)<br /> <br />   (setq        norm (mapcar '- p2 p1)<br /> <br />         p1   (trans p1 0 norm)<br /> <br />         cp   (trans cp 0 norm)<br /> <br />         )<br /> <br />   (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)<br /> <br />   )<br />

cnks

Gu_xl 发表于 2011-9-26 21:24

这一看就是算法牛人

millermin

(trans p1 0 norm)
请问这句这么理解？norm是一个点，在这里代表什么？谢谢。

hhbhyt

这一看就是算法牛人

guohq

(defun GetFootPoint1 (Pt PtA PtB / X1 Y1 X2 Y2 X3 Y3 AA BB CC DD EE FF XX YY)
  ;直线方程的一般形式 AX + BY  + C  = 0
  ;Pt为第三点 Pt3
  ;PtA PtB 为直线上的两个点

    (setq X1 (* 1.0 (nth 0 PtA))  Y1 (* 1.0 (nth 1 PtA)))
    (setq X2 (* 1.0 (nth 0 PtB))  Y2 (* 1.0 (nth 1 PtB)))
    (setq X3 (* 1.0 (nth 0 Pt ))  Y3 (* 1.0 (nth 1 Pt )))

    ;(y2 - y1) X + (x1 - x2) Y = x1y2 - x2y1
    ;(x2 - x1) X + (y2 - y1) Y = x2x3 - x1x3 + y2y3 - y1y3

    (setq AA  (- Y2 Y1)  BB (- X1 X2)  CC (- (* X1 Y2) (* X2 Y1)))
    (setq DD  (- X2 X1)  EE (- Y2 Y1)  FF (- (+ (- (* X2 X3) (* X1 X3)) (* Y2 Y3)) (* Y1  Y3)))

   
    ;构成行列式
    ; |A B|   |X|   |C|
    ; |   | * | | = | |
    ; |D E|   |Y|   |F|

    (setq XX (/ (- (* CC EE) (* BB FF))    (- (* AA  EE) (* BB DD))))
    (setq YY (/ (- (* AA FF) (* CC DD))    (- (* AA  EE) (* BB DD))))
    (list XX YY)
    )

guohq

(defun GetFootPoint2(Pt A B C / X3 Y3 AA BB CC DD EE FF XX YY)
  ;直线方程的一般形式 AX + BY  + C  = 0
  ;Pt为第三点 Pt3
  ;方程1 AX + BY =  -C
  ;方程2 BX - AY = BX3 - AY3

  (setq X3 (* 1.0 (nth 0 Pt)) Y3 (* 1.0 (nth 1 Pt)))
  (setq AA (* 1.0 A)  BB (* 1.0 B)    CC (* -1.0 C))
  (setq DD (* 1.0 B)  EE (* -1.0 A)   FF (-(* BB X3) (* AA Y3)))

  (setq XX (/ (- (* CC EE) (* BB FF))    (- (* AA  EE) (* BB DD))))
  (setq YY (/ (- (* AA FF) (* CC DD))    (- (* AA  EE) (* BB DD))))
  (list XX YY)
  )

dajio

millermin 发表于 2012-6-22 08:15
(trans p1 0 norm)
请问这句这么理解？norm是一个点，在这里代表什么？谢谢。

代表的是目标坐标系的Z轴正方向

guankuiwu

学习了！！