Bonjour a tous,
Je suis partie d'une macro existante, je l'ai modifiée pour affecter des calques suivant les élément sélectionné.
Je ne trouve pas comment affecter un calque élément de référence, tolérance géométrique.
Il faut sélectionner toutes les annotations
Ci joint la macro
Merci d'avance de votre aide
Yannick
Si je comprend bien, la macro fonctionne sauf pour les tolérances géométriques. Dans ce cas remplace: Set swAnn = swGtol.Gtol
par : Set swAnn = swGtol.GetAnnotation
Je teste cette après midi
Merci
yannick
Je viens de tester
Ca fonctionne pour les tolérances géométrique
1. mais pas les pour les éléments de référence
2. Je dois également sélectionner toutes les tables présentent dans ma Mise en plan.
Y a t il une ligne de commande pour identifier toutes les tables?
3.Est t il possible de sélectionner tous les dimensions ,annotations, tolérances, table.... avec la macro que j'utilise ? Ctrl A n est pas pris en compte par l enregistreur de macro.
Merci
1. Pour les éléments de référence utilise
ElseIf TypeOf swSelObj Is SldWorks.DatumTag Then
Dim swDatum As SldWorks.DatumTag
Set swDatum = swSelObj
Set swAnn = swDatum.GetAnnotation
swAnn.Layer = layerName
2. pour traverser les tables tu peux utiliser GetTableAnnotations
3. pour traverser toute les annotation tu peux utiliser GetFirstDisplayDimension et NextDisplayDimension voir: https://help.solidworks.com/2018/English/api/sldworksapi/Traverse_Annotations_Example_VB.htm
salut Jérome,
Merci pour le retour.
Pas de probleme pour le point 1
Par contre le point 2 n'est pas pris en compte.
ElseIf TypeOf swSelObj Is SldWorks.TableAnnotation Then
Dim swAnnTable As SldWorks.TableAnnotation
Set swAnnTable = swSelObj
Set swAnn = swAnnTable.GetTableAnnotations
swAnn.Layer = layerName
Pas de sélection d'une bom ou liste de pièce soudées.
Serais tu d'ou cela peut provenir?
Je vais regarder la semaine prochaine pour le point 3
Merci pour tes retours.
Yannick
GetTableAnnotations retourne une liste. Il faut ensuite traiter chacune individuellement.
Dim swView As SldWorks.View
Dim swTables As Variant
Dim swTable As Variant
Dim swTableAnn As SldWorks.TableAnnotation
Set swView = swDraw.GetFirstView
If swView.GetTableAnnotationCount > 0 Then
swTables = swView.GetTableAnnotations
For Each swTable In swTables
Set swTableAnn = swTable
Set swAnn = swTableAnn.GetAnnotation
swAnn.Layer = layerName
next
End If
Pour mettre sur un calque spécifique chaque table, annotation, dimension, segment, etc... de chaque feuille et chaque vue, sans avoir à les sélectionner, essaye ca:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim vSheets As Variant
Dim vSheet As Variant
Dim swView As SldWorks.View
Dim swAnn As SldWorks.Annotation
Dim swNote As SldWorks.Note
Dim swDispDim As SldWorks.DisplayDimension
Dim swGtol As SldWorks.Gtol
Dim swDatum As SldWorks.DatumTag
Dim swAnnSFSymbol As SldWorks.SFSymbol
Dim swTables As Variant
Dim swTable As Variant
Dim swTableAnn As SldWorks.TableAnnotation
Dim swSketch As SldWorks.Sketch
Dim vSegs As Variant
Dim vSeg As Variant
Dim swSkSeg As SldWorks.SketchSegment
Dim vPts As Variant
Dim vPt As Variant
Dim swSkPt As SldWorks.SketchPoint
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Ouvrir une mise en plan"
Exit Sub
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
MsgBox "Ouvrir une mise en plan"
Exit Sub
End If
Set swDraw = swModel
vSheets = swDraw.GetSheetNames
For Each vSheet In vSheets
swDraw.ActivateSheet vSheet
Set swView = swDraw.GetFirstView
If swView.GetTableAnnotationCount > 0 Then
swTables = swView.GetTableAnnotations
For Each swTable In swTables
Set swTableAnn = swTable
Set swAnn = swTableAnn.GetAnnotation
swAnn.Layer = "Annotations"
Next
End If
Set swView = swView.GetNextView
While Not swView Is Nothing
Set swNote = swView.GetFirstNote
While Not swNote Is Nothing
Set swAnn = swNote.GetAnnotation
swAnn.Layer = "Annotations"
Set swNote = swNote.GetNext
Wend
Set swDatum = swView.GetFirstDatumTag
While Not swDatum Is Nothing
Set swAnn = swDatum.GetAnnotation
swAnn.Layer = "Annotations"
Set swDatum = swDatum.GetNext
Wend
Set swGtol = swView.GetFirstGTOL
While Not swGtol Is Nothing
Set swAnn = swGtol.GetAnnotation
swAnn.Layer = "Annotations"
Set swGtol = swGtol.GetNextGTOL
Wend
Set swAnnSFSymbol = swView.GetFirstSFSymbol
While Not swAnnSFSymbol Is Nothing
Set swAnn = swAnnSFSymbol.GetAnnotation
swAnn.Layer = "Annotations"
Set swAnnSFSymbol = swAnnSFSymbol.GetNext
Wend
Set swDispDim = swView.GetFirstDisplayDimension5
While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
swAnn.Layer = "Annotations"
Set swDispDim = swDispDim.GetNext5
Wend
Set swSketch = swView.GetSketch
vSegs = swSketch.GetSketchSegments
If Not IsEmpty(vSegs) Then
For Each vSeg In vSegs
Set swSkSeg = vSeg
swSkSeg.Layer = "Dessin"
Next
End If
vPts = swSketch.GetSketchPoints2
If Not IsEmpty(vPts) Then
For Each vPt In vPts
Set swSkPt = vPt
swSkPt.Layer = "Dessin"
Next
End If
Set swView = swView.GetNextView
Wend
Next
swModel.ClearSelection2 True
End Sub