Makroauswahl Kreiszeichnung

Out of category
1

Ich möchte ein Makro erstellen, um die Farbe eines Kreises in einer Solidworks-Zeichnung zu ändern.

Ich möchte das Makro starten, wählen Sie einen Durchmesser aus , den Sie suchen möchten, zum Beispiel: 5   , dann in der Ansicht, die ich ausgewählt hätte, dass es nach allen Durchmessern sucht und sie auswählt, um dann die Farbe ändern zu können.  

Ist das möglich? Wenn ja, wie finde ich Kreise und Auswahl?


capture.png
2

Ich denke, dieses Tutorial entspricht Ihrem Wunsch:

https://www.codestack.net/solidworks-api/document/selection/drawing-view-entities/

Zu Ihrer Information, diese Seite, die ich gerade entdeckt habe, ist voll von netten Makros. Und es ist sehr nützlich beim Erlernen von Makros.

1 „Gefällt mir“
3

In diesem Tutorial können Sie einen einzelnen Kreis auswählen, aber ich habe noch viel mehr. Und das Umbenennen jeder Kante jedes Kreises im Raum, damit das Makro funktioniert, ist viel länger als das direkte Auswählen der Kreise in der Zeichnung. Die Idee war gut, aber bei mir funktioniert sie nicht. 

4

Hallo, versuchen Sie dies mit einer ausgewählten Ansicht:

Dadurch werden die Kreise rot dargestellt.

Wenn Sie nur die Kreise auswählen möchten: Löschen Sie die letzten 2 Zeilen 

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim Comp As SldWorks.Component2
Dim vComps As Variant
Dim vComp As Variant
Dim vEdges As Variant
Dim vEdge As Variant
Dim swEdge As SldWorks.Edge
Dim swCurve As SldWorks.Curve
Dim swEntity As SldWorks.Entity
Dim CurveParam As Variant
Dim IsClosed As Boolean
Dim Diameter As Double
Dim boolstatus As Boolean

Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.ActiveDrawingView
swModel.ClearSelection2 True
vComps = swView.GetVisibleComponents
Diameter = InputBox("Entrer le diamètre en mm")
For Each vComp In vComps
    Set Comp = vComp
    vEdges = swView.GetVisibleEntities(Comp, swViewEntityType_e.swViewEntityType_Edge)
    For Each vEdge In vEdges
        Set swEdge = vEdge
        Set swCurve = swEdge.GetCurve
        If swCurve.IsCircle Then
            swCurve.GetEndParams Empty, Empty, IsClosed, Empty
            If IsClosed Then
                CurveParam = swCurve.CircleParams
                If Abs(Diameter - CurveParam(6) * 2 * 1000) < 0.0001 Then
                    Set swEntity = swEdge
                    swEntity.Select4 True, Nothing
                End If
            End If
        End If
    Next
Next
swModel.SetLineColor 255
swModel.ClearSelection2 True
End Sub

 

3 „Gefällt mir“
5

Das ist genau das, was ich gebraucht habe, danke:)