AnsweredAssumed Answered

Need Help automatically Scaling Drawings created from Macro.

Question asked by Andy Casper on Jun 12, 2019
Latest reply on Jun 17, 2019 by Fifi Riri

I'm looking for some help with my macro that automatically creates drawings for each configuration.  This macro is used to create drawings for all of our configured parts such as fasteners and routing fittings.  This is working as intended except for one issue.  Whatever drawing scale is automatically chosen by SolidWorks for the first configuration is the drawing scale it uses for all configurations.  This causes issue when you have HHCS that range from 1/4-20 x 0.5 thru 1 1/2"-6 x 14.00.


I was hoping that there is a way to have SolidWorks auto scale the drawing for each configuration so that the views are not overlapping or hanging off the sheet.


My Code:


Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc

Dim vConfs As Variant
Dim i As Integer

Dim sDrTemplate As String
Dim lDrSize As Long

Dim FieldName As String
Dim UseCached As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim Name As String
Dim WasResolved As Boolean
Dim value As Boolean
Dim value2 As Boolean

Dim sOutputFolder As String


Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

sOutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - Len(swModel.GetTitle()))

sDrTemplate = swApp.GetUserPreferenceStringValue(swUserPreferenceStringValue_e.swDefaultTemplateDrawing)
lDrSize = swDwgPaperSizes_e.swDwgPaperDsize

vConfs = swModel.GetConfigurationNames()
FieldName = "Part Number"

For i = 0 To UBound(vConfs)

Name = swModel.GetPathName()
Set swDraw = swApp.NewDocument(sDrTemplate, lDrSize, 0, 0)
value2 = swDraw.Create3rdAngleViews2(Name)

Dim swView As SldWorks.View
Set swView = swDraw.GetFirstView

While Not swView Is Nothing

swView.ReferencedConfiguration = vConfs(i)

Set swView = swView.GetNextView


'Get "Part Number" variable from data card for active configuration

ResolvedValOut = swModel.GetCustomInfoValue(vConfs(i), FieldName)

Dim swDrawModel As SldWorks.ModelDoc2
Set swDrawModel = swDraw

swDrawModel.ForceRebuild3 True

swDraw.InsertModelAnnotations3 swImportModelItemsSource_e.swImportModelItemsFromEntireModel, 32776, True, True, False, False

swDrawModel.Extension.SaveAs sOutputFolder + ResolvedValOut + ".slddrw", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, 0, 0

swDrawModel.ForceRebuild3 True

'Second Save to pull data card information from model


swApp.CloseDoc swDrawModel.GetTitle()


End Sub




I appreciate any help,


Thank You,

Andy Casper