Eigendom van onderdelen van assemblage bewerken

3D Design
1

Hallo

Ik ben op zoek naar een manier om de aangepaste eigenschappen van een onderdeel uit de assemblage te bewerken.

Ik vond deze kleine macro op het web, maar het is gewoon een kijker.

Ik heb ook een paar macrosjablonen die de geselecteerde componenten openen of opslaan.

Ik dacht dat ik in de code gemakkelijk de "geselecteerde component" en "open" of "save" onderdelen zou vinden om te vervangen door "open props". gepersonaliseerd", maar ze zijn anders geschreven, er zijn tellers, veel dingen die ik niet begrijp, kortom, nee, het is niet gemakkelijk...

 

 


view_properties_of_selected_component_from_assembly.swp
2

Hallo

Hier is een klein voorbeeld (snel gemaakt) dat u zou moeten helpen:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim CompModel As ModelDoc2
Dim swChildComp As SldWorks.Component2
Dim SelectedObject As Object
Dim NbrSelections As Long
Dim i As Long
Dim lErrors As Long
Dim lWarnings As Long

Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim myAssy As AssemblyDoc
Dim nInfo As Long
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim val As String
Dim valout As String

Sub main()

    Set swApp = Application.SldWorks
    Set Model = swApp.ActiveDoc
    
    Set myAssy = Model

    Dim SelMgr As SelectionMgr
    Set SelMgr = Model.SelectionManager
        
    NbrSelections = SelMgr.GetSelectedObjectCount2(-1)

    Set SelectedObject = SelMgr.GetSelectedObject6(1, -1)
    If NbrSelections = 1 Then
        Set swChildComp = SelectedObject
        Set CompModel = swChildComp.GetModelDoc2
        
        bRet = myAssy.EditPart2(True, True, nInfo)
        Set swModel = myAssy.GetEditTarget
        Set swModelDocExt = swModel.Extension
        Set swCustProp = swModelDocExt.CustomPropertyManager("")
        
        bRet = swCustProp.Add3("MaPropriete", swCustomInfoType_e.swCustomInfoText, "Ma valeur 1", swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
        bRet = swCustProp.Get4("MaPropriete", False, val, valout)
        
        Debug.Print "valeur évaluée : " & valout
        
        bRet = swCustProp.Set2("MaPropriete", "Ma valeur 3")
        bRet = swCustProp.Get4("MaPropriete", False, val, valout)
        
        Debug.Print "valeur évaluée : " & valout
        
        bRet = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
        
        myAssy.EditAssembly
    End If
    
End Sub

Om te testen, opent u een assemblage en selecteert u vervolgens een onderdeel in de functiebeheerder voordat u de macro start (te doen op testonderdelen).

Vriendelijke groeten

1 like
3

Dank je wel d.roger

Ik heb je macro geprobeerd, het werkt, maar het is niet precies wat ik had verwacht (in feite gaat het een beetje te ver)

in feite uw macro

- Activeer de geselecteerde component : ok voor mij

- heeft de propriété "Ma propriété", avec la vale " Ma valeur 1" : en fait je voudrais juste ouvrir la fenêtre de propriété personnalisés.

- enregistre (?) et ferme le composant pour retourner a l'assemblage : Idéalement cette opération peut être déclanché à la fermeture de la fenêtre de propriété personnalisés. si non, a faire manuellement, ça sera déjà bien.

 

 

 

4

Zoiets als dit:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim CompModel As ModelDoc2
Dim swChildComp As SldWorks.Component2
Dim SelectedObject As Object
Dim NbrSelections As Long
Dim i As Long
Dim lErrors As Long
Dim lWarnings As Long

Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim myAssy As AssemblyDoc
Dim nInfo As Long

Sub main()

    Set swApp = Application.SldWorks
    Set Model = swApp.ActiveDoc
    
    Set myAssy = Model

    Dim SelMgr As SelectionMgr
    Set SelMgr = Model.SelectionManager
        
    NbrSelections = SelMgr.GetSelectedObjectCount2(-1)

    Set SelectedObject = SelMgr.GetSelectedObject6(1, -1)
    If NbrSelections = 1 Then
        Set swChildComp = SelectedObject
        Set CompModel = swChildComp.GetModelDoc2
        
        bRet = myAssy.EditPart2(True, True, nInfo)
        Set swModel = myAssy.GetEditTarget

        swModel.FileSummaryInfo
        
        bRet = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
        
        myAssy.EditAssembly
    End If
    
End Sub

Vriendelijke groeten

2 likes
5

ALLELUIA ! Glorie aan u, zowel op het land als op zee!

Ik heb het gevoel dat mijn collega's het leuk zullen vinden!

Miles bedankt D.Roger, altijd zo efficiënt

1 like
6

Ik heb nog een heel kleine opmerking: het werkt niet goed op de subassemblages:

Het lijkt erop dat er een omkering is tussen de stappen "open het eigenschappenvenster" en "activeer de geselecteerde component"

 

7

Hallo

Probeer het eens met deze macroversie:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim CompModel As ModelDoc2
Dim swChildComp As SldWorks.Component2
Dim SelectedObject As Object
Dim NbrSelections As Long
Dim i As Long
Dim lErrors As Long
Dim lWarnings As Long

Dim swModel As Object
Dim bRet As Boolean
Dim myAssy As AssemblyDoc
Dim nInfo As Long

Sub main()

    Set swApp = Application.SldWorks
    Set Model = swApp.ActiveDoc
    
    Set myAssy = Model

    Dim SelMgr As SelectionMgr
    Set SelMgr = Model.SelectionManager
        
    NbrSelections = SelMgr.GetSelectedObjectCount2(-1)

    Set SelectedObject = SelMgr.GetSelectedObject6(1, -1)
    If NbrSelections = 1 Then
        Set swChildComp = SelectedObject
        Set CompModel = swChildComp.GetModelDoc2
        
        If CompModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
            myAssy.EditAssembly
        End If

        bRet = myAssy.EditPart2(True, True, nInfo)
        Set swModel = myAssy.GetEditTarget
    
        swModel.FileSummaryInfo
            
        bRet = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
            
        myAssy.EditAssembly

    End If
    
End Sub

Vriendelijke groeten

1 like
8

Ontzagwekkend. Niets om over te klagen.

Deze macro compenseert enigszins de bug van de visualisatietool die in dit bericht wordt genoemd

Hartelijk dank!

1 like