vba code to extract Part Number from Ipart Member

[jwisler434493]

I'm trying to write a VBA Code to save the flat Pattern for an Ipart member out to use for our laser. I have the code to where it will save out, but it save the file as the Ipart File Name. I need it to use the Part Number from the Ipart child.


Below is the current code:



' Get the active document. This assumes it is a part document.
Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument

' Get DXF File Name
Dim sDWGFileName As String
sDWGFileName = Left(oDoc.Inventor.kiPartMemberObject.kiPartTableRowObject.PartName, Len(oDoc.Inventor.kiPartMemberObject.kiPartTableRowObject.PartName) - 4) & ".dwg"

' Get the DataIO object.
Dim oDataIO As DataIO
Set oDataIO = oDoc.ComponentDefinition.DataIO

' Build the string that defines the format of the DXF file
Dim sOut As String
sOut = "FLAT PATTERN DWG?AcadVersion=2000" _
+ "&OuterProfileLayer=Profile&OuterProfileLayerColor=0;255;255" _
+ "&InteriorProfilesLayer=Hole&InteriorProfilesLayerColor=255;255;0" _
+ "&FeatureProfilesLayer=Scribe&FeatureProfilesLayerColor=0;0;255" _
+ "&InvisibleLayers=IV_TANGENT;IV_BEND;IV_BEND_DOWN;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS"

' Create the DWG file (With string function to isolate file name from original path).
oDataIO.WriteDataToFile sOut, "P:\(Engineering\Drawings\DWGs\" & Mid(sDWGFileName, InStrRev(sDWGFileName, "\") + 1, Len(sDWGFileName))

' SAVE AND CLOSE
SendKeys "%F", False
SendKeys "C", False
SendKeys "Y", True

End Sub