真诚为您提供优质参考资料，若有不当之处，请指正 模型地球内部引力图地球模型计算的引力外地核处引力最大,外地核向内或向外均在减小，从地核核心区处逃离地球引力需要能量为W=3.822MgR,由于不均匀分布，势能增加了0.5MgR实际引力为分层球体的引力标准线叠加的结果如果地球模型不错我们完全可以根据分层密度计算它的内引力图半径R密度12.750.994823.40.8461785.350.54481210.70.26228212.30.19431812.5R/N分层密度12.751.0052070.651.1817841.951.8354965.353.812691.65.1462040.2把密度确定以后，我们再把密度分层，先按最小密度绘制大圆图，再把第二层密度减去第一层后绘图，如此循环，画到地核，再把所有值叠加起来，就是模型引力图了如果模型不错，那么地球的实际引力就会和所画图一样当然还必须要用到内部引力公式AUTOcadvba模型程序代码Sub 地球引力模型() Dim ml As Object Dim a As Variant, a1 As Variant, a2 As Variant, a3 As Variant, a4 As Variant Dim v As Variant, v1 As Variant, v2 As Variant, v3 As Variant, v4 As Variant, v5 As Variant Dim U As Variant, U1 As Variant, U2 As Variant, U3 As Variant, U4 As Variant Dim co As Variant co = 3 Dim p(0 To 20001) As Double Dim i As Integer Dim J As Variant a = 1.00520697211556: a1 = 1.18178444724396: a2 = 1.8354955470878: a3 = 3.81269015792163: a4 = 5.14620364557066 b = 0.236363636363636: b1 = 0.709090909090909: b2 = 1.94545454545455: b3 = 0.581818181818182: b4 = 7.27272727272727E-02 For i = 0 To 10000 Step 2 v = i / 1000: v1 = v * a: v2 = v * a1: v3 = v * a2: v4 = v * a3: v5 = v * a4 p(i) = i If v1 <= 1 Then U = 750 * b * (1 + v1 * 2 - (1 - v1 ^ 2 + (v1 ^ 4) / 3) / (1 + (1 - v1 ^ 2) ^ 1.5)) / a ElseIf v1 > 1 And v1 <= a Then U = 500 * b * a ^ -3 / v ^ 2 ElseIf v1 > a Then U3 = 0 End If If v2 <= 1 Then U1 = 750 * b1 * (1 + v2 * 2 - (1 - v2 ^ 2 + (v2 ^ 4) / 3) / (1 + (1 - v2 ^ 2) ^ 1.5)) / a1 ElseIf v2 > 1 And v2 <= a1 Then U1 = 500 * b1 * a1 ^ -3 / v ^ 2 ElseIf v2 > a1 Then U3 = 0 End If If v3 <= 1 Then U2 = 750 * b2 * (1 + v3 * 2 - (1 - v3 ^ 2 + (v3 ^ 4) / 3) / (1 + (1 - v3 ^ 2) ^ 1.5)) / a2 ElseIf v3 > 1 And v3 <= a2 Then U2 = 500 * b2 * a2 ^ -3 / v ^ 2 ElseIf v3 > a2 Then U2 = 0 End If If v4 <= 1 Then U3 = 750 * b3 * (1 + v4 * 2 - (1 - v4 ^ 2 + (v4 ^ 4) / 3) / (1 + (1 - v4 ^ 2) ^ 1.5)) / a3 ElseIf v4 > 1 And v4 <= a3 Then U3 = 500 * b3 * a3 ^ -3 / v ^ 2 ElseIf v4 > a3 Then U3 = 0 End If If v5 <= 1 Then U4 = 750 * b4 * (1 + v5 * 2 - (1 - v5 ^ 2 + (v5 ^ 4) / 3) / (1 + (1 - v5 ^ 2) ^ 1.5)) / a4 ElseIf v5 > 1 And v5 <= a4 Then U4 = 500 * b4 * a4 ^ -3 / v ^ 2 ElseIf v5 > a4 Then U4 = 0 End If If v <= 1 Then p(i + 1) = 750 * (1 + v * 2 - (1 - v ^ 2 + (v ^ 4) / 3) / (1 + (1 - v ^ 2) ^ 1.5)) + U + U1 + U2 + U3 + U4 Else p(i + 1) = 500 * (1 + b * a ^ -3 + b1 * a1 ^ -3 + b2 * a2 ^ -3 + b3 * a3 ^ -3 + b4 * a4 ^ -3) / v ^ 2 End If Next i Set ml = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) co = co + 1 ml.color = coEnd Sub / 。