Makro wybór średnic z regulacją na rysunku

Macro
1

Witam

 

Czy na rysunkach można wybrać wszystkie Ø z regulacją?

 

i zamienić na pasowanie z tolerancjami?

Tolerancje, które należy dodatkowo umieścić w nawiasach

 

Oto fragment makra, który zacząłem.

Utknąłem na wyborze średnicy z regulacją i zamianie na korektę z tolerancjami (w nawiasach)

Z góry dziękuję za pomoc

Yannicka


mep_-_selectionner_dimensions_avec_ajustement.swp
2

Witam. Spróbuj tego:

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

Witaj Hieronim,

Makro do modyfikacji wszystkich średnic, chcę zastosować tylko do średnicy z już wypełnioną regulacją

przykład poniżej, aplikacja tylko na Ø33g6

 

 

Yannicka

4

Spróbuj tego:

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 polubienia
5

Witaj Hieronim,

 

Dziękujemy za Twoją opinię, 

Dodałem wymiary liniowe w przetwarzaniu (swDimensionType_e.swLinearDimension), nie ma obaw, działa idealnie

Z drugiej strony mam  dodatkowe pytanie, czy można zarządzać liczbą miejsc po przecinku tolerancji ( np. 3)? 

 

Z góry dziękuję

 

Yannicka

 

6

dodaj to po "swDispDim.ShowTolParenthesis = True":

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

Zobacz tutaj , aby uzyskać więcej informacji

7

Dziękuję Jerome

To jest dokładnie to, czego szukałem