Lynkoa

MENU
Stop guided tour Guided tours

Access more resources with myCADservices

  • Custom support
  • Download CAO
  • 3D Components
  • Premium applications
Learn more about myCADservices

Macro pour propriétés de mises en plan
  • Topic:
    • 3DEXPERIENCE
    • SOLIDWORKS

  • 3 answers
  • 381 views

By jviala13 The 17 February 2022

Bonjour,

Nouvel utilisateur 3DExperience, j'ai besoin de créer les modèles de mises en plans qui seront utilisés avec la plateforme. Celle-ci ne faisant pas de liens entre les produits physiques et les dessins, je ne peux pas importer les propriétés de mes pièces et assemblages vers les mises en plan en croisant les attributs dans la plateforme. 
Pour ce faire, j'utilise actuellement l'outils Integration des MyCADTools qui me permet d'écrire sur les fichiers SLDDRW les propriétés récupérées sur la pièce ou l'assemblage utilisé dans le document. Tous les utilisateurs de mon entreprise ne possédant pas la suite MyCADTools, je fais appel à vous pour une macro qui me permettrait de remplacer l'outil Integration et de récupérer les propriétés SLDPRT/SLDASM vers SLDDRW. 

Je vous remercie d'avance. 

Answers

Louis LEAU

ll | 1897 point(s) 

Sub Propriétées()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2

    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc

    Debug.Print "File = " + swModel.GetPathName

    Debug.Print "  Titre             = " + swModel.SummaryInfo(swSumInfoTitle)
    Text = swModel.SummaryInfo(swSumInfoTitle)
    Debug.Print "  Sujet            = " + swModel.SummaryInfo(swSumInfoSubject)
    Debug.Print "  Auteur            = " + swModel.SummaryInfo(swSumInfoAuthor)
    Debug.Print "  Mots clés         = " + swModel.SummaryInfo(swSumInfoKeywords)
    Debug.Print "  Commentaires      = " + swModel.SummaryInfo(swSumInfoComment)
    Debug.Print "  Enregistré par    = " + swModel.SummaryInfo(swSumInfoSavedBy)
    Debug.Print "  Créé le (01)      = " + swModel.SummaryInfo(swSumInfoCreateDate)
    Debug.Print "  Enregistré le (01)= " + swModel.SummaryInfo(swSumInfoSaveDate)
    Debug.Print "  Créé le (02) = " + swModel.SummaryInfo(swSumInfoCreateDate2)
    Debug.Print "  Enregistré le (02)= " + swModel.SummaryInfo(swSumInfoSaveDate2)
    
End Sub

voici un exemple que j'ai pour afficher les info

 

Louis LEAU

ll | 1897 point(s) 

Sub Propriétées()

Dim boolstatus As Boolean
Dim lErrors As Long, lWarnings As Long
    
Set swApp = Application.SldWorks
Set CurrentDOC = swApp.ActiveDoc            'Document actif
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")

Set swDraw = swModel
vSheets = swDraw.GetSheetNames
swDraw.ActivateSheet vSheets(0)             'Affiche la 1ère feuille : en cas d'assemblage avec des vues de pièces séparées (soudure)
                                            'la 1ère vue de la 1ère feuille à plus de chance d'être l'assemblage plutôt qu'une pièce
                                            
Set swView = swDraw.GetFirstView            'active/récupère le fond de plan pour les propriétées perso
Set swView = swView.GetNextView             'active/récupère la première vue pour les propriétées perso
Set swRefDoc = swView.ReferencedDocument    '3D de la mise en plan

NP = swRefDoc.GetCustomInfoValue("", "TA PROPRIETE PERSO") 'Récupère le TITRE du 3D
Existe_NP = swModel.GetCustomInfoValue("", "TA PROPRIETE PERSO") 'Teste l'existence de la propriétée dans la MEP

If Existe_NP <> NP Then
    swRefDoc.SummaryInfo(swSumInfoTitle) = NP 'TITRE 'Récapitulatif' du 3D
    swCustPropMgr.Delete "TA PROPRIETE PERSO"
    retVal = swCustPropMgr.Add2("TA PROPRIETE PERSO", swCustomInfoText, NP) 'TITRE 'Personnaliser'
    swModel.SummaryInfo(swSumInfoTitle) = NP 'TITRE 'Récapitulatif'
    swModel.SummaryInfo(swSumInfoAuthor) = "TA PROPRIETE PERSO 02" 'AUTEUR 'Récapitulatif'
    
    'Zoom sur la feuille avant enregistrement
    Dim swModelDocExt As SldWorks.ModelDocExtension
    Set swModelDocExt = swModel.Extension
    swModelDocExt.ViewZoomToSheet

    boolstatus = swRefDoc.Save3(swSaveAsOptions_Silent, lErrors, lWarnings) 'Sauvegarde le 3D
    boolstatus = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings) 'Sauvegarde la MEP
End If

End Sub

a adapter a ton cas

The most popular posts

By continuing your visit to this site, you accept the use of cookies. Read more

OK