Help streamlining/alpha testing code to create parts based on interferences.

Anonymous · ‎01-16-2015

I have these two codes that work together. They take an assy w/ a subassy and 2 parts representing a caution area and an interference area. The user picks the sub and the 2 parts then the routine will create an updateable assy for each part in the subassy, combining three multibodied parts into interference, caution, and unaffected.

It seems to work find for me however I'm trying to use this for a part w/ 1400+solids. I have an overall assy w/ many multibodied parts that large totalling close to 35K solids. I created this to automate showing the interference areas. The problem I have is that when the code starts to run it takes about 6s to perform the combine command (using the interference part to slice and dice the multibodied part). While I'm hoping this code can help people I could really use some suggestions on how to make the code more streamlined/run faster. It takes 18 hours to create one assy.

Also the reason I do combine features for each solid in the part is so that if I rotate the part in the assy I'll be able to update without redoing all the features. I thought of creating a updater, or just adding features for a bounding box of the interference part but haven't gotten anything to work yet.

Option Explicit
Dim StartTime As String

'Adds adaptable parts to an assembly's components and creates 3 files representing
'the caution, interference, and unaffected areas based on user inputs. The User
'Selects the assembly or part to be analyzed, the part representing the interference,
'and then the part representing a caution area. The code then creates a new subassy
'containing the 3 altered parts.  *This code only works for solid bodies.
Public Sub AddAndCut()

    'declare and select the object to be analyzed, caution, and interference
    Dim coAnalyze As ComponentOccurrence
    Dim coInt As ComponentOccurrence
    Dim coCaut As ComponentOccurrence
    
    'Select analysis objects
    Call PickObject(coAnalyze, "Pick part to analyze")
    Call PickObject(coInt, "Pick interference")
    Call PickObject(coCaut, "Pick caution")
    
    ThisApplication.ScreenUpdating = False
    ThisApplication.SilentOperation = True
    'determine if any items were selected.
    If coAnalyze Is Nothing Or coInt Is Nothing Or coCaut Is Nothing Then
        MsgBox ("One or more solids not selected")
        Exit Sub
    Else
        'determine if object is part or assy.  If Assy, perform action on all
        'first level parts in the Assy.
        Dim strFilePath As String
        If coAnalyze.DefinitionDocumentType = kAssemblyDocumentObject Then
            Dim coParts As ComponentOccurrence
            For Each coParts In coAnalyze.SubOccurrences
                Call AddObjects(coParts, coInt, coCaut)
                Call FormNewAssy(coParts)
            Next coParts
            
        ElseIf coAnalyze.DefinitionDocumentType = kPartDocumentObject Then
            Call AddObjects(coAnalyze, coInt, coCaut)
            Call FormNewAssy(coAnalyze)
        End If
    End If
    ThisApplication.ScreenUpdating = True
    ThisApplication.SilentOperation = False
End Sub
'Routine to allow the user select an object within an assembly
Public Sub PickObject(oPart As ComponentOccurrence, strMessage As String)

    'Select part or assy
    Set oPart = ThisApplication.CommandManager. _
                Pick(kAssemblyLeafOccurrenceFilter, strMessage)
    
    'check if nothing was selected
    If (oPart Is Nothing) Then Exit Sub
    
    'verification print
    Debug.Print oPart.Definition.Document.FullFileName
    
