Macro ajout note avec lien propriété pour pièces assemblage dans MPE

Out of category
1

bonjour a tous,

Je travaille sur une macro afin d'ajouter une note liée à un propriété. Celle ci fonction pour une pièce.

Je cherche à ce que la note soit inséré automatiquement pour toutes les pièces présentent  (provenant d'un assemblage) sur la vue sélectionnée .

 

Quelqu'un aurait une idée?

ci joint la macro et fichier sur lequel je travaille.

Merci d'avance de vos retours


exemple.zip
2

Bonjour,
La partie compliquée est de trouver et sélectionner l'entité sur laquelle placer la flèche. Il y a plusieurs méthodes pour ca:   GetVisibleEntities2 et SelectByRay (généralement à éviter, mais plus rapide pour sélectionner les arrêtes en silhouette)
Ensuite il n'y a plus qu'a insérer l'annotation avec:

Set myNote = swModel.InsertNote("$PRPMODEL:""NUMERO_PLAN""")

Et repositionner la note avec:

Set myAnnotation = myNote.GetAnnotation
boolstatus = myAnnotation.SetPosition(0.13, 0.11, 0)

 

1 « J'aime »
3

Bonjour jérome,

Merci pour ton retour. j'ai écrit cette macro, mais elle tourne indéfiniment et n'insère pas la note souhaitée.

Aurais tu une idée du problème?

 

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.view
Dim Comp As SldWorks.Component2
Dim vComps As Variant
Dim vComp As Variant
Dim vEdges As Variant
Dim vEdge As Variant
Dim swEdge As SldWorks.Edge
Dim myNote As Object
Dim myAnnotation As Object
Dim boolstatus As Boolean
Dim swEntity As SldWorks.Entity


Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.ActiveDrawingView
swModel.ClearSelection2 True
vComps = swView.GetVisibleComponents
For Each vComp In vComps
    Set Comp = vComp
    vEdges = swView.GetVisibleEntities(Comp, swViewEntityType_e.swViewEntityType_Edge)
    For Each vEdge In vEdges
        Set swEdge = vEdge
        Set swEntity = swEdge
        swEntity.Select4 True, Nothing
            Set myNote = swModel.InsertNote("$PRPMODEL:""NUMERO_PLAN""")
            Set myAnnotation = myNote.GetAnnotation
            boolstatus = myAnnotation.SetPosition(0.13, 0.11, 0)

    Next
Next

 

End Sub

4

Essaye ca:

Note: les flèches sont placées aléatoirement sur la face la plus grande. Pour les placer plus exactement il faudrait trouver les coordonnées du point voulut dans le composant, puis transformer dans le repère de l'assemblage (en prenant en compte l'éclaté) et ensuite transformer dans le repère de la vue. Puis utiliser SelectByRay

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDrawing As SldWorks.DrawingDoc
    Dim swView As SldWorks.View
    Dim swComp As SldWorks.Component2
    Dim swEnt As SldWorks.Entity
    Dim CompCount As Long
    Dim vComps As Variant
    Dim vFaces As Variant
    Dim swFace As SldWorks.Face2
    Dim i As Long
    Dim j As Long
    Dim boolstatus As Boolean
    Dim MaxArea As Double
    Dim swNote As SldWorks.Note
    Dim swAnn As SldWorks.Annotation
    Dim CompNames As Object
    Dim vPos As Variant
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawing = swModel
    Set swView = swDrawing.ActiveDrawingView
    Set CompNames = CreateObject("Scripting.Dictionary")
   
    swModel.ClearSelection2 True
    Debug.Assert Not swView Is Nothing

    CompCount = swView.GetVisibleComponentCount
    Debug.Assert CompCount <> 0
    Debug.Print "Nombre de composants = " & CompCount

    vComps = swView.GetVisibleComponents
    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        Debug.Print "Fichier du composant " & i & ": " & swComp.GetPathName
        vFaces = swView.GetVisibleEntities2(swComp, swViewEntityType_e.swViewEntityType_Face)
        If Not IsEmpty(vFaces) Then
            Debug.Print "   Ce composant a " & UBound(vFaces) + 1 & " faces visible dans cette vue"
            MaxArea = 0
            For j = 0 To UBound(vFaces)
                Set swFace = vFaces(j)
                If swFace.GetArea > MaxArea Then
                    MaxArea = swFace.GetArea
                    Set swEnt = swFace
                End If
            Next j
            If Not CompNames.Exists(swComp.GetPathName) Or MaxArea > 0.001 Then
                If Not CompNames.Exists(swComp.GetPathName) Then CompNames.Add swComp.GetPathName, 1
                boolstatus = swEnt.Select4(False, Nothing)
                Set swNote = swModel.InsertNote("$PRPMODEL:""NUMERO_PLAN""")
                Set swAnn = swNote.GetAnnotation
                vPos = swAnn.GetPosition
                boolstatus = swAnn.SetPosition(0.18, vPos(1), 0)
            End If
        End If
    Next
End Sub

 

5

Merci Jérome 

1 « J'aime »