De bestanden van de creatieboom uit de nomenclatuur halen?

Out of category
21

Heb je geprobeerd om een pakket te maken en ga van de montage en test het. Om er zeker van te zijn dat het niet van de PDM komt.

22

Ik denk dat het afkomstig is van de PDM, ik heb logischerwijs hetzelfde probleem met de assemblages van de PDM, om dit te verhelpen moet je elke assemblage openen en dan teruggaan naar de hoofdassemblage en de macro starten en alles werkt anders is het de fout ... Elk onderdeel moet in het Solidworks-geheugen worden geladen.

Vriendelijke groeten

23

Bedankt d.roger voor deze informatie. Het is ingewikkelder dan ik dacht... Op de schaal van een machine van 4000 onderdelen of meer zal het lang duren!

Ik denk dat ik bij mijn huidige methode moet blijven, die vrij vervelend maar effectief is.

 

Ik valideer de macrocode nog steeds als antwoord op mijn vraag, het kan nuttig zijn voor anderen.

1 like
24

Hier is een andere benadering die de ontwerpboom gebruikt in plaats van de stukken zelf.
Wat zou meer compatibel moeten zijn met PDM

Option Explicit
Dim FilePath As String
Sub main()
    FilePath = "C:\Temp\myBOM.TSV"
    If Dir(FilePath) <> "" Then Kill FilePath
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim rootNode As SldWorks.TreeControlItem
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set rootNode = swModel.FeatureManager.GetFeatureTreeRootItem2(swFeatMgrPane_e.swFeatMgrPaneBottom)
    If rootNode Is Nothing Then Exit Sub
    TraverseNode rootNode, Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1, InStrRev(swModel.GetPathName, ".") - InStrRev(swModel.GetPathName, "\") - 1)
End Sub

Private Sub TraverseNode(node As SldWorks.TreeControlItem, Rep As String)
Dim CompNode As SldWorks.Component2
If node.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
    Debug.Print "Pièce: " & node.Text
    If Not node.Object Is Nothing Then
        Set CompNode = node.Object
        WriteIntoFile Rep
    End If
End If

Dim ChildNode As SldWorks.TreeControlItem
Set ChildNode = node.GetFirstChild
While Not ChildNode Is Nothing
    If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
        Set CompNode = ChildNode.Object
        Dim CompName As String
        CompName = CompNode.Name2
        CompName = Mid(CompName, InStrRev(CompName, "/") + 1)
        TraverseNode ChildNode, Rep & " > " & CompName
    End If
    If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Feature Then
        Dim FeatNode As SldWorks.Feature
        Set FeatNode = ChildNode.Object
        If FeatNode.GetTypeName2 = "FtrFolder" Then
            Debug.Print "Répertoire: " & ChildNode.Text
            TraverseNode ChildNode, Rep & " > " & FeatNode.Name
        End If
    End If
    Set ChildNode = ChildNode.GetNext
Wend
End Sub

Sub WriteIntoFile(logSTR As String)
    Debug.Print "  =>  " & logSTR
    Dim FileNum As Integer
    FileNum = FreeFile
    Open FilePath For Append As #FileNum
    Print #FileNum, logSTR
    Close #FileNum
End Sub

 

1 like
25

Uitstekend! Het werkt perfect!

Ik heb alleen een klein bericht aan het einde toegevoegd om aan te geven dat de export is gedaan

Msgbox "Export réalisé"

 

Heel erg bedankt voor je hulp JeromeP.

Is het toevallig mogelijk om alleen het eerste niveau van de subset in elke map in de boom te hebben?

26

Graag.

Opmerking: ik heb zojuist aangepast om rekening te houden met de submappen

27

Het is al geweldig in de staat, maar er zouden 2 kleine dingen ontbreken om perfect aan mijn behoeften te voldoen:

- beperk de export tot het eerste subsetniveau in elke map (ik heb niet meer nodig)

- Exporteer geen artikelen die zijn uitgesloten van de stuklijst.

Denk je dat dit mogelijk is?

28

Alles is mogelijk.

Option Explicit
Dim FilePath As String
Sub main()
    FilePath = "C:\Temp\myBOM.TSV"
    If Dir(FilePath) <> "" Then Kill FilePath
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim rootNode As SldWorks.TreeControlItem
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set rootNode = swModel.FeatureManager.GetFeatureTreeRootItem2(swFeatMgrPane_e.swFeatMgrPaneBottom)
    If rootNode Is Nothing Then Exit Sub
    TraverseNode rootNode, 0, Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1, InStrRev(swModel.GetPathName, ".") - InStrRev(swModel.GetPathName, "\") - 1)
End Sub

Private Sub TraverseNode(node As SldWorks.TreeControlItem, level As Integer, Rep As String)
Dim CompNode As SldWorks.Component2
If node.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
    'Debug.Print "Pièce: " & node.Text
    If Not node.Object Is Nothing Then
        Set CompNode = node.Object
        WriteIntoFile Rep
    End If
End If

Dim ChildNode As SldWorks.TreeControlItem
Set ChildNode = node.GetFirstChild
While Not ChildNode Is Nothing
    If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
        Set CompNode = ChildNode.Object
        Dim CompName As String
        CompName = CompNode.Name2
        CompName = Mid(CompName, InStrRev(CompName, "/") + 1)
        If level < 1 And CompNode.ExcludeFromBOM = False Then
            TraverseNode ChildNode, level + 1, Rep & " > " & CompName
        End If
    End If
    If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Feature Then
        Dim FeatNode As SldWorks.Feature
        Set FeatNode = ChildNode.Object
        If FeatNode.GetTypeName2 = "FtrFolder" Then
            'Debug.Print "Répertoire: " & ChildNode.Text
            TraverseNode ChildNode, level, Rep & " > " & FeatNode.Name
        End If
    End If
    Set ChildNode = ChildNode.GetNext
Wend
End Sub

Sub WriteIntoFile(logSTR As String)
    Debug.Print "  =>  " & logSTR
    Dim FileNum As Integer
    FileNum = FreeFile
    Open FilePath For Append As #FileNum
    Print #FileNum, logSTR
    Close #FileNum
End Sub

 

29

Extra, het is perfect!

Ik weet niet hoe ik je moet bedanken, dit alles zal veel perspectieven openen in mijn bedrijf!