32 Replies Latest reply on Dec 6, 2018 8:32 AM by Fifi Riri

    adding a converted dimension as a note in a dimension box

    Mike Flanders

      I was wondering if using a macro could fill in an annotation into the dimension text box? Our parts shrink in a furnace. I was wondering if it was possible to fill in a dimension text that takes the primary value and divides it by .810? Then have it loop through every dimension on the print. I could do this in the part file itself or do it in the drawing with smart dimension. could maybe have it pop up a window and ask what the conversion figure(.810,.811,.812, etc.) is??

      I put in an enhancement request years ago about being able to control the "DUAL" dimension conversion figure instead of metric to be a value desired by the designer.

       

      adding a value with macro.JPG

      adding a value with macro dwg.JPG

        • Re: adding a converted dimension as a note in a dimension box
          Josh Brady

          Sorry, I forget if you have any API skills...  If you do, this should be a no-brainer.  If not, you should still be able to figure it out with a little bit of head-scratching.

           

          Here's a macro that I wrote approximately forever ago.  Based on the name, I think it takes every dim and subtracts a set value... Take a crack at modifying it!  :-)  It might only do the active sheet.  I haven't even looked at it.

            • Re: adding a converted dimension as a note in a dimension box
              Mike Flanders

              That would be awesome because I would only want it to do the active sheet. I'll look into this. Thanks!!

              • Re: adding a converted dimension as a note in a dimension box
                Mike Flanders

                That is awesome. I changed some wording and had the value come in different. Dividing instead of subtracting. Love it. How might I get it to add it under the dimension instead of to the right of it?

                • Re: adding a converted dimension as a note in a dimension box
                  Mike Flanders

                  Hey Josh, I was wondering if it was possible to take this macro and have it do two conversion figures and have the macro look at the dimension code and have it base its figure off one of the shrink values based on a notation in front of the dimension. Our parts shrink differently lengthwise vs diameter-wise.  I see that any diameter dimension throws in <MOD-DIAM> which is the diameter symbol. I would like it to recognize this and convert by "Diameter Shrink" and if not, then divide by "Length Shrink". The other side of this is angles. If this functionality could work then it should probably recognize decimal places. Any value that has a decimal place less than 2 then it would do anything. I can totally live without the angle option but the segregating the lengths vs the diameters would be HUGE!!!!

                  diameter code.JPG

                   

                  length code.JPG

                  angular code.JPG

                    • Re: adding a converted dimension as a note in a dimension box
                      Josh Brady

                      Here's a macro that does something to selected dimensions vs. all dimensions (I think... It's old too).  All of what you've mentioned is possible...  Play around, explore the API and you should be able to get what you want.

                      • Re: adding a converted dimension as a note in a dimension box
                        Fifi Riri

                        Try this:

                         

                        Option Explicit

                        Dim swApp As SldWorks.SldWorks

                        Dim swDoc As SldWorks.ModelDoc2

                        Dim swDwg As SldWorks.DrawingDoc

                        Dim swView As SldWorks.View

                        Dim swDispDim As SldWorks.DisplayDimension

                        Dim swDim As SldWorks.Dimension

                        Dim sCurSuffix As String

                        Dim nOpenParPos As Long

                        Dim nCloseParPos As Long

                        Dim vDimVal As Variant

                        Dim dInchVal As Double

                        Dim sInchString As String

                        Dim sNewSuffix As String

                        Const ShrinkH As Double = 0.812

                        Const ShrinkV As Double = 0.809

                        Dim myShrinkH As Double

                        Dim myShrinkV As Double

                        Dim DisplayData As SldWorks.DisplayData

                        Dim ArrowHeadPos As Variant

                        Dim ArrowHeadDir As Variant

                         

                        Sub main()

                        Set swApp = Application.SldWorks

                        Set swDoc = swApp.ActiveDoc

                        If swDoc.GetType <> swDocDRAWING Then

                            MsgBox "This macro only works for drawing files."

                            Exit Sub

                        End If

                         

                        myShrinkH = Val(InputBox("Enter the Horizontal Shrink Value:", "SHRINK VALUE", ShrinkH))

                        If myShrinkH = 0 Then Exit Sub

                        myShrinkV = Val(InputBox("Enter the Vertical Shrink Value:", "SHRINK VALUE", ShrinkV))

                        If myShrinkV = 0 Then Exit Sub

                         

                        Set swDwg = swDoc

                        Set swView = swDwg.GetFirstView

                        While Not (swView Is Nothing)

                            Set swDispDim = swView.GetFirstDisplayDimension5

                            While Not swDispDim Is Nothing

                                Set DisplayData = swDispDim.GetDisplayData

                                ArrowHeadPos = DisplayData.GetArrowHeadAtIndex2(0)

                                ArrowHeadDir = DisplayData.GetArrowHeadAtIndex2(1)

                                Set swDim = swDispDim.GetDimension

                                vDimVal = swDim.GetValue3(swThisConfiguration, Empty)

                         

                                If swDispDim.GetPrimaryPrecision2 < 2 Then

                                    GoTo nextdim

                                ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                    dInchVal = vDimVal(0) / myShrinkV

                                ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                    dInchVal = vDimVal(0) / myShrinkH

                                Else

                                    GoTo nextdim

                                End If

                                

                                sInchString = FormatNumber(dInchVal, 3)

                                sCurSuffix = swDispDim.GetText(swDimensionTextSuffix)

                                nOpenParPos = InStr(1, sCurSuffix, "(", vbTextCompare)

                                nCloseParPos = InStr(1, sCurSuffix, ")", vbTextCompare)

                               

                                If (nOpenParPos > 0) And (nCloseParPos > 0) Then

                                    sNewSuffix = Left(sCurSuffix, nOpenParPos)

                                    sNewSuffix = sNewSuffix & sInchString

                                    sNewSuffix = sNewSuffix & Right(sCurSuffix, Len(sCurSuffix) - (nCloseParPos - 1))

                                Else

                                    sNewSuffix = "(" & sInchString & ") " & sCurSuffix

                                End If

                                swDispDim.SetText swDimensionTextSuffix, sNewSuffix

                        nextdim:

                                Set swDispDim = swDispDim.GetNext5

                            Wend

                            Set swView = swView.GetNextView

                        Wend

                        End Sub

                          • Re: adding a converted dimension as a note in a dimension box
                            Mike Flanders

                            FIFI, It pops up the two direction shrink values however nothing appears to happen after that point. You get this to work like I think your code is trying to get it to work and I swear to you I'll have a money order for you in the mail!!! This could potentially be huge for me.

                                • Re: adding a converted dimension as a note in a dimension box
                                  Mike Flanders

                                  These dimensions are not imported model dimensions. I could always go that way also where it actually adds the conversion within the model dimensions and have them import from there. Thats kind of what I have been working on instead of always dimensioning my prints having it pull in the dimensions from the model. The reason I never do this is because of this scaling that happens. When I scale the model out to the larger size before sintered the model dimensions are of the sketches. they dont scale so I have to dimension the surfaces if I was to use a scale feature in my model to do this. If I use a macro that just converts a variable then I can pull in the actual sketch dimension and probably make thing faster that way. I'm not sure which way to go. I really like this macro idea of just having them converted. Our guys on the floor takes every print we do (110-150 per day) and have to calculate out the shrink values to the test piece shrink. Give me your thoughts. I SO SO much appreciate this!!!

                                    • Re: adding a converted dimension as a note in a dimension box
                                      Fifi Riri

                                      My mistake, some dimensions use the system precision instead of their own

                                      also corrected an error with the radius dimensions but I'm not sure what factor to apply to them

                                       

                                      Option Explicit

                                      Dim swApp As SldWorks.SldWorks

                                      Dim swDoc As SldWorks.ModelDoc2

                                      Dim swDwg As SldWorks.DrawingDoc

                                      Dim swView As SldWorks.View

                                      Dim swDispDim As SldWorks.DisplayDimension

                                      Dim swDim As SldWorks.Dimension

                                      Dim sCurSuffix As String

                                      Dim nOpenParPos As Long

                                      Dim nCloseParPos As Long

                                      Dim vDimVal As Variant

                                      Dim dInchVal As Double

                                      Dim sInchString As String

                                      Dim sNewSuffix As String

                                      Const ShrinkH As Double = 0.812

                                      Const ShrinkV As Double = 0.809

                                      Dim myShrinkH As Double

                                      Dim myShrinkV As Double

                                      Dim DisplayData As SldWorks.DisplayData

                                      Dim ArrowHeadPos As Variant

                                      Dim ArrowHeadDir As Variant

                                       

                                      Sub main()

                                      Set swApp = Application.SldWorks

                                      Set swDoc = swApp.ActiveDoc

                                      If swDoc.GetType <> swDocDRAWING Then

                                          MsgBox "This macro only works for drawing files."

                                          Exit Sub

                                      End If

                                       

                                      myShrinkH = Val(InputBox("Enter the Horizontal Shrink Value:", "SHRINK VALUE", ShrinkH))

                                      If myShrinkH = 0 Then Exit Sub

                                      myShrinkV = Val(InputBox("Enter the Vertical Shrink Value:", "SHRINK VALUE", ShrinkV))

                                      If myShrinkV = 0 Then Exit Sub

                                       

                                      Set swDwg = swDoc

                                      Set swView = swDwg.GetFirstView

                                      While Not (swView Is Nothing)

                                          Set swDispDim = swView.GetFirstDisplayDimension5

                                          While Not swDispDim Is Nothing

                                              Set DisplayData = swDispDim.GetDisplayData

                                              ArrowHeadPos = DisplayData.GetArrowHeadAtIndex2(0)

                                              ArrowHeadDir = DisplayData.GetArrowHeadAtIndex2(1)

                                              Set swDim = swDispDim.GetDimension

                                              vDimVal = swDim.GetValue3(swThisConfiguration, Empty)

                                       

                                              If DisplayData.GetArrowHeadCount <> 2 Then

                                                  GoTo nextdim

                                              ElseIf (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                  GoTo nextdim

                                              ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                                  dInchVal = vDimVal(0) / myShrinkV

                                              ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                                  dInchVal = vDimVal(0) / myShrinkH

                                              Else

                                                  GoTo nextdim

                                              End If

                                            

                                              sInchString = FormatNumber(dInchVal, 3)

                                              sCurSuffix = swDispDim.GetText(swDimensionTextSuffix)

                                              nOpenParPos = InStr(1, sCurSuffix, "(", vbTextCompare)

                                              nCloseParPos = InStr(1, sCurSuffix, ")", vbTextCompare)

                                           

                                              If (nOpenParPos > 0) And (nCloseParPos > 0) Then

                                                  sNewSuffix = Left(sCurSuffix, nOpenParPos)

                                                  sNewSuffix = sNewSuffix & sInchString

                                                  sNewSuffix = sNewSuffix & Right(sCurSuffix, Len(sCurSuffix) - (nCloseParPos - 1))

                                              Else

                                                  sNewSuffix = "(" & sInchString & ") " & sCurSuffix

                                              End If

                                              swDispDim.SetText swDimensionTextSuffix, sNewSuffix

                                      nextdim:

                                              Set swDispDim = swDispDim.GetNext5

                                          Wend

                                          Set swView = swView.GetNextView

                                      Wend

                                      End Sub

                                        • Re: adding a converted dimension as a note in a dimension box
                                          Mike Flanders

                                          WHERE DO I SEND THE CHECK???????????????? This is amazing!!!!!!

                                          • Re: adding a converted dimension as a note in a dimension box
                                            Mike Flanders

                                            actually I would want any single arrows to convert to the horizontal value.

                                              • Re: adding a converted dimension as a note in a dimension box
                                                Fifi Riri

                                                Replace

                                                        If DisplayData.GetArrowHeadCount <> 2 Then

                                                           ...

                                                        End If

                                                by

                                                        If (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                            'precision <2

                                                            GoTo nextdim

                                                        ElseIf DisplayData.GetArrowHeadCount <> 2 Then

                                                            'Radius

                                                            dInchVal = vDimVal(0) / myShrinkH

                                                        ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                                            'vertical dim

                                                            dInchVal = vDimVal(0) / myShrinkV

                                                        ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                                            'horizontal dim

                                                            dInchVal = vDimVal(0) / myShrinkH

                                                        Else

                                                            'other dim

                                                            GoTo nextdim

                                                        End If

                                                  • Re: adding a converted dimension as a note in a dimension box
                                                    Fifi Riri

                                                    Option Explicit

                                                    Dim swApp As SldWorks.SldWorks

                                                    Dim swDoc As SldWorks.ModelDoc2

                                                    Dim swDwg As SldWorks.DrawingDoc

                                                    Dim swView As SldWorks.View

                                                    Dim swDispDim As SldWorks.DisplayDimension

                                                    Dim swDim As SldWorks.Dimension

                                                    Dim vDimVal As Variant

                                                    Dim dInchVal As Double

                                                    Dim sNewSuffix As String

                                                    Const ShrinkH As Double = 0.812

                                                    Const ShrinkV As Double = 0.809

                                                    Dim myShrinkH As Double

                                                    Dim myShrinkV As Double

                                                    Dim DisplayData As SldWorks.DisplayData

                                                    Dim ArrowHeadPos As Variant

                                                    Dim ArrowHeadDir As Variant

                                                    Dim length As Double

                                                    Dim boolstatus As Boolean

                                                     

                                                    Sub main()

                                                    Set swApp = Application.SldWorks

                                                    Set swDoc = swApp.ActiveDoc

                                                    If swDoc.GetType <> swDocDRAWING Then

                                                        MsgBox "This macro only works for drawing files."

                                                        Exit Sub

                                                    End If

                                                     

                                                    myShrinkH = Val(InputBox("Enter the Horizontal Shrink Value:", "SHRINK VALUE", ShrinkH))

                                                    If myShrinkH = 0 Then Exit Sub

                                                    myShrinkV = Val(InputBox("Enter the Vertical Shrink Value:", "SHRINK VALUE", ShrinkV))

                                                    If myShrinkV = 0 Then Exit Sub

                                                     

                                                    Set swDwg = swDoc

                                                    Set swView = swDwg.GetFirstView

                                                    While Not (swView Is Nothing)

                                                        Set swDispDim = swView.GetFirstDisplayDimension5

                                                        While Not swDispDim Is Nothing

                                                            Set DisplayData = swDispDim.GetDisplayData

                                                            ArrowHeadPos = DisplayData.GetArrowHeadAtIndex2(0)

                                                            ArrowHeadDir = DisplayData.GetArrowHeadAtIndex2(1)

                                                            Set swDim = swDispDim.GetDimension

                                                            vDimVal = swDim.GetValue3(swThisConfiguration, Empty)

                                                           

                                                            boolstatus = swDim.GetSystemChamferValues(length, Empty)

                                                           

                                                            If (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                                'precision <2

                                                                GoTo nextdim

                                                            ElseIf boolstatus Then

                                                                'chamfer

                                                                dInchVal = length / 0.00254 / myShrinkH

                                                            ElseIf swView.GetDimensionCount4 < 8 Then

                                                                'side view

                                                                dInchVal = vDimVal(0) / myShrinkH

                                                            ElseIf DisplayData.GetArrowHeadCount <> 2 Then

                                                                'Radius

                                                                dInchVal = vDimVal(0) / myShrinkH

                                                            ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                                                'vertical dim

                                                                dInchVal = vDimVal(0) / myShrinkV

                                                            ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                                                'horizontal dim

                                                                 dInchVal = vDimVal(0) / myShrinkH

                                                            Else

                                                                'other dim

                                                                GoTo nextdim

                                                            End If

                                                            

                                                            sNewSuffix = vbCr & "<FONT color=0x000000ff>(" & FormatNumber(dInchVal, 3) & ")<FONT color=0x000000ff>"

                                                            swDispDim.SetText swDimensionTextSuffix, sNewSuffix

                                                    nextdim:

                                                            Set swDispDim = swDispDim.GetNext5

                                                        Wend

                                                        Set swView = swView.GetNextView

                                                    Wend

                                                    End Sub

                                                      • Re: adding a converted dimension as a note in a dimension box
                                                        Mike Flanders

                                                        I am having no luck getting this macro to work together with another one. I added the one macro into one that copies my sheet and paste it while renaming it. I cant see where I can attach it in this thread so I'll just copy and paste in here and tell me what you think.

                                                         

                                                        Option Explicit

                                                        'Dim swApp As Object

                                                         

                                                         

                                                        Dim Part As Object

                                                        Dim boolstatus As Boolean

                                                        Dim longstatus As Long, longwarnings As Long

                                                        Dim swApp As SldWorks.SldWorks

                                                        Dim swDoc As SldWorks.ModelDoc2

                                                        Dim swDwg As SldWorks.DrawingDoc

                                                        Dim swView As SldWorks.View

                                                        Dim swDispDim As SldWorks.DisplayDimension

                                                        Dim swDim As SldWorks.Dimension

                                                        Dim sCurSuffix As String

                                                        Dim nOpenParPos As Long

                                                        Dim nCloseParPos As Long

                                                        Dim vDimVal As Variant

                                                        Dim dInchVal As Double

                                                        Dim sInchString As String

                                                        Dim sNewSuffix As String

                                                        Const ShrinkV As Double = 0.809

                                                        Const ShrinkH As Double = 0.812

                                                        Dim myShrinkH As Double

                                                        Dim myShrinkV As Double

                                                        Dim DisplayData As SldWorks.DisplayData

                                                        Dim ArrowHeadPos As Variant

                                                        Dim ArrowHeadDir As Variant

                                                         

                                                        Sub main()

                                                         

                                                         

                                                        Set swApp = Application.SldWorks

                                                         

                                                         

                                                        'COPY AND PASTE PREFORM SHEET. RENAME TO RED FIGURE PRINT.

                                                         

                                                         

                                                         

                                                         

                                                        Set Part = swApp.ActiveDoc

                                                        Dim myModelView As Object

                                                        Set myModelView = Part.ActiveView

                                                        myModelView.FrameState = swWindowState_e.swWindowMaximized

                                                        boolstatus = Part.Extension.SelectByID2("PREFORM", "SHEET", 0, 0, 0, False, 0, Nothing, 0)

                                                        Part.EditCopy

                                                        Part.Paste

                                                         

                                                         

                                                        ' Zoom To Fit

                                                        Part.ViewZoomtofit2

                                                        Part.ClearSelection2 True

                                                        Dim myDrawingSheet As Object

                                                        Set myDrawingSheet = Part.GetCurrentSheet()

                                                        myDrawingSheet.SetName "RED FIGURE PRINT"

                                                        boolstatus = Part.ActivateView("Drawing View6")

                                                         

                                                         

                                                         

                                                         

                                                        boolstatus = Part.ActivateSheet("RED FIGURE PRINT")

                                                         

                                                         

                                                        'Rebuild

                                                        Part.ForceRebuild3 (True)

                                                         

                                                         

                                                        '------------------------------------------------------------

                                                         

                                                         

                                                        Set swApp = Application.SldWorks

                                                        Set swDoc = swApp.ActiveDoc

                                                        If swDoc.GetType <> swDocDRAWING Then

                                                            MsgBox "This macro only works for drawing files."

                                                            Exit Sub

                                                        End If

                                                        myShrinkV = Val(InputBox("Enter the Vertical Shrink Value:", "SHRINK VALUE", ShrinkV))

                                                        If myShrinkV = 0 Then Exit Sub

                                                        myShrinkH = Val(InputBox("Enter the Horizontal Shrink Value:", "SHRINK VALUE", ShrinkH))

                                                        If myShrinkH = 0 Then Exit Sub

                                                         

                                                         

                                                         

                                                        Set swDwg = swDoc

                                                        Set swView = swDwg.GetFirstView

                                                        While Not (swView Is Nothing)

                                                            Set swDispDim = swView.GetFirstDisplayDimension5

                                                            While Not swDispDim Is Nothing

                                                                Set DisplayData = swDispDim.GetDisplayData

                                                                ArrowHeadPos = DisplayData.GetArrowHeadAtIndex2(0)

                                                                ArrowHeadDir = DisplayData.GetArrowHeadAtIndex2(1)

                                                                Set swDim = swDispDim.GetDimension

                                                                vDimVal = swDim.GetValue3(swThisConfiguration, Empty)

                                                               

                                                                boolstatus = swDim.GetSystemChamferValues(Length, Empty)

                                                               

                                                                If (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                                    '''precision <2

                                                                    GoTo nextdim

                                                               ElseIf boolstatus Then

                                                                    '''chamfer

                                                                    dInchVal = Length / 0.0254 / myShrinkH

                                                                ElseIf swView.GetDimensionCount4 < 3 Then

                                                                    '''side view

                                                                    dInchVal = vDimVal(0) / myShrinkH

                                                                ElseIf DisplayData.GetArrowHeadCount <> 2 Then

                                                                    '''Radius

                                                                   dInchVal = vDimVal(0) / myShrinkH

                                                                ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                                                    '''vertical dim

                                                                    dInchVal = vDimVal(0) / myShrinkV

                                                                ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                                                    '''horizontal dim

                                                                     dInchVal = vDimVal(0) / myShrinkH

                                                                Else

                                                                    '''other dim

                                                                    GoTo nextdim

                                                                End If

                                                                

                                                                sInchString = FormatNumber(dInchVal, 3)

                                                                sCurSuffix = swDispDim.GetText(swDimensionTextSuffix)

                                                                nOpenParPos = InStr(1, sCurSuffix, "(", vbTextCompare)

                                                                nCloseParPos = InStr(1, sCurSuffix, ")", vbTextCompare)

                                                               

                                                                If (nOpenParPos > 0) And (nCloseParPos > 0) Then

                                                                    sNewSuffix = Left(sCurSuffix, nOpenParPos)

                                                                    sNewSuffix = sNewSuffix & sInchString

                                                                    sNewSuffix = sNewSuffix & Right(sCurSuffix, Len(sCurSuffix) - (nCloseParPos - 1))

                                                                Else

                                                                 sNewSuffix = "(" & sInchString & ") " & sCurSuffix

                                                                End If

                                                                sNewSuffix = vbCr & "<FONT color=0x000000ff>" & Replace(sNewSuffix, Chr(13), "")

                                                                swDispDim.SetText swDimensionTextSuffix, sNewSuffix

                                                        nextdim:

                                                                Set swDispDim = swDispDim.GetNext5

                                                            Wend

                                                            Set swView = swView.GetNextView

                                                        Wend

                                                        End Sub

                                    • Re: adding a converted dimension as a note in a dimension box
                                      Mike Flanders

                                      Fifi Riri

                                      Fifi, If you happen to look at see this, This doesn't seem to dimension the coolant holes. This is what I was referring to when I said something about the anything over 1place decimal I need it to calculate with one of the myshrink"" values. I think it would be best if it was using the "myshrinkH".  I dont want the angular dimensions converting but I do want the holes size itself to calculate. The .051" should be (0.063). This is so close to being perfect. I don't know what is going on. I could swear this was working in the beginning. I keep going back and coping what we have in this forum but nothing seems to be working on these holes sizes

                                       

                                      NOT DIMENSIONING THE ANGULAR HOLES.PNG

                                        • Re: adding a converted dimension as a note in a dimension box
                                          Fifi Riri

                                          Replace the if with:

                                           

                                                  If swDispDim.GetType = swDimensionType_e.swLinearDimension And (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - precision <2"

                                                      GoTo nextdim

                                                  'ElseIf swDispDim.GetType = swDimensionType_e.swAngularDimension And (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingAngularDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                      'Debug.Print swDispDim.GetNameForSelection & " - angular precision <2"

                                                      'GoTo nextdim

                                                  ElseIf boolstatus Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - chamfer"

                                                      dInchVal = length / 0.00254 / myShrinkH

                                                  ElseIf swDispDim.GetType = swDimensionType_e.swAngularDimension Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - Angle"

                                                      GoTo nextdim

                                                  ElseIf swView.GetDimensionCount4 < 5 Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - side view"

                                                      dInchVal = vDimVal(0) / myShrinkH

                                                  ElseIf DisplayData.GetArrowHeadCount <> 2 Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - Radius"

                                                      dInchVal = vDimVal(0) / myShrinkH

                                                  ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - vertical dim"

                                                      dInchVal = vDimVal(0) / myShrinkV

                                                  ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - horizontal dim"

                                                      dInchVal = vDimVal(0) / myShrinkH

                                                  ElseIf swDispDim.GetType = swDimensionType_e.swLinearDimension Then

                                                      Debug.Print swDispDim.GetNameForSelection & " - angled dim"

                                                      dInchVal = vDimVal(0) / myShrinkH

                                                  Else

                                                      Debug.Print swDispDim.GetNameForSelection & " - other dim"

                                                      GoTo nextdim

                                                  End If

                                            • Re: adding a converted dimension as a note in a dimension box
                                              Mike Flanders

                                              we are so close. it is converting angles again. I posted what I have under photo.

                                              maco.PNG

                                               

                                              Option Explicit

                                              Dim swApp As SldWorks.SldWorks

                                              Dim swDoc As SldWorks.ModelDoc2

                                              Dim swDwg As SldWorks.DrawingDoc

                                              Dim swView As SldWorks.View

                                              Dim swDispDim As SldWorks.DisplayDimension

                                              Dim swDim As SldWorks.Dimension

                                              Dim vDimVal As Variant

                                              Dim dInchVal As Double

                                              Dim sNewSuffix As String

                                              Const ShrinkH As Double = 0.812

                                              Const ShrinkV As Double = 0.809

                                              Dim myShrinkH As Double

                                              Dim myShrinkV As Double

                                              Dim DisplayData As SldWorks.DisplayData

                                              Dim ArrowHeadPos As Variant

                                              Dim ArrowHeadDir As Variant

                                              Dim length As Double

                                              Dim boolstatus As Boolean

                                               

                                              Sub main()

                                              Set swApp = Application.SldWorks

                                              Set swDoc = swApp.ActiveDoc

                                              If swDoc.GetType <> swDocDRAWING Then

                                                  MsgBox "This macro only works for drawing files."

                                                  Exit Sub

                                              End If

                                              Set swDwg = swDoc

                                               

                                              Dim myModelView As Object

                                              Set myModelView = swDwg.ActiveView

                                              myModelView.FrameState = swWindowState_e.swWindowMaximized

                                              boolstatus = swDwg.Extension.SelectByID2("PREFORM", "SHEET", 0, 0, 0, False, 0, Nothing, 0)

                                              swDwg.EditCopy

                                              swDwg.Paste

                                               

                                              ' Zoom To Fit

                                              swDwg.ViewZoomtofit2

                                              swDwg.ClearSelection2 True

                                              Dim myDrawingSheet As Object

                                              Set myDrawingSheet = swDwg.GetCurrentSheet()

                                              myDrawingSheet.SetName "RED FIGURE PRINT"

                                              boolstatus = swDwg.ActivateView("Drawing View6")

                                              boolstatus = swDwg.Extension.SelectByRay(0.119488618854222, 0.129761048681381, 166.666666666667, 0, 0, -1, 5.89599615358807E-04, 46, False, 0, 0)

                                               

                                               

                                              boolstatus = swDwg.ActivateSheet("RED FIGURE PRINT")

                                              'Rebuild

                                              swDwg.ForceRebuild3 (True)

                                               

                                              '------------------------

                                              myShrinkV = Val(InputBox("Enter the Vertical Shrink Value:", "SHRINK VALUE", ShrinkV))

                                              If myShrinkV = 0 Then Exit Sub

                                               

                                               

                                              myShrinkH = Val(InputBox("Enter the Horizontal Shrink Value:", "SHRINK VALUE", ShrinkH))

                                              If myShrinkH = 0 Then Exit Sub

                                               

                                               

                                               

                                              Set swView = swDwg.GetFirstView

                                              While Not (swView Is Nothing)

                                                  Set swDispDim = swView.GetFirstDisplayDimension5

                                                  While Not swDispDim Is Nothing

                                                      Set DisplayData = swDispDim.GetDisplayData

                                                      ArrowHeadPos = DisplayData.GetArrowHeadAtIndex2(0)

                                                      ArrowHeadDir = DisplayData.GetArrowHeadAtIndex2(1)

                                                      Set swDim = swDispDim.GetDimension

                                                      vDimVal = swDim.GetValue3(swThisConfiguration, Empty)

                                                     

                                                      boolstatus = swDim.GetSystemChamferValues(length, Empty)

                                                      If swDispDim.GetType = swDimensionType_e.swLinearDimension And (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingLinearDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - precision <2"

                                                          GoTo nextdim

                                                      'ElseIf swDispDim.GetType = swDimensionType_e.swAngularDimension And (swDispDim.GetPrimaryPrecision2 = -2 And swDwg.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDetailingAngularDimPrecision) < 2) Or (swDispDim.GetPrimaryPrecision2 <> -2 And swDispDim.GetPrimaryPrecision2 < 2) Then

                                                          'Debug.Print swDispDim.GetNameForSelection & " - angular precision <2"

                                                          'GoTo nextdim

                                                      ElseIf boolstatus Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - chamfer"

                                                          dInchVal = length / 0.00254 / myShrinkH

                                                      ElseIf swDispDim.GetType = swDimensionType_e.swAngularDimension Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - Angle"

                                                          dInchVal = vDimVal(0) / myShrinkH

                                                      ElseIf swView.GetDimensionCount4 < 8 Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - side view"

                                                          dInchVal = vDimVal(0) / myShrinkH

                                                      ElseIf DisplayData.GetArrowHeadCount <> 2 Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - Radius"

                                                          dInchVal = vDimVal(0) / myShrinkH

                                                      ElseIf Abs(ArrowHeadPos(0) - ArrowHeadDir(0)) < 0.0001 Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - vertical dim"

                                                          dInchVal = vDimVal(0) / myShrinkV

                                                      ElseIf Abs(ArrowHeadPos(1) - ArrowHeadDir(1)) < 0.0001 Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - horizontal dim"

                                                          dInchVal = vDimVal(0) / myShrinkH

                                                      ElseIf swDispDim.GetType = swDimensionType_e.swLinearDimension Then

                                                          Debug.Print swDispDim.GetNameForSelection & " - angled dim"

                                                          dInchVal = vDimVal(0) / myShrinkH

                                                      Else

                                                          Debug.Print swDispDim.GetNameForSelection & " - other dim"

                                                          dInchVal = vDimVal(0) / myShrinkH

                                                  

                                                          GoTo nextdim

                                                      End If

                                                      

                                                      sNewSuffix = vbCr & "<FONT color=0x000000ff>(" & FormatNumber(dInchVal, 3) & ")<FONT color=0x000000ff>"

                                                      swDispDim.SetText swDimensionTextSuffix, sNewSuffix

                                              nextdim:

                                                      Set swDispDim = swDispDim.GetNext5

                                                  Wend

                                                  Set swView = swView.GetNextView

                                              Wend

                                              End Sub

                                          • Re: adding a converted dimension as a note in a dimension box
                                            Mike Flanders

                                            This whole thing is going to be incredible!! The last portion of this thread you had me add some code to get the values we input for our shrinks to be placed in a note on the print. I was wondering if this could be done by adding them to values into the models custom properties. By doing so I can add in two spaces for these two values into my title block on my print and just have them linked to the new custom properties. It wouldn't be just and annotation on the print but a dynamic note.

                                             

                                             

                                            Fifi Riri

                                             

                                             

                                            macro addition.PNG

                                            custom property.JPG