Makroauswahl von Durchmessern mit Anpassung in der Zeichnung

Macro
1

Hallo

 

Ist es möglich, alle Ø mit einer Anpassung in den Zeichnungen auszuwählen?

 

und durch Passform mit Toleranzen ersetzen?

Toleranzen, die zusätzlich in Klammern zu setzen sind

 

Hier ist das kleine Makro, das ich begonnen habe.

Ich bleibe bei der Durchmesserauswahl mit Anpassung hängen und ersetze sie durch Anpassung mit Toleranzen (in Klammern)

Vielen Dank im Voraus für Ihre Hilfe

Yannick


mep_-_selectionner_dimensions_avec_ajustement.swp
2

Hallo. Versuchen Sie Folgendes:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swDimTol As SldWorks.DimensionTolerance
'Dim swAnn As SldWorks.Annotation '
          
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Veuillez ouvrir un dessin": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then MsgBox "Veuillez ouvrir un dessin": Exit Sub
Set swDraw = swModel
swModel.ClearSelection2 True
Set swView = swDraw.GetFirstView
While Not swView Is Nothing
    Set swDispDim = swView.GetFirstDisplayDimension5
    While Not swDispDim Is Nothing
        If swDispDim.GetType = swDimensionType_e.swRadialDimension Or swDispDim.GetType = swDimensionType_e.swDiameterDimension Then
           
            Set swDim = swDispDim.GetDimension2(0)
            Set swDimTol = swDim.Tolerance
            swDimTol.Type = swTolType_e.swTolFITWITHTOL
            swDispDim.ShowTolParenthesis = True
           
            ' Set swAnn = swDispDim.GetAnnotation '
            ' swAnn.Select3 True, Nothing '
        End If
        Set swDispDim = swDispDim.GetNext5
    Wend
    Set swView = swView.GetNextView
Wend
End Sub

 

3

Hallo Jerome,

Das Makro zum Ändern aller Durchmesser, das ich nur auf den Durchmesser anwenden möchte, bei dem die Anpassung bereits ausgefüllt ist

Beispiel unten, Anwendung nur auf Ø33g6

 

 

Yannick

4

Versuchen Sie Folgendes:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swDimTol As SldWorks.DimensionTolerance
'Dim swAnn As SldWorks.Annotation '
           
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Veuillez ouvrir un dessin": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then MsgBox "Veuillez ouvrir un dessin": Exit Sub
Set swDraw = swModel
swModel.ClearSelection2 True
Set swView = swDraw.GetFirstView
While Not swView Is Nothing
    Set swDispDim = swView.GetFirstDisplayDimension5
    While Not swDispDim Is Nothing
        If swDispDim.GetType = swDimensionType_e.swDiameterDimension Then
           
            Set swDim = swDispDim.GetDimension2(0)
            Set swDimTol = swDim.Tolerance
            If swDimTol.Type = swTolType_e.swTolFIT Or swDimTol.Type = swTolType_e.swTolFITWITHTOL Then
                swDimTol.Type = swTolType_e.swTolFITWITHTOL
                swDispDim.ShowTolParenthesis = True
            End If
           
            ' Set swAnn = swDispDim.GetAnnotation '
            ' swAnn.Select3 True, Nothing '
        End If
        Set swDispDim = swDispDim.GetNext5
    Wend
    Set swView = swView.GetNextView
Wend
End Sub

 

2 „Gefällt mir“
5

Hallo Jerome,

 

Vielen Dank für Ihr Feedback, 

Ich habe die linearen Abmessungen in der Verarbeitung (swDimensionType_e.swLinearDimension) hinzugefügt, keine Sorge, es funktioniert perfekt

Auf der anderen Seite habe ich eine  zusätzliche Frage, ist es möglich, die Anzahl der Dezimalstellen der Toleranz (z. B. 3) zu verwalten. 

 

Vielen Dank im Voraus

 

Yannick

 

6

Fügen Sie dies nach "swDispDim.ShowTolParenthesis = True" hinzu:

  swDispDim.SetPrecision3 3, 0, 3, 0
  swModel.ForceRebuild

Weitere Informationen finden Sie hier

7

Danke Jerome

Es ist genau das, wonach ich gesucht habe