Macro adding note with property link for assembly parts in MPE

Out of category
1

Hello everyone,

I'm working on a macro to add a note related to a property. This one functions for a room.

I want the note to be inserted automatically for all parts present  (from an assembly) on the selected view.

 

Anyone have an idea?

Here is the macro and file I'm working on.

Thank you in advance for your feedback


exemple.zip
2

Hello
The tricky part is finding and selecting the entity on which to place the arrow. There are several methods for this:   GetVisibleEntities2 and SelectByRay (usually to avoid, but faster to select silhouette edges)
Then all you have to do is insert the annotation with:

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

And reposition the note with:

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

 

1 Like
3

Hello Jerome,

Thank you for your feedback. I wrote this macro, but it runs indefinitely and doesn't insert the desired note.

Do you have an idea of the problem?

 

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

Try this:

Note: The arrows are placed randomly on the largest face. To place them more exactly, you would have to find the coordinates of the desired point in the component, then transform in the coordinate system of the assembly (taking into account the exploded figure) and then transform in the coordinate system of the view. Then use 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

Thank you Jerome 

1 Like