[功能] pt到p1p2上的垂点

自贡黄明儒

;;http://bbs.mjtd.com/thread-109018-1-1.html这里已经说了函数，由于常用，故提取出来

1. ;; [功能] pt到p1p2上的垂点  自贡黄明儒
   
2. (defun HH:perPt        (P p1 p2 / pt)
   
3.   (setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p))            ;highflybir论矩阵
   
4.   (inters p1 p2 p pt nil)                                    ;垂点  
   
5. )

;; [功能] pt到p1p2上的垂点  自贡黄明儒<br /> (defun HH:perPt        (P p1 p2 / pt)<br />   (setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p))            ;highflybir论矩阵<br />   (inters p1 p2 p pt nil)                                    ;垂点  <br /> )

edata

2. ;;;-----------------------------------------------------------;;
   
3. ;;; 旋转一个向量或者点90度                                    ;;
   
4. ;;; 输入: 一个向量                                            ;;
   
5. ;;; 输出: 被旋转90度后的向量                                  ;;
   
6. ;;;-----------------------------------------------------------;;
   
7. (defun MAT:Rot90 (vec)
   
8.   (vl-list* (- (cadr vec)) (car vec) (cddr vec))
   
9. )

;;;-----------------------------------------------------------;;<br /> ;;; 旋转一个向量或者点90度                                    ;;<br /> ;;; 输入: 一个向量                                            ;;<br /> ;;; 输出: 被旋转90度后的向量                                  ;;<br /> ;;;-----------------------------------------------------------;;<br /> (defun MAT:Rot90 (vec)<br />   (vl-list* (- (cadr vec)) (car vec) (cddr vec))<br /> )

llsheng_73

2. [code=lisp](defun PerPt(p p1 p2 / a)
   
3.   (setq a(mapcar'- p1 p2))
   
4.   (inters(mapcar'+(list(-(cadr a))(car a)(caddr a))p)p p1 p2'nil))

[code=lisp](defun PerPt(p p1 p2 / a)<br />   (setq a(mapcar'- p1 p2))<br />   (inters(mapcar'+(list(-(cadr a))(car a)(caddr a))p)p p1 p2'nil))

[/code]

wzg356

llsheng_73 发表于 2014-12-14 18:24
[/code]

好，简洁，继续

自贡黄明儒

llsheng_73 发表于 2014-12-14 18:24
[/code]

73，你又研究出了什么新成果？手机上看不到呀？是不是直接用trans

llsheng_73

自贡黄明儒 发表于 2014-12-14 20:15
73，你又研究出了什么新成果？手机上看不到呀？是不是直接用trans

试过，直接trans写出来还复杂些（因为对TRANS的，结果理解不到位）还不如以前直接用数学计算简洁，这里我只是把Rot90给直接放内部了

namezg

2. ;获得空间一点pt在空间两点pt1、pt2连线的垂足点(trans方法)
   
3. ;(zg-getPerPt-3P '(1.0 2.0 3.0) '(3.0 5.0 7.0) '(4.0 6.0 8.0))
   
4. ;返回:(0.0 2.0 4.0)
   
5. (defun zg-getPerPt-3P (pt pt1 pt2 / norm PerPt)
   
6.         (setq norm (mapcar '- pt2 pt1))
   
7.         (setq pt1 (trans pt1 0 norm))
   
8.         (setq pt (trans pt 0 norm))
   
9.         (setq PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0))
   
10. )

;获得空间一点pt在空间两点pt1、pt2连线的垂足点(trans方法)<br /> ;(zg-getPerPt-3P '(1.0 2.0 3.0) '(3.0 5.0 7.0) '(4.0 6.0 8.0))<br /> ;返回:(0.0 2.0 4.0)<br /> (defun zg-getPerPt-3P (pt pt1 pt2 / norm PerPt)<br />         (setq norm (mapcar '- pt2 pt1))<br />         (setq pt1 (trans pt1 0 norm))<br />         (setq pt (trans pt 0 norm))<br />         (setq PerPt (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0))<br /> )

自贡黄明儒

llsheng_73 发表于 2014-12-14 21:49
试过，直接trans写出来还复杂些（因为对TRANS的，结果理解不到位）还不如以前直接用数学计算简洁，这里我 ...

这是高飞的源程序
;;(PerToLine '(0 1) '(0 0) '(2 2))=>(0.5 0.5 0.0)
(defun PerToLine (cp p1 p2 / norm)
  (setq        norm (mapcar '- p2 p1)
        p1   (trans p1 0 norm)
        cp   (trans cp 0 norm)
  )
  (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
)

lijiao

(defun HH:perPt        (P p1 p2 / pt)
  (setq pt (polar p (+ (* 0.5 pi) (angle p1 p2)) 10.0))
  (inters p1 p2 p pt nil)
)

chwnin

学习一下这些基本东东