Macro One less & one more decimal places... Doesn't function until you hit rebuild...

I've been using these two macros for years, and they're great, but with
the advent of I think SW 2005 they stopped being automatic, and
required a rebuild to refresh the screen and actually add the new
decimal places. I've been putting up with this for a while, and I'm
wondering if anyone has a solution for this...

--Matt Schroeder

 

Add a rebulid to the end of the macro.

 

I'm so out of practice with VB and SolidWorks command structure that
I'd be fooling myself if I could do that... The code does have a
couple lines that look like they're supposed to do just that though...

Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager()
selCount = SelMgr.GetSelectedObjectCount()
If (selCount > 0) Then
Dim i As Integer
For i = 1 To selCount
selType = SelMgr.GetSelectedObjectType2(i)
If (selType = swSelDIMENSIONS) Then
Set dimension = SelMgr.GetSelectedObject3(i)
Dim primaryPrec As Long
Dim alternatePrec As Long
Dim primaryTol As Long
Dim alternateTol As Long
'Set dimension = currSelection
retval = dimension.GetUseDocPrecision()
'If (not retval) Then
primaryPrec = dimension.GetPrimaryPrecision()
alternatePrec = dimension.GetAlternatePrecision()
primaryTol = dimension.GetPrimaryTolPrecision()
alternateTol = dimension.GetAlternateTolPrecision()
If (primaryPrec < 8) Then
primaryPrec = primaryPrec + 1
primaryTol = primaryTol + 1
retval = dimension.SetPrecision(False, primaryPrec,
alternatePrec, primaryTol, alternateTol)
changeOcurred = True
End If
End If
'End If
Next
End If
If (changeOcurred) Then
retval = Part.GraphicsRedraw2()
End If
End Sub

 

I'm far from a VB expert myself, but here is a simple macro I use that
rebuilds, puts in isometric view, zooms to fit, and saves. I would
start by grabbing the rebuild line and sticking it in right above "End
Sub" in your code.

Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Part.EditRebuild3

Part.ShowNamedView2 "*Isometric", 7
Part.ViewZoomtofit2
Part.Save2 False
End Sub

 

That did it! Thanks. It seemed to look like what was there should
have done just that, but something changed in the API since I started
using these macros, and they failed to work properly ever since.

Thanks

--Matt Schroeder

 

Matt,

How kind of errors are you getting? I don't know if this addresses
your issues, but I have had a issue before where macros wouldn't run on
my system. The solution for me was to make sure the correct Reference
Libraries where attached to the macros. From what my VAR told me, this
shouldn't normally be an issue, but does happen on some systems.

Matt

 

--Never really had errors, the macro used to add a decimal place or
take away a decimal place for my dimension(s) that were currently
selected, and it still did, but I had to hit redraw to see the results
since loading SW 2005.

I can only assume something in the API functionality changed so that
the macro was no longer perfect... I added the redraw function as the
previous poster recommended, eventhough to me it looks like it's
already there, and it works great again now.

--Matt Schroeder