Macro voor tekeneigenschappen

Hallo

Nieuw bij 3DExperience is dat ik de tekensjablonen moet maken die met het platform zullen worden gebruikt . Aangezien deze laatste geen verbanden legt tussen fysieke producten en tekeningen, kan ik de eigenschappen van mijn onderdelen en samenstellingen niet importeren in de tekeningen door de attributen in het platform te vergelijken. 
Om dit te doen, gebruik ik momenteel de MyCADTools-integratietool waarmee ik naar SLDDRW-bestanden kan schrijven met de eigenschappen die zijn opgehaald op het onderdeel of merk dat in het document wordt gebruikt. Niet alle gebruikers in mijn bedrijf hebben de MyCADTools-suite, dus ik doe een beroep op u voor een macro waarmee ik de integratietool kan vervangen en de SLDPRT/SLDASM-eigenschappen naar SLDDRW kan ophalen. 

Bij voorbaat dank. 


proprietes_slddrw.jpg
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

Hier is een voorbeeld dat ik heb om de info weer te geven

 

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

aan te passen aan uw geval

1 like

Nog een aanwijzing, kijk eens naar deze:

https://help.solidworks.com/2017/English/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm

of cel daar:

https://www.codestack.net/solidworks-api/document/drawing/copy-view-properties/