List dimension names and their values 1

[JMulligan]

I would like to create a list of dimension names, their values and associated tolerances for all dimensions in a detail drawing.

This list will be used to document output from a CMM (Coordinate Measuring Machine).

Is this possible without being proficient in the SolidWorks API?

Thank You
JoeM
SolidWorks 2006 SP 3.1

 

[handleman]

Yes, it is possible without being proficient in API. However, it's much easier if you know someone who's proficient in API. Short of that, someone who dabbles in API may suffice. It's in that capacity that I offer this code. It will export all dimension names, values, tolerance types, and tolerance values in a drawing to an Excel sheet. You can then include the excel sheet with your drawing or even embed it. A little more code would be required to put this information into a SW general table. See if this gets you started.

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 swTol As SldWorks.DimensionTolerance
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBooks As Excel.Workbooks
Dim CurRow As Long
Const STARTROW As Long = 3
Const DIMNAMECOL As Long = 2
Const DIMVALCOL As Long = 3
Const DIMTOLTYPECOL As Long = 4
Const DIMUPPERTOLVALCOL As Long = 5
Const DIMLOWERTOLVALCOL As Long = 6
Const DIMTOLFITCLASSCOL As Long = 7
Const TOLSCALEFACTOR As Double = 1000





Sub ExportDims()

Dim NumTolVals As Integer
Dim TolIsFit As Boolean

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
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBooks = xlApp.Workbooks
xlBooks.Add
Set xlSheet = xlApp.ActiveSheet
CurRow = STARTROW
xlSheet.Cells(CurRow, DIMNAMECOL).Value = "Dimension Name"
xlSheet.Cells(CurRow, DIMVALCOL).Value = "Nominal Value"
xlSheet.Cells(CurRow, DIMTOLTYPECOL).Value = "Tolerance Type"
xlSheet.Cells(CurRow, DIMUPPERTOLVALCOL).Value = "Upper Tol"
xlSheet.Cells(CurRow, DIMLOWERTOLVALCOL).Value = "Lower Tol"
xlSheet.Cells(CurRow, DIMTOLFITCLASSCOL).Value = "Fit Class (Hole/shaft)"
CurRow = CurRow + 1

Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
    Set swDispDim = swView.GetFirstDisplayDimension5
    While Not swDispDim Is Nothing
        Set swDim = swDispDim.GetDimension
        Set swTol = swDim.Tolerance
        xlSheet.Cells(CurRow, DIMNAMECOL).Value = swDim.FullName
        xlSheet.Cells(CurRow, DIMVALCOL).Value = swDim.Value
        xlSheet.Cells(CurRow, DIMTOLTYPECOL).Value = GetTolTypeName(swTol, NumTolVals, TolIsFit)
        If NumTolVals > 0 Then
            xlSheet.Cells(CurRow, DIMUPPERTOLVALCOL).Value = swTol.GetMaxValue * TOLSCALEFACTOR
        End If
        If NumTolVals > 1 Then
            xlSheet.Cells(CurRow, DIMLOWERTOLVALCOL).Value = swTol.GetMinValue * TOLSCALEFACTOR
        End If
        If TolIsFit Then xlSheet.Cells(CurRow, DIMTOLFITCLASSCOL).Value = swTol.GetHoleFitValue & "/" & swTol.GetShaftFitValue
        Set swDispDim = swDispDim.GetNext5
        CurRow = CurRow + 1
    Wend
    Set swView = swView.GetNextView
Wend

xlApp.Range("A:Z").EntireColumn.AutoFit
End Sub

Function GetTolTypeName(ByRef myTol As SldWorks.DimensionTolerance, ByRef NumVals As Integer, ByRef FitTol As Boolean) As String
Dim s As String
FitTol = False
Select Case myTol.Type
    Case swTolNONE
        s = "None"
        NumVals = 0
    Case swTolBASIC
        s = "Basic"
        NumVals = 0
    Case swTolBILAT
        s = "Bilateral"
        NumVals = 2
    Case swTolLIMIT
        s = "Limit"
        NumVals = 2
    Case swTolSYMMETRIC
        s = "Symmetric"
        NumVals = 1
    Case swTolMIN
        s = "Minimum"
        NumVals = 0
    Case swTolMAX
        s = "Maximum"
        NumVals = 0
    Case swTolMETRIC
        s = "Metric"
        NumVals = 2
    Case swTolFIT
        s = "Fit"
        NumVals = 0
        FitTol = True
    Case swTolFITWITHTOL
        s = "Fit With Tolerance"
        NumVals = 2
        FitTol = True
    Case swTolFITTOLONLY
        s = "Fit, Tolerance Only"
        NumVals = 2
        FitTol = False
    Case swTolBLOCK
        s = "Block"
        NumVals = 2
        FitTol = False
End Select
GetTolTypeName = s
End Function

 

[handleman]

Sorry, I forgot to mention that any hole notes that are "Define by Hole Wizard" will not have the tolerances (if any) exported. The hole note must be "Define By Geometry" in order for the tolerance to be exported properly.

 

[JMulligan]

handleman,

Thank you for the fast response and code sample, I really appreciate it.

Joe

 

[JordonMusser]

handleman-
Although I have some programming experience, and quite a bit of solidworks experience I have zero experience with APIs('cept googles map API).

I tried building a marco with your code, but quickly get an error when you declare the excel app

"Dim xlApp As Excel.Application"

I am sure I am just doing something wrong.. thanks!

 

[handleman]

I assume you're getting the message:

Compile error:

User-defined type not defined

You'll need to include a reference to the Excel object library. To do this, click Tools->References from the VBA editor. Scroll down in the list and check the box for "Microsoft Excel [version number] Object Library", then click OK. That should take care of the problem.


Enjoy, and good luck!

 

[JordonMusser]

Thanks, that was it. makes sense.

I now get an error on this line:
Set swDim = swDispDim.GetDimension

"assignment to constant not allowed".

not sure why that isnt working. i was thinking about just assinging swDim to a double or something, and then getting rid of "set" but since this is your code, and apparntly HAS been working- i figure I am doing something wrong.

thanks again !!

 

[handleman]

Did you paste the entire code in the window above into a new, blank macro? If you missed the part at the top from

Dim swApp As SldWorks.SldWorks

through

Const TOLSCALEFACTOR As Double = 1000

you would get the error you described. swDim has to be declared as a SldWorks.Dimension. Otherwise, it looks in the libraries and finds that swDim is a constant defined in the swGeomType_e enum of the constant type library with a value of 12. Obviously, you can't change the value of a constant, much less assign it to an object.

So basically I chose the name of that variable poorly. If you copied all of the declarations at the top then they should take precedence over the constant in the library. However, SolidWorks/VBA don't always seem to get the order of precedence correct, so if you did copy the declarations and you're still getting the error, try replacing every instance of "swDim" with "mySwDim" or something similar.