Private Sub CommandButton1_Click() Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim swAssy As SldWorks.AssemblyDoc Dim swSelMgr As SldWorks.SelectionMgr Dim CompArray As SldWorks.Component2 Dim CompArray1(1) As SldWorks.Component2 Dim CompArray2(0) As SldWorks.Component2 Dim CompArray3(0) As SldWorks.Component2 Dim swSelData As SldWorks.SelectData Dim RootComponent As SldWorks.Component2 Dim Configuration As SldWorks.Configuration Dim vCompArray As Variant Dim vIntCompArray1 As Variant Dim vIntFaceArray1 As Variant Dim vIntCompArray2 As Variant Dim vIntFaceArray2 As Variant Dim vIntCompArray3 As Variant Dim vIntFaceArray3 As Variant Dim swFace As SldWorks.face2 Dim swEnt As SldWorks.entity Dim swComp As SldWorks.Component2 Dim swComp1 As SldWorks.Component2 Dim TEXT(1) As String Dim Children As Variant Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Dim m As Integer Dim o As Integer Dim ch_P1 As Integer Dim ch_P2 As Integer Dim ch_P9 As Integer Dim ch_A9 As Integer Dim ch_P79 As Integer Dim ch_A79 As Integer Dim ChildHidd1 As Integer Dim nSelCount As Long Dim Count As Integer Dim bRet As Boolean Dim Child As Object Dim TEST As SldWorks.body2 If MsgBox("チェックしますか？", vbYesNo) = vbYes Then Set swApp = CreateObject("SldWorks.Application") Set swModel = swApp.ActiveDoc Set swAssy = swModel Set swSelMgr = swModel.SelectionManager Set swSelData = swSelMgr.CreateSelectData セル内クリア Cells(Ycell初期 - 2, 1) = swAssy.GetTitle '*****現在表示されているコンフィギュレーションを取得 Set Configuration = swAssy.GetActiveConfiguration() '*****コンフィギュレーション名 Cells(Ycell初期 - 2, 2) = Configuration.Name '*****コンフィギュレーションの構成部品を取得 Set CompArray = Configuration.GetRootComponent() Children = CompArray.GetChildren nSelCount = UBound(Children) + 1 Count = 0 For i = 1 To nSelCount - 1 Count = Count + i Next i Cells(2, 3).Value = Count Cells(2, 4).Value = 0 Cells(2, 5).Value = 0 Cells(4, 3).Value = 0 Cells(4, 4).Value = 0 Cells(4, 5).Value = 0 m = Ycell初期 For i = 0 To (nSelCount - 2) '***** Set CompArray1(0) = Nothing Set CompArray1(0) = Children(i) '*****子構成部品が抑制(0)・ライトウェイト(1)・正常表示(2)かを判断 ChildHidd1 = CompArray1(0).GetSuppression If ChildHidd1 <> 0 Then If ChildHidd1 <> 1 Then '*****構成部品単体の干渉確認1 Set CompArray2(0) = Nothing Set CompArray2(0) = Children(i) o = 0 swAssy.ToolsCheckInterference2 1, (CompArray2), False, vIntCompArray2, vIntFaceArray2 If (IsEmpty(vIntCompArray2) = True) And (IsEmpty(vIntFaceArray2) = True) Then oo = 0 '内部干渉なし ' ch_P1 = 0 ch_P2 = 0 ElseIf (IsEmpty(vIntCompArray2) = False) And (IsEmpty(vIntFaceArray2) = True) Then oo = 1 '内部一致あり ' ch_P1 = 0 ch_P2 = 0 Else oo = 2 '内部干渉あり ' ch_P1 = UBound(vIntCompArray2) - UBound(vIntFaceArray2) ch_P2 = UBound(vIntFaceArray2) End If For j = i + 1 To (nSelCount - 1) o = oo Set CompArray1(1) = Nothing Set CompArray1(1) = Children(j) '*****子構成部品が抑制(0)・ライトウェイト(1)・正常表示(2)かを判断 ChildHidd1 = CompArray1(1).GetSuppression If ChildHidd1 <> 0 Then If ChildHidd1 <> 1 Then '*****構成部品単体の干渉確認2 Set CompArray3(0) = Nothing Set CompArray3(0) = Children(j) swAssy.ToolsCheckInterference2 1, (CompArray3), False, vIntCompArray3, vIntFaceArray3 If o = 0 Or o = 1 Then If (IsEmpty(vIntCompArray3) = False) And (IsEmpty(vIntFaceArray3) = False) Then o = 2 '内部干渉あり ' ch_P9 = ch_P1 + UBound(vIntCompArray3) - UBound(vIntFaceArray3) ch_P9 = ch_P2 + UBound(vIntFaceArray3) ElseIf (IsEmpty(vIntCompArray3) = False) And (IsEmpty(vIntFaceArray3) = True) Then o = 1 '内部一致あり ' ch_P9 = ch_P1 ch_P9 = ch_P2 Else ' ch_P9 = ch_P1 ch_P9 = ch_P2 End If Else If (IsEmpty(vIntCompArray3) = False) And (IsEmpty(vIntFaceArray3) = False) Then ' ch_P9 = ch_P1 + UBound(vIntCompArray3) - UBound(vIntFaceArray3) ch_P9 = ch_P2 + UBound(vIntFaceArray3) ElseIf (IsEmpty(vIntCompArray3) = False) And (IsEmpty(vIntFaceArray3) = True) Then ' ch_P9 = ch_P1 ch_P9 = ch_P2 Else ' ch_P9 = ch_P1 ch_P9 = ch_P2 End If End If vCompArray = CompArray1 swAssy.ToolsCheckInterference2 2, (CompArray1), False, vIntCompArray1, vIntFaceArray1 '*****@ If (IsEmpty(vIntCompArray1) = True) And (IsEmpty(vIntFaceArray1) = True) Then Cells(m, 3).Select Cells(m, 1).Value = CompArray1(0).Name2 Cells(m, 2).Value = CompArray1(1).Name2 Cells(m, 3).Value = "干渉なし" Cells(m, 4).Value = "干渉なし" Cells(m, 5).Value = "×" Cells(m, 6).Value = "×" Cells(m, 7).Value = "1," m = m + 1 ElseIf (IsEmpty(vIntCompArray1) = False) And (IsEmpty(vIntFaceArray1) = True) Then '*****A If o = 0 Then Cells(m, 3).Select Cells(m, 1).Value = CompArray1(0).Name2 Cells(m, 2).Value = CompArray1(1).Name2 Cells(m, 3).Value = "干渉なし" '一致あり Cells(m, 4).Value = "干渉なし" Cells(m, 5).Value = "△" Cells(m, 6).Value = "×" Cells(m, 7).Value = "2," m = m + 1 Else '*****DE Cells(m, 3).Select Cells(m, 1).Value = CompArray1(0).Name2 Cells(m, 2).Value = CompArray1(1).Name2 Cells(m, 3).Value = "干渉なし" 'Dのとき一致あり Cells(m, 4).Value = "干渉なし" '一致あり Cells(m, 5).Value = "×or△" Cells(m, 6).Value = "△" Cells(m, 7).Value = "5,6" m = m + 1 End If ElseIf (IsEmpty(vIntCompArray1) = False) And (IsEmpty(vIntFaceArray1) = False) Then '*****B If o = 0 Then Cells(m, 3).Select Cells(m, 1).Value = CompArray1(0).Name2 Cells(m, 2).Value = CompArray1(1).Name2 Cells(m, 3).Value = "干渉あり" Cells(m, 4).Value = "干渉なし" Cells(m, 5).Value = "○" Cells(m, 6).Value = "×" Cells(4, 3).Value = Cells(4, 3).Value + 1 Cells(m, 7).Value = "3," m = m + 1 '*****C ElseIf o = 1 Then Cells(m, 3).Select Cells(m, 1).Value = CompArray1(0).Name2 Cells(m, 2).Value = CompArray1(1).Name2 Cells(m, 3).Value = "干渉あり" Cells(m, 4).Value = "干渉なし" '一致あり Cells(m, 5).Value = "○" Cells(m, 6).Value = "△" Cells(4, 3).Value = Cells(4, 3).Value + 1 Cells(m, 7).Value = "4," m = m + 1 Else '*****FGH Cells(4, 4).Value = Cells(4, 4).Value + 1 ch_A9 = UBound(vIntFaceArray1) If ch_P9 + 1 < ch_A9 Then '+1は詳細不明 Cells(m, 3).Select Cells(m, 1).Value = CompArray1(0).Name2 Cells(m, 2).Value = CompArray1(1).Name2 Cells(m, 3).Value = "干渉あり（怪しい）" '一致あり Cells(m, 4).Value = "干渉あり" '干渉・一致どちらかあり Cells(m, 5).Value = "○" Cells(m, 6).Value = "○(△含む)" Cells(4, 3).Value = Cells(4, 3).Value + 1 Cells(m, 7).Value = "9," m = m + 1 Else Cells(m, 3).Select Cells(m, 1).Value = CompArray1(0).Name2 Cells(m, 2).Value = CompArray1(1).Name2 Cells(m, 3).Value = "干渉なし（怪しい）" '一致あり Cells(m, 4).Value = "干渉あり" '干渉・一致どちらかあり Cells(m, 5).Value = "×" Cells(m, 6).Value = "○(△含む)" Cells(m, 7).Value = "7,8" m = m + 1 End If End If End If Cells(2, 4).Value = Cells(2, 4).Value + 1 Else Cells(2, 5).Value = Cells(2, 5).Value + 1 Cells(4, 5).Value = Cells(4, 5).Value + 1 End If Else Cells(2, 5).Value = Cells(2, 5).Value + 1 Cells(4, 5).Value = Cells(4, 5).Value + 1 End If Next j Else Cells(2, 5).Value = Cells(2, 5).Value + nSelCount - i - 1 Cells(4, 5).Value = Cells(4, 5).Value + 1 End If Else Cells(2, 5).Value = Cells(2, 5).Value + nSelCount - i - 1 Cells(4, 5).Value = Cells(4, 5).Value + 1 End If Next i End If End Sub