Macro's - Instelling voor pre-launch macro's

Macro
1

Hallo allemaal,

Om een macro te verfijnen die ik heb gemaakt en die werkt, probeer ik te controleren wanneer ik deze macro's 2 parameter start:

Dat het geopende bestand inderdaad een tekening is?
Dat deze tekening inderdaad een nomenclatuurtabel bevat?

Heb je een idee voor een code om deze twee elementen te controleren?

Bij voorbaat dank

2

Kijk naar deze macro die alle gevraagde vakjes lijkt aan te vinken:

Option Explicit
Const ToLayer               As String = "Cotation"
Sub moveDimensionsToLayer()
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swDraw              As SldWorks.DrawingDoc
    Dim vSheets             As Variant
    Dim vSheet              As Variant
    Dim swView              As SldWorks.View
    Dim swAnn               As SldWorks.Annotation
    Dim swNote              As SldWorks.Note
    Dim swDispDim           As SldWorks.DisplayDimension
    Dim swGtol              As SldWorks.Gtol
    Dim swDatum             As SldWorks.DatumTag
    Dim swAnnSFSymbol       As SldWorks.SFSymbol
    Dim swTables            As Variant
    Dim swTable             As Variant
    Dim swTableAnn          As SldWorks.TableAnnotation
    Dim swSketch            As SldWorks.Sketch
    Dim vSegs               As Variant
    Dim vSeg                As Variant
    Dim swSkSeg             As SldWorks.SketchSegment
    Dim vPts                As Variant
    Dim vPt                 As Variant
    Dim swSkPt              As SldWorks.SketchPoint
    Dim bRet                As Boolean
    
    Set swApp = Application.SldWorks
    SupressLayers.SupressLayers
    
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "Ouvrir une mise en plan"
        Exit Sub
    End If
    If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then 'Vérif si plan'
        MsgBox "Ouvrir une mise en plan"
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    vSheets = swDraw.GetSheetNames
    For Each vSheet In vSheets
        swDraw.ActivateSheet vSheet
    
        Set swView = swDraw.GetFirstView
    
        If swView.GetTableAnnotationCount > 0 Then 'Vérif si table nomenclature'
            swTables = swView.GetTableAnnotations
            For Each swTable In swTables
               Set swTableAnn = swTable
               Set swAnn = swTableAnn.GetAnnotation
               swAnn.Layer = ToLayer
            Next
        End If

        Set swView = swView.GetNextView
            While Not swView Is Nothing
                Set swNote = swView.GetFirstNote
                While Not swNote Is Nothing
                    Set swAnn = swNote.GetAnnotation
                    swAnn.Layer = ToLayer
                    Set swNote = swNote.GetNext
                Wend
    
                Set swDatum = swView.GetFirstDatumTag
                While Not swDatum Is Nothing
                    Set swAnn = swDatum.GetAnnotation
                    swAnn.Layer = ToLayer
                    Set swDatum = swDatum.GetNext
                Wend
            
                Set swGtol = swView.GetFirstGTOL
                While Not swGtol Is Nothing
                    Set swAnn = swGtol.GetAnnotation
                    swAnn.Layer = ToLayer
                    Set swGtol = swGtol.GetNextGTOL
                Wend
    
                Set swAnnSFSymbol = swView.GetFirstSFSymbol
                While Not swAnnSFSymbol Is Nothing
                    Set swAnn = swAnnSFSymbol.GetAnnotation
                    swAnn.Layer = ToLayer
                    Set swAnnSFSymbol = swAnnSFSymbol.GetNext
                Wend
            
                Set swDispDim = swView.GetFirstDisplayDimension5
                While Not swDispDim Is Nothing
                    Set swAnn = swDispDim.GetAnnotation
                    swAnn.Layer = ToLayer
                    Set swDispDim = swDispDim.GetNext5
                Wend
                
            Set swView = swView.GetNextView
        Wend
    Next
    
    'On active le calque cotation'
    bRet = swModel.SetCurrentLayer(ToLayer)

    swModel.ClearSelection2 True
Debug.Print "Fin de move dimension to layer"
End Sub

De rest van de macro Als u geïnteresseerd bent, wijzigt u de nomenclatuurlaag en de opmerkingen en beoordelingen van de verschillende weergaven.
Bewerken: om te voltooien:
https://help.solidworks.com/2016/English/api/sldworksapi/SOLIDWORKS.Interop.sldworks~SOLIDWORKS.Interop.sldworks.IModelDoc2~GetType.html
en
https://help.solidworks.com/2017/English/api/sldworksapi/Get_Table_Annotation_and_Contents_Example_VB.htm

3 likes