Macro that give names to dimesions? 2

[SAWH]

Hi

We are ordered to choose three sigificant dimension on every SW part we make and name them L, OD, ID. Then link those dimensions to customptoperties with the same name.

I guess that it would be really easy to create a macro that automates this work.

- Choose a dimension(manually)
- Push a button named L, OD or ID
- The dimesion is named L.....
- The property is created L... and the link
to the dimension is created

The question is only, where to start?? Any suggestions

Thanks,

Sam White

 

[SBaugh]

Try recording a macro while you manually rename a dimension.

Regards,

Scott Baugh, CSWP

http://www.3dvisiontech.com

http://www.scottjbaugh.com

If you are in the SW Forum Check out the FAQ section

To make the Best of Eng-Tips Forums FAQ731-376

 

[SAWH]

Sorry but that was the first I tried, but the naming is not recorded. Also the linking in to custom properties where recorded

Regards,

Sam

 

[SAWH]

Ooops, Also the linking of the dimension into custom properties where NOT recorded.

Regards,

Sam

 

[aamoroso]

You have to first determine if this is going to be done in the model or the drawing. Display dimensions and Model dimensions differ by ID (I am pretty sure anyway). I think this would probably be easier to do in a model.

I always try to record macros first, usually not statisfied with that method. Then I search the popular macro sites, SolidWorks Support, Lennys, Ticks, Matt Lombard .... and I look for similar macros that I can learn from. Usually with some effort I can put together enough info to finish the macro off myself. It helps of course if you know someone with VB knowledge.

 

[aamoroso]

K, I found something that works. Let me know if this works out for you. This will rename a dimension. Delete this paragraph and paste the rest into a macro. Select a Dimension and it will be named by the line that says put your dimension name here. This code will name the dimension A84. Change the A84 below to what you want and assign a button.





' Preconditions:

' 1) Drawing is open with dimensions inserted

' 2) A dimension is selected

'

'

Option Explicit



Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swSelMgr As SldWorks.SelectionMgr

Dim swDispDim As SldWorks.DisplayDimension

Dim swDim As SldWorks.Dimension

Dim swFeat As SldWorks.feature

Dim swEnt As SldWorks.entity

Dim swComp As SldWorks.Component2
Dim vname As Variant




Sub main()



Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swSelMgr = swModel.SelectionManager

Set swDispDim = swSelMgr.GetSelectedObject5(1)

' Get the selected dimension

Set swDim = swDispDim.GetDimension

swDim.Name = "A84" ' Enter you new dimension name here.



End Sub

 

[SAWH]

Its in the part.

Thanks aamoroso, thats also the way I also usually approches it. Search, cut, paste, patch together and finally crosses my fingers. I tried it this time too but got a bit stuck and hoped that someone else done something similar. I was a bit frustrated because I really hoped this would be a easy thing to accomplish

Thanks anyway,

Sam

 

[SAWH]

Thanks again aamoroso,

It seems to work fine. The only thing I have to fix is if a user runs the macro twice on separate dimensions in the same sketch, the strange thing happends that booth dimensions gets the same name and if you changes the first changed dim only the second changed dim alters its value.
But thats a different problem. Now Im going to look for the solution for establish the link to the custom property.

Regards,

Sam

 

[aamoroso]

No problem, good luck.

 

[MElam]

Is it a standard enough shape (or even multiple shapes) to try this?:

Make a template (or templates) with just the basic shape. Create a sketch with ID and OD dims and name them. Extrude length L. Create the custom props linked to the named dims and save as template.

If you coud do something like this, a macro may not be necessary.

 

[Stoker]

Option Explicit

Dim swApp As Object
Dim Doc As Object
Dim SelMgr As Object
Dim Dimension As Object

Dim Msg As String
Dim LongStatus, i As Long
Dim BoolVal As Boolean

Const swDocPART = 1
Const swMbWarning = 1
Const swMbOk = 2
Const swSelDIMENSIONS = 14
Const swCustomInfoText = 30
Const swCustomInfoNumber = 3

Sub main()

Set swApp = CreateObject("SldWorks.Application")
Set Doc = swApp.ActiveDoc
Set SelMgr = Doc.SelectionManager()

If ((Doc Is Nothing) Or (Not (Doc.GetType Eqv swDocPART))) Then
Msg = "A part document must be active to use this command!"
LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)
End
Else
If (SelMgr.GetSelectedObjectType2(1) <> swSelDIMENSIONS) Then
Msg = "This command can only be used with dimensions!"
LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)
End
Else
Set Dimension = SelMgr.GetSelectedObject3(1).GetDimension
Dimension.Name = "OD"
BoolVal = Doc.AddCustomInfo3("", Dimension.Name, swCustomInfoText, Chr(34) & Dimension.FullName & Chr(34))
Doc.EditRebuild

Set Doc = Nothing
Set swApp = Nothing
End If

End If

End Sub

 

[SAWH]

Thanks Stoker,

To bad I didnt see your replay before I created my own program.

If you guys have any comments/suggestions on my code please tell me, I´m here to learn

Regards,

Sam

' ******************************************************************************
'NamingDimensions.swb - Macro Created on 08/31/04 by Sam White
'
'The User selects a dimension and runns the NamingDimensions macro to assign the
'dimension a signifikant letter L(Length), OD(Outer Diameter), ID (Inner Diameter)
'NamingDimensions also creates a Custom Propety with the same letter and a link
'to the dimension
'Assing three Macro buttons / hotkeys in SW and call the specifik Method(L,OD,ID)******************************************************************************
Option Explicit


    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swFeat                  As SldWorks.Feature
    Dim swSubFeat               As SldWorks.Feature
    Dim swDispDim               As SldWorks.DisplayDimension
    Dim swDim, swDimMem         As SldWorks.Dimension
    Dim swAnn                   As SldWorks.Annotation
    Dim bRet                    As Boolean

    Dim swSelMgr                As SldWorks.SelectionMgr
    Dim swEnt                   As SldWorks.entity
    Dim swComp                  As SldWorks.Component2
    

Sub DimensionL()
Call Naming("L")
End Sub


Sub DimensionOD()
Call Naming("OD")
End Sub


Sub DimensionID()
Call Naming("ID")
End Sub

Public Sub Naming(Letter As String)
       
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swFeat = swModel.FirstFeature
    Set swSelMgr = swModel.SelectionManager
    Set swDispDim = swSelMgr.GetSelectedObject5(1)
    'Check if the user really selected a dimension prior to running the macro
    If swDispDim Is Nothing Then
        swApp.SendMsgToUser "Select the dimension you want to assign the " & Letter & " before running the macro!"
        End
    End If
    'Check so that there are no dimension already assigned to that letter
    Set swDimMem = swDispDim.GetDimension
    Do While Not swFeat Is Nothing
        Set swSubFeat = swFeat.GetFirstSubFeature
        Do While Not swSubFeat Is Nothing
            Set swDispDim = swSubFeat.GetFirstDisplayDimension
            Do While Not swDispDim Is Nothing
                Set swAnn = swDispDim.GetAnnotation
                Set swDim = swDispDim.GetDimension
                Set swDispDim = swSubFeat.GetNextDisplayDimension(swDispDim)
            Loop
            Set swSubFeat = swSubFeat.GetNextSubFeature
        Loop
        
        Set swDispDim = swFeat.GetFirstDisplayDimension
        Do While Not swDispDim Is Nothing
            Set swAnn = swDispDim.GetAnnotation
            Set swDim = swDispDim.GetDimension
            ' If we find a dimension with that letter we activates that feature and then the dimension before we ends the macro
            If swDim.Name = Letter Then
                Set swFeat = swDim.GetFeatureOwner
                swApp.SendMsgToUser "A dimension named " & Letter & " already exist in " & swFeat.Name & "! " & Chr(10) & "Solve this problem before running the macro"
                swModel.SelectByID swFeat.Name, "BODYFEATURE", 0, 0, 0
                swModel.SelectByID swFeat.Name, "SKETCH", 0, 0, 0
                swModel.ActivateSelectedFeature
                swModel.SelectByID swDim.FullName, "DIMENSION", 0, 0, 0
                End
           End If
        Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
        Loop

        Set swFeat = swFeat.GetNextFeature
    Loop
    
'If we got through the tests we assign the dimension the letter and creates the custom property
swDimMem.Name = Letter
swModel.AddCustomInfo3 "", Letter, swCustomInfoText, Chr(34) & swDimMem.FullName & Chr(34)


End Sub