我想首先研究截面特性的計算

然后才是在CAD中的計算。

面積矩：

       微原面積和微原距旋轉軸的距離的導數。 也就是一個薄片 單位面力的作用下 繞坐標軸 的力矩。其值可正可負可為零，也稱面積的一次矩。

形心（質心）：

       轉動力矩除以合力及得到其坐標，形心就是合力的等效作用點。對稱圖形對其對稱軸的面積矩為零。
慣性矩：

      微原面積和微原距旋轉軸的距離的二次方的導數。類似動力學中的轉動慣量。其值總是正的，又稱面積的二次矩。他可以看成是某一距離的平方也面積的乘積，這個距離就是其旋轉半徑(慣性半徑),一個面域的旋轉半徑與坐標軸有關系。

慣性積：

       微原面積和微原在相互垂直的兩個方向上的距離的乘積的導數。其值可正可負可為零，又稱面積的二次積。慣性積為零則坐標軸為對稱軸，此軸為主軸，坐標軸交點為主形心，對應的慣性矩為主慣性矩。

極慣性矩：

      是指微原面積和微原到圓心的極軸長度的二次方的導數。他是與扭轉有關系的一個量。

抗扭截面模量：極慣性矩除以扭轉半徑。

抗彎截面模量：慣性矩除以點到中性軸的距離。主慣性矩是慣性矩的一個極大值和一個技校值。

