判断是不是 点 ，点对,转换成2d 3d 4d ,以前写的，以后可能会用到

aeo

2. 
   
3. <P>;;;===========================================
   
4. ;;;listp and not nil
   
5. (defun consp (lst) (not (atom lst)))
   
6. ;;;点对？
   
7. (defun dot-pair-p(lst / e)
   
8.    (and (consp lst)
   
9.         (progn (while(consp lst)(setq lst(cdr lst)))
   
10.                (not(null lst))
    
11.         )
    
12.    )
    
13. )
    
14. ;;;是 点?
    
15. (defun pointp(x / )
    
16.   (and (listp x)
    
17.        (not(dot-pair-p x))
    
18.        (<= 2 (length x) 3)
    
19.        (apply 'and (mapcar ' numberp x))
    
20.   )
    
21. )</P>
    
22. <P>;;;=====================================</P>
    
23. <P>;;;2005.8.25
    
24. (defun 3d(p / x y)
    
25. (if p(mapcar '(lambda(x y)x)(append p '(0. 0. 0.)) '(0. 0. 0.)))
    
26. )
    
27. (defun 2d(p / x y)
    
28.     (if p(mapcar '(lambda(x y)x)(append p '(0. 0.)) '(0. 0.)))
    
29. )
    
30. (defun 4d(p / x y)
    
31. (if(/= 4(length p))
    
32.   (append (3d p) '(1.))
    
33.   p
    
34. )
    
35. )</P>

<br /> <P>;;;===========================================<br /> ;;;listp and not nil<br /> (defun consp (lst) (not (atom lst)))<br /> ;;;点对？<br /> (defun dot-pair-p(lst / e)<br />    (and (consp lst)<br />         (progn (while(consp lst)(setq lst(cdr lst)))<br />                (not(null lst))<br />         )<br />    )<br /> )<br /> ;;;是 点?<br /> (defun pointp(x / )<br />   (and (listp x)<br />        (not(dot-pair-p x))<br />        (<= 2 (length x) 3)<br />        (apply 'and (mapcar ' numberp x))<br />   )<br /> )</P><br /> <P>;;;=====================================</P><br /> <P>;;;2005.8.25<br /> (defun 3d(p / x y)<br /> (if p(mapcar '(lambda(x y)x)(append p '(0. 0. 0.)) '(0. 0. 0.)))<br /> )<br /> (defun 2d(p / x y)<br />     (if p(mapcar '(lambda(x y)x)(append p '(0. 0.)) '(0. 0.)))<br /> )<br /> (defun 4d(p / x y)<br /> (if(/= 4(length p))<br />   (append (3d p) '(1.))<br />   p<br /> )<br /> )</P>

以后可能会用到

aeo

;;两个里面选一个非nil
(defun or2(a b)(cond(a)(b)))

;;表lst里面第一个非nil
(defun or3(lst)(eval(cons 'cond(mapcar 'list lst))))

aeo

2. ;;;=====================================================
   
3. ;;;直线 m b
   
4. (defun get-line-data (e / b dx dy m p1 p2)
   
5.    (setq p1 (trans(vlax-curve-getstartpoint e)0 1)
   
6.          p2 (trans(vlax-curve-getendpoint e)0 1)
   
7.          dx (- (car p2) (car p1))
   
8.          dy (- (cadr p2) (cadr p1))   
   
9.    )
   
10.   (if (and (>(abs dy)1e-5)
    
11.            (<(abs(/ dx dy))0.002)    ;;差不多0.1度
    
12.       )
    
13.        (setq m 1e33                         ;竖线.
    
14.              b (car p1)
    
15.        )
    
16.        (setq m (/ dy dx)
    
17.              b (- (cadr p1)(* m (car p1)))) ; -> b=y-m*x
    
18.    )
    
19.    (list m b)
    
20. )

;;;=====================================================<br /> ;;;直线 m b<br /> (defun get-line-data (e / b dx dy m p1 p2) <br />    (setq p1 (trans(vlax-curve-getstartpoint e)0 1)<br />          p2 (trans(vlax-curve-getendpoint e)0 1)<br />          dx (- (car p2) (car p1))<br />          dy (- (cadr p2) (cadr p1))    <br />    ) <br />   (if (and (>(abs dy)1e-5)<br />            (<(abs(/ dx dy))0.002)    ;;差不多0.1度<br />       )<br />        (setq m 1e33                         ;竖线.<br />              b (car p1) <br />        )<br />        (setq m (/ dy dx) <br />              b (- (cadr p1)(* m (car p1)))) ; -> b=y-m*x<br />    )<br />    (list m b)<br /> )

直线用方程表示 y = mx+b ,精度自己调

aeo

2. ;;;==========================================
   
3. ;;;矢量叉乘
   
4. ;;;------------------------------------------
   
5. (defun vector-cross (v1 v2 / )
   
6. (setq v1(3d v1)v2(3d v2))
   
7.     (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
   
8.           (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
   
9.           (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
   
10.     )
    
11.   )
    
12. ;;;二矢量点积
    
13. (defun vector-scalar (v1 v2)
    
14.    (apply '+ (mapcar '* v1 v2))
    
15. )
    
16. 
    
17. ;;;矢量的长度:
    
18.   (defun vector-length (v)
    
19.     (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) v)))
    
20.   )
    
21. ;;;矢量的单位化
    
22.   (defun vector-unit (v)
    
23.     (mapcar '(lambda (x) (/ x (vector-length v))) v)
    
24.   )

;;;==========================================<br /> ;;;矢量叉乘<br /> ;;;------------------------------------------<br /> (defun vector-cross (v1 v2 / )<br /> (setq v1(3d v1)v2(3d v2))<br />     (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))<br />           (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))<br />           (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))<br />     )<br />   )<br /> ;;;二矢量点积<br /> (defun vector-scalar (v1 v2)<br />    (apply '+ (mapcar '* v1 v2))<br /> )<br /> <br /> ;;;矢量的长度:<br />   (defun vector-length (v)<br />     (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) v)))<br />   )<br /> ;;;矢量的单位化<br />   (defun vector-unit (v)<br />     (mapcar '(lambda (x) (/ x (vector-length v))) v)<br />   )

矢量：

st788796

aeo版主一来就送上这么多好东西，支持一个

aeo

2. ;;;==============================================================
   
3. ;;;t:p1点在线p2 p3的上下方,或线上. 如果垂足在p2或p3上,返回p2 p3
   
4. (defun pt-on-line(p1 p2 p3 / k len v1 v2 v3)
   
5. (if(not(equal p2 p3 1e-4))
   
6.   (setq v1(mapcar '- p1 p2)
   
7.         v2(mapcar '- p3 p2)
   
8.         ;v3(vector-cross v1 v2)
   
9.         len(vector-length v2)
   
10.         k (/(vector-scalar v1 v2)len len)
    
11.   )
    
12. )
    
13.   (cond((equal k 0. 1e-3)p2)
    
14.        ((equal k 1. 1e-3)p3)
    
15.        ((< 0. k 1.) t)
    
16.        (t nil)
    
17.   )
    
18. )

;;;==============================================================<br /> ;;;t:p1点在线p2 p3的上下方,或线上. 如果垂足在p2或p3上,返回p2 p3<br /> (defun pt-on-line(p1 p2 p3 / k len v1 v2 v3) <br /> (if(not(equal p2 p3 1e-4))<br />   (setq v1(mapcar '- p1 p2) <br />         v2(mapcar '- p3 p2)<br />         ;v3(vector-cross v1 v2)<br />         len(vector-length v2)<br />         k (/(vector-scalar v1 v2)len len)<br />   )<br /> )<br />   (cond((equal k 0. 1e-3)p2)<br />        ((equal k 1. 1e-3)p3)<br />        ((< 0. k 1.) t)<br />        (t nil)<br />   )<br /> )

点是否可以垂直投影到线上:
如果是端部，返回端点坐标，如果在中间返回t

aeo

2. ;;;==============================================================
   
3. ;;;p1 和p2 p3关系.1:逆时 0:上 -1:顺时
   
4. (defun pt-line-rl(p1 p2 p3 /  len v1 v2 v3)
   
5.   (setq v1(mapcar '- p1 p2)
   
6.         v2(mapcar '- p3 p2)
   
7.         v3(vector-cross v1 v2)
   
8.         len(apply '+ v3)
   
9.   )
   
10.   (cond
    
11.    ((equal len 0.0 1e-4) 0)     ;;上
    
12.     ((> len 0) -1)              ;;顺时
    
13.     (t 1)                       ;;逆时
    
14.   )
    
15. )

;;;==============================================================<br /> ;;;p1 和p2 p3关系.1:逆时 0:上 -1:顺时<br /> (defun pt-line-rl(p1 p2 p3 /  len v1 v2 v3)<br />   (setq v1(mapcar '- p1 p2) <br />         v2(mapcar '- p3 p2)<br />         v3(vector-cross v1 v2)<br />         len(apply '+ v3)<br />   )<br />   (cond <br />    ((equal len 0.0 1e-4) 0)     ;;上<br />     ((> len 0) -1)              ;;顺时<br />     (t 1)                       ;;逆时<br />   )<br /> )

三点的时针关系

newer

欢迎AEO版主回家{:soso_e113:}

aeo

2. ;;p1到p2 p3垂足
   
3. (defun pt-line-per(p1 p2 p3 / k len per v1 v2 x)
   
4. (if(not(equal p2 p3 1e-4))
   
5.    (setq v1(mapcar '- p1 p2)
   
6.          v2(mapcar '- p3 p2)
   
7.          len(vector-length v2)
   
8.          k (/(vector-scalar v1 v2)len len)
   
9.          per (mapcar '+ p2 (mapcar '(lambda(x)(* k x)) v2))
   
10.    )
    
11.   nil)
    
12. )

;;p1到p2 p3垂足<br /> (defun pt-line-per(p1 p2 p3 / k len per v1 v2 x) <br /> (if(not(equal p2 p3 1e-4))<br />    (setq v1(mapcar '- p1 p2) <br />          v2(mapcar '- p3 p2)<br />          len(vector-length v2)<br />          k (/(vector-scalar v1 v2)len len)<br />          per (mapcar '+ p2 (mapcar '(lambda(x)(* k x)) v2))<br />    )<br />   nil) <br /> )

返回 垂足

st788796

AEO版主这些都是数学方法啊，学习了

eachy

又见老朋友了:)欢迎

aeo

三点一线

(= 0(pt-line-rl p1 p2 p3))

newer

st788796 发表于 2013-10-13 20:00
AEO版主这些都是数学方法啊，学习了

喜欢数学的方法。

aeo

2. ;;;转换点(矩阵作用于向量上)
   
3. (defun MxV (mat v)
   
4.   (setq v (4d v))
   
5.   (mapcar '(lambda (row) (vector-scalar  row v)) mat)
   
6. )
   
7. 
   
8. 
   
9. 
   
10. ;;;----------------------------
    
11. ;;;运用一下，其实还没有几何方法方便
    
12. 
    
13. ;;;3点的内接圆--》 '(圆心 半径)
    
14. ;;;(ax1+bx2+cx3)/(a+b+c),(ay1...)/(a+b+c)
    
15. (defun 3p->circle-in (p1 p2 p3 / lst x y pcen r)
    
16.   (if (/= 0(pt-line-rl p1 p2 p3))
    
17.      (setq lst(mapcar '(lambda(x y )(distance x y)) (list p2 p3 p1)(list p3 p1 p2))
    
18.            lst(mapcar '(lambda(x)(/ x (apply '+ lst))) lst )
    
19.            pcen  (MxV (apply 'mapcar (cons 'list (list p1 p2 p3))) lst)
    
20.            r  (list pcen (distance pcen(pt-line-per pcen p2 p3)))
    
21.      )
    
22.    nil)
    
23. )

;;;转换点(矩阵作用于向量上)<br /> (defun MxV (mat v)<br />   (setq v (4d v))<br />   (mapcar '(lambda (row) (vector-scalar  row v)) mat)<br /> )<br /> <br /> <br /> <br /> ;;;----------------------------<br /> ;;;运用一下，其实还没有几何方法方便<br /> <br /> ;;;3点的内接圆--》 '(圆心 半径)<br /> ;;;(ax1+bx2+cx3)/(a+b+c),(ay1...)/(a+b+c) <br /> (defun 3p->circle-in (p1 p2 p3 / lst x y pcen r) <br />   (if (/= 0(pt-line-rl p1 p2 p3))<br />      (setq lst(mapcar '(lambda(x y )(distance x y)) (list p2 p3 p1)(list p3 p1 p2))<br />            lst(mapcar '(lambda(x)(/ x (apply '+ lst))) lst )<br />            pcen  (MxV (apply 'mapcar (cons 'list (list p1 p2 p3))) lst)<br />            r  (list pcen (distance pcen(pt-line-per pcen p2 p3)))<br />      )<br />    nil) <br /> )

内接圆

aeo

两 pl线连起来 首尾相连成一根
http://bbs.xdcad.net/thread-671093-1-1.html

多义线反向，外观不变
http://bbs.xdcad.net/thread-671091-1-1.html