Code to Convert

I have written this macro, and I have gotten a little help from this forum, and I need some more. If macro is not written very well, don't be surprised. Like I said, I am no expert.

The pre-requisite to this macro is that your part is modeled, and 3 reference dimension are put on the part. The problem is that I have a few variables that I need written to the custom properties of SolidWorks. I can write them as a decimal, but I don't know how to write them as a fraction that rounds to the 16th.

I am posting all of my code below. Can someone please help.

================================================================= Public Thickness As String Public Width As String Public Length As String Public RW As Double Sub Main()

Dim swApp As Object Dim Part As Object Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc

FlatPattern

SelectDims

ChgDimsToFractions

WriteEquation

HideAnnotations

DeleteCustomProps

GetDimValues

WriteCustomProps

Formed_Iso_Fit

Part.ForceRebuild

End Sub Private Sub FlatPattern()

Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim FeatureData As Object Dim Feature As Object Dim Component As Object

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc

boolstatus = Part.Extension.SelectByID2("Flat-Pattern1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0) Part.ClearSelection2 True Part.SetBendState 2 boolstatus = Part.EditRebuild3

End Sub Private Sub SelectDims()

Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc

boolstatus = Part.Extension.SelectByID2("RD3@Annotations@DS TEST.moPart_c", "DIMENSION", -0.004780741706299, -0.05064288656189,

0.1173281560361, False, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("RD2@Annotations@DS TEST.moPart_c", "DIMENSION", 0.09844823636707, -0.07157967685629, 0.03503256571634, True, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("RD1@Annotations@DS TEST.moPart_c", "DIMENSION", 0.07994366233927, -0.06914516635694, 0.05110302488907, True, 0, Nothing, 0)

End Sub Private Sub ChgDimsToFractions()

Dim swApp As Object Dim swModel As Object Dim swSelMgr As Object Dim selCount As Integer Dim selType As Integer Dim CurrentSelDimension As Object Dim i As Integer

Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc

Set swSelMgr = swModel.SelectionManager() selCount = swSelMgr.GetSelectedObjectCount()

If (selCount > 0) Then For i = 1 To selCount selType = swSelMgr.GetSelectedObjectType2(i) If (selType = swSelDIMENSIONS) Then Set CurrentSelDimension = swSelMgr.GetSelectedObject3(i) CurrentSelDimension.SetDual True CurrentSelDimension.SetUnits False, swINCHES, swFRACTION,

16, True End If Next End If

End Sub Private Sub WriteEquation()

Dim swApp As Object Dim Part As Object

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc

Part.ClearSelection2 True

Part.DeleteAllRelations Part.AddRelation """D1@RectWeight"" = ""RD1@Annotations"" * ""RD2@Annotations"" * ""RD3@Annotations"" * .2836"

Part.ForceRebuild

End Sub Private Sub HideAnnotations()

Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim FeatureData As Object Dim Feature As Object Dim Component As Object

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc

boolstatus = Part.SetUserPreferenceToggle(197, False)

End Sub Private Sub GetDimValues()

Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Const Density = 0.2836

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc

Thickness = Round(Part.Parameter("RD1@Annotations").SystemValue /

0.0254, 3) Width = Round(Part.Parameter("RD2@Annotations").SystemValue / 0.0254, 3) Length = Round(Part.Parameter("RD3@Annotations").SystemValue / 0.0254, 3) RW = Round(Thickness * Width * Length * Density, 3)

End Sub Private Sub DeleteCustomProps()

Dim ModelDoc2 As Object

Set swApp = CreateObject("SldWorks.Application") Set ModelDoc2 = swApp.ActiveDoc

retval = ModelDoc2.DeleteCustomInfo2("", "CutSize") retval = ModelDoc2.DeleteCustomInfo2("", "RectangularWeight") retval = ModelDoc2.DeleteCustomInfo2("", "SWDescription") retval = ModelDoc2.DeleteCustomInfo2("", "GroupType")

End Sub Private Sub WriteCustomProps()

Dim ModelDoc2 As Object

Set swApp = CreateObject("SldWorks.Application") Set ModelDoc2 = swApp.ActiveDoc

retval = ModelDoc2.AddCustomInfo3("", "CutSize", 30, Width & " x " & Length) retval = ModelDoc2.AddCustomInfo3("", "RectangularWeight", 30, RW) retval = ModelDoc2.AddCustomInfo3("", "SWDescription", 30, "PLATE, " & Thickness & " x " & Width & " x " & Length & ", ""SW-Material@DS TEST.SLDPRT""") retval = ModelDoc2.AddCustomInfo3("", "GroupType", 30, Thickness)

'MsgBox Thickness 'MsgBox Width 'MsgBox Length 'MsgBox RW

End Sub Private Sub Formed_Iso_Fit()

Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim FeatureData As Object Dim Feature As Object Dim Component As Object

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc

boolstatus = Part.Extension.SelectByID2("Flat-Pattern1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0) Part.ClearSelection2 True Part.SetBendState 3 boolstatus = Part.EditRebuild3

Part.ShowNamedView2 "*Isometric", 7

Part.ViewZoomtofit2

End Sub

I pulled this function from one of my programs. There may be simpler methods out there, but I know it works. You can specify any denominator value and if the number you pass to the function is close enough to the fractional value it send the fraction, otherwise it leaves it alone. You can specify a tolerance large enough such that it will always return a fraction if you want to.

Function DimensionalFraction(DecimalValue As Double, MaxDenominator As Double, Tolerance As Double) As String 'converts Decimal Value to a mixed fraction text in a dimesional form using 2,4,8,16,32 in the denominator Dim withintol As Boolean Dim toler As Double Dim num As Double 'numerator Dim denom As Double 'denominator

denom = 2 ' start with denominator = 2 for halves then double it for 4ths ,8ths etc. withintol = False

Do ' num = Application.WorksheetFunction.RoundUp(DecimalValue * denom, 0) ' Use this function in Excel. num = Round(DecimalValue * denom, 0) 'Multiply decimal value by the denominator and round to nearest int If num < (DecimalValue * denom) Then 'If it rounded down then add 1 to force Round Up to nearest integer num = num + 1 End If 'if the decimal value times the denominator is greater than the rounded up value plus the 'tolerance * denom, then it is within tolerance If ((DecimalValue * denom) >= (num - (Tolerance * denom))) Then withintol = True Exit Do End If

num = Round(DecimalValue * denom, 0) 'Round Down to nearest integer If num > (DecimalValue * denom) Then num = num - 1 End If If ((DecimalValue * denom) be surprised. Like I said, I am no expert.