API-Solidworks-Loch-Beschriftung

Out of category
1

Hallo

Ich entwickle ein Makro, das unsere Zeichnungen für das Laserschneiden aus dem Werkstück anfertigt.

Zum größten Teil ist es funktionsfähig, aber ich muss noch einen Teil bezüglich der Bewertung der Armaturen abschließen.

Ich möchte, dass mein Makro die Kreise meiner Ansicht 1 mal 1 auswählt und dann, wenn es sich um ein Tippen handelt (und nur, wenn es ein Tippen ist), die Seite in dieser Form M10 oder wenn nicht standardmäßig M10x1 (siehe Beispiel unten)

Im Moment gelingt es mir dank eines Makros (hier abrufbar), die Kreise auszuwählen, aber ich bleibe beim Zitatteil hängen, ich habe ein oder 2 Codes auf der Lochbeschriftung wiederhergestellt, aber viele funktionieren nicht einmal in der wiederhergestellten Version.

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
                    'ici le code pour cotation avec hole callout
                'End If
            End If
        End If
    Next
Next
'swModel.SetLineColor 255
swModel.ClearSelection2 True
End Sub

Exemple de MEP

1 „Gefällt mir“
2

Hallo

Ich bin zurück für mein teilweise gelöstes Problem, ich kann die Anmerkung jetzt mit einer anderen Methode setzen, andererseits möchte ich nicht die Informationen über das Gewindeloch, ich möchte nur die M10x1- oder M10-Informationen. Wenn jemand eine Idee zu dem Thema hat. Vielen Dank.

Dim vThreads As Variant
    Dim vThread As Variant
    Dim swThread As CThread
    Dim swAnn As Annotation
    Dim swDrawingComp As DrawingComponent
    
    vThreads = swView.GetCThreads
    If Not IsEmpty(vThreads) Then
        For Each vThread In vThreads
            Set swThread = vThread
            Set swAnn = swThread.GetAnnotation
            Set swDrawingComp = swView.RootDrawingComponent
            boolstatus = swModel.Extension.SelectByID2(swAnn.GetName & "@" & swDrawingComp.Name & "@" & swView.Name, "CTHREAD", 0, 0, 0, False, 0, Nothing, 0)
            swDraw.InsertThreadCallout
        Next