CAD Forum

Code: Select all

Const SomeBlocPatch As String =  "Y:\FlatBloc2_sheet.SLDBLK"
Dim swApp As Object
Dim swDoc As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim holeTableAnchor As TableAnchor
Dim sketchManager As SldWorks.sketchManager
Dim swMathUtility As SldWorks.MathUtility
Dim swMathPoint As SldWorks.MathPoint
Dim pointsArray(2) As Double

Sub main()

Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
If Not swModel Is Nothing Then
    If swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then
        Set swDraw = swDoc
        Dim swDrawSheet As Sheet
        Set swDrawSheet = swDraw.GetCurrentSheet
                Dim Ans As Integer
        Ans = swDrawSheet.ReloadTemplate(False)  'True to keep note modifications made to the sheet format and reload all other elements from the original sheet format template, false to reload all elements from the original sheet format template and discard any note modifications made to the sheet format
        'Ans 0:Success;1:UnknownError;2:FileNotFound;3:CustomSheet;4:ViewOnly;
                Set sketchManager = swDoc.sketchManager
                If Not sketchManager Is Nothing Then
'TableAnchor(TableType)   TableType:
'0-General;
'1-HoleChart;
'2-BillOfMaterials;
'3-RevisionBlock;
'4-WeldmentCutList;
'5-TitleBlock;
'6-WeldTable;
'7-BendTable;
'8-PunchTable;
'9-GeneralTolerance
                        Set holeTableAnchor = swDrawSheet.TableAnchor(1)
                        If Not holeTableAnchor Is Nothing Then
                            Dim anchorPosition As Variant
                            anchorPosition = holeTableAnchor.Position
                            Set swMathUtility = swApp.GetMathUtility
                            pointsArray(0) = anchorPosition(0): pointsArray(1) = anchorPosition(1): pointsArray(2) = 0 'x y and z = 0
                            Set swMathPoint = swMathUtility.CreatePoint(pointsArray)
                                If Not swMathPoint Is Nothing Then
                                    swDraw.EditTemplate
                                    Dim myBlockDefinition As Object
                                    Set myBlockDefinition = sketchManager.MakeSketchBlockFromFile(swMathPoint, SomeBlocPatch, False, 1, 0)
                                    swDraw.EditSheet
                                End If
                        End If
                Else
                    MsgBox "Failed to get SketchManager."
                End If
    Else
        MsgBox "The active document is not a drawing. Bye Bye"
    End If
Else
    MsgBox "There is no active document."
End If
End Sub