End Sub
'Adds adaptable solids to a part, assuming one represents a
'caution area and the other and interference
Public Sub AddObjects(coBase As ComponentOccurrence, _
                      coInt As ComponentOccurrence, _
                      coCaution As ComponentOccurrence)
     
    StartTime = DateTime.Now
    Debug.Print (StartTime & ", AddObjects, " & coBase.Name)
    
    'declare initial variables
    Dim sbInt As SurfaceBody
    Dim sbIntID As Long
    Dim sbCaut As SurfaceBody
    Dim sbCautID As Long
    
    Dim coBasePart As PartDocument
    Set coBasePart = coBase.Definition.Document
    Dim coBaseDef As PartComponentDefinition
    Set coBaseDef = coBasePart.ComponentDefinition
      
    'check if selected parts overlap
    If Not (coBase.Name = coCaution.Name) _
       And Not (coBase.Name = coInt.Name) Then
    
        'Copy the interference object and rename any solids
        Call AssociativeBodyCopy(coBase, coInt)
        
        Dim oPartDef1 As PartComponentDefinition
        Set oPartDef1 = coBase.Definition
        Dim wsInt As WorkSurface
        Dim wsIntID As Long
        wsIntID = oPartDef1.WorkSurfaces.Count
        Set wsInt = oPartDef1.WorkSurfaces.Item(wsIntID)

        Call SculptSurface(wsInt, oPartDef1, kSymmetricExtentDirection)
    
        Call CleanSolidNames(coBase, "Int")
        
        'Set newly created solid name to Int
        sbIntID = coBase.SurfaceBodies.Count
        Set sbInt = coBaseDef.SurfaceBodies.Item(sbIntID)
        sbInt.Name = "Int"
              
        'Copy the caution object and rename any solids
        Call AssociativeBodyCopy(coBase, coCaution)
        wsIntID = oPartDef1.WorkSurfaces.Count
        Set wsInt = oPartDef1.WorkSurfaces.Item(wsIntID)

        Call SculptSurface(wsInt, oPartDef1, kNegativeExtentDirection)
        
        Call CleanSolidNames(coBase, "Caut")
        
        'Set newly created solid name to Caut
        sbCautID = coBase.SurfaceBodies.Count
        Set sbCaut = coBaseDef.SurfaceBodies.Item(sbCautID)
        sbCaut.Name = "Caut"
        
        Call coBasePart.Save

    End If
End Sub

