03-16-2020
10:23 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
03-16-2020
10:23 AM
The following code will derive in multiple parts, whose filenames are specified under the "Specify parts to derived in" section. You could instead use a loop of InputBoxes to specify part filenames, or some other method -- I wasn't sure what to do because you didn't provide any details about how you want to specify the parts to be derived in.
Dim ruleTitle As String = "Derive Multiple" ' Get current part document (the "recipient" part) Dim partDoc As PartDocument = ThisDoc.Document ' Set reference to Derived Part Components manager for recipient part Dim derPartComps As DerivedPartComponents = partDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents ' Specify parts to derived in (the "source" parts) Dim sourcePartPaths As New List(Of String) sourcePartPaths.Add("C:\...\PartToDeriveIn.ipt") ' <-- Change to path of the part you want to derive in. sourcePartPaths.Add("...") ' <-- Repeat for each desired source part. If sourcePartPaths.Count > 0 Then ' Start transaction Dim trans As Transaction = ThisApplication.TransactionManager.StartTransaction(partDoc, ruleTitle) ' Derive in each specified part Dim failedParts As New List(Of String) For Each sourcePartPath As String In sourcePartPaths If IO.File.Exists(sourcePartPath) Then Dim derivedPartDef As DerivedPartUniformScaleDef Try ' Create definition for derived part. derivedPartDef = derPartComps.CreateUniformScaleDef(sourcePartPath) Catch ex As Exception failedParts.Add("- '" & sourcePartPath & "': Error creating derive definition: '" & ex.Message & "'") Continue For End Try Try ' Set up the Derive. 'derivedPartDef.IncludeAll 'derivedPartDef.IncludeAllSolids = True Catch ex As Exception failedParts.Add("- '" & sourcePartPath & "': Error setting up derive: '" & ex.Message & "'") Continue For End Try Try ' Create Derive feature. derPartComps.Add(derivedPartDef) Catch ex As Exception failedParts.Add("- '" & sourcePartPath & "': Error creating derive feature: '" & ex.Message & "'") End Try Else failedParts.Add("- '" & sourcePartPath & "': File does not exist") End If Next If failedParts.Count = sourcePartPaths.Count Then trans.Abort Else trans.End End If If failedParts.Count > 0 Then MessageBox.Show("The following parts could not be Derived:" & vbCr & vbCr & String.Join(vbCr, failedParts), ruleTitle, MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End If Else MessageBox.Show("Must provide at least one Part to derive in.", ruleTitle, MessageBoxButtons.OK, MessageBoxIcon.Information) End If