Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


29896 / 76732 ←次へ | 前へ→

【52109】Re:各要素に各弾性係数を与えて計算する方法について
質問  ちゃや  - 07/10/21(日) 14:42 -

引用なし
パスワード
  
さきほどのプログラムの続きです。

Private Sub aSub(M, Ix, Iy, Jx, Jy, Kx, Ky, S)

  Dim S1, S2

  Ix = 要素節点(M, 1)
  Iy = Ix + 節点の数
  Jx = 要素節点(M, 2)
  Jy = Jx + 節点の数
  Kx = 要素節点(M, 3)
  Ky = Kx + 節点の数
  S1 = 座標(Jx) * 座標(Ky) + 座標(Kx) * 座標(Iy) _
      + 座標(Ix) * 座標(Jy)
  S2 = 座標(Kx) * 座標(Jy) + 座標(Ix) * 座標(Ky) _
      + 座標(Jx) * 座標(Iy)
  S = 0.5 * (S1 - S2)

End Sub

Private Sub bSub(Ix, Iy, Jx, Jy, Kx, Ky, S)
  
  B(1, 1) = 0.5 * (座標(Jy) - 座標(Ky)) / S
  B(2, 1) = 0#
  B(3, 1) = 0.5 * (座標(Kx) - 座標(Jx)) / S
  B(1, 2) = 0.5 * (座標(Ky) - 座標(Iy)) / S
  B(2, 2) = 0#
  B(3, 2) = 0.5 * (座標(Ix) - 座標(Kx)) / S
  B(1, 3) = 0.5 * (座標(Iy) - 座標(Jy)) / S
  B(2, 3) = 0#
  B(3, 3) = 0.5 * (座標(Jx) - 座標(Ix)) / S
  B(1, 4) = 0#
  B(2, 4) = 0.5 * (座標(Kx) - 座標(Jx)) / S
  B(3, 4) = 0.5 * (座標(Jy) - 座標(Ky)) / S
  B(1, 5) = 0#
  B(2, 5) = 0.5 * (座標(Ix) - 座標(Kx)) / S
  B(3, 5) = 0.5 * (座標(Ky) - 座標(Iy)) / S
  B(1, 6) = 0#
  B(2, 6) = 0.5 * (座標(Jx) - 座標(Ix)) / S
  B(3, 6) = 0.5 * (座標(Iy) - 座標(Jy)) / S

End Sub

