【自我挑戰93】

Joseflin 发表于 2006-10-4 09:58:00

求a b c值：

highflybir 发表于 2006-10-7 16:07:00

1、求出切线AH长度，方法见下图；
2、AM为角BAC平分线，MH垂直AB；
3、M为圆心，MH为半径画圆1；
4、相切、相切、相切画其他的圆2，3。
5、擦除辅助线，完成。
 
1、OP=75，AE=sqrt(75*60)；BF=sqrt(75*50)，CG=sqrt(75*40)；
2、OM为角COP的角平分线，MJ=KA；
3、在OA的延长线上，作OH=KA；
4、延长KL交过H的垂直线于L。
5、LH就是上图中所要求的切线AH。
 
这个题目的解题方法是同AHLZL的那个题目一样的，我重新发一次。但方法较简略，直接用了计算法：因为（60+50+40）/2=75，所以乘了个75 ，半径也取了75 ，这样省去了Sqrt（边长）的几何画法步骤和缩放步骤。
这种方法适用于所有的三角形。

ahlzl 发表于 2006-10-7 16:25:00

这个程序是两年前写的。
并不是很完美，当一个内角接近180度时，CAD会死掉（现在不想花精力修正了）
Sub try()     Dim PA, PB, PC As Variant     PA = ThisDrawing.Utility.GetPoint(, vbCrLf & "请输入三角形的第一个角点：")     PB = ThisDrawing.Utility.GetPoint(, vbCrLf & "请输入三角形的第二个角点：")     PC = ThisDrawing.Utility.GetPoint(, vbCrLf & "请输入三角形的第三个角点：")     pi = 3.1415926535         '获得三个内角     Dim aa As Double, bb As Double, cc As Double     aa = Abs(ThisDrawing.Utility.AngleFromXAxis(PA, PB) _     - ThisDrawing.Utility.AngleFromXAxis(PA, PC))     If aa > pi Then aa = 2 * pi - aa         bb = Abs(ThisDrawing.Utility.AngleFromXAxis(PB, PA) _     - ThisDrawing.Utility.AngleFromXAxis(PB, PC))     If bb > pi Then bb = 2 * pi - bb         cc = Abs(ThisDrawing.Utility.AngleFromXAxis(PC, PB) _     - ThisDrawing.Utility.AngleFromXAxis(PC, PA))     If cc > pi Then cc = 2 * pi - cc         '获得三边的长度     Dim a As Double, d As Double, c As Double     a = dis(PB, PC)     b = dis(PC, PA)     c = dis(PA, PB)         '赋初值     Dim R1 As Double, R2 As Double, R3 As Double, R11 As Double     R1 = 0.005 * (dis(PA, PB) + dis(PB, PC) + dis(PC, PA))         '中间变量     Dim ta As Double, tb As Double, tc As Double     ta = 1 / Tan(aa / 2): tb = 1 / Tan(bb / 2): tc = 1 / Tan(cc / 2)     R11 = R1         Dim S2 As Double, S3 As Double     Dim LR2 As Double, LR3 As Double     Do     R1 = R11     S2 = (4 - 4 * ta * tb) * R1 * R1 + 4 * c * tb     S3 = (4 - 4 * tc * ta) * R1 * R1 + 4 * b * tc         R2 = (-2 * R1 + Sqr(S2)) / (2 * tb)     R3 = (-2 * R1 + Sqr(S3)) / (2 * tc)         LR2 = -1 / ta + (2 * (4 - 4 * ta * tb) * R1) / (4 * ta * Sqr(S2))     LR3 = -1 / tc + (2 * (4 - 4 * tc * ta) * R1) / (4 * tc * Sqr(S3))         fx = tb * R2 * R2 + tc * R3 * R3 + 2 * R2 * R3 - a     flx = 2 * tb * R2 * LR2 + 2 * tc * R3 * LR3 + 2 * R2 * LR3 + 2 * R3 * LR2     R11 = R1 - fx / flx     Loop While Abs(R11 - R1) > 0.0000000000001         Dim paa(2) As Double, pbb(2) As Double, pcc(2) As Double     Dim Dab, Dbc, Dca As Double     Dab = dis(PC, PA) / dis(PC, PB)     Dbc = dis(PA, PB) / dis(PA, PC)     Dca = dis(PB, PC) / dis(PB, PA)         paa(0) = (PB(0) + Dbc * PC(0)) / (1 + Dbc)     paa(1) = (PB(1) + Dbc * PC(1)) / (1 + Dbc)     pbb(0) = (PC(0) + Dca * PA(0)) / (1 + Dca)     pbb(1) = (PC(1) + Dca * PA(1)) / (1 + Dca)     pcc(0) = (PA(0) + Dab * PB(0)) / (1 + Dab)     pcc(1) = (PA(1) + Dab * PB(1)) / (1 + Dab)         Dim Aang As Double, Bang As Double, Cang As Double     Aang = ThisDrawing.Utility.AngleFromXAxis(PA, paa)     Bang = ThisDrawing.Utility.AngleFromXAxis(PB, pbb)     Cang = ThisDrawing.Utility.AngleFromXAxis(PC, pcc)         Dim p1, p2, p3 As Variant     p1 = ThisDrawing.Utility.PolarPoint(PA, Aang, R1 * R1 / Sin(aa / 2))     p2 = ThisDrawing.Utility.PolarPoint(PB, Bang, R2 * R2 / Sin(bb / 2))     p3 = ThisDrawing.Utility.PolarPoint(PC, Cang, R3 * R3 / Sin(cc / 2))         Dim c1 As AcadCircle, c2 As AcadCircle, c3 As AcadCircle     Set c1 = ThisDrawing.ModelSpace.AddCircle(p1, R1 * R1)     Set c2 = ThisDrawing.ModelSpace.AddCircle(p2, R2 * R2)     Set c3 = ThisDrawing.ModelSpace.AddCircle(p3, R3 * R3)
End Sub Function dis(PA, PB As Variant) As Double     dis = ((PA(0) - PB(0)) ^ 2 + (PA(1) - PB(1)) ^ 2 + (PA(2) - PB(2)) ^ 2) ^ 0.5 End Function
用VBALOAD命令加载，VBARUN命令运行。

