Macro sélection cercle mise en plan

Out of category
1

Je souhaiterais créer une macro pour changer la couleur d'un cercle sur une mise en plan Solidworks.

je voudrais au lancement de la macro sélectionner un diamètre à rechercher par exemple : 5   , puis dans la vue que j'aurais sélectionner qu'il recherche tout les diamètres et les sélectionne pour ensuite pouvoir changer la couleur.  

est ce que cela est possible ? si oui comment faire pour la recherche des cercles et de la sélection, ?


capture.png
2

Je pense que ce tuto correspond à ta demande:

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

Pour info ce site que je viens de découvrir, regorge de macro sympa. Et ps'avère très utile dans mon apprentissage des macros.

1 « J'aime »
3

ce tuto permet de sélectionner un seul cercle, or moi j'en est beaucoup plus. Et renommer dans la pièce chaque arrête de chaque cercles pour faire fonctionner la macro, est beaucoup plus long que de sélectionner directement les cercles dans la mise en plan. l'idée était bonne mais ne marche pas pour moi. 

4

Bonjour, essaye ca avec une vue sélectionnée:

Cela mettra les cercles en rouge.

Si tu veux juste sélectionner les cercles: efface les 2 dernières lignes 

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 « J'aime »
5

c'est exactement ce qu'il me fallait, merci :)