I have this macro mostly working. There's a few spots I need to work on, but it's coming along.
Can anyone say why my swPlane.Autosize value doesn't change when I run this code? It runs the line okay, but the value doesn't change.
If featType = "RefPlane" Then
Set swPlane = swFeat.GetDefinition
If swPlane.Type2 = 11 Then
swPlane.AutoSize = True
swPlane.UpdatePlane = True
DidSelect = swFeat.ModifyDefinition(swPlane, swModel, Nothing)
End If
End If
I copied the whole macro below.
Thanks
Dwight
'
****************************************************************************
' C:\Users\10056185\AppData\Local\Temp\swx3112\Macro1.swb - macro recorded on 12/20/21 by 10056185
'
****************************************************************************
Dim swApp As SldWorks.SldWorks
Dim swModel As IModelDoc2
Dim Transfer As String
Sub SetSettings(Transfer As String)
Dim boolstatus As Boolean
Dim Scene As SldWorks.SWScene
Dim swConfig As SldWorks.Configuration
Set swConfig = swModel.GetActiveConfiguration
Set Scene = swConfig.GetScene
Scene.BackgroundType = swSceneBackgroundType_e.swBackgroundType_None
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision, swUserPreferenceOption_e.swDetailingDimension, 4)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAltLinearDimPrecision, swUserPreferenceOption_e.swDetailingDimension, 4)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitSystem, 0, swUnitSystem_e.swUnitSystem_MMGS)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swImageQualityShaded, 2, 2)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swImageQualityWireframeValue, 0, 14)
boolstatus = swModel.FeatureManager.EditRollback(swMoveRollbackBarTo_e.swMoveRollbackBarToEnd, "")
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayAllAnnotations, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayAxes, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayCenterOfMassSymbol, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayCoordSystems, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayDatumCoordSystems, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayCurves, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayOrigins, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayPlanes, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayPartingLines, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayReferencePoints2, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplaySketches, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayDecals, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swHideShowSketchDimensions, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swViewSketchRelations, True)
boolstatus = swModel.SetUserPreferenceToggle(swUserPreferenceToggle_e.swViewDisplayHideAllTypes, False)
End Sub
Sub HideFeatures(Transfer As String)
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Dim swFeat As SldWorks.Feature
Set swFeat = swModel.FirstFeature
Dim featType As String
Dim Append As Boolean
Dim Mark As Integer
Dim DidSelect As Boolean
Dim swPlane As IRefPlaneFeatureData
While Not swFeat Is Nothing
featName = swFeat.Name
featType = swFeat.GetTypeName
DidSelect = swFeat.Select2(Append, Mark)
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
DidSelect = swModel.EditUnsuppress2()
End If
If featType = "RefPlane" Or _
featType = "RefAxis" Or _
featType = "CoordSys" Then
swModel.BlankRefGeom
End If
If featType = "RefPlane" Then
Set swPlane = swFeat.GetDefinition
If swPlane.Type2 = 11 Then
swPlane.AutoSize = True
swPlane.UpdatePlane = True
DidSelect = swFeat.ModifyDefinition(swPlane, swModel, Nothing)
End If
End If
If featType = "ProfileFeature" Or _
featType = "OriginProfileFeature" Or _
featType = "3DProfileFeature" Then
swModel.BlankSketch
End If
Set swFeat = swFeat.GetNextFeature
Wend
Set swFeat = swModel.FirstFeature
DidSelect = swFeat.Select2(Append, Mark)
End Sub
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Please open a model first"
End
End If
If swModel.GetType <> swDocumentTypes_e.swDocPART And _
swModel.GetType <> swDocumentTypes_e.swDocASSEMBLY Then
MsgBox "Please open a part model or assembly model first"
End
End If
If swModel.GetConfigurationByName("Default") Is Nothing Then
Dim swConfig As SldWorks.Configuration
Set swConfig = swModel.AddConfiguration3("Default", "", "", swConfigurationOptions2_e.swConfigOption_UseDescriptionInBOM)
MsgBox "A Default configuration was created. Please delete other configurations if they are not needed."
End If
swModel.ShowConfiguration2 ("Default")
SetSettings Transfer
HideFeatures Transfer
swModel.ShowNamedView2 "*Isometric", 7
swModel.ViewZoomtofit2
' Save
Dim swErrors As Long
Dim swWarnings As Long
boolstatus = swModel.Save3(1, swErrors, swWarnings)