De Tekening van de macro Cirkel van de Selectie

Out of category
1

Ik wil graag een macro maken om de kleur van een cirkel op een Solidworks-tekening te wijzigen.

Ik wil graag de macro te starten, selecteer een diameter om te zoeken, bijvoorbeeld: 5   , dan in de weergave die ik zou hebben geselecteerd dat het zoekt naar alle diameters en selecteert ze om vervolgens de kleur te kunnen veranderen.  

Is dit mogelijk? Zo ja, hoe vind je cirkels en selectie?


capture.png
2

Ik denk dat deze tutorial overeenkomt met uw verzoek:

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

Ter informatie, deze site die ik net heb ontdekt, staat vol met leuke macro's. En het is erg handig bij het leren van macro's.

1 like
3

Met deze tutorial kun je een enkele cirkel selecteren, maar ik heb er nog veel meer. En het hernoemen van elke rand van elke cirkel in de kamer om de macro te laten werken, is veel langer dan het direct selecteren van de cirkels in de tekening. Het idee was goed, maar het werkt niet voor mij. 

4

Hallo, probeer dit met een geselecteerde weergave:

Hierdoor worden de cirkels rood weergegeven.

Als je alleen de cirkels wilt selecteren: wis de laatste 2 regels 

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

Dat is precies wat ik nodig had, dank je:)