highflybir 发表于 2006-10-7 22:23:00

本帖最后由作者于 2006-11-2 19:12:11 编辑 
我也发一个lisp程序，与版主PK一下,检测我lisp学得怎么样了。
加载程序，运行：mal
;;***************************************************************************** ;;求各切点到各顶点距离--------------------------------------------------------- (defun C:Mal (/    pa pb   pc   a    b    c  p    xa   xb xc        ya   yb yc   aga  agb  agc  ang  ta   tb   tc ja        jb   jc ha   hb   hc   vpa  vpb  vpc  cen  ra rb        rc   la lb   lc   cena cenb cenc       )   ;;(defun C:Mal ()   (graphscr)   (setq oldmode (getvar "osmode"))   (setq oce (getvar "cmdecho"))   (setvar "cmdecho" 0)   ;;输入数据   (command ".ucs" "W")   (setq pa (getpoint "请输入第一点：\n"))   (setq pb (getpoint "请输入第二点：\n"))   (setq pc (getpoint "请输入第三点：\n"))   (command ".ucs" "O" pa)   (setq pa (trans pa 0 1)  pb (trans pb 0 1)  pc (trans pc 0 1)   )   ;;求三角形边长和半周长    (setq a (distance pb pc)  b (distance pc pa)  c (distance pa pb)  p (/ (+ a b c) 2)   )   ;;计算切线长   (setq xa (sqrt (- (* p p) (* p a)))  xb (sqrt (- (* p p) (* p b)))  xc (sqrt (- (* p p) (* p c)))   )   (setq ya (sqrt (* p a))  yb (sqrt (* p b))  yc (sqrt (* p c))   )   (setq aga (angle '(0 0) (list xa ya))  agb (angle '(0 0) (list xb yb))  agc (angle '(0 0) (list xc yc))   )   (setq ang (/ (+ aga agb agc) 2))   (setq ta (* p (* (sin (- ang aga))) (* (sin (- ang aga)))))   (setq tb (* p (* (sin (- ang agb))) (* (sin (- ang agb)))))   (setq tc (* p (* (sin (- ang agc))) (* (sin (- ang agc)))))   ;;***************************************************************************   ;;求三角形内心---------------------------------------------------------------   (defun cen_incir (pa pb pc)     (setq jc (angle pa pb)    ja (angle pb pc)    jb (angle pc pa)     )     (setq ha (/ (+ jb jc pi) 2)    hb (/ (+ jc ja pi) 2)    hc (/ (+ ja jb pi) 2)     )     (setq vpa (polar pa ha 1)    vpb (polar pb hb 1)    vpc (polar pc hc 1)     )     (inters pa vpa pb vpb nil)   )   (setq cen (cen_incir pa pb pc))   ;;***************************************************************************   ;;求每个圆的半径，圆心位置---------------------------------------------------   (defun tan (x)     (/ (sin x) (cos x))   )   ;;定义正切函数   (if (> 1e-16   (abs (* (sin (- jb jc)) (sin (- jc ja)) (sin (- ja jb))))       )     (progn (alert "你输入的三点在一条直线上,请重新输入!")     (command ".UCS" "P")     (command ".UCS" "P")     (setvar "osmode" oldmode)     (setvar "cmdecho" oce)     (princ)     )     ;;判断输入的三点是否在同一条直线上     (progn       (setq ra (* ta (/ 1 (abs (tan (/ (- jb jc) 2))))))       (setq rb (* tb (/ 1 (abs (tan (/ (- jc ja) 2))))))       (setq rc (* tc (/ 1 (abs (tan (/ (- ja jb) 2))))))       (if (= 0 (abs (* ra rb rc)))  (progn (princ "你输入的三点在一条直线上,请重新输入!")         (setvar "cmdecho" oce)         (setvar "osmode" oldmode)         (princ)  )  ;;判断圆的半径是否为零  (progn    (defun gougu (x y)      (sqrt (+ (* x x) (* y y)))    )    (setq la (gougu ta ra)   lb (gougu tb rb)   lc (gougu tc rc)    )    (setq cena (polar pa (angle pa cen) la)   cenb (polar pb (angle pb cen) lb)   cenc (polar pc (angle pc cen) lc)    )    ;;***********************************************************************    ;;画圆-------------------------------------------------------------------    (setvar "osmode" 0)    (command ".line" pa pb pc "C")    (command ".CIRCLE" cena ra)    (command ".CIRCLE" cenb rb)    (command ".CIRCLE" cenc rc)    (command ".UCS" "P")    (command ".UCS" "P")    (setvar "osmode" oldmode)    (setvar "cmdecho" oce)    (princ)  )       )     )   ) )
附注：我重新检查了lisp程序，增加了一个如果三点在同一条直线的出错判断，我想版主说的在有一个内角接近180度时CAD会出错，可能也与之相关。另外我增加了程序的可读性。版主的VB十分了得，我以后还得向版主学习。

ahlzl 发表于 2006-10-7 22:49:00

PK结果：<A name=34799>highflybir</A>胜！

zwf9900 发表于 2008-1-6 16:59:00

这题好做！请看我的做法应该是最简单最快的！做法是书上来的！

hejoseph 发表于 2008-1-23 13:28:00

这是著名的Malfatti作图问题，而zwf9900所给的方法是Steiner首先给出的，三角法在《100个著名初等数学问题》里有，通过三角法可以求出三圆的半径。

页: [1]

明经CAD社区's Archiver

【自我挑戰93】