Lesson 6.1 code

Files

Associated model(s) Lesson 6.1 code

Code

Const strModelPath As String = _
    "C:\Users\Keith\Desktop\French press\French press.SLDASM"
Const strFormatPath As String = _
    "C:\programdata\solidworks\solidworks 2011\lang\english\sheetformat\a - landscape - cadsharp.slddrt"
Const strHandlePath As String = _
    "C:\Users\Keith\Desktop\French press\handle.SLDPRT"
Const strBOMTemplatePath As String = _
    "C:\Program Files\SolidWorks Corp\SolidWorks\lang\english\bom-standard.sldbomtbt"
    
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
    
Sub main()
    Set swApp = Application.SldWorks
    
    'IDRAWINGDOC
    'Create new drawing
    Dim strTemplatePath As String
    strTemplatePath = swApp.GetUserPreferenceStringValue _
        (swUserPreferenceStringValue_e.swDefaultTemplateDrawing)
    Set swModel = swApp.NewDocument(strTemplatePath, _
        swDwgPapersUserDefined, 0.2794, 0.2159)
    Set swDraw = swModel
    
    'ISHEET
    'Setup sheet format
    swDraw.SetupSheet5 "Sheet1", 12, 12, 1, 4, False, _
        strFormatPath, 0.2794, 0.2159, "Default", True
    
    'Add a new sheet
    swDraw.NewSheet3 "Sheet2", 12, 12, 1, 1, False, _
        strFormatPath, 0.2794, 0.2159, "Default"
    
    'Change name of sheets
    Dim swSheet As SldWorks.Sheet
    Dim vSheetNames As Variant
    Dim i As Integer
    vSheetNames = swDraw.GetSheetNames
    For i = 0 To UBound(vSheetNames)
        Set swSheet = swDraw.Sheet(vSheetNames(i))
        If i = 0 Then swSheet.SetName "Full Assy"
        If i = 1 Then swSheet.SetName "Handle"
    Next i
    
    'Activate first sheet
    vSheetNames = swDraw.GetSheetNames
    swDraw.ActivateSheet vSheetNames(0)
    
    'IVIEW
    'Add isometric view of assembly on first sheet
    Dim swView As SldWorks.View
    Dim swIsoView As SldWorks.View
    Set swView = swDraw.CreateDrawViewFromModelView3 _
        (strModelPath, "*Isometric", 0.08, 0.1, 0)
    Set swIsoView = swView
    swDraw.ViewDisplayShaded
    
    'Change view scale to 1:2
    Dim dblScale(1) As Double
    dblScale(0) = 1
    dblScale(1) = 2
    swView.ScaleRatio = dblScale
    
    'Activate second sheet
    swDraw.ActivateSheet vSheetNames(1)
    
    'Add standard three-view on second sheet
    swDraw.Create3rdAngleViews2 strHandlePath
    
    'Change sheet scale
    Set swSheet = swDraw.GetCurrentSheet
    swSheet.SetScale 1, 4, True, True
    
    'Traverse views on second sheet and hide tangent edges
    Dim vViews As Variant
    vViews = swSheet.GetViews
    For i = 0 To UBound(vViews)
        Set swView = vViews(i)
        swView.SetDisplayTangentEdges2 swTangentEdgesHidden
    Next i
    
    'If this is missing then next line fails for unknown reason
    swModel.ForceRebuild3 False
    
    'IANNOTATION
    'Start on 2nd sheet (should be currently active sheet)
    'Add dimensions; for last arg, false = auto-align
    swDraw.InsertModelAnnotations3 swImportModelItemsFromEntireModel, _
        swInsertDimensionsMarkedForDrawing, True, True, False, True
    
    'Select all display dimensions
    Dim swDispDim As SldWorks.DisplayDimension
    Dim swDispData As SldWorks.DisplayData
    swModel.ClearSelection2 True
    For i = 0 To UBound(vViews)
        Set swView = vViews(i)
        Set swDispDim = swView.GetFirstDisplayDimension5
        While Not swDispDim Is Nothing
            swModel.Extension.SelectByID2 swDispDim.GetNameForSelection, _
                "DIMENSION", 0, 0, 0, True, 0, Nothing, 0
            Set swDispData = swDispDim.GetDisplayData
            Set swDispDim = swDispDim.GetNext5
            If InStr(1, swDispData.GetTextAtIndex(0), "°") <> 0 Then _
                swModel.EditDelete
        Wend
    Next i
    
    'Reposition dimensions
    swModel.Extension.AlignDimensions _
        swAlignDimensionType_AutoArrange, 0.06
    
    'Activate first sheet
    swDraw.ActivateSheet vSheetNames(0)
    
    'Autoballoon; select isometric view first, which is a feature
    Dim swFeat As SldWorks.Feature
    Set swFeat = swDraw.FeatureByName(swIsoView.Name)
    swFeat.Select2 False, 0
    Dim vNotes As Variant
    vNotes = swDraw.AutoBalloon4(swDetailingBalloonLayout_Right, _
        True, swBS_Circular, 2, 1, Empty, 1, Empty, "-None-", True)
        
    'Move balloons to better position
    Dim swNote As SldWorks.Note
    Dim swAnn As SldWorks.Annotation
    Dim vPos As Variant
    For i = 0 To UBound(vNotes)
        Set swNote = vNotes(i)
        Set swAnn = swNote.GetAnnotation
        vPos = swAnn.GetPosition
        swAnn.SetPosition vPos(0), vPos(1) - 0.07, 0
    Next i
    
    'IBOMTABLEANNOTATION
    'Add BOM to first sheet
    Dim swBOMAnn As SldWorks.BomTableAnnotation
    Set swBOMAnn = swIsoView.InsertBomTable3 _
        (False, 0.27, 0.20808, swBOMConfigurationAnchor_TopRight, _
        swBomType_PartsOnly, "Default", strBOMTemplatePath, False)
    
    'Change BOM column to reference Part No custom property
    swBOMAnn.SetColumnCustomProperty 2, "PartNo"
    
    'Change BOM column name and column widths
    Dim swTableAnn As SldWorks.TableAnnotation
    Set swTableAnn = swBOMAnn
    swTableAnn.Text(0, 2) = "PART NO"
    swTableAnn.SetColumnWidth 1, 0.04, swTableRowColChange_TableSizeCanChange
    swTableAnn.SetColumnWidth 2, 0.03, swTableRowColChange_TableSizeCanChange
    
    'Save drawing to same location as model
    Dim strFilePath As String
    strFilePath = swIsoView.GetReferencedModelName
    strFilePath = Replace(strFilePath, "SLDASM", "SLDDRW")
    swModel.Extension.SaveAs strFilePath, 0, 0, Nothing, Empty, Empty
    
End Sub