CAD截面特性计算

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

然后才是在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