程序代碼： [ 復制代碼到剪貼板 ] 
Sub JMTX()
    JMTX_Frm.Hide
    On Error GoTo errorhandle:
    'On Error Resume Next
    Dim Origin(0 To 2) As Double
    Dim Centroid As Variant
    Dim GuanXingJu1 As Variant
    Dim GuanXingJu2  As Variant
    Dim SSet As AcadSelectionSet         '定義創建選擇集
    Set SSet = ThisDrawing.SelectionSets.Add("xx") '創建選擇集xx
    '選擇面域
    Dim filterType(0) As Integer
    Dim filterData(0) As Variant
    '設置過濾器類型
    filterType(0) = 0
    '設置過濾數據,只選擇面域
    filterData(0) = "Region"

    '使用過濾器,由用戶在屏幕上選擇
    SSet.SelectOnScreen filterType, filterData
    '我不知道怎么樣限制用戶每次只能選擇一個,所以將多余的剔出,只留下第一個。
    Dim i As Integer
    If SSet.Count > 1 Then
        For i = 1 To SSet.Count - 1
            SSet.item(i).Delete
        Next i
    End If

    Centroid = SSet.item(0).Centroid '質心 為2維坐標
    Origin(0) = Centroid(0): Origin(1) = Centroid(1): Origin(2) = 0
    '創建匿名塊，用來繪制截面特性的相關圖形和數據
    Dim TX As AcadBlock
    Set TX = ThisDrawing.Blocks.Add(Origin, "*B")

    '繪制出質心點
    Dim PO As AcadPoint
    Set PO = TX.AddPoint(Origin)
    PO.color = acRed
   
    Dim MaxPoint As Variant, MinPoint As Variant
    SSet.item(0).GetBoundingBox MinPoint, MaxPoint
    '繪制包圍面域的最小矩形
    'Dim P(7) As Double
    'P(0) = MinPoint(0):    P(1) = MinPoint(1):   P(2) = MinPoint(0):   P(3) = MaxPoint(1):#p#分頁標題#e#
    'P(4) = MaxPoint(0):    P(5) = MaxPoint(1):   P(6) = MaxPoint(0):   P(7) = MinPoint(1):
    'Dim PL As AcadLWPolyline
    'Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(P)
    'PL.color = acYellow
    'PL.Closed = True
    DrawBoundingBox MinPoint, MaxPoint
   
   
    '填充面域
    Dim TC_Entity(0 To 0) As AcadEntity
    Dim TC As AcadHatch
    Dim TC_Name As String
    Dim TC_Type As Long
    Dim TC_Associativity As Boolean
    TC_Name = "SOLID"
    TC_Type = 0
    TC_Associativity = True
    Set TC = ThisDrawing.ModelSpace.AddHatch(TC_Type, TC_Name, TC_Associativity)
    Set TC_Entity(0) = SSet.item(0)
    TC.AppendInnerLoop (TC_Entity)
    TC.Evaluate
   
    '繪制主慣性軸
    Dim L As Double
    L = P2PDistance(MinPoint, MaxPoint)
    Dim Lx As AcadLine
    Dim Ly As AcadLine
    Dim LJ As AcadLine
    Set Lx = TX.AddLine(Origin, Point3D(Origin(0) + L, Origin(1), Origin(2)))
    Set Ly = TX.AddLine(Origin, Point3D(Origin(0), Origin(1) + L, Origin(2)))
    Lx.color = acGreen
    Ly.color = acGreen
   
    '繪制x軸箭頭
    Dim Temp As Variant
    Temp = Point3D(Origin(0) + L, Origin(1), Origin(2))
    Set LJ = TX.AddLine(Temp, GetPointAR(Temp, Atn(1) * 10 / 3, L / 20))
    LJ.color = acRed
    Set LJ = TX.AddLine(Temp, GetPointAR(Temp, -Atn(1) * 10 / 3, L / 20))
    LJ.color = acRed
    TX.AddText "X", Temp, L / 20

    '繪制Y軸箭頭
    Temp = Point3D(Origin(0), Origin(1) + L, Origin(2))
    Set LJ = TX.AddLine(Temp, GetPointAR(Temp, -Atn(1) * 4 / 3, L / 20))
    LJ.color = acRed
    Set LJ = TX.AddLine(Temp, GetPointAR(Temp, -Atn(1) * 8 / 3, L / 20))
    LJ.color = acRed
    TX.AddText "Y", Temp, L / 20

    '拷貝一份到原點并隱藏
    Dim NewReg As AcadRegion
    Dim OldReg As AcadRegion
    Dim O(2) As Double
    O(0) = 0#: O(1) = 0#: O(2) = 0#
    Set NewReg = SSet.item(0).Copy
    Set OldReg = SSet.item(0)
    NewReg.Move Origin, O
    NewReg.Visible = False
    GuanXingJu1 = NewReg.momentOfInertia        '慣性據
    GuanXingJu2 = SSet.item(0).momentOfInertia

    '兩個角點的截面抵抗矩
    Dim x1 As Double, x2 As Double
    x1 = Abs(Origin(0) - MinPoint(0))
    x2 = Abs(MaxPoint(0) - Origin(0))

    Dim y1 As Double, y2 As Double
    y1 = Abs(MaxPoint(1) - Origin(1))#p#分頁標題#e#
    y2 = Abs(Origin(1) - MinPoint(1))

    Dim Wx1 As Double, Wx2 As Double
    ' Wx1 = Ix / y1
    ' Wx2 = Ix / y2

    Dim Wy1 As Double, Wy2 As Double
    ' Wy1 = Iy / x1
    ' Wy2 = Iy / x2

    '計算截面的抵抗矩,按照邊界點計算
    With JMTX_Frm.TextBox1
        .TEXT = .TEXT & "坐標原點   X=0,000000000000000, Y=0,000000000000000, Z=0,000000000000000" & vbCrLf
        .TEXT = .TEXT & "質  心     X =" & NewReg.Centroid(0) & ",　" & "Y =" & NewReg.Centroid(1) & ",　" & "Z =0" & vbCrLf
        .TEXT = .TEXT & "周  長     C =" & NewReg.Perimeter & vbCrLf
        .TEXT = .TEXT & "面  積     A =" & NewReg.Area & vbCrLf

        .TEXT = .TEXT & "慣性矩     Ix=" & GuanXingJu1(0) & ",　" & "Iy=" & GuanXingJu1(1) & vbCrLf
        .TEXT = .TEXT & "慣性積     S =" & NewReg.ProductOfInertia & vbCrLf '面域只有一個慣性積
        'Rx = Sqr((Ix / Area))
        'Ry = Sqr((Iy / Area))
        .TEXT = .TEXT & "旋轉半徑   Rx=" & NewReg.RadiiOfGyration(0) & ",　" & "RY=" & NewReg.RadiiOfGyration(1) & vbCrLf
        .TEXT = .TEXT & "主  軸     Zx=" & NewReg.PrincipalDirections(0) & ",　" & "Zy=" & NewReg.PrincipalDirections(1) & ",　" & "Zz=" & NewReg.PrincipalDirections(2) & vbCrLf

        .TEXT = .TEXT & "主  矩     Mx=" & NewReg.PrincipalMoments(0) & ",　" & "My=" & NewReg.PrincipalMoments(1) & vbCrLf
    End With

    With JMTX_Frm.TextBox2
        .TEXT = .TEXT & "坐標原點   X=0,000000000000000, Y=0,000000000000000, Z=0,000000000000000" & vbCrLf
        .TEXT = .TEXT & "質  心     X =" & OldReg.Centroid(0) & ",　" & "Y =" & OldReg.Centroid(1) & ",　" & "Z =0" & vbCrLf
        .TEXT = .TEXT & "周  長     C =" & OldReg.Perimeter & vbCrLf
        .TEXT = .TEXT & "面  積     A =" & OldReg.Area & vbCrLf

        .TEXT = .TEXT & "慣性矩     Ix=" & GuanXingJu2(0) & ",　" & "Iy=" & GuanXingJu2(1) & vbCrLf#p#分頁標題#e#
        .TEXT = .TEXT & "慣性積     S = " & OldReg.ProductOfInertia & vbCrLf '面域只有一個慣性積
        .TEXT = .TEXT & "旋轉半徑   Rx=" & OldReg.RadiiOfGyration(0) & ",　" & "RY=" & OldReg.RadiiOfGyration(1) & vbCrLf

        '主軸的三個值應該是與x軸夾角的正弦值
        'Lx.Rotate Origin, Arcsin(OldReg.PrincipalDirections(0))
        'Ly.Rotate Origin, Arcsin(OldReg.PrincipalDirections(0))

        .TEXT = .TEXT & "主  軸     Zx=" & OldReg.PrincipalDirections(0) & ",　" & "Zy=" & OldReg.PrincipalDirections(1) & ",　" & "Zz=" & OldReg.PrincipalDirections(2) & vbCrLf
        .TEXT = .TEXT & "主  矩     Mx=" & OldReg.PrincipalMoments(0) & ",　" & "My=" & OldReg.PrincipalMoments(1) & vbCrLf
    End With

    ThisDrawing.ModelSpace.InsertBlock Origin, TX.Name, 1, 1, 1, Arcsin(OldReg.PrincipalDirections(0))

    JMTX_Frm.Show
    NewReg.Delete
    SSet.Delete

    Exit Sub

errorhandle:
    MsgBox Err.Description
    SSet.Delete
    JMTX_Frm.Show
End Sub