Macro selecteer de afmeting in het PRT-bestand en verwijder de optie "markeren voor tekening"

Out of category
1

Hoi allemaal

Ik heb een macro gemaakt om alle afmetingen in een schets van een bestandsonderdeel te selecteren, dit deel werkt.

Aan de andere kant kan ik de opdrachtregel niet vinden om de optie "markeren voor tekenen" te verwijderen

Iemand een idee over het coderen van de "mark for drawing" optie?

 

Alvast bedankt voor uw feedback

Bijgevoegd is de macro die ik ben gestart.

Yannick


verwijderdim.swp
2

Hallo

Gebruik MarkedForDrawing

Dim swDispDim As DisplayDimension
swDispDim.MarkedForDrawing = False

 

1 like
3

Hallo Hiëronymus,

 

Ik krijg het bericht uitvoeringsfout 91  objectvariabele niet gedefinieerd voor regel swDispDim.MarkedForDrawing = Onwaar

 

Dim swApp als SldWorks.SldWorks
Dim swmodel als SldWorks.ModelDoc2
Dim swdraw als SldWorks.DrawingDoc
Dim Reponse als geheel getal
Dim swDispDim   als SldWorks.DisplayDimension

 


Sub hoofd()

Stel swApp = Toepassing.SldWorks in
Stel swmodel = swApp.ActiveDoc in

 

Stel swApp = Toepassing.SldWorks in
Stel swmodel = swApp.ActiveDoc in
    Als swmodel niets is, dan
        swApp.SendMsgToUser2 "Geen documenten open", swMbWarning, swMbOk
        Sub afsluiten
    Einde als
    
    Als swmodel. GetType <> dan 1
        swApp.SendMsgToUser2 "Open onderdeelbestand", swMbWarning, swMbOk
        Sub afsluiten
    Einde als
    
Antwoord = MsgBox("Heb je je schets bewerkt", vbJaNee)

    Als reactie = vbJa dan


        swApp.SetSelectionFilter 14, waar
        swmodel. Extensie.Alles selecteren
        swDispDim.MarkedForDrawing = Onwaar
        swApp.SetSelectionFilter 14, Onwaar

    ElseIf Reponse <> vbJa Dan
    
        MsgBox ("Bedankt voor het bewerken van je schets")
        Sub afsluiten
    Einde als

Einde Sub

4

Hallo Hiëronymus,

 

 

Ik heb fout 91 die verschijnt op de regel swDispDim.MarkedForDrawing = False

Ik denk dat er een ontbrekende set  swDispDim=??

Heb je enig idee van deze boodschap?

Yannick

5

Hallo Hiëronymus,

Ik heb fout 91  die verschijnt op de regel swDispDim.MarkedForDrawing = False

6

Hallo Hiëronymus,

Ik heb fout 91 op de regel swDispDim.MarkedForDrawing = Onwaar

Er moet een set ontbreken swDispDim , denk ik

Hoe moet ik te werk gaan?

Bedankt

Yannick


verwijderdim.swp
7

Hoi Hiëronymus,

 

Ik heb fout 91 die verschijnt op de regel swDispDim.MarkedForDrawing = False

Weet jij waar het vandaan kan komen?

Yannick

 


verwijderdim.swp
8

Hoi Hiëronymus,

Ik heb fout 91 die verschijnt op de regel swDispDim.MarkedForDrawing = False

Weet jij waar het vandaan kan komen?

Bedankt

9

U moet swDispDim definiëren voordat u er toegang toe krijgt, bijvoorbeeld met GetSelectedObject6 als de dimensies al zijn geselecteerd

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

Of een snellere methode waarbij u niet vooraf afmetingen hoeft te selecteren:

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

 

10

Jerome

De code retourneert fout 424.


verwijderdim.swp
11

Hiermee wordt gewerkt aan een schets die is geopend of geselecteerd in de boom

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

Dat is precies wat ik nodig had

Even een kleine opmerking, is het mogelijk om de schets te valideren?

 

 

13 
om uit de schets te komen voegt toe: swModel. Schets invoegen2 Waar

maar als u de macro start met de schets geselecteerd en gesloten, werkt deze zonder dat u deze hoeft te openen en sluiten.