三角形内心（角平分线交点）

newer

1. ;;三角形内心 （角平分线交点，内切圆圆心）
   
2. (defun XD::Geom:Triangleheart (p1 p2 p3 / v1 v12 v13 v2 v21 v23)
   
3.    (setq v13 (xdrx_vector_normalize (mapcar '- p3 p1))
   
4.          v12 (xdrx_vector_normalize (mapcar '- p2 p1))
   
5.          v1 (mapcar '+ v13 v12)
   
6.          v23 (xdrx_vector_normalize (mapcar '- p3 p2))
   
7.          v21 (xdrx_vector_normalize (mapcar '- p1 p2))
   
8.          v2 (mapcar '+ v23 v21)   
   
9.    )
   
10.    (inters p1 (mapcar '+ p1 v1) p2 (mapcar '+ p2 v2) nil)
    
11. )
    
12. 
    

;;三角形内心 （角平分线交点，内切圆圆心）<br /> (defun XD::Geom:Triangleheart (p1 p2 p3 / v1 v12 v13 v2 v21 v23)<br />    (setq v13 (xdrx_vector_normalize (mapcar '- p3 p1))<br />          v12 (xdrx_vector_normalize (mapcar '- p2 p1))<br />          v1 (mapcar '+ v13 v12)<br />          v23 (xdrx_vector_normalize (mapcar '- p3 p2))<br />          v21 (xdrx_vector_normalize (mapcar '- p1 p2))<br />          v2 (mapcar '+ v23 v21)   <br />    )<br />    (inters p1 (mapcar '+ p1 v1) p2 (mapcar '+ p2 v2) nil)<br /> )<br /> <br />

st788796

1. (defun triangle:heart (p1 p2 p3 / p11 p12 )
   
2.   (setq p11 (c:cal "pld(p1,p3,abs(p1-p2))")
   
3.           p22 (c:cal "pld(p3,p2,abs(p1-p3))")
   
4.   )
   
5.   (inters p1
   
6.           (c:cal "(p2+p11)/2")
   
7.           p3
   
8.           (c:cal "(p1+p22)/2")
   
9.   )
   
10. )

(defun triangle:heart (p1 p2 p3 / p11 p12 )<br />   (setq p11 (c:cal "pld(p1,p3,abs(p1-p2))")<br />           p22 (c:cal "pld(p3,p2,abs(p1-p3))")<br />   )<br />   (inters p1<br />           (c:cal "(p2+p11)/2")<br />           p3<br />           (c:cal "(p1+p22)/2")<br />   )<br /> )

st788796

放到一个表达式

1. (defun ff (p1 p2 p3)
   
2.   (inters p1
   
3.           (c:cal "plt(p2,pld(p1,p3,abs(p1-p2)),0.5)")
   
4.           p3
   
5.           (c:cal "(p1+pld(p3,p2,abs(p1-p3)))/2")
   
6.   )
   
7. )

(defun ff (p1 p2 p3)<br />   (inters p1<br />           (c:cal "plt(p2,pld(p1,p3,abs(p1-p2)),0.5)")<br />           p3<br />           (c:cal "(p1+pld(p3,p2,abs(p1-p3)))/2")<br />   )<br /> )

Free-Lancer

st788796 发表于 2014-10-16 21:17
放到一个表达式

如上帖，一次完成

1. (defun ff (p1 p2 p3)
   
2.   (c:cal
   
3.     "ill(p1,plt(p2,pld(p1,p3,abs(p1-p2)),0.5),p3,plt(p1,pld(p3,p2,abs(p1-p3)),0.5))"
   
4.   )
   
5. )

(defun ff (p1 p2 p3)<br />   (c:cal<br />     "ill(p1,plt(p2,pld(p1,p3,abs(p1-p2)),0.5),p3,plt(p1,pld(p3,p2,abs(p1-p3)),0.5))"<br />   )<br /> )

高山流水

求三角形的中心，用角度求解效率可能比较高（当然用向量求解比较通用，可以用于空间）。

2. 
   
3. (defun triheart  (p0 p1 p2 / f)
   
4.   ;; by GSLS(SS) 2014.10.17
   
5.   (setq f (lambda (p0 p1 p2 / d a a0)
   
6.      (setq d (distance p0 p1)
   
7.     a (- (setq a0 (angle p1 p0)) (angle p1 p2)))
   
8.      (- a0 (/ (angle '(0 0) (list (* d (cos a)) (* d (sin a)))) 2.))))
   
9.   (inters p1 (polar p1 (f p0 p1 p2) 1000.) p2 (polar p2 (f p1 p2 p0) 1000.) nil))
   
10. ;; for test
    
11. (defun c:test  (/ p0 p1 p2 ph)
    
12.   (setq p0 (getpoint "\nSelect First Point of the triangle :")
    
13. p1 (getpoint p0 "\nSelect Second Point of the triangle :")
    
14. p2 (getpoint p1 "\nSelect Third Point of the triangle :"))
    
15.   (if (and p0
    
16.     p1
    
17.     p2
    
18.     (setq ph (triheart p0 p1 p2)))
    
19.     (entmake (list (cons 0 "Point")
    
20.      (cons 10 ph)
    
21.      (cons 62 1))))
    
22.   (princ))
    

<br /> (defun triheart  (p0 p1 p2 / f)<br />   ;; by GSLS(SS) 2014.10.17<br />   (setq f (lambda (p0 p1 p2 / d a a0)<br />      (setq d (distance p0 p1)<br />     a (- (setq a0 (angle p1 p0)) (angle p1 p2)))<br />      (- a0 (/ (angle '(0 0) (list (* d (cos a)) (* d (sin a)))) 2.))))<br />   (inters p1 (polar p1 (f p0 p1 p2) 1000.) p2 (polar p2 (f p1 p2 p0) 1000.) nil))<br /> ;; for test<br /> (defun c:test  (/ p0 p1 p2 ph)<br />   (setq p0 (getpoint "\nSelect First Point of the triangle :")<br /> p1 (getpoint p0 "\nSelect Second Point of the triangle :")<br /> p2 (getpoint p1 "\nSelect Third Point of the triangle :"))<br />   (if (and p0<br />     p1<br />     p2<br />     (setq ph (triheart p0 p1 p2)))<br />     (entmake (list (cons 0 "Point")<br />      (cons 10 ph)<br />      (cons 62 1))))<br />   (princ))<br />

wzjck01

学习，学习。

xmlk

谢谢分享！学习学习。