Makro wählen Sie die Bemaßung in der PRT-Datei aus und entfernen Sie die Option "Zum Zeichnen markieren"

Out of category
1

Hallo ihr alle

Ich habe ein Makro erstellt, um alle Bemaßungen in einer Skizze eines Dateiteils auszuwählen, dieses Teil funktioniert.

Auf der anderen Seite kann ich die Befehlszeile zum Entfernen der Option "Zum Zeichnen markieren" nicht finden

Hat jemand eine Idee, wie man die Option "Markierung zum Zeichnen" codieren kann?

 

Vielen Dank im Voraus für Ihr Feedback

Im Anhang befindet sich das Makro, das ich gestartet habe.

Yannick


gelöschtim.swp
2

Hallo

Verwendet MarkedForDrawing

Dim swDispDim As DisplayDimension
swDispDim.MarkedForDrawing = False

 

1 „Gefällt mir“
3

Hallo Jerome,

 

Ich erhalte die Meldung Ausführungsfehler 91  Objektvariable nicht definiert für Zeile swDispDim.MarkedForDrawing = False

 

Dim swApp als SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim Reponse As Integer
Dim swDispDim   As SldWorks.DisplayDimension

 


Sub main()

Legen Sie swApp = Application.SldWorks fest
Legen Sie swmodel = swApp.ActiveDoc fest.

 

Legen Sie swApp = Application.SldWorks fest
Legen Sie swmodel = swApp.ActiveDoc fest.
    Wenn swmodel nichts ist, dann
        swApp.SendMsgToUser2 "Keine Dokumente geöffnet", swMbWarning, swMbOk
        Sub beenden
    Ende, wenn
    
    Wenn swmodel. GetType <> dann 1
        swApp.SendMsgToUser2 "Teiledatei öffnen", swMbWarning, swMbOk
        Sub beenden
    Ende, wenn
    
Antwort = MsgBox("Haben Sie Ihre Skizze bearbeitet?", vbJaNein)

    Wenn Antwort = vbJa, dann


        swApp.SetSelectionFilter 14, Wahr
        sw-Modell verwenden. Erweiterung.SelectAll
        swDispDim.MarkedForDrawing = Falsch
        swApp.SetSelectionFilter 14, Falsch

    ElseIf Reponse <> vbJa, dann
    
        MsgBox ("Vielen Dank für die Bearbeitung Ihrer Skizze")
        Sub beenden
    Ende, wenn

Ende Sub

4

Hallo Jerome,

 

 

Ich habe Fehler 91, der in der Zeile swDispDim.MarkedForDrawing = False angezeigt wird

Ich vermute, es fehlt ein Set  swDispDim=??

Hast du eine Ahnung von dieser Botschaft?

Yannick

5

Hallo Jerome,

Ich habe Fehler 91 , der in der Zeile swDispDim.MarkedForDrawing = False angezeigt wird

6

Hallo Jerome,

Ich habe Fehler 91 in der Zeile swDispDim.MarkedForDrawing = False

Da muss wohl ein Set swDispDim fehlen, denke ich

Wie muss ich vorgehen?

Vielen Dank

Yannick


gelöschtim.swp
7

Hallo Jerome,

 

Ich habe Fehler 91, der in der Zeile swDispDim.MarkedForDrawing = False angezeigt wird

Wissen Sie, woher es kommen kann?

Yannick

 


gelöschtim.swp
8

Hallo Jerome,

Ich habe Fehler 91, der in der Zeile swDispDim.MarkedForDrawing = False angezeigt wird

Wissen Sie, woher es kommen kann?

Vielen Dank

9

Bevor Sie darauf zugreifen können, müssen Sie swDispDim definieren, z. B. mit GetSelectedObject6, wenn die Dimensionen bereits ausgewählt sind

For n = 1 to swModel.SelectionManager.GetSelectedObjectCount2
    Set swDispDim = swModel.SelectionManager.GetSelectedObject6(n, -1)
    swDispDim.MarkedForDrawing = False
Next n

oder eine schnellere Methode, bei der die Dimensionen nicht vorher ausgewählt werden müssen:

Dim swDispDim As DisplayDimension
set swDispDim = swView.GetFirstDisplayDimension5
While not swDispDim Is Nothing
    swDispDim.MarkedForDrawing = False
    set swDispDim = swDispDim.GetNext5
Wend

 

10

Jerome

Der Code gibt den Fehler 424 zurück.


gelöschtim.swp
11

Dies funktioniert mit einer Skizze, die im Baum geöffnet oder ausgewählt ist

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swFeat As SldWorks.Feature
    Dim swSketch As SldWorks.Sketch
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swDispDim As SldWorks.DisplayDimension
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    If swModel Is Nothing Then
        swApp.SendMsgToUser2 "Pas de documents ouvert", swMbWarning, swMbOk
        Exit Sub
    End If
    If swModel.GetType <> swDocumentTypes_e.swDocPART Then
        swApp.SendMsgToUser2 "Ouvrir un fichier pièce", swMbWarning, swMbOk
        Exit Sub
    End If

    If swSelMgr.GetSelectedObjectType3(1, -1) = swSelectType_e.swSelSKETCHES Then
        Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
    Else
        Set swSketch = swModel.SketchManager.ActiveSketch
        Set swFeat = swSketch
    End If
    If swFeat Is Nothing Then
        swApp.SendMsgToUser2 "Ouvrir ou sélectionner une esquisse", swMbWarning, swMbOk
        Exit Sub
    End If
    Set swDispDim = swFeat.GetFirstDisplayDimension
    While Not swDispDim Is Nothing
        swDispDim.MarkedForDrawing = False
        Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    Wend
End Sub

 

12

Das war genau das, was ich brauchte

Nur eine kleine Bemerkung, ist es möglich, die Skizze zu validieren?

 

 

13 
Um aus dem Sketch herauszukommen, fügt man hinzu: swModel. Skizze einfügen2 STIMMT

Wenn Sie das Makro jedoch mit ausgewählter und geschlossener Skizze starten, funktioniert es, ohne dass es geöffnet und geschlossen werden muss.