'Takes a part from an assembly and creates a new assy which houses 3
'parts.  One representing the interference, one for caution, and one
'showing the unaffected areas.
Public Sub FormNewAssy(coBase As ComponentOccurrence)
    
    StartTime = DateTime.Now
    Debug.Print (StartTime & ", FormNewAssy, " & coBase.Name)
    
    'declare and set variable for the current part document to be saved
    Dim oPartDoc As PartDocument
    Set oPartDoc = coBase.Definition.Document
        
    'declare and set variables to copy the occurrence's location and name
    Dim strFilePath As String
    Dim strFileName As String
    strFilePath = oPartDoc.FullFileName
    strFileName = oPartDoc.ComponentDefinition.Document.DisplayName
    strFilePath = Replace(strFilePath, strFileName, "")
    strFileName = Replace(strFileName, ".ipt", "")
   
    'declare and set variables for the full file name of parts to be created
    Dim strIntFileName As String
    strIntFileName = strFilePath & strFileName & "_Int.ipt"
    
    Dim strCautFileName As String
    strCautFileName = strFilePath & strFileName & "_Caut.ipt"
    
    Dim strUAFileName As String
    strUAFileName = strFilePath & strFileName & "_UA.ipt"

    ' Create a 3 new part documents for Interference, Caution, and Unaffected.
    Dim pdInt As PartDocument   'Create part representing Interference area
    Set pdInt = ThisApplication.Documents.Add(kPartDocumentObject, _
                ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
    Call pdInt.SaveAs(strIntFileName, True)
    pdInt.Close (True)

    Dim pdCaut As PartDocument  'Create part representing caution area
    Set pdCaut = ThisApplication.Documents.Add(kPartDocumentObject, _
                 ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
    Call pdCaut.SaveAs(strCautFileName, True)
    pdCaut.Close (True)
    
    Dim pdUA As PartDocument    'Create part representing unaffected area
    Set pdUA = ThisApplication.Documents.Add(kPartDocumentObject, _
               ThisApplication.FileManager.GetTemplateFile _
               (kPartDocumentObject))
    Call pdUA.SaveAs(strUAFileName, True)
    pdUA.Close (True)
    
    'Create and save new assembly housing the three parts
    Dim oAssy As AssemblyDocument
    Set oAssy = ThisApplication.Documents.Add(kAssemblyDocumentObject, _
                ThisApplication.FileManager.GetTemplateFile _
                (kAssemblyDocumentObject), True)
    Call oAssy.SaveAs(strFilePath & strFileName & ".iam", False)
    
    ' Set a reference to the transient geometry object.
    'Transient Geometry needed to create new position/rotation matrix
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry

    ' Create a position/rotation matrix.  All positions/rotations set to origin.
    Dim oMatrix As Matrix
    Set oMatrix = oTG.CreateMatrix
    
    Dim appAsset As Asset
    Dim asLocal As Asset
    Dim oLib As AssetLibrary

    Set oLib = ThisApplication.AssetLibraries("Autodesk Appearance Library")
    'Add new parts to the assembly, geometry, and color to each part.
    'Interference
    Call oAssy.ComponentDefinition.Occurrences.Add(strIntFileName, oMatrix)
    Dim coInt As ComponentOccurrence
    Set coInt = oAssy.ComponentDefinition.Occurrences.Item(1)
    Set appAsset = oLib.AppearanceAssets("Smooth - Red")
    Set asLocal = appAsset.CopyTo(oAssy, False)
    coInt.Appearance = asLocal
    Call AddDerivedSolids(coBase, coInt)
    Call Combine.DeriveInterference(coInt)
    ThisApplication.ScreenUpdating = True
    
    'Caution
    Call oAssy.ComponentDefinition.Occurrences.Add(strCautFileName, oMatrix)
    Dim coCaut As ComponentOccurrence
    Set coCaut = oAssy.ComponentDefinition.Occurrences.Item(2)
    Set appAsset = oLib.AppearanceAssets("Blue - Wall Paint - Glossy")
    Set asLocal = appAsset.CopyTo(oAssy, False)
    coCaut.Appearance = asLocal
    Call AddDerivedSolids(coBase, coCaut)
    Call Combine.DeriveCaution(coCaut)
    
    'Unaffected
    Call oAssy.ComponentDefinition.Occurrences.Add(strUAFileName, oMatrix)
    Dim coUA As ComponentOccurrence
    Set coUA = oAssy.ComponentDefinition.Occurrences.Item(3)
    Call AddDerivedSolids(coBase, coUA)
    Call Combine.DeriveUA(coUA)
    
    'Save application shutting off the user prompts
    'ThisApplication.SilentOperation = True
    Call oAssy.Save
    'ThisApplication.SilentOperation = False
    
    'close new assy and all parts within
    oAssy.Close (True)
End Sub
'Takes 2 occurrences in an assy and adds all solids from the source to a target occurrence.
Public Sub AddDerivedSolids(coSource As ComponentOccurrence, coTarget As ComponentOccurrence)
    
    StartTime = DateTime.Now
    Debug.Print (StartTime & ", AddDerivedSolids, " & coTarget.Name)
    
    'Declare and set partdocuments represented by occurrences.
        'An assy uses occurrences which are a representation of the actual
        'part.  Creating a PartDocument and defining that document allows the program
        'to utilize the actual document rather than a reference.
    Dim pdSource As PartDocument
    Set pdSource = coSource.Definition.Document
    
    Dim pdTarget As PartDocument
    Set pdTarget = coTarget.Definition.Document
    
    ' Create a derived definition for the solids to be added.
    Dim oDerivedPartDef As DerivedPartUniformScaleDef
    Set oDerivedPartDef = pdTarget.ComponentDefinition.ReferenceComponents. _
      DerivedPartComponents.CreateUniformScaleDef(pdSource.FullFileName)
    oDerivedPartDef.DeriveStyle = kDeriveAsMultipleBodies
    oDerivedPartDef.IncludeAllSolids = kDerivedIncludeAll
    
    ' Create the derived part.
    Call pdTarget.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)
    Dim oDerPartComp As DerivedPartComponent
    Set oDerPartComp = pdTarget.ComponentDefinition.ReferenceComponents.DerivedPartComponents(1)

    'Rename the appropriate solids to int and caut.  The solids to be renamed
    'should be the last 2 in the document.
    Dim sbBody As SurfaceBody
    Dim sbBodyID As Long
    
    sbBodyID = pdTarget.ComponentDefinition.SurfaceBodies.Count
    Set sbBody = pdTarget.ComponentDefinition.SurfaceBodies.Item(sbBodyID)
    sbBody.Name = "Caut"
    
    sbBodyID = pdTarget.ComponentDefinition.SurfaceBodies.Count - 1
    Set sbBody = pdTarget.ComponentDefinition.SurfaceBodies.Item(sbBodyID)
    sbBody.Name = "Int"
    
    'ensure all solids match the part color
    Call MatchSolidColors2Part(pdTarget)
    

    
End Sub
'Make all solids default appearance match the part
Public Sub MatchSolidColors2Part(pdPart As PartDocument)
   
    StartTime = DateTime.Now
    Debug.Print (StartTime & ", MatchSolidColors2Part")
   
    Dim sbBody As SurfaceBody
    For Each sbBody In pdPart.ComponentDefinition.SurfaceBodies
        sbBody.AppearanceSourceType = kPartAppearance
    Next sbBody
    
End Sub
'Finds any solids named int or caut and renames them
Public Sub CleanSolidNames(coPart As ComponentOccurrence, strFirstLetters As String)

    StartTime = DateTime.Now
    Debug.Print (StartTime & ", CleanSolidNames, " & coPart.Name)
    
    Dim sbBody As SurfaceBody
    Dim lngCounter As Long
    Dim strName As String
    lngCounter = 1
    
    For Each sbBody In coPart.SurfaceBodies
        strName = sbBody.Name
        If Left(strName, Len(strFirstLetters)) = strFirstLetters Then
            sbBody.Name = Replace(strName, strFirstLetters, strFirstLetters & lngCounter)
            lngCounter = lngCounter + 1
        End If
    Next sbBody
        
End Sub
'Adds an adaptive surface from one occurrence to another
'then sculpts a solid from that surface
Public Sub AssociativeBodyCopy(oOccurrence1 As ComponentOccurrence, _
                               oOccurrence2 As ComponentOccurrence)

    StartTime = DateTime.Now
    Debug.Print (StartTime & ", AssocBodyCopy, " & oOccurrence1.Name)
    
    Dim oPartDef1 As PartComponentDefinition
    Set oPartDef1 = oOccurrence1.Definition

    Dim oPartDef2 As PartComponentDefinition
    Set oPartDef2 = oOccurrence2.Definition

    ' Get the source solid body from the first part.
    Dim oSourceBody As SurfaceBody
    Set oSourceBody = oPartDef2.SurfaceBodies.Item(1)

    Dim oSourceBodyProxy As SurfaceBodyProxy
    Call oOccurrence2.CreateGeometryProxy(oSourceBody, oSourceBodyProxy)

    ' Create an associative surface base feature in the second part.
    Dim oFeatureDef1 As NonParametricBaseFeatureDefinition
    Set oFeatureDef1 = oPartDef1.Features.NonParametricBaseFeatures.CreateDefinition

    Dim oCollection As ObjectCollection
    Set oCollection = ThisApplication.TransientObjects.CreateObjectCollection

    oCollection.Add oSourceBodyProxy

    oFeatureDef1.BRepEntities = oCollection
    oFeatureDef1.OutputType = kSurfaceOutputType
    oFeatureDef1.TargetOccurrence = oOccurrence1
    oFeatureDef1.IsAssociative = True

    Dim oBaseFeature1 As NonParametricBaseFeature
    Set oBaseFeature1 = oPartDef1.Features.NonParametricBaseFeatures.AddByDefinition(oFeatureDef1)
      
    ThisApplication.ActiveDocument.Update
End Sub
'Sculpts an new solid inside a part
Public Sub SculptSurface(wsSurf2Sculpt As WorkSurface, ptBasePart As PartComponentDefinition, _
                         sedDirection As PartFeatureExtentDirectionEnum)

    StartTime = DateTime.Now
    Debug.Print (StartTime & ", SculptSurface")
    
    Dim ptfeatSculpt As PartFeature
    Dim ptFeats As PartFeatures
    Dim ptfeatsSculpt As SculptFeatures
    Dim sbInt As WorkSurface
    Dim sbIntSculpt As SculptSurface
    
    Set ptFeats = ptBasePart.Features
    Set ptfeatsSculpt = ptFeats.SculptFeatures
    
    Set sbIntSculpt = ptBasePart.Features.SculptFeatures.CreateSculptSurface(wsSurf2Sculpt)
    sbIntSculpt.Direction = sedDirection

    Dim ocSculpt As ObjectCollection
    Set ocSculpt = ThisApplication.TransientObjects.CreateObjectCollection
    Call ocSculpt.Add(sbIntSculpt)
    
    Set ptfeatSculpt = ptfeatsSculpt.Add(ocSculpt, kNewBodyOperation)
    
End Sub
'Changes color of a part to a named appearance
Public Sub ChangePartColor(coPart As ComponentOccurrence, strColor As String)

    StartTime = DateTime.Now
    Debug.Print (StartTime & ", ChangePartColor, " & coPart.Name)
    
    Dim oPartDoc As PartDocument
    Dim oCompDef As ComponentDefinition

    Set oPartDoc = coPart.Definition.Document
    Set oCompDef = oPartDoc.ComponentDefinition
    Dim appAsset As Asset
    Dim oLib As AssetLibrary
    Set oLib = ThisApplication.AssetLibraries("Autodesk Appearance Library")
    Set appAsset = oLib.AppearanceAssets(strColor)
    coPart.Appearance = appAsset
    'oPartDoc.ActiveAppearance = appAsset
    
End Sub
'Alter solid's color within a part
Public Sub ChangeSBColor(sbPart As SurfaceBody, strColor As String)

    Dim appAsset As Asset
    Dim oLib As AssetLibrary
    Dim assyAssets As Assets
    Dim oParent As Object
    Dim oPartDoc As PartDocument

    Set oLib = ThisApplication.AssetLibraries("Inventor Material Library")
    Set appAsset = oLib.AppearanceAssets(strColor)

    Set oParent = sbPart.Parent
    Set oPartDoc = oParent.Document

     'Copy the library into the document.
    Dim docAsset As Asset
    Dim testassets As Assets
    Set testassets = oPartDoc.Assets
    
    Set docAsset = appAsset.CopyTo(oPartDoc, False)

    sbPart.Appearance = docAsset
    
End Sub

And

Option Explicit
'Time Stamps
Dim StartTime As String
Dim oSurfBody As SurfaceBody
Dim oCompDef As ComponentDefinition
Dim oPartCompDef As PartComponentDefinition
Dim oPartDoc As PartDocument
Public Sub DeriveCaution(coPart As ComponentOccurrence)

    StartTime = DateTime.Now
    Debug.Print (StartTime & ", Derive caution")
    
    Dim i As Long
    Dim oSurfBodies As SurfaceBodies
    
    Set oPartDoc = coPart.Definition.Document
    Set oPartCompDef = oPartDoc.ComponentDefinition
    
    Dim oSBInt As SurfaceBody
    Dim oSBCaut As SurfaceBody
    Dim lngSBIntID As Long
    Dim lngSBCautID As Long
    Dim lngCounter As Long
    lngCounter = 1
    Set oSurfBodies = oPartCompDef.SurfaceBodies

    For Each oSurfBody In oPartCompDef.SurfaceBodies
        If oSurfBody.Name = "Int" Then
            Set oSBInt = oSurfBody
            lngSBIntID = lngCounter
        ElseIf oSurfBody.Name = "Caut" Then
            Set oSBCaut = oSurfBody
            lngSBCautID = lngCounter
        End If
        lngCounter = lngCounter + 1
    Next oSurfBody
    
    Dim test As Long
    oSBInt.Visible = False
    oSBCaut.Visible = False
    
    For i = 1 To oPartCompDef.SurfaceBodies.Count
        StartTime = DateTime.Now
        Debug.Print (StartTime & ", Solid " & i)
        
        Set oSurfBodies = oPartCompDef.SurfaceBodies
                
        Set oSBInt = oPartCompDef.SurfaceBodies.Item(lngSBIntID)
        Set oSBCaut = oPartCompDef.SurfaceBodies.Item(lngSBCautID)
        
        Set oSurfBody = oSurfBodies.Item(i)
        
        Set oSurfBody = oPartCompDef.SurfaceBodies.Item(i)
        Call IntCombine(oSurfBody, oSBCaut)
    Next i

End Sub
Public Sub DeriveInterference(coPart As ComponentOccurrence)
    StartTime = DateTime.Now
    Debug.Print (StartTime & ", Derive Interference")
    
    Dim i As Long
    Dim oSurfBodies As SurfaceBodies

    Set oPartDoc = coPart.Definition.Document
    Set oPartCompDef = oPartDoc.ComponentDefinition
    
    Dim oSBInt As SurfaceBody
    Dim oSBCaut As SurfaceBody
    Dim lngSBIntID As Long
    Dim lngSBCautID As Long
    Dim lngCounter As Long

    Set oSurfBodies = oPartCompDef.SurfaceBodies
    lngCounter = 1
    For Each oSurfBody In oPartCompDef.SurfaceBodies
        
        If oSurfBody.Name = "Int" Then
            Set oSBInt = oSurfBody
            lngSBIntID = lngCounter
        ElseIf oSurfBody.Name = "Caut" Then
            Set oSBCaut = oSurfBody
            lngSBCautID = lngCounter
        End If
        lngCounter = lngCounter + 1
    Next oSurfBody
    
    Dim test As Long
    oSBInt.Visible = False
    oSBCaut.Visible = False

    For i = 1 To oPartCompDef.SurfaceBodies.Count
        StartTime = DateTime.Now
        Debug.Print (StartTime & ", Solid " & i)
        
        Set oSurfBodies = oPartCompDef.SurfaceBodies
        Set oSurfBody = oSurfBodies.Item(i)
        
        Set oSBInt = oPartCompDef.SurfaceBodies.Item(lngSBIntID)
        Set oSBCaut = oPartCompDef.SurfaceBodies.Item(lngSBCautID)
        
        Set oSurfBody = oPartCompDef.SurfaceBodies.Item(i)
        Call IntCombine(oSurfBody, oSBInt)
    Next i

End Sub
Public Sub DeriveUA(coPart As ComponentOccurrence)
    StartTime = DateTime.Now
    Debug.Print (StartTime & ", UA")
            
    Dim i As Long
    Dim oSurfBodies As SurfaceBodies

    Set oPartDoc = coPart.Definition.Document
    Set oPartCompDef = oPartDoc.ComponentDefinition
    
    Dim oSBInt As SurfaceBody
    Dim oSBCaut As SurfaceBody
    Dim oSBMain As SurfaceBody
    Set oSurfBodies = oPartCompDef.SurfaceBodies
    Dim lngItemNumber As Long
    lngItemNumber = 1
    Dim lngSBIntID As Long
    Dim lngSBCautID As Long
    
    For Each oSurfBody In oPartCompDef.SurfaceBodies
        If oSurfBody.Name = "Int" Then
            Set oSBInt = oSurfBody
            lngSBIntID = lngItemNumber
        ElseIf oSurfBody.Name = "Caut" Then
            Set oSBCaut = oSurfBody
            lngSBCautID = lngItemNumber
        End If
        lngItemNumber = lngItemNumber + 1
    Next oSurfBody

    oSBInt.Visible = False
    oSBCaut.Visible = False
    
    For i = 1 To oPartCompDef.SurfaceBodies.Count
        StartTime = DateTime.Now
        Debug.Print (StartTime & ", Solid " & i)
    
        Set oSBInt = oPartCompDef.SurfaceBodies.Item(lngSBIntID)
        Set oSBCaut = oPartCompDef.SurfaceBodies.Item(lngSBCautID)
        Set oSurfBody = oPartCompDef.SurfaceBodies.Item(i)
        Call CutCombine(oSurfBody, oSBInt, oSBCaut)
    Next i

End Sub

Public Sub CutCombine(sbBase As SurfaceBody, ocRemove1 As SurfaceBody, ocRemove2 As SurfaceBody)
'            StartTime = DateTime.Now
'            Debug.Print (StartTime & "CutCombine")
            
    Dim oCombFeat As CombineFeature
    Dim oCombFeats As CombineFeatures
    Dim ocRemove As ObjectCollection
    Dim oTO As TransientObjects
    
    Set oTO = ThisApplication.TransientObjects
    Set ocRemove = oTO.CreateObjectCollection
    Call ocRemove.Add(ocRemove1)
    Call ocRemove.Add(ocRemove2)
    
    'ThisApplication.ScreenUpdating = False
    
    If Not (sbBase.Name = "Int") And Not (sbBase.Name = "Caut") Then
        
        sbBase.Visible = True
        Set oCombFeats = oPartCompDef.Features.CombineFeatures
        
        If Not (CombineFeatureExists(sbBase)) Then
            Set oCombFeat = oCombFeats.Add _
                (sbBase, ocRemove, kCutOperation, True)
        End If
    End If
    
    'ThisApplication.ScreenUpdating = True
    
End Sub
Public Sub IntCombine(sbBase As SurfaceBody, sbIntersect As SurfaceBody)
'    StartTime = DateTime.Now
'    Debug.Print (StartTime & ", IntCombine")
    
    Dim oCombFeat As CombineFeature
    Dim oCombFeats As CombineFeatures
    Dim ocRemove As ObjectCollection
    Dim oTO As TransientObjects
    
    Set oTO = ThisApplication.TransientObjects
    Set ocRemove = oTO.CreateObjectCollection
    Call ocRemove.Add(sbIntersect)
    
    'ThisApplication.ScreenUpdating = False
    
    If Not (sbBase.Name = "Int") And Not (sbBase.Name = "Caut") Then
        sbBase.Visible = True
        Set oCombFeats = oPartCompDef.Features.CombineFeatures

        If Not (CombineFeatureExists(sbBase)) Then
            Set oCombFeat = oCombFeats.Add _
              (sbBase, ocRemove, kIntersectOperation, True)
        End If
    End If
    
    ThisApplication.ScreenUpdating = True
    
End Sub
Private Function CombineFeatureExists(sbCombFeatSB As SurfaceBody) As Boolean
    
    Dim cfExists As Boolean
    Dim j As Long
    Dim oCombFeats As CombineFeatures
    
    Set oCombFeats = oPartCompDef.Features.CombineFeatures
    
    cfExists = False
    
    For j = 1 To oCombFeats.Count
        If (oCombFeats.Item(j).SurfaceBodies.Item(1).Name = sbCombFeatSB.Name) Then
            cfExists = True
        End If
    Next j
    
    CombineFeatureExists = cfExists

End Function

Community

Help streamlining/alpha testing code to create parts based on interferences.

Help streamlining/alpha testing code to create parts based on interferences.

Help streamlining/alpha testing code to create parts based on interferences.