Macro that give names to dimesions?
Macro that give names to dimesions?
(OP)
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
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






RE: Macro that give names to dimesions?
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
RE: Macro that give names to dimesions?
Regards,
Sam
RE: Macro that give names to dimesions?
Regards,
Sam
RE: Macro that give names to dimesions?
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.
RE: Macro that give names to dimesions?
' 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
RE: Macro that give names to dimesions?
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
RE: Macro that give names to dimesions?
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
RE: Macro that give names to dimesions?
RE: Macro that give names to dimesions?
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.
RE: Macro that give names to dimesions?
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
RE: Macro that give names to dimesions?
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
CODE
'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