Macro toevoegen notitie met eigenschapslink voor assemblageonderdelen in MPE

Out of category
1

Hallo allemaal,

Ik werk aan een macro om een notitie toe te voegen die betrekking heeft op een eigenschap. Deze functioneert voor een kamer.

Ik wil dat de notitie automatisch wordt ingevoegd voor alle onderdelen die aanwezig  zijn (van een assemblage) op de geselecteerde weergave.

 

Iemand een idee?

Hier is de macro en het bestand waar ik aan werk.

Alvast bedankt voor uw feedback


exemple.zip
2

Hallo
Het lastige is het vinden en selecteren van de entiteit waarop de pijl moet worden geplaatst. Hier zijn verschillende methoden voor:   GetVisibleEntities2 en SelectByRay (meestal om te vermijden, maar sneller om silhouetranden te selecteren)
Dan hoef je alleen nog maar de annotatie in te voegen met:

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

En verplaats de notitie met:

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

 

1 like
3

Hallo Hiëronymus,

Bedankt voor je feedback. Ik heb deze macro geschreven, maar deze wordt voor onbepaalde tijd uitgevoerd en voegt niet de gewenste notitie in.

Heb je een idee van het probleem?

 

Optie Expliciete
Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim swDraw als SldWorks.DrawingDoc
Dim swView als SldWorks.view
Dim Comp als SldWorks.Component2
Dim vComps als variant
Dim vComp als variant
Dim vEdges als variant
Dim vEdge als variant
Dim swEdge als SldWorks.Edge
MyNote dimmen als object
MyAnnotation dimmen als object
Dim boolstatus als Booleaanse
Dim swEntity als SldWorks.Entity


Sub hoofd()
Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
Stel swDraw = swModel in
Stel swView = swDraw.ActiveDrawingView in
swModel.ClearSelection2 Waar
vComps = swView.GetVisibleComponents
Voor elke vComp In vComps
    Stel Comp in = vComp
    vEdges = swView.GetVisibleEntities(Comp, swViewEntityType_e.swViewEntityType_Edge)
    Voor elke vEdge in vEdges
        Stel swEdge in = vEdge
        Stel swEntity = swEdge in
        swEntity.Select4 Waar, niets
            Stel myNote in = swModel.InsertNote("$PRPMODEL:""NUMERO_PLAN""")
            Stel myAnnotation in = myNote.GetAnnotation
            boolstatus = myAnnotation.SetPosition(0.13, 0.11, 0)

    Volgend
Volgend

 

Einde Sub

4

Probeer het volgende:

Opmerking: De pijlen worden willekeurig op het grootste vlak geplaatst. Om ze nauwkeuriger te plaatsen , zou je de coördinaten van het gewenste punt in de component moeten vinden, vervolgens moeten transformeren in het coördinatensysteem van de assemblage (rekening houdend met de geëxplodeerde figuur) en vervolgens transformeren in het coördinatensysteem van de weergave. Gebruik dan 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

Dank je wel Jerome 

1 like