Files
Associated model(s) Lesson 6.2 - advanced drawings
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\sheetformata - 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"
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Set swApp = Application.SldWorks
'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
'Setup first sheet
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, 4, 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)
'Add iso view of assy 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
Dim dblScale(1) As Double
dblScale(0) = 1
dblScale(1) = 2
swView.ScaleRatio = dblScale
'Activate the second sheet
swDraw.ActivateSheet vSheetNames(1)
'Add standard three-view
swDraw.Create3rdAngleViews2 strHandlePath
'Traverse views and turn off tangent edges
Dim vViews As Variant
vViews = swSheet.GetViews
For i = 0 To UBound(vViews)
Set swView = vViews(i)
swView.SetDisplayTangentEdges2 swTangentEdgesHidden
Next i
'Rebuild
swModel.ForceRebuild3 True
'Add dimensions
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
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
'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
'####BEGINNING OF LESSON 6.2####
'Reactivate second sheet
swDraw.ActivateSheet vSheetNames(1)
'Determine which view is top view
Dim swMathUtil As SldWorks.MathUtility
Dim swTransform As SldWorks.MathTransform
Dim swMathVect As SldWorks.MathVector
Dim dblPts(2) As Double
Dim vPts As Variant
Set swMathUtil = swApp.GetMathUtility
dblPts(0) = 0
dblPts(1) = 1
dblPts(2) = 0
Set swMathVect = swMathUtil.CreateVector(dblPts)
For i = 0 To UBound(vViews)
Set swView = vViews(i)
Set swTransform = swView.ModelToViewTransform
Set swMathVect = swMathVect.MultiplyTransform(swTransform)
Set swMathVect = swMathVect.Normalise
vPts = swMathVect.ArrayData
If Round(vPts(0), 1) = 0 And Round(vPts(1), 1) = 0 And _
Round(vPts(2), 1) = 1 Then Exit For
Next i
'####Make section view from top view####
'Get center of the top drawing view
vPts = swView.GetXform
'Get sheet scale
Dim vSheetProps As Variant
vSheetProps = swSheet.GetProperties
'Create line +/- 20 mm in the X from view center
Dim dblX1 As Double, dblY1 As Double, dblX2 As Double, dblY2 As Double
Dim swSketchMgr As SldWorks.SketchManager
Dim swSketchSeg As SldWorks.SketchSegment
Set swSketchMgr = swModel.SketchManager
dblX1 = Round(vSheetProps(3) * (vPts(0) - 0.02), 3)
dblY1 = Round(vSheetProps(3) * vPts(1), 3)
dblX2 = Round(vSheetProps(3) * (vPts(0) + 0.02), 3)
dblY2 = Round(vSheetProps(3) * vPts(1), 3)
Set swSketchSeg = swSketchMgr.CreateLine(dblX1, dblY1, 0, dblX2, dblY2, 0)
'Select that line
swSketchSeg.Select4 False, Nothing
'Create section view
Set swView = swDraw.CreateSectionViewAt5(0, 0, 0, "A", 0, Empty, 0)
'Select and flip section view, then rebuild
swModel.Extension.SelectByID2 "Section Line1", _
"SECTIONLINE", 0, 0, 0, False, 0, Nothing, 0
swDraw.FlipSectionLine
swModel.ForceRebuild3 False
'Break alignment
swView.AlignWithView swNoViewAlignment, Nothing
'Relocate view
vPts = swView.GetXform
vPts(0) = 0.16
vPts(1) = 0.17
swView.SetXform vPts
'####DIMENSION THIN PIECE####
'Get an underlying model edge as the launching _
point for your face locator code
Dim vEdges As Variant
Dim swEdge As SldWorks.Edge
vEdges = swView.GetPolylines7(1, Empty)
For i = 0 To UBound(vEdges)
If Not vEdges(i) Is Nothing Then
Set swEdge = vEdges(i)
Exit For
End If
Next i
'Locate the faces for dimensioning
Dim swBody As SldWorks.Body2
Dim swFace As SldWorks.Face2
Dim swSurf As SldWorks.Surface
Dim vBodies As Variant
Dim vFaces As Variant
Dim swFinalFaces(1) As SldWorks.Face2
Dim swEnt As SldWorks.Entity
Set swBody = swEdge.GetBody
vFaces = swBody.GetFaces
For i = 0 To UBound(vFaces)
Set swFace = vFaces(i)
Set swSurf = swFace.GetSurface
If swSurf.IsPlane Then
If swFinalFaces(0) Is Nothing Then
Set swFinalFaces(0) = swFace
Set swFinalFaces(1) = swFace
End If
If swFace.GetArea > swFinalFaces(0).GetArea Then
Set swFinalFaces(1) = swFinalFaces(0)
Set swFinalFaces(0) = swFace
ElseIf swFace.GetArea > swFinalFaces(1).GetArea Then
Set swFinalFaces(1) = swFace
End If
End If
Next i
'Get an edge from the face and select in drawing view
For i = 0 To 1
vEdges = swFinalFaces(i).GetEdges
Set swEdge = vEdges(0)
Set swEnt = swEdge
If i = 0 Then swView.SelectEntity swEnt, False
If i = 1 Then swView.SelectEntity swEnt, True
Next i
'Garbage collection
Set swFinalFaces(0) = Nothing
Set swFinalFaces(1) = Nothing
'Add dimension
swModel.AddDimension2 0.2, 0.165, 0
'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