Private Sub dSub(計算フラグ)

  Dim R

  If 計算フラグ <> 1 Then
    R = 弾性係数 / (1# - ポアソン比 ^ 2)
    Dsep(1, 1) = R
    Dsep(2, 1) = R * ポアソン比
    Dsep(3, 1) = 0#
    Dsep(1, 2) = Dsep(2, 1)
    Dsep(2, 2) = R
    Dsep(3, 2) = 0#
    Dsep(1, 3) = 0#
    Dsep(2, 3) = 0#
    Dsep(3, 3) = 0.5 * R * (1# - ポアソン比)
  Else
    R = 弾性係数 * (1# - ポアソン比) _
        / (1# + ポアソン比) / (1# - 2# * ポアソン比)
    Dsep(1, 1) = R
    Dsep(2, 1) = R * ポアソン比 / (1# - ポアソン比)
    Dsep(3, 1) = 0#
    Dsep(1, 2) = Dsep(2, 1)
    Dsep(2, 2) = R
    Dsep(3, 2) = 0#
    Dsep(1, 3) = 0#
    Dsep(2, 3) = 0#
    Dsep(3, 3) = 0.5 * 弾性係数 / (1# + ポアソン比)
  End If

End Sub

Private Sub tSub(Ix, Iy, Jx, Jy, Kx, Ky)

  Dim I, J, Ixj, Jxj, Kxj, Iyj, Jyj, Kyj, It, Jt

  For J = 1 To 2 * 節点の数
    If (Kanl(J) = Ix) Then Ixj = J
    If (Kanl(J) = Jx) Then Jxj = J
    If (Kanl(J) = Kx) Then Kxj = J
    If (Kanl(J) = Iy) Then Iyj = J
    If (Kanl(J) = Jy) Then Jyj = J
    If (Kanl(J) = Ky) Then Kyj = J
  Next J
  For I = 1 To 6
    If (I = 1) Then It = Ixj
    If (I = 2) Then It = Jxj
    If (I = 3) Then It = Kxj
    If (I = 4) Then It = Iyj
    If (I = 5) Then It = Jyj
    If (I = 6) Then It = Kyj
    For J = 1 To 6
      If (J = 1) Then Jt = Ixj
      If (J = 2) Then Jt = Jxj
      If (J = 3) Then Jt = Kxj
      If (J = 4) Then Jt = Iyj
      If (J = 5) Then Jt = Jyj
      If (J = 6) Then Jt = Kyj
      If (It <= Jt) Then
        Syk(It, Jt - It + 1) = Syk(It, Jt - It + 1) _
            + elk(I, J)
      End If
    Next J
  Next I

End Sub

Private Sub 境界()

  Dim N, I, K, L

  N = 2 * 節点の数
  For I = 1 To N
    反力(I) = 0#
  Next I
  For K = 1 To N
    For I = 1 To 拘束の数
      L = 拘束節点(I)
      If (L < 0) Then L = 節点の数 - L
      If (Kanl(K) = L) Then
        Syk(K, 1) = 10000000000# * Syk(K, 1)
        反力(K) = Syk(K, 1) * 拘束変位(I)
        Exit For
      End If
    Next I
  Next K
  If (荷重の数 > 0) Then
    For K = 1 To N
      For I = 1 To 荷重の数
        L = 荷重節点(I)
        If (L < 0) Then L = 節点の数 - L
        If (Kanl(K) = L) Then 反力(K) = 荷重(I)
      Next I
    Next K
  End If

End Sub

Private Sub 連立計算(バンド幅)

  Dim I, J, L, N, S
  Dim Ik(MAX節点), Jk(MAX節点)

  N = 2 * 節点の数
  For I = 1 To バンド幅
    Ik(I) = 1
  Next I
  For I = バンド幅 + 1 To N
    Ik(I) = I - バンド幅 + 1
  Next I
  For J = 1 To N - バンド幅
    Jk(J) = J + バンド幅 - 1
  Next J
  For J = N - バンド幅 + 1 To N
    Jk(J) = N
  Next J
  For J = 2 To Jk(1)
    Syk(1, J) = Syk(1, J) / Syk(1, 1)
  Next J
  For I = 2 To N
    S = 0#
    For L = Ik(I) To I - 1
      S = S + Syk(L, I - L + 1) _
          * Syk(L, I - L + 1) * Syk(L, 1)
    Next L
    Syk(I, 1) = Syk(I, 1) - S
    If (I <> N) Then
      For J = I + 1 To Jk(I)
        S = 0#
        If (I >= N - バンド幅 + 2 Or J <> Jk(I)) Then
          For L = Ik(J) To I - 1
            S = S + Syk(L, I - L + 1) _
                * Syk(L, J - L + 1) * Syk(L, 1)
          Next L
        End If
        Syk(I, J - I + 1) = (Syk(I, J - I + 1) - S) _
                    / Syk(I, 1)
      Next J
    End If
  Next I
  For I = 2 To N
    S = 0#
    For J = Ik(I) To I - 1
      S = S + Syk(J, I - J + 1) * 反力(J)
    Next J
    反力(I) = 反力(I) - S
  Next I
  For L = 1 To N
    I = N - L + 1
    S = 0#
    If (I <> N) Then
      For J = I + 1 To Jk(I)
        S = S + Syk(I, J - I + 1) * 変位(J)
      Next J
    End If
    変位(I) = 反力(I) / Syk(I, 1) - S
  Next L
  For I = 1 To MAX要素
    For J = 1 To MAXバンド幅
      Syk(I, J) = Tky(I, J)
    Next J
  Next I
  For I = 1 To N
    S = 0#
    If (I <> N) Then
      For J = I + 1 To Jk(I)
        S = S + Syk(I, J - I + 1) * 変位(J)
      Next J
    End If
    For J = Ik(I) To I
      S = S + Syk(J, I - J + 1) * 変位(J)
    Next J
    反力(I) = S
  Next I
  For I = 1 To 節点の数
    J = I + 節点の数
    Syk(I, 1) = 変位(2 * I - 1)
    Syk(J, 1) = 変位(2 * I)
  Next I
  For I = 1 To N
    変位(I) = Syk(I, 1)
  Next I

End Sub

Private Sub 結果(計算フラグ)

  Dim M, Ix, Iy, Jx, Jy, Kx, Ky
  Dim S, Epsx, Epsy, Gaxy1, Gaxy2, Gaxy

  For M = 1 To 要素の数
    Call aSub(M, Ix, Iy, Jx, Jy, Kx, Ky, S)
    Call bSub(Ix, Iy, Jx, Jy, Kx, Ky, S)
    Call dSub(計算フラグ)
    Epsx = B(1, 1) * 変位(Ix) + B(1, 2) * 変位(Jx) _
        + B(1, 3) * 変位(Kx)
    Epsy = B(2, 4) * 変位(Iy) + B(2, 5) * 変位(Jy) _
        + B(2, 6) * 変位(Ky)
    Gaxy1 = B(3, 1) * 変位(Ix) + B(3, 2) * 変位(Jx) _
        + B(3, 3) * 変位(Kx)
    Gaxy2 = B(3, 4) * 変位(Iy) + B(3, 5) * 変位(Jy) _
        + B(3, 6) * 変位(Ky)
    Gaxy = Gaxy1 + Gaxy2
    歪み(M, 1) = Epsx
    歪み(M, 2) = Epsy
    Gxy(M) = Gaxy
    応力(M, 1) = Dsep(1, 1) * Epsx + Dsep(1, 2) * Epsy _
          + Dsep(1, 3) * Gaxy
    応力(M, 2) = Dsep(2, 1) * Epsx + Dsep(2, 2) * Epsy _
          + Dsep(2, 3) * Gaxy
    tauxy(M) = Dsep(3, 1) * Epsx + Dsep(3, 2) * Epsy _
          + Dsep(3, 3) * Gaxy
    If (計算フラグ <> 1) Then
      応力(M, 3) = 0#
      歪み(M, 3) = (1# - 2# * ポアソン比) / (弾性係数 _
          * (応力(M, 1) + 応力(M, 2))) - (Epsx + Epsy)
    Else
      応力(M, 3) = ポアソン比 * (応力(M, 1) + 応力(M, 2))
      歪み(M, 3) = 0#
    End If
  Next M

End Sub

Private Sub 結果出力()

  Dim I, M

  With Worksheets(出力シート名)
    For I = 1 To 節点の数
      .Range("_節点番号").Offset(I, 0) = I
      .Range("_変位X").Offset(I, 0) = 変位(I)
      .Range("_変位Y").Offset(I, 0) = 変位(節点の数 + I)
    Next I
    For I = 1 To 拘束の数
      If (拘束節点(I) > 0) Then
        M = 2 * 拘束節点(I) - 1
      Else
        M = 2 * -拘束節点(I)
      End If
      .Range("_反力節点").Offset(I, 0) = 拘束節点(I)
      .Range("_反力").Offset(I, 0) = 反力(M)
    Next I
  
    For I = 1 To 要素の数
      .Range("_要素番号").Offset(I, 0) = I
      .Range("_歪みX").Offset(I, 0) = 歪み(I, 1)
      .Range("_歪みY").Offset(I, 0) = 歪み(I, 2)
      .Range("_歪みZ").Offset(I, 0) = 歪み(I, 3)
      .Range("_歪みXY").Offset(I, 0) = Gxy(I)
      .Range("_応力X").Offset(I, 0) = 応力(I, 1)
      .Range("_応力Y").Offset(I, 0) = 応力(I, 2)
      .Range("_応力Z").Offset(I, 0) = 応力(I, 3)
      .Range("_応力XY").Offset(I, 0) = tauxy(I)
    Next I
  End With

End Sub
1 hits

【52108】各要素に各弾性係数を与えて計算する方法について ちゃや 07/10/21(日) 14:41 質問
【52109】Re:各要素に各弾性係数を与えて計算する方... ちゃや 07/10/21(日) 14:42 質問
【52110】Re:各要素に各弾性係数を与えて計算する方... りん 07/10/21(日) 15:11 発言
【52118】Re:各要素に各弾性係数を与えて計算する方... ちゃや 07/10/22(月) 7:07 質問
【52131】Re:各要素に各弾性係数を与えて計算する方... りん 07/10/22(月) 19:29 回答
【52158】Re:各要素に各弾性係数を与えて計算する方... ちゃや 07/10/25(木) 17:30 お礼

29896 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free