Macro Selection Circle Drawing

Out of category
1

I would like to create a macro to change the color of a circle on a Solidworks drawing.

I would like to launch the macro select a diameter to search for example: 5   , then in the view that I would have selected that it searches for all the diameters and selects them to then be able to change the color.  

Is this possible? If so, how to find circles and selection?


capture.png
2

I think this tutorial corresponds to your request:

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

For your information, this site that I just discovered, is full of nice macros. And it's very useful in my learning of macros.

1 Like
3

This tutorial allows you to select a single circle, but I have a lot more. And renaming each edge of each circle in the room to make the macro work, is much longer than directly selecting the circles in the drawing. The idea was good but it doesn't work for me. 

4

Hello, try this with a view selected:

This will put the circles in red.

If you just want to select the circles: erase the last 2 lines 

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

That's exactly what I needed, thank you:)