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