Sub CATMain()
Dim oDwgDoc1 As DrawingDocument
On Error Resume Next
Set oDwgDoc1 = CATIA.ActiveDocument
If Err.Number <> 0 Then
MsgBox ("The active document must be a drawing."), vbExclamation
End
End If
On Error GoTo 0
Dim oSel As Selection
Set oSel = oDwgDoc1.Selection
If oSel.Count < 1 Then
MsgBox ("No dimensions selected."), vbExclamation
End
End If
Dim oDwgDim As DrawingDimension
Dim oInt As Integer
Dim dblDims()
Dim oTolType As Long
Dim oTolName As String
Dim oUpTol As String
Dim oLowTol As String
Dim odUpTol As Double
Dim odLowTol As Double
Dim oDisplayMode As Long
For ctr = 1 To oSel.Count
On Error Resume Next
Set oDwgDim = oSel.Item(ctr).Value
If Err.Number <> 0 Then
MsgBox ("One of the selected elements is not a drawing dimension."), vbExclamation
End
End If
On Error GoTo 0
ReDim Preserve dblDims(3, ctr - 1)
If oDwgDim.DimType = catDimAngle Then
dblDims(0, ctr - 1) = oDwgDim.GetValue.Value * 57.2957795
Else
dblDims(0, ctr - 1) = oDwgDim.GetValue.Value
End If
oDwgDim.GetTolerances oTolType, oTolName, oUpTol, oLowTol, odUpTol, odLowTol, oDisplayMode
dblDims(1, ctr - 1) = odUpTol
dblDims(2, ctr - 1) = odLowTol
dblDims(3, ctr - 1) = oDwgDim.Parent.Parent.Name
odUpTol = 0
odLowTol = 0
Next
Dim strFilePath As String
Dim objFSO As Object
Dim objStream As Object
strFilePath = "C:\Users\Drew\Desktop\dimensions.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objStream = objFSO.OpenTextFile(strFilePath, 8, True, 0)
For i = 1 To oSel.Count
objStream.WriteLine (dblDims(0, i - 1) & "," & dblDims(1, i - 1) & "," & dblDims(2, i - 1) & "," & dblDims(3, i - 1))
Next
objStream.Close
End Sub
