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)
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)
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