Partnumber - automatic change by VBA macro
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello all,
I would like to change partnumber in my project in "automatic mode " like on scheme below:
I have a simple code, but it works only for parts on one BOM level and does not save the scheme 0.001 ... 1.001 etc. (I do not think that's the way):
Sub Zmiana_partnumber()
Dim asmDoc As AssemblyDocument
Set asmDoc = ThisApplication.ActiveDocument
Dim oBom As BOM
Set oBom = asmDoc.ComponentDefinition.BOM
oBom.StructuredViewEnabled = True
oBom.StructuredViewFirstLevelOnly = False
Dim oBOMView As BOMView
Set oBOMView = oBom.BOMViews(2)
Dim compDef As ComponentDefinition
Dim doc As Document
Dim row As BOMRow
Dim prop As Property
Dim NUMER As String
Dim Licznik As Long
NUMER = InputBox("Wprowadź NUMER", "Okno wprowadzania", xx_xxxx)
For Each row In oBOMView.BOMRows
Set compDef = row.ComponentDefinitions(1)
Set doc = compDef.Document
If compDef.Type = kVirtualComponentDefinitionObject Then
Set prop = compDef.PropertySets("Design Tracking Properties")("Part Number")
Else
Set prop = doc.PropertySets("Design Tracking Properties")("Part Number")
End If
Licznik = Licznik + 1
If doc.IsModifiable Then
If prop.Value <> NUMER Then prop.Value = NUMER & "-" & Licznik
End If
Next
End SubThe next thing would be copying the entire file structure to a new folder, changing the names of files to part numbers 
Is it possible to do this type of macro in VBA at all?
Thanks in advance,
ralfmj