求作已知三角形的内接直角三角形

chenmik

网上看到的一道题。

mahuan1279

原来是调和点列的性质。

飞雪神光

按照楼上大佬思路写的

1. (defun c:tt(/ an b bf-curve-subsegment-picked-points bf-curve-subsegment-points c gs1- gs1+ gs2 h jd1 jd2 lm-3d2d lm-entmake-pline pt pt1 pt2 pt3 pts1 pts2 ptx ty x1 x2)
   
2.         (defun BF-curve-subsegment-picked-Points (obj p)
   
3.                 (BF-curve-subsegment-points
   
4.                         obj
   
5.                         (fix
   
6.                                 (vlax-curve-getParamAtPoint
   
7.                                         obj
   
8.                                         (vlax-curve-getClosestPointTo obj (trans p 1 0))
   
9.                                 )
   
10.                         )
    
11.                 )
    
12.         )
    
13.         (defun BF-curve-subsegment-points (curve n)
    
14.                 (list       
    
15.                         (lm-3d2d(vlax-curve-getPointAtParam curve (fix n)))
    
16.                         (lm-3d2d(vlax-curve-getPointAtParam curve (1+ (fix n))))
    
17.                 )
    
18.         )
    
19.         (defun lm-3d2d (pt) (mapcar '+ '(0 0) pt))
    
20.   (defun lm-entmake-pline (pldata / a s1 ptlst bihe co tc)
    
21.                 (mapcar'set '(ptlst bihe co tc) pldata)
    
22.                 (or co (setq co 256))
    
23.                 (or tc (setq tc (getvar "clayer")))
    
24.                 (entmake (append (list
    
25.                                                                                          '(0 . "LWPOLYLINE")
    
26.                                                                                          '(100 . "AcDbEntity")
    
27.                                                                                          '(100 . "AcDbPolyline")
    
28.                                                                                          (cons 62 co)
    
29.                                                                                          (cons 8 tc)
    
30.                                                                                          (cons 90 (length ptlst))
    
31.                                                                                          (cons 70 (if bihe 1 0))
    
32.                                                                                          (cons 38 (if (setq h(nth 2 (car ptlst))) h 0))
    
33.                                                                                  )
    
34.                                                          (mapcar '(lambda (a) (cons 10 a)) ptlst))
    
35.                 )
    
36.                 (entlast)
    
37.         )
    
38.         (setq ty (car(entsel "选择三角形多段线:")))
    
39.         (setq pts1(mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10) ) (entget ty))))
    
40.         (setq pt (getpoint "\n指定D点:"))
    
41.         (setq pts2(vl-sort (BF-curve-subsegment-picked-Points ty pt) '(lambda (p1 p2)(< (car p1) (car p2)))))
    
42.         (foreach x pts2 (setq pts1(vl-remove x pts1)))
    
43.         (setq
    
44.                 pt1(car pts2)
    
45.                 pt2(cadr pts2)
    
46.                 pt3(car pts1)
    
47.                 an1(angle pt pt1)
    
48.                 h(distance pt pt3)
    
49.                 b(distance pt pt1)
    
50.                 c(distance pt pt2)
    
51.         )
    
52.         (setq gs1+(* h (+ (* 3.0 c) b (sqrt (* (+ b c (/ (* 2.0 b c) h)) (+ b c (- (/ (* 2.0 b c) h))))))))
    
53.         (setq gs1-(* h(+ (* 3.0 c) b (- (sqrt (* (+ b c (/ (* 2.0 b c) h)) (+ b c (- (/ (* 2.0 b c) h)))))))))
    
54.         (setq gs2(+ (/ (* 2 b c) h) (/ (* 4 h c) b) (* 2 h)))
    
55.         (setq x1 (/ gs1+ gs2))
    
56.         (setq x2 (/ gs1- gs2))
    
57.         (setq ptx(polar pt an1 x1))
    
58.         (setq jd1(inters ptx (polar ptx (+ an1 (* pi 0.5)) 0.5) pt1 pt3 nil))
    
59.         (setq an(- (angle pt jd1) (* pi 0.5)))
    
60.         (setq jd2(inters pt (polar pt an 0.5) pt2 pt3 nil))
    
61.         (lm-entmake-pline(list (list pt jd1 jd2) t 4))
    
62.         (setq ptx(polar pt pi x2))
    
63.         (setq jd1(inters ptx (polar ptx (+ an1(* pi 0.5)) 0.5) pt1 pt3 nil))
    
64.         (setq an(- (angle pt jd1) (* pi 0.5)))
    
65.         (setq jd2(inters pt (polar pt an 0.5) pt2 pt3 nil))
    
66.         (lm-entmake-pline(list (list pt jd1 jd2) t 3))
    
67.         ;(entmake (list '(0 . "CIRCLE")'(100 . "AcDbEntity")'(100 . "AcDbCircle")(cons 62 1)(cons 10 pt)(cons 40 x1)))
    
68.         ;(entmake (list '(0 . "CIRCLE")'(100 . "AcDbEntity")'(100 . "AcDbCircle")(cons 62 2)(cons 10 pt)(cons 40 x2)))
    
69.         (princ)
    
70. )

(defun c:tt(/ an b bf-curve-subsegment-picked-points bf-curve-subsegment-points c gs1- gs1+ gs2 h jd1 jd2 lm-3d2d lm-entmake-pline pt pt1 pt2 pt3 pts1 pts2 ptx ty x1 x2)<br />         (defun BF-curve-subsegment-picked-Points (obj p)<br />                 (BF-curve-subsegment-points<br />                         obj<br />                         (fix<br />                                 (vlax-curve-getParamAtPoint<br />                                         obj<br />                                         (vlax-curve-getClosestPointTo obj (trans p 1 0))<br />                                 )<br />                         )<br />                 )<br />         )<br />         (defun BF-curve-subsegment-points (curve n)<br />                 (list        <br />                         (lm-3d2d(vlax-curve-getPointAtParam curve (fix n)))<br />                         (lm-3d2d(vlax-curve-getPointAtParam curve (1+ (fix n))))<br />                 )<br />         )<br />         (defun lm-3d2d (pt) (mapcar '+ '(0 0) pt))<br />   (defun lm-entmake-pline (pldata / a s1 ptlst bihe co tc)<br />                 (mapcar'set '(ptlst bihe co tc) pldata)<br />                 (or co (setq co 256))<br />                 (or tc (setq tc (getvar "clayer")))<br />                 (entmake (append (list <br />                                                                                          '(0 . "LWPOLYLINE")<br />                                                                                          '(100 . "AcDbEntity")<br />                                                                                          '(100 . "AcDbPolyline")<br />                                                                                          (cons 62 co)<br />                                                                                          (cons 8 tc)<br />                                                                                          (cons 90 (length ptlst))<br />                                                                                          (cons 70 (if bihe 1 0))<br />                                                                                          (cons 38 (if (setq h(nth 2 (car ptlst))) h 0))<br />                                                                                  )<br />                                                          (mapcar '(lambda (a) (cons 10 a)) ptlst))<br />                 )<br />                 (entlast)<br />         )<br />         (setq ty (car(entsel "选择三角形多段线:")))<br />         (setq pts1(mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10) ) (entget ty))))<br />         (setq pt (getpoint "\n指定D点:"))<br />         (setq pts2(vl-sort (BF-curve-subsegment-picked-Points ty pt) '(lambda (p1 p2)(< (car p1) (car p2)))))<br />         (foreach x pts2 (setq pts1(vl-remove x pts1)))<br />         (setq <br />                 pt1(car pts2) <br />                 pt2(cadr pts2)<br />                 pt3(car pts1)<br />                 an1(angle pt pt1)<br />                 h(distance pt pt3)<br />                 b(distance pt pt1)<br />                 c(distance pt pt2)<br />         )<br />         (setq gs1+(* h (+ (* 3.0 c) b (sqrt (* (+ b c (/ (* 2.0 b c) h)) (+ b c (- (/ (* 2.0 b c) h))))))))<br />         (setq gs1-(* h(+ (* 3.0 c) b (- (sqrt (* (+ b c (/ (* 2.0 b c) h)) (+ b c (- (/ (* 2.0 b c) h)))))))))<br />         (setq gs2(+ (/ (* 2 b c) h) (/ (* 4 h c) b) (* 2 h)))<br />         (setq x1 (/ gs1+ gs2))<br />         (setq x2 (/ gs1- gs2))<br />         (setq ptx(polar pt an1 x1))<br />         (setq jd1(inters ptx (polar ptx (+ an1 (* pi 0.5)) 0.5) pt1 pt3 nil))<br />         (setq an(- (angle pt jd1) (* pi 0.5)))<br />         (setq jd2(inters pt (polar pt an 0.5) pt2 pt3 nil))<br />         (lm-entmake-pline(list (list pt jd1 jd2) t 4))<br />         (setq ptx(polar pt pi x2))<br />         (setq jd1(inters ptx (polar ptx (+ an1(* pi 0.5)) 0.5) pt1 pt3 nil))<br />         (setq an(- (angle pt jd1) (* pi 0.5)))<br />         (setq jd2(inters pt (polar pt an 0.5) pt2 pt3 nil))<br />         (lm-entmake-pline(list (list pt jd1 jd2) t 3))<br />         ;(entmake (list '(0 . "CIRCLE")'(100 . "AcDbEntity")'(100 . "AcDbCircle")(cons 62 1)(cons 10 pt)(cons 40 x1)))<br />         ;(entmake (list '(0 . "CIRCLE")'(100 . "AcDbEntity")'(100 . "AcDbCircle")(cons 62 2)(cons 10 pt)(cons 40 x2)))<br />         (princ)<br /> )

mahuan1279

以D为坐标原点建立直角坐标，求出距离X。

chenjun_nj

mahuan1279

chenjun_nj 发表于 2023-4-18 08:27

再进一步，若AM/MD=n（n不等于1），还能做吗？

chenmik

多谢各位大神的解答。这道作图题改编于下面这道证明题。我所知道的证法有点繁琐，各位大神有兴趣的也可证一下，看是否有更简洁的。

chenjun_nj

mahuan1279 发表于 2023-4-18 10:53
再进一步，若AM/MD=n（n不等于1），还能做吗？

如果AM/MD=2，那么只要把我的作图法中的圆半径改为AD/4并与AB相切，其他步骤一样，其他的n应该是同样的规律，我还没摸清楚。

chenjun_nj

mahuan1279 发表于 2023-4-18 10:53
再进一步，若AM/MD=n（n不等于1），还能做吗？

解出来了，AM:MD=n
在AD上取点P，使AD:PD=2*n，以P为圆心，PD为半径作圆，
其他作法不变。

mahuan1279

chenjun_nj 发表于 2023-4-18 16:49
解出来了，AM:MD=n
在AD上取点P，使AD:PD=2*n，以P为圆心，PD为半径作圆，
其他作法不变。

怎么证明呢？