Attribute VB_Name = "Module4" Option Explicit Type FEM_POINT x As Integer y As Integer End Type Type FEM_LINE p1 As FEM_POINT p2 As FEM_POINT End Type Public FDraw() As FEM_LINE Public LDraw() As FEM_LINE Public NDraw() As FEM_LINE Public QDraw() As FEM_LINE Public MDraw() As FEM_LINE Public DDraw() As FEM_LINE Public nNumOfFDraw As Integer Public nNumOfLDraw As Integer Public nNumOfNDraw As Integer Public nNumOfQDraw As Integer Public nNumOfMDraw As Integer Public nNumOfDDraw As Integer Public sngMdlSizeX, sngMdlSizeY As Single '描画データ計算前処理 Public Sub PreCalculateDrawData() Dim i As Integer nNumOfFDraw = 0 nNumOfLDraw = 0 nNumOfNDraw = 0 nNumOfQDraw = 0 nNumOfMDraw = 0 nNumOfDDraw = 0 ReDim FDraw(0) ReDim LDraw(0) ReDim NDraw(0) ReDim QDraw(0) ReDim MDraw(0) ReDim DDraw(0) '解析モデルのサイズを取得 Dim sngMinX, sngMinY, sngMaxX, sngMaxY As Single sngMinX = NodeData(0).sngX sngMinY = NodeData(0).sngY sngMaxX = NodeData(0).sngX sngMaxY = NodeData(0).sngY For i = 1 To (nNumOfNode - 1) If sngMinX > NodeData(i).sngX Then sngMinX = NodeData(i).sngX End If If sngMinY > NodeData(i).sngY Then sngMinY = NodeData(i).sngY End If If sngMaxX < NodeData(i).sngX Then sngMaxX = NodeData(i).sngX End If If sngMaxY < NodeData(i).sngY Then sngMaxY = NodeData(i).sngY End If Next i sngMdlSizeX = sngMaxX - sngMinX sngMdlSizeY = sngMaxY - sngMinY If sngMdlSizeX = 0 Then sngMdlSizeX = sngMdlSizeY If sngMdlSizeY = 0 Then sngMdlSizeY = sngMdlSizeX End Sub Public Sub CalculateFDrawData(nWndWidth, nWndHeight As Integer) Dim m, i As Integer '描画サイズ決定 Dim GSize As FEM_POINT GSize.x = nWndWidth * 0.8 GSize.y = nWndHeight * 0.8 '描画縮尺決定 Dim dblScaleF As Double If (CSng(GSize.y) / sngMdlSizeY) > (CSng(GSize.x) / sngMdlSizeX) Then dblScaleF = CSng(GSize.x) / sngMdlSizeX Else dblScaleF = CSng(GSize.y) / sngMdlSizeY End If Dim GOffset As FEM_POINT GOffset.x = (GSize.x * 0.1) + (GSize.x - dblScaleF * sngMdlSizeX) / 2 GOffset.y = (GSize.y * 0.1) + (GSize.y - dblScaleF * sngMdlSizeY) / 2 '描画データ領域確保 nNumOfFDraw = nNumOfMember ReDim FDraw(nNumOfFDraw) For m = 0 To (nNumOfMember - 1) '構成部材を順番に取得 Dim Member As FEM_MEMBER Member = MemberData(m) '部材の節点、特性を取得 Dim Node1 As FEM_NODE Dim Node2 As FEM_NODE Node1 = NodeData(Member.nN1Index) Node2 = NodeData(Member.nN2Index) Dim FLine As FEM_LINE FLine.p1.x = GOffset.x + CInt(Node1.sngX * dblScaleF) FLine.p1.y = GOffset.y + CInt(Node1.sngY * dblScaleF) FLine.p2.x = GOffset.x + CInt(Node2.sngX * dblScaleF) FLine.p2.y = GOffset.y + CInt(Node2.sngY * dblScaleF) FDraw(m) = FLine Next m End Sub Public Sub CalculateLDrawData(nWndWidth, nWndHeight As Integer) Dim m, l, i As Integer '描画サイズ決定 Dim GSize As FEM_POINT GSize.x = nWndWidth * 0.8 GSize.y = nWndHeight * 0.8 '描画縮尺決定、矢印の長さ決定 Dim dblScaleF As Double Dim nArrowSize As Integer If (CSng(GSize.y) / sngMdlSizeY) > (CSng(GSize.x) / sngMdlSizeX) Then dblScaleF = CSng(GSize.x) / sngMdlSizeX nArrowSize = GSize.x * 0.1 Else dblScaleF = CSng(GSize.y) / sngMdlSizeY nArrowSize = GSize.y * 0.1 End If Dim GOffset As FEM_POINT GOffset.x = (GSize.x * 0.1) + (GSize.x - dblScaleF * sngMdlSizeX) / 2 GOffset.y = (GSize.y * 0.1) + (GSize.y - dblScaleF * sngMdlSizeY) / 2 '描画データ領域確保 nNumOfLDraw = 0 For l = 0 To (nNumOfLoad - 1) '構成部材を順番に取得 Dim Load As FEM_LOAD Load = LoadData(l) '部材の節点、特性を取得 Dim Node As FEM_NODE Node = NodeData(Load.nNIndex) Dim LLine As FEM_LINE If Load.sngFx <> 0 Then nNumOfLDraw = nNumOfLDraw + 3 ReDim Preserve LDraw(nNumOfLDraw) If Load.sngFx > 0 Then LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) - nArrowSize LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) LLine.p2.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p2.y = GOffset.y + CInt(Node.sngY * dblScaleF) LDraw(nNumOfLDraw - 3) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) - nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) + nArrowSize / 4 LDraw(nNumOfLDraw - 2) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) - nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) - nArrowSize / 4 LDraw(nNumOfLDraw - 1) = LLine Else LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) + nArrowSize LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) LLine.p2.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p2.y = GOffset.y + CInt(Node.sngY * dblScaleF) LDraw(nNumOfLDraw - 3) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) + nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) + nArrowSize / 4 LDraw(nNumOfLDraw - 2) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) + nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) - nArrowSize / 4 LDraw(nNumOfLDraw - 1) = LLine End If End If If Load.sngFy <> 0 Then nNumOfLDraw = nNumOfLDraw + 3 ReDim Preserve LDraw(nNumOfLDraw) If Load.sngFy > 0 Then LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) - nArrowSize LLine.p2.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p2.y = GOffset.y + CInt(Node.sngY * dblScaleF) LDraw(nNumOfLDraw - 3) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) + nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) - nArrowSize / 4 LDraw(nNumOfLDraw - 2) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) - nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) - nArrowSize / 4 LDraw(nNumOfLDraw - 1) = LLine Else LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) + nArrowSize LLine.p2.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p2.y = GOffset.y + CInt(Node.sngY * dblScaleF) LDraw(nNumOfLDraw - 3) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) + nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) + nArrowSize / 4 LDraw(nNumOfLDraw - 2) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) - nArrowSize / 4 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) + nArrowSize / 4 LDraw(nNumOfLDraw - 1) = LLine End If End If If Load.sngM <> 0 Then nNumOfLDraw = nNumOfLDraw + 3 ReDim Preserve LDraw(nNumOfLDraw) If Load.sngM > 0 Then LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) LLine.p2.x = nArrowSize / 4 * 3 LLine.p2.y = nArrowSize / 4 * 3 LDraw(nNumOfLDraw - 3) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) + nArrowSize / 4 * 3 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) LLine.p2.x = LLine.p1.x + nArrowSize / 4 LLine.p2.y = LLine.p1.y + nArrowSize / 4 LDraw(nNumOfLDraw - 2) = LLine LLine.p2.x = LLine.p1.x - nArrowSize / 4 LLine.p2.y = LLine.p1.y + nArrowSize / 4 LDraw(nNumOfLDraw - 1) = LLine Else LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) LLine.p2.x = -nArrowSize / 4 * 3 LLine.p2.y = -nArrowSize / 4 * 3 LDraw(nNumOfLDraw - 3) = LLine LLine.p1.x = GOffset.x + CInt(Node.sngX * dblScaleF) - nArrowSize / 4 * 3 LLine.p1.y = GOffset.y + CInt(Node.sngY * dblScaleF) LLine.p2.x = LLine.p1.x + nArrowSize / 4 LLine.p2.y = LLine.p1.y + nArrowSize / 4 LDraw(nNumOfLDraw - 2) = LLine LLine.p2.x = LLine.p1.x - nArrowSize / 4 LLine.p2.y = LLine.p1.y + nArrowSize / 4 LDraw(nNumOfLDraw - 1) = LLine End If End If Next l End Sub Public Sub CalculateNDrawData(nWndWidth, nWndHeight As Integer) Dim m, i As Integer Dim strWorkFile2 As String strWorkFile2 = App.Path & "\work2.txt" Open strWorkFile2 For Input As #WORKFILE2_NO '描画サイズ決定 Dim GSize As FEM_POINT GSize.x = nWndWidth * 0.8 GSize.y = nWndHeight * 0.8 '描画縮尺決定 Dim dblScaleN As Double If dblNMax = 0 Then dblNMax = 1 If (CSng(GSize.y) / sngMdlSizeY) > (CSng(GSize.x) / sngMdlSizeX) Then dblScaleN = CSng(GSize.x) * 0.1 / dblNMax Else dblScaleN = CSng(GSize.y) * 0.1 / dblNMax End If '描画データ領域確保 nNumOfNDraw = nNumOfMember ReDim NDraw(nNumOfNDraw) For m = 0 To (nNumOfMember - 1) '構成部材を順番に取得 Dim Member As FEM_MEMBER Member = MemberData(m) '部材の節点、特性を取得 Dim Node1 As FEM_NODE Dim Node2 As FEM_NODE Node1 = NodeData(Member.nN1Index) Node2 = NodeData(Member.nN2Index) Dim FLine As FEM_LINE FLine = FDraw(m) '部材のx成分、y成分 Dim sngDX, sngDY As Single sngDX = Node2.sngX - Node1.sngX sngDY = Node2.sngY - Node1.sngY '部材長、部材のCos、Sin Dim dblL, dblSin, dblCos As Double dblL = Sqr(sngDX ^ 2 + sngDY ^ 2) dblCos = sngDX / dblL dblSin = sngDY / dblL '作業用ファイルからマトリクスの値を読み込む Dim FMtrx(6) As Double For i = 0 To 5 Input #WORKFILE2_NO, FMtrx(i) Next i 'N図描画データ作成 Dim NLine As FEM_LINE NLine.p1.x = FLine.p1.x + CInt(dblSin * FMtrx(0) * dblScaleN) NLine.p1.y = FLine.p1.y - CInt(dblCos * FMtrx(0) * dblScaleN) NLine.p2.x = FLine.p2.x + CInt(dblSin * FMtrx(0) * dblScaleN) NLine.p2.y = FLine.p2.y - CInt(dblCos * FMtrx(0) * dblScaleN) NDraw(m) = NLine Next m Close #WORKFILE2_NO End Sub Public Sub CalculateQDrawData(nWndWidth, nWndHeight As Integer) Dim m, i As Integer Dim strWorkFile2 As String strWorkFile2 = App.Path & "\work2.txt" Open strWorkFile2 For Input As #WORKFILE2_NO '描画サイズ決定 Dim GSize As FEM_POINT GSize.x = nWndWidth * 0.8 GSize.y = nWndHeight * 0.8 '描画縮尺決定 Dim dblScaleQ As Double If (CSng(GSize.y) / sngMdlSizeY) > (CSng(GSize.x) / sngMdlSizeX) Then dblScaleQ = CSng(GSize.x) * 0.1 / dblQMax Else dblScaleQ = CSng(GSize.y) * 0.1 / dblQMax End If '描画データ領域確保 nNumOfQDraw = nNumOfMember ReDim QDraw(nNumOfQDraw) For m = 0 To (nNumOfMember - 1) '構成部材を順番に取得 Dim Member As FEM_MEMBER Member = MemberData(m) '部材の節点、特性を取得 Dim Node1 As FEM_NODE Dim Node2 As FEM_NODE Node1 = NodeData(Member.nN1Index) Node2 = NodeData(Member.nN2Index) Dim FLine As FEM_LINE FLine = FDraw(m) '部材のx成分、y成分 Dim sngDX, sngDY As Single sngDX = Node2.sngX - Node1.sngX sngDY = Node2.sngY - Node1.sngY '部材長、部材のCos、Sin Dim dblL, dblSin, dblCos As Double dblL = Sqr(sngDX ^ 2 + sngDY ^ 2) dblCos = sngDX / dblL dblSin = sngDY / dblL '作業用ファイルからマトリクスの値を読み込む Dim FMtrx(6) As Double For i = 0 To 5 Input #WORKFILE2_NO, FMtrx(i) Next i 'Q図描画データ作成 Dim QLine As FEM_LINE QLine.p1.x = FLine.p1.x + CInt(dblSin * FMtrx(1) * dblScaleQ) QLine.p1.y = FLine.p1.y - CInt(dblCos * FMtrx(1) * dblScaleQ) QLine.p2.x = FLine.p2.x + CInt(dblSin * FMtrx(1) * dblScaleQ) QLine.p2.y = FLine.p2.y - CInt(dblCos * FMtrx(1) * dblScaleQ) QDraw(m) = QLine Next m Close #WORKFILE2_NO End Sub Public Sub CalculateMDrawData(nWndWidth, nWndHeight As Integer) Dim m, i As Integer Dim strWorkFile2 As String strWorkFile2 = App.Path & "\work2.txt" Open strWorkFile2 For Input As #WORKFILE2_NO '描画サイズ決定 Dim GSize As FEM_POINT GSize.x = nWndWidth * 0.8 GSize.y = nWndHeight * 0.8 '描画縮尺決定 Dim dblScaleM As Double If (CSng(GSize.y) / sngMdlSizeY) > (CSng(GSize.x) / sngMdlSizeX) Then dblScaleM = CSng(GSize.x) * 0.1 / dblMMax Else dblScaleM = CSng(GSize.y) * 0.1 / dblMMax End If '描画データ領域確保 nNumOfMDraw = nNumOfMember ReDim MDraw(nNumOfMDraw) For m = 0 To (nNumOfMember - 1) '構成部材を順番に取得 Dim Member As FEM_MEMBER Member = MemberData(m) '部材の節点、特性を取得 Dim Node1 As FEM_NODE Dim Node2 As FEM_NODE Node1 = NodeData(Member.nN1Index) Node2 = NodeData(Member.nN2Index) Dim FLine As FEM_LINE FLine = FDraw(m) '部材のx成分、y成分 Dim sngDX, sngDY As Single sngDX = Node2.sngX - Node1.sngX sngDY = Node2.sngY - Node1.sngY '部材長、部材のCos、Sin Dim dblL, dblSin, dblCos As Double dblL = Sqr(sngDX ^ 2 + sngDY ^ 2) dblCos = sngDX / dblL dblSin = sngDY / dblL '作業用ファイルからマトリクスの値を読み込む Dim FMtrx(6) As Double For i = 0 To 5 Input #WORKFILE2_NO, FMtrx(i) Next i 'M図描画データ作成 Dim MLine As FEM_LINE MLine.p1.x = FLine.p1.x - CInt(dblSin * FMtrx(2) * dblScaleM) MLine.p1.y = FLine.p1.y + CInt(dblCos * FMtrx(2) * dblScaleM) MLine.p2.x = FLine.p2.x + CInt(dblSin * FMtrx(5) * dblScaleM) MLine.p2.y = FLine.p2.y - CInt(dblCos * FMtrx(5) * dblScaleM) MDraw(m) = MLine Next m Close #WORKFILE2_NO End Sub Public Sub CalculateDDrawData(nWndWidth, nWndHeight As Integer) Dim m, i, k As Integer Dim strWorkFile1, strWorkFile2 As String strWorkFile2 = App.Path & "\work2.txt" Open strWorkFile2 For Input As #WORKFILE2_NO '描画サイズ決定 Dim GSize As FEM_POINT GSize.x = nWndWidth * 0.8 GSize.y = nWndHeight * 0.8 '描画縮尺決定 Dim dblScaleF, dblScaleD As Double If (CSng(GSize.y) / sngMdlSizeY) > (CSng(GSize.x) / sngMdlSizeX) Then dblScaleF = CSng(GSize.x) / sngMdlSizeX dblScaleD = CSng(GSize.x) * 0.1 / dblDMax Else dblScaleF = CSng(GSize.y) / sngMdlSizeY dblScaleD = CSng(GSize.y) * 0.1 / dblDMax End If '描画データ領域確保 nNumOfDDraw = 0 For m = 0 To (nNumOfMember - 1) '構成部材を順番に取得 Dim Member As FEM_MEMBER Member = MemberData(m) '部材の節点、特性を取得 Dim Node1 As FEM_NODE Dim Node2 As FEM_NODE Dim Char As FEM_CHAR Node1 = NodeData(Member.nN1Index) Node2 = NodeData(Member.nN2Index) Char = CharData(Member.nCIndex) Dim FLine As FEM_LINE FLine = FDraw(m) '部材のx成分、y成分 Dim sngDX, sngDY As Single sngDX = Node2.sngX - Node1.sngX sngDY = Node2.sngY - Node1.sngY '部材長、部材のCos、Sin Dim dblL, dblSin, dblCos As Double dblL = Sqr(sngDX ^ 2 + sngDY ^ 2) dblCos = sngDX / dblL dblSin = sngDY / dblL '座標変換マトリックス 'TMtrx = ' ┌ dblCos, dblSin, 0, 0, 0, 0 ┐ ' │ -dblSin, dblCos, 0, 0, 0, 0 │ ' │ 0, 0, 1, 0, 0, 0 │ ' │ 0, 0, 0, dblCos, dblSin, 0 │ ' │ 0, 0, 0, -dblSin, dblCos, 0 │ ' └ 0, 0, 0, 0, 0, 1 ┘ Dim TMtrx(6, 6) As Double TMtrx(0, 0) = dblCos: TMtrx(1, 1) = dblCos TMtrx(0, 1) = dblSin: TMtrx(1, 0) = -dblSin TMtrx(3, 3) = dblCos: TMtrx(4, 4) = dblCos TMtrx(3, 4) = dblSin: TMtrx(4, 3) = -dblSin TMtrx(2, 2) = 1: TMtrx(5, 5) = 1 Dim XMtrx(6) As Double XMtrx(0) = GXMtrx(Member.nN1Index * 3) XMtrx(1) = GXMtrx(Member.nN1Index * 3 + 1) XMtrx(2) = GXMtrx(Member.nN1Index * 3 + 2) XMtrx(3) = GXMtrx(Member.nN2Index * 3) XMtrx(4) = GXMtrx(Member.nN2Index * 3 + 1) XMtrx(5) = GXMtrx(Member.nN2Index * 3 + 2) 'δ図描画データ作成 Dim UMtrx(6) As Double '行列計算: 要素剛性マトリックス × 変位 For i = 0 To 5 UMtrx(i) = 0 For k = 0 To 5 UMtrx(i) = UMtrx(i) + TMtrx(i, k) * XMtrx(k) Next k Next i Dim dblA0, dblA1, dblA2, dblA3 As Double Dim dblB0, dblB1, dblB2, dblB3, dblB4 As Double Dim dblDelta, dblWW As Double Dim dblXDS, dblXDE, dblYDS, dblYDE As Double dblB0 = UMtrx(0) * dblCos - UMtrx(1) * dblSin dblB1 = UMtrx(0) * dblSin + UMtrx(1) * dblCos dblA0 = UMtrx(1) dblA1 = UMtrx(2) dblA2 = -(3 * dblA0 + 2 * dblL * dblA1 - 3 * UMtrx(4) + dblL * UMtrx(5)) / dblL ^ 2 dblA3 = (2 * dblA0 + dblL * dblA1 - 2 * UMtrx(4) + dblL * UMtrx(5)) / dblL ^ 3 dblXDS = dblB0 * dblScaleD dblYDS = dblB1 * dblScaleD Dim DLine As FEM_LINE 'トラス材か? If Char.sngI = 0 Then nNumOfDDraw = nNumOfDDraw + 1 ReDim Preserve DDraw(nNumOfDDraw) dblXDE = (UMtrx(3) * dblCos - UMtrx(4) * dblSin) * dblScaleD dblYDE = (UMtrx(3) * dblSin + UMtrx(4) * dblCos) * dblScaleD DLine.p1.x = FLine.p1.x + CInt(dblXDS) DLine.p1.y = FLine.p1.y + CInt(dblYDS) DLine.p2.x = FLine.p2.x + CInt(dblXDE) DLine.p2.y = FLine.p2.y + CInt(dblYDE) DDraw(m) = DLine Else nNumOfDDraw = nNumOfDDraw + 10 ReDim Preserve DDraw(nNumOfDDraw) For k = 0 To 9 dblDelta = dblL * (k + 1) / 10 dblB2 = UMtrx(0) dblB3 = (UMtrx(3) - UMtrx(0)) * (k + 1) / 10 dblB4 = dblA0 + dblA1 * dblDelta + dblA2 * dblDelta ^ 2 + dblA3 * dblDelta ^ 3 dblWW = dblB4 * dblScaleD dblXDE = dblCos * dblB2 * dblScaleD + dblCos * (dblDelta * dblScaleF + dblB3 * dblScaleD) - dblSin * dblWW dblYDE = dblSin * dblB2 * dblScaleD + dblSin * (dblDelta * dblScaleF + dblB3 * dblScaleD) + dblCos * dblWW DLine.p1.x = FLine.p1.x + CInt(dblXDS) DLine.p1.y = FLine.p1.y + CInt(dblYDS) DLine.p2.x = FLine.p1.x + CInt(dblXDE) DLine.p2.y = FLine.p1.y + CInt(dblYDE) DDraw(m * 10 + k) = DLine dblXDS = dblXDE dblYDS = dblYDE Next k End If '作業用ファイルからマトリクスの値を読み込む Dim FMtrx(6) As Double For i = 0 To 5 Input #WORKFILE2_NO, FMtrx(i) Next i Next m Close #WORKFILE2_NO End Sub