8 Replies Latest reply on Feb 3, 2015 2:11 PM by Lois Claracq

Keeping Current Prefix and Adding New One to Drawing Dimensions

Jay Wagamon Sep 24, 2014 12:09 PM

Hey Guys,

I am trying to make a macro that I select a drawing dimension and it keeps the current prefix and then adds a new prefix in front of the current prefix. For example the dimension would be displayed as a diameter symbol and then the diameter. I want to add a quantity in front of that diameter symbol without deleting the diameter symbol. I am trying to modify my current macro that deletes the current prefix and am having problems getting the current prefix. Below is my current macro and snips of before and after for what I would like the macro to do.

Any help would be great!

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

' This Macro will add 4 x in front of the dimension in a drawing

' and keep the original Dimension Prefix.

' Preconditions:

' 1. Open a drawing.

' 2. Select a dimension.

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

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim boolstatus As Boolean

Dim swDispDim As SldWorks.DisplayDimension

Dim swDim As SldWorks.Dimension

Dim CurPrefix As System.String

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set CurPrefix = swDispDim.GetText(swDimensionTextPrefix)

Set swDim = swDispDim.GetDimension

boolstatus = swModelDocExt.EditDimensionProperties(0, 0, 0, "", "", True, 9, 2, True, 12, 12, "4 x CurPrefix ", "", True, "", "", False)

swModel.ClearSelection2 True

End Sub

Thanks,

Jay

Re: Keeping Current Prefix and Adding New One to Drawing Dimensions

Deepak Gupta Sep 24, 2014 1:25 PM (in response to Jay Wagamon)

Jay does this macro works for you? I'm getting errors in using this macro.

if the macro works for you then try using "4 x " & CurPrefix & " "
Like Show 0 Likes(0)

Actions
- Re: Keeping Current Prefix and Adding New One to Drawing Dimensions
  
  Jay Wagamon Sep 24, 2014 1:59 PM (in response to Deepak Gupta)
  
  Deepak,
  
  No this does not work for me either. I removed the System in Dim CurPrefix As System.String so it's now Dim CurPrefix As String and now it runs but it does not do anything to the dimension. When I run it in the editor without selecting the dimension it gives me a compile error: object required for CurPrefix. I did try it with "4 x " & CurPrefix & " " and that did not work either.
  
  Here's the macro that I currently use that deletes the existing prefix and puts in "4 x".
  
  Dim swApp As Object
  
  Dim Part As Object
  Dim boolstatus As Boolean
  Dim longstatus As Long, longwarnings As Long
  
  Sub main()
  
  Set swApp = _
  Application.SldWorks
  
  Set Part = swApp.ActiveDoc
  boolstatus = Part.EditDimensionProperties2(0, 0, 0, "", "", True, 9, 2, True, 12, 12, "4 x ", "", True, "", "", False)
  Part.ClearSelection2 True
  
  End Sub
  
  Thanks,
  Jay
  
  Like Show 0 Likes(0)
  
  Actions
  - Re: Keeping Current Prefix and Adding New One to Drawing Dimensions
    
    Jesse Seger Sep 24, 2014 2:45 PM (in response to Jay Wagamon)
    
    Here is the working code.
    
    '------------------------------------------------------
    ' This Macro will add 4 x in front of the dimension in a drawing
    ' and keep the original Dimension Prefix.
    '
    ' Preconditions:
    ' 1. Open a drawing.
    ' 2. Select a dimension.
    ' -----------------------------------------------------
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim selMgr As SelectionMgr
    Dim swModelDocExt As SldWorks.ModelDocExtension
    Dim boolstatus As Boolean
    Dim swDispDim As SldWorks.DisplayDimension
    Dim swDim As SldWorks.Dimension
    Dim CurPrefix As String
    
    Sub main()
        Set swApp = Application.SldWorks
        Set swModel = swApp.ActiveDoc
        Set selMgr = swModel.SelectionManager
        Set swModelDocExt = swModel.Extension
        Debug.Print selMgr.GetSelectedObjectType(1)
        Set swDispDim = selMgr.GetSelectedObject6(1, 0)
        CurPrefix = swDispDim.GetText(swDimensionTextParts_e.swDimensionTextPrefix)
        Set swDim = swDispDim.GetDimension
        boolstatus = swModelDocExt.EditDimensionProperties(0, 0, 0, "", "", True, 9, 2, True, 12, 12, "4 x " & CurPrefix, "", True, "", "", False, False, 0, "")
        swModel.ClearSelection2 True
    End Sub
    
    Like Show 2 Likes(2)
    
    Actions
    - Re: Keeping Current Prefix and Adding New One to Drawing Dimensions
      
      Jay Wagamon Sep 24, 2014 3:10 PM (in response to Jesse Seger)
      
      Jesse that works perfectly! Thanks this is going to save me a bunch of time on prints!
      
      Thanks guys for the help!!!
      Jay
      
      Like Show 0 Likes(0)
      
      Actions
Re: Keeping Current Prefix and Adding New One to Drawing Dimensions

Jay Wagamon Sep 25, 2014 3:30 PM (in response to Jay Wagamon)

Roger,

It does change the precision to the document precision which is the one thing i don't like. Most of the time I am making a new print so I like to do the multiplier first and then change the precision after if it's different from the document precision. Then a style does do the same thing but i like to use a hot key to run my macro so i can use my mouse to dimension and before going to my next dimension hit my hot key to get my multiplier. This seems to be faster to me but its all preference.
Like Show 0 Likes(0)

Actions
- Re: Keeping Current Prefix and Adding New One to Drawing Dimensions
  
  Deepak Gupta Sep 26, 2014 7:25 AM (in response to Jay Wagamon)
  
  Use this line in case you want to retain the dimension precision
  
  boolstatus = swModelDocExt.EditDimensionProperties(0, 0, 0, "", "", False, 9, 2, True, 12, 12, "4 x " & CurPrefix, "", True, "", "", False, False, 0, "")
  
  Also when I used the macro, it would put a False under the dimension if you not noticed. So I removed this False and changed to ""
  
  boolstatus = swModelDocExt.EditDimensionProperties(0, 0, 0, "", "", False, 9, 2, True, 12, 12, "4 x " & CurPrefix, "", True, "", "", "", False, 0, "")
  
  Like Show 1 Likes(1)
  
  Actions
Re: Keeping Current Prefix and Adding New One to Drawing Dimensions

Jay Wagamon Sep 26, 2014 8:30 AM (in response to Jay Wagamon)

Thanks Deepak that works beautifully! I also ended up removing the false statement after one of my coworkers had the problem with False under his dimension. I don't exactly know why it didn't say false when I used the macro but now its just how I want it. Thanks for the help Deepak!

This is the new full macro

'------------------------------------------------------
' This Macro will add Quantity x in front of the dimension in a drawing
' and keep the original Dimension Prefix.
'
' Preconditions:
' 1. Open a drawing.
' 2. Select a dimension.
' -----------------------------------------------------
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim selMgr As SelectionMgr
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim boolstatus As Boolean
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim CurPrefix As String

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set selMgr = swModel.SelectionManager
    Set swModelDocExt = swModel.Extension
    Debug.Print selMgr.GetSelectedObjectType(1)
    Set swDispDim = selMgr.GetSelectedObject6(1, 0)
    CurPrefix = swDispDim.GetText(swDimensionTextParts_e.swDimensionTextPrefix)
    Set swDim = swDispDim.GetDimension
    boolstatus = swModelDocExt.EditDimensionProperties(0, 0, 0, "", "", False, 9, 2, True, 12, 12, "4 x " & CurPrefix, "", True, "", "", "", False, 0, "")
    swModel.ClearSelection2 True
End Sub
Like Show 0 Likes(0)

Actions
Re: Keeping Current Prefix and Adding New One to Drawing Dimensions

Lois Claracq Feb 3, 2015 2:11 PM (in response to Jay Wagamon)

If you only want to change text you should use "SetText". It does not change any property of the dimensions
Here is an example which basically loop every selected dimension and add a suffix and text below :

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swDispDim As SldWorks.DisplayDimension

Sub main()

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

For i = 1 To swSelMgr.GetSelectedObjectCount2(0)
    Set swDispDim = swSelMgr.GetSelectedObject6(i, 0)
    swDispDim.SetText swDimensionTextParts_e.swDimensionTextSuffix, " suffix"
    swDispDim.SetText swDimensionTextParts_e.swDimensionTextCalloutBelow, "text below dim"
Next

swModel.GraphicsRedraw2

End Sub
Like Show 0 Likes(0)

Actions

Go to original post