Macro sélection cotes importées horizontales
  • Topic:
    • SOLIDWORKS

  • 10 réponses
  • 200 vues

Par yannick.petit Le 03 juillet 2020

Bonjour à tous,

Est t'il possible par macro de sélectionner toutes les cotes horizontales ou veticales d'un plan ?

Merci d'avance de vos retours.

Yannick

Meilleure réponse

JeromeP | 3787 point(s)

Bonjour,

Ceci sélectionnera les dimensions verticales (ou sinon celles horizontales) de chaque vue de la feuille.

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 DisplayData As SldWorks.DisplayData
Dim swAnn As SldWorks.Annotation
Dim ArrowHeadPos1 As Variant
Dim ArrowHeadPos2 As Variant
Dim Reponse As Integer
Reponse = MsgBox("Selectionner les dimensions verticales?", vbYesNo)
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Veuillez ouvrir un dessin"
    Exit Sub
End If
Set swDraw = swModel
swModel.ClearSelection2 True
Set swView = swDraw.GetFirstView
While Not swView Is Nothing
    Set swDispDim = swView.GetFirstDisplayDimension5
    While Not swDispDim Is Nothing
        Set DisplayData = swDispDim.GetDisplayData
        If swDispDim.GetType = swDimensionType_e.swLinearDimension And DisplayData.GetArrowHeadCount = 2 Then
            ArrowHeadPos1 = DisplayData.GetArrowHeadAtIndex2(0)
            ArrowHeadPos2 = DisplayData.GetArrowHeadAtIndex2(1)
            If Reponse = vbYes And Abs(ArrowHeadPos1(0) - ArrowHeadPos2(0)) < 0.0001 Then
                Set swAnn = swDispDim.GetAnnotation
                swAnn.Select3 True, Nothing
            ElseIf Reponse <> vbYes And Abs(ArrowHeadPos1(1) - ArrowHeadPos2(1)) < 0.0001 Then
                Set swAnn = swDispDim.GetAnnotation
                swAnn.Select3 True, Nothing
            End If
        End If
        Set swDispDim = swDispDim.GetNext5
    Wend
    Set swView = swView.GetNextView
Wend
End Sub

 

Les autres réponses

JeromeP | 3787 point(s)

Bonjour,

Ceci sélectionnera les dimensions verticales (ou sinon celles horizontales) de chaque vue de la feuille.

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 DisplayData As SldWorks.DisplayData
Dim swAnn As SldWorks.Annotation
Dim ArrowHeadPos1 As Variant
Dim ArrowHeadPos2 As Variant
Dim Reponse As Integer
Reponse = MsgBox("Selectionner les dimensions verticales?", vbYesNo)
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Veuillez ouvrir un dessin"
    Exit Sub
End If
Set swDraw = swModel
swModel.ClearSelection2 True
Set swView = swDraw.GetFirstView
While Not swView Is Nothing
    Set swDispDim = swView.GetFirstDisplayDimension5
    While Not swDispDim Is Nothing
        Set DisplayData = swDispDim.GetDisplayData
        If swDispDim.GetType = swDimensionType_e.swLinearDimension And DisplayData.GetArrowHeadCount = 2 Then
            ArrowHeadPos1 = DisplayData.GetArrowHeadAtIndex2(0)
            ArrowHeadPos2 = DisplayData.GetArrowHeadAtIndex2(1)
            If Reponse = vbYes And Abs(ArrowHeadPos1(0) - ArrowHeadPos2(0)) < 0.0001 Then
                Set swAnn = swDispDim.GetAnnotation
                swAnn.Select3 True, Nothing
            ElseIf Reponse <> vbYes And Abs(ArrowHeadPos1(1) - ArrowHeadPos2(1)) < 0.0001 Then
                Set swAnn = swDispDim.GetAnnotation
                swAnn.Select3 True, Nothing
            End If
        End If
        Set swDispDim = swDispDim.GetNext5
    Wend
    Set swView = swView.GetNextView
Wend
End Sub

 

yannick.petit | 4971 point(s)

merci jérome, c'est ce qu'il me fallait. Connais tu la ligne de commande pour intégrer des lignes de cassure

 

JeromeP | 3787 point(s)

J'avais compris ca. Mais pas qu'est ce que tu entend par "intégrer".

JeromeP | 3787 point(s)

Est ce que tu veux dire appliquer l'option de "cassure" à chaque dimension verticale ou horizontale sélectionnée?