Hinzufügen einer Notiz mit Makro mit Eigenschaftsverknüpfung für Baugruppenteile in MPE

Hallo an alle

Ich arbeite an einem Makro, um eine Notiz hinzuzufügen, die sich auf eine Eigenschaft bezieht. Dieser funktioniert für einen Raum.

Ich möchte, dass die Notiz automatisch für alle Teile eingefügt wird, die (aus einer Baugruppe) in der ausgewählten Ansicht vorhanden sind .

 

Hat jemand eine Idee?

Hier ist das Makro und die Datei, an der ich arbeite.

Vielen Dank im Voraus für Ihr Feedback


exemple.zip

Hallo
Der knifflige Teil besteht darin, das Element zu finden und auszuwählen , auf dem der Pfeil platziert werden soll. Hierfür gibt es mehrere Methoden:   GetVisibleEntities2 und SelectByRay (normalerweise zum Vermeiden, aber schneller, um Silhouettenkanten auszuwählen)
Dann müssen Sie nur noch die Anmerkung einfügen mit:

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

Und positionieren Sie die Notiz neu mit:

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

 

1 „Gefällt mir“

Hallo Jerome,

Vielen Dank für Ihr Feedback. Ich habe dieses Makro geschrieben, aber es läuft unbegrenzt und fügt die gewünschte Note nicht ein.

Haben Sie eine Vorstellung von dem Problem?

 

Option Explizit
Dim swApp als SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.view
Dim-Comp als SldWorks.Component2
Dimmen von vComps als Variante
Dim vComp als Variante
Dim vEdges als Variante
Dim vEdge als Variante
Dim swEdge als SldWorks.Edge
myNote als Objekt dimmen
myAnnotation als Objekt dimmen
Dim boolstatus als boolescher Wert
Dim swEntity als SldWorks.Entity


Sub main()
Legen Sie swApp = Application.SldWorks fest
Festlegen von swModel = swApp.ActiveDoc
Festlegen von swDraw = swModel
Legen Sie swView = swDraw.ActiveDrawingView fest
swModel.ClearSelection2 Wahr
vComps = swView.GetVisibleComponents
Für jede vComp In vComps
    Set Comp = vComp
    vEdges = swView.GetVisibleEntities(Comp, swViewEntityType_e.swViewEntityType_Edge)
    Für jede vEdge in vEdges
        Festlegen von swEdge = vEdge
        Legen Sie swEntity = swEdge fest
        swEntity.Select4 True, Nichts
            Set myNote = swModel.InsertNote("$PRPMODEL:""NUMERO_PLAN""")
            Legen Sie myAnnotation = myNote.GetAnnotation fest
            boolstatus = myAnnotation.SetPosition(0.13; 0.11; 0)

    Nächster
Nächster

 

Ende Sub

Versuchen Sie Folgendes:

Hinweis: Die Pfeile werden zufällig auf der größten Fläche platziert. Um sie genauer zu platzieren , müssten Sie die Koordinaten des gewünschten Punktes in der Komponente finden, dann im Koordinatensystem der Baugruppe transformieren (unter Berücksichtigung der aufgelösten Figur) und dann im Koordinatensystem der Ansicht transformieren. Verwenden Sie dann 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

 

Danke Jerome 

1 „Gefällt mir“