Makroauswahl von horizontal importierten Bemaßungen

Macro
1

Hallo ihr alle

Ist es möglich, alle horizontalen oder rechteckigen Abmessungen einer Ebene per Makro auszuwählen?

Vielen Dank im Voraus für Ihr Feedback.

Yannick


2020_07_03_11_36_45_window.png
2

Die API verfügt über eine IDisplayDimension-Schnittstelle, die über eine Type2-Eigenschaft für eine Enumerations SwDimensionType_e verfügt.

SwDimensionType_e.swHorLinearDimension oder SwDimensionType_e.swVertLinearDimension sehen vielversprechend aus:)

 

http://help.solidworks.com/2012/english/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IDisplayDimension_members.html

3

Hallo

Dadurch werden die vertikalen (oder anderweitig horizontalen) Abmessungen jeder Blattansicht ausgewählt.

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

 

1 „Gefällt mir“
4

Danke Jerome, das war es, was ich brauchte. Kennen Sie die Befehlszeile zum Einbinden von Bruchkanten?

 

5

Was meinen Sie mit "integrieren"?

6

Überprüfen Sie die Registerkarte Bruchlinien

7

Das habe ich verstanden. Aber nicht, was meinst du mit "integrieren".

8

Ich habe mich schlecht ausgedrückt, es ist das Wochenende, an dem ich eine Ausrede habe ;0)

9

Meinen Sie, dass Sie die Option "Pause" auf jede ausgewählte vertikale oder horizontale Dimension anwenden können?

10

Ja, das war's

11

Leider scheint diese Option nicht verfügbar zu sein.