Macro sélection dimension dans fichier PRT et enlever l'option "marquer pour la mise en plan"

Out of category
1

Bonjour à tous,

J'ai créé une macro pour sélectionner toutes les dimensions dans une esquisse d'un fichier part, cette partie fonctionne.

Par contre , je ne trouve pas la ligne de commande pour enlever l'option "marquer pour la mise en plan"

Quelqu'un aurait une idée sur le codage de l'option "marquer pour la mise en plan"?

 

Merci d'avance de vos retours

Ci joint la macro que j'ai commencée.

Yannick


deletedim.swp
2

Bonjour,

Utilise MarkedForDrawing

Dim swDispDim As DisplayDimension
swDispDim.MarkedForDrawing = False

 

1 « J'aime »
3

Bonjour Jérome,

 

J'ai le message erreur execution 91  variable objet non définie pour la ligne swDispDim.MarkedForDrawing = False

 

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

 


Sub main()

Set swApp = Application.SldWorks
Set swmodel = swApp.ActiveDoc

 

Set swApp = Application.SldWorks
Set swmodel = swApp.ActiveDoc
    If swmodel Is Nothing Then
        swApp.SendMsgToUser2 "Pas de documents ouvert", swMbWarning, swMbOk
        Exit Sub
    End If
    
    If swmodel.GetType <> 1 Then
        swApp.SendMsgToUser2 "Ouvrir un fichier pièce", swMbWarning, swMbOk
        Exit Sub
    End If
    
Reponse = MsgBox("Avez vous édité votre esquisse", vbYesNo)

    If Reponse = vbYes Then


        swApp.SetSelectionFilter 14, True
        swmodel.Extension.SelectAll
        swDispDim.MarkedForDrawing = False
        swApp.SetSelectionFilter 14, False

    ElseIf Reponse <> vbYes Then
    
        MsgBox (" Merci d'éditer votre esquisse")
        Exit Sub
    End If

End Sub

4

Bonjour Jérome,

 

 

J'ai l'erreur 91 qui s'affiche sur la ligne swDispDim.MarkedForDrawing = False

Je suppose qu'il manque un Set  swDispDim= ??

Aurais tu une idée de ce message?

Yannick

5

Bonjour Jérome,

J'ai l'erreur 91  qui s'affiche sur la ligne swDispDim.MarkedForDrawing = False

6

Bonjour Jérome,

J'ai l'erreur 91 sur la ligne swDispDim.MarkedForDrawing = False

Il doit manquer un set swDispDim , je penses

Comment dois je procéder?

merci

yannick


deletedim.swp
7

Salut Jérome,

 

J'ai l'erreur 91 qui s'affiche sur la ligne swDispDim.MarkedForDrawing = False

saurais tu d'ou cela peut til provenir?

Yannick

 


deletedim.swp
8

Salut Jérôme,

J'ai l'erreur 91 qui s'affiche sur la ligne swDispDim.MarkedForDrawing = False

saurais tu d'ou cela peut t'il provenir?

merci

9

Il faut définir swDispDim avant de pouvoir y accéder par exemple avec GetSelectedObject6 si les dimensions sont déja sélectionnées

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

ou une méthode plus rapide qui ne nécessite pas de sélectionner les dimensions au préalable:

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

 

10

Jérome,

le code me renvoi l'erreur 424 .


deletedim.swp
11

Ceci fonctionnera sur une esquisse ouverte ou sélectionnée dans l'arbre

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

C'est exactement cela qu'il me fallait

Juste une petite remarque, est t'il possible de valider l'esquisse?

 

 

13 
pour sortir de l'esquisse ajoute : swModel.InsertSketch2 True

mais si tu lance la macro avec l'Esquisse sélectionnée et fermée, ca fonctionnera sans avoir besoin de l'ouvrir puis fermer.