Hallo Andreas,
Eine weitere Möglichkeit wäre, Toolbox-Komponenten von der Kollisionsprüfung auszuschließen. Ich habe Makro MoolsCheckInterference2 in Api Hilfe gefunden und noch auswahl von Tolboxkomponenten.
Gruß
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swAssy As AssemblyDoc
Dim swModel As SldWorks.ModelDoc2
Dim swConfMgr As SldWorks.ConfigurationManager
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim StartTime As Double
Dim FinishTime As Double
Dim TotalTime As Double
Dim i As Integer
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swAssy = swModel
Dim vCompArray() As String
Dim CompArray() As Component2
Dim nSelCount As Long
nSelCount = -1
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelData As SldWorks.SelectData
Set swSelMgr = swModel.SelectionManager
Set swSelData = swSelMgr.CreateSelectData
Set swConfMgr = swModel.ConfigurationManager
Set swConf = swConfMgr.ActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)
StartTime = Timer ' Start time
Debug.Print "File = " & swModel.GetPathName
' TraverseModelFeatures swModel, 1
If swModel.GetType = SwConst.swDocASSEMBLY Then
Dim vChildComp As Variant
Dim swChildComp As SldWorks.Component2
Dim objDoc As Variant
Dim mmDoc As ModelDoc2
vChildComp = swRootComp.GetChildren
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)
If swChildComp.GetSuppression > 0 Then
Set mmDoc = swChildComp.GetModelDoc2
Debug.Print swChildComp.Name2
If mmDoc.Extension.ToolboxPartType = 0 Then
nSelCount = nSelCount + 1
ReDim Preserve vCompArray(nSelCount)
ReDim Preserve CompArray(nSelCount)
vCompArray(nSelCount) = swChildComp.GetSelectByIDString
Set CompArray(nSelCount) = swChildComp
End If
End If
Next i
End If
Debug.Print ("nSelCount = " & nSelCount)
Dim swFace As SldWorks.Face2
Dim swEnt As SldWorks.Entity
Dim swComp As SldWorks.Component2
Dim bRet As Boolean
For i = 0 To nSelCount
Debug.Print vCompArray(i)
Next i
Dim objCompArray As Variant
Dim vIntCompArray As Variant
Dim vIntFaceArray As Variant
objCompArray = CompArray
swAssy.ToolsCheckInterference2 nSelCount, (objCompArray), False, vIntCompArray, vIntFaceArray
If (IsEmpty(vIntCompArray) = True) And (IsEmpty(vIntFaceArray) = True) Then
Debug.Print " No contact"
Exit Sub
End If
If Not IsEmpty(vIntFaceArray) Then
Debug.Print " " & UBound(vIntFaceArray) + 1 & " faces interfere!"
swModel.ClearSelection2 True
For i = 0 To UBound(vIntFaceArray)
Set swFace = vIntFaceArray(i)
Set swEnt = swFace
Set swComp = swEnt.GetComponent
Debug.Print " Component face[" & i & "] = " & swComp.Name2
bRet = swEnt.Select4(True, swSelData): Debug.Assert bRet
Next i
' Interfering faces selected
Stop
' Examine the graphics area and Immediate window, then
' press F5 to continue
Else
Debug.Assert Not IsEmpty(vIntCompArray)
' Debug.Assert False = False
Debug.Print " Faces touch but not checking for coincident interference!"
End If
If Not IsEmpty(vIntCompArray) Then
Debug.Print " " & UBound(vIntCompArray) + 1 & " Components interfere!"
swModel.ClearSelection2 True
For i = 0 To UBound(vIntCompArray)
Set swComp = vIntCompArray(i)
Debug.Print " Component [" & i & "] = " & swComp.Name2
bRet = swComp.Select2(True, 0): Debug.Assert bRet
Next i
' Interfering components selected
Stop
' Examine the graphics area and Immediate window, then
' press F5 to continue
End If
FinishTime = Timer ' End time
TotalTime = FinishTime - StartTime ' Elapsed time
Debug.Print ("Time = " & TotalTime & " sec")
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de
HOMEPAGE | 
FACEBOOK | 
unterwegs. Die Funktion kannte ich nicht. Und nein mit Toolboxteilen funktioniert es nicht. Gerade mal ein Gewinde, was ich auch erstellte, wurde gefunden. Eben mit einem alen Projekt getestet.
