Macro select dimension in PRT file and remove the "mark for drawing" option

Out of category
1

Hi all

I created a macro to select all the dimensions in a sketch of a file part, this part works.

On the other hand, I can't find the command line to remove the "mark for drawing" option

Anyone have an idea about coding the "mark for drawing" option?

 

Thank you in advance for your feedback

Attached is the macro I started.

Yannick


deletedim.swp
2

Hello

Uses MarkedForDrawing

Dim swDispDim As DisplayDimension
swDispDim.MarkedForDrawing = False

 

1 Like
3

Hello Jerome,

 

I get the message execution error 91  object variable not defined for line 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 "No documents open", swMbWarning, swMbOk
        Exit Sub
    End If
    
    If swmodel. GetType <> 1 Then
        swApp.SendMsgToUser2 "Open Part File", swMbWarning, swMbOk
        Exit Sub
    End If
    
Answer = MsgBox("Have you edited your sketch", vbYesNo)

    If Response = vbYes Then


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

    ElseIf Reponse <> vbYes Then
    
        MsgBox ("Thank you for editing your sketch")
        Exit Sub
    End If

End Sub

4

Hello Jerome,

 

 

I have error 91 showing up on the line swDispDim.MarkedForDrawing = False

I guess there is a missing set  swDispDim=??

Do you have any idea of this message?

Yannick

5

Hello Jerome,

I have error 91  showing up on the line swDispDim.MarkedForDrawing = False

6

Hello Jerome,

I have error 91 on the line swDispDim.MarkedForDrawing = False

There must be missing a set swDispDim , I think

How should I proceed?

Thank you

yannick


deletedim.swp
7

Hi Jerome,

 

I have error 91 showing up on the line swDispDim.MarkedForDrawing = False

Do you know where it can come from?

Yannick

 


deletedim.swp
8

Hi Jerome,

I have error 91 showing up on the line swDispDim.MarkedForDrawing = False

Do you know where it can come from?

Thank you

9

You have to define swDispDim before you can access it, for example with GetSelectedObject6 if the dimensions are already selected

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

or a faster method that doesn't require selecting dimensions beforehand:

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

 

10

Jerome,

The code returns error 424.


deletedim.swp
11

This will work on a sketch that is open or selected in the tree

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

That's exactly what I needed

Just a small remark, is it possible to validate the sketch?

 

 

13 
to get out of the sketch adds: swModel. InsertSketch2 True

but if you launch the macro with the Sketch selected and closed, it will work without the need to open and close it.