Hallo an alle
Um ein Makro zu verfeinern, das ich erstellt habe und das funktioniert, versuche ich zu überprüfen, wann ich diesen Makro-2-Parameter starte:
Dass es sich bei der geöffneten Datei tatsächlich um eine Zeichnung handelt?
Dass diese Zeichnung tatsächlich eine Nomenklaturtabelle enthält?
Haben Sie eine Idee für einen Code, um diese beiden Elemente zu überprüfen?
Vielen Dank im Voraus
Schauen Sie sich dieses Makro an, das alle angeforderten Kästchen anzukreuzen scheint:
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
Den Rest des Makros Wenn Sie interessiert sind, ändern Sie die Nomenklaturebene sowie die Notizen und Bewertungen der verschiedenen Ansichten.
Bearbeiten: zum Vervollständigen:
https://help.solidworks.com/2016/English/api/sldworksapi/SOLIDWORKS.Interop.sldworks~SOLIDWORKS.Interop.sldworks.IModelDoc2~GetType.html
und
https://help.solidworks.com/2017/English/api/sldworksapi/Get_Table_Annotation_and_Contents_Example_VB.htm