Community
Hello, I need help with a code.
I derive all inspection dimensions into a table.
If the date identifier is K4 as an example, this should also be extracted in column 1. Unfortunately I can't manage this at the moment.
Code:
Dim oDrawingDocument As DrawingDocument
oDrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawingDocument.ActiveSheet
Dim oCustomTable As CustomTable
Dim oCustomTables As CustomTables
oCustomTables = oSheet.CustomTables
' Delete existing table if it exists
For Each oCustomTable In oCustomTables
If oCustomTable.Title = "FIELD VERIFICATION DIMENSIONS" Then
oCustomTable.Delete()
End If
Next
Dim oInspectionDimension As DrawingDimension
Dim oInspectionDimensionText As DimensionText
Dim oInspectionDimensionString As String
Dim oCellInspectionDimensionItem As Cell
Dim oCellInspectionDimension As Cell
Dim oCellLowestValue As Cell
Dim oCellHighestValue As Cell
Dim oCellMeasurementValue As Cell
Dim oInspectionDimensionCount As Integer
oInspectionDimensionCount = 0
' Count inspection dimensions
For Each oInspectionDimension In oSheet.DrawingDimensions
If oInspectionDimension.IsInspectionDimension Then
oInspectionDimensionCount = oInspectionDimensionCount + 1
End If
Next
' Define table column titles
Dim oColumnTitle(0 To 4) As String ' Adjust size to 5 since we removed the symbol column
oColumnTitle(0) = "Inspection Number"
oColumnTitle(1) = "Inspection Dimension"
oColumnTitle(2) = "Lowest value"
oColumnTitle(3) = "Highest value"
oColumnTitle(4) = "Measurement Value"
' Get the table style and title
Dim oActiveTableStyle As TableStyle
Dim oTableTitle As String
oActiveTableStyle = oDrawingDocument.StylesManager.TableStyles("Inspection_Table")
oTableTitle = oActiveTableStyle.Title
' Create a custom table with specified dimensions and titles
Dim oFieldVerificationTable As CustomTable
oFieldVerificationTable = oSheet.CustomTables.Add(oTableTitle, ThisApplication.TransientGeometry.CreatePoint2d(0.635, oSheet.Height - 0.635), 5, oInspectionDimensionCount, oColumnTitle)
Dim oInspectionDimensionCount2 As Integer
oInspectionDimensionCount2 = 0
' Populate the table with inspection dimension data
For Each oInspectionDimension In oSheet.DrawingDimensions
If oInspectionDimension.IsInspectionDimension Then
oInspectionDimensionCount2 = oInspectionDimensionCount2 + 1
oInspectionDimensionText = oInspectionDimension.Text
oInspectionDimensionString = oInspectionDimensionText.Text
' Replace the letter "n" with the diameter symbol (Ø) in the dimension text
oInspectionDimensionString = Replace(oInspectionDimensionString, "n", ChrW(&H00D8)) ' Ø character
' Extract symbols from the dimension string
Dim symbolPrefix As String
Dim symbolSuffix As String
symbolPrefix = ""
symbolSuffix = ""
' Check for symbols at the start and end of the string
If Len(oInspectionDimensionString) > 0 And Not IsNumeric(Left(oInspectionDimensionString, 1)) Then
symbolPrefix = Left(oInspectionDimensionString, 1)
End If
If Len(oInspectionDimensionString) > 1 And Not IsNumeric(Right(oInspectionDimensionString, 1)) Then
symbolSuffix = Right(oInspectionDimensionString, 1)
End If
' Assign values to table cells
oCellInspectionDimensionItem = oFieldVerificationTable.Rows.Item(oInspectionDimensionCount2).Item("Inspection Number")
oCellInspectionDimensionItem.Value = "K" & oInspectionDimensionCount2 ' Prefix "K" to inspection number
oCellInspectionDimension = oFieldVerificationTable.Rows.Item(oInspectionDimensionCount2).Item("Inspection Dimension")
oCellInspectionDimension.Value = oInspectionDimensionString
' Check if the dimension is an angle
Dim isAngle As Boolean
isAngle = InStr(oInspectionDimensionString, "°") > 0
If isAngle Then
' If it is an angle, calculate values as nominal - 2° and nominal + 2°
Dim nominalAngle As Double
nominalAngle = CDbl(Replace(oInspectionDimensionString, "°", "")) ' Remove the ° symbol and convert to double
Dim lowestAngle As Double
Dim highestAngle As Double
lowestAngle = nominalAngle - 2
highestAngle = nominalAngle + 2
' Format the angles to include the ° symbol and two decimal places
Dim formattedLowestAngle As String
formattedLowestAngle = Format(lowestAngle, "0.00") & "°"
Dim formattedHighestAngle As String
formattedHighestAngle = Format(highestAngle, "0.00") & "°"
' Add lowest angle to the table
oCellLowestValue = oFieldVerificationTable.Rows.Item(oInspectionDimensionCount2).Item("Lowest value")
oCellLowestValue.Value = formattedLowestAngle
' Add highest angle to the table
oCellHighestValue = oFieldVerificationTable.Rows.Item(oInspectionDimensionCount2).Item("Highest value")
oCellHighestValue.Value = formattedHighestAngle
Else
' Calculate the lowest and highest values for non-angle dimensions
Dim nominalValue As Double
nominalValue = oInspectionDimension.ModelValue
Dim upperTolerance As Double
upperTolerance = oInspectionDimension.Tolerance.Upper
' Calculate lowest value using symmetrical tolerance
Dim lowestValue As Double
lowestValue = (nominalValue - upperTolerance) * 10 ' Assuming a scaling factor of 10
' Calculate highest value
Dim highestValue As Double
highestValue = (nominalValue + upperTolerance) * 10 ' Assuming a scaling factor of 10
' Format lowest and highest values to 2 decimal places
Dim formattedLowestValue As String
formattedLowestValue = Format(lowestValue, "0.00")
Dim formattedHighestValue As String
formattedHighestValue = Format(highestValue, "0.00")
' Add lowest value to the table with symbols
oCellLowestValue = oFieldVerificationTable.Rows.Item(oInspectionDimensionCount2).Item("Lowest value")
oCellLowestValue.Value = symbolPrefix & formattedLowestValue & symbolSuffix
' Add highest value to the table with symbols
oCellHighestValue = oFieldVerificationTable.Rows.Item(oInspectionDimensionCount2).Item("Highest value")
oCellHighestValue.Value = symbolPrefix & formattedHighestValue & symbolSuffix
End If
' Add measurement value to the table
oCellMeasurementValue = oFieldVerificationTable.Rows.Item(oInspectionDimensionCount2).Item("Measurement Value")
oCellMeasurementValue.Value = "" ' Assign your measurement value here
End If
Next
' Apply the table style to the created table
oFieldVerificationTable.Style = oActiveTableStyle
' Ensure that the document updates after the script execution
iLogicVb.UpdateWhenDone = True
As shown in the figure, the labels in the inspection dimensions and the Datum Identifier and tolerance in the control features frame can be automatically extracted into the table.Can this meet your requirements?
Dim oDrawingDocument As DrawingDocument
oDrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawingDocument.ActiveSheet
Dim oCustomTable As CustomTable
Dim oCustomTables As CustomTables
oCustomTables = oSheet.CustomTables
' Delete existing table if it exists
For Each oCustomTable In oCustomTables
If oCustomTable.Title = "FIELD VERIFICATION DIMENSIONS" Then
oCustomTable.Delete()
End If
Next
Dim oInsDim As DrawingDimension
Dim oInsDimText As DimensionText
Dim oInsDimString As String
Dim oCellInsDimItem As Cell
Dim oCellInspectionDimension As Cell
Dim oCellLowestValue As Cell
Dim oCellHighestValue As Cell
Dim oCellMsValue As Cell
Dim oColumnTitle(0 To 4) As String ' Adjust size to 5 since we removed the symbol column
oColumnTitle(0) = "Inspection Number"
oColumnTitle(1) = "Inspection Dimension"
oColumnTitle(2) = "Lowest value"
oColumnTitle(3) = "Highest value"
oColumnTitle(4) = "Measurement Value"
' Get the table style and title
Dim oActiveTableStyle As TableStyle
Dim oTableTitle As String
oActiveTableStyle = oDrawingDocument.StylesManager.TableStyles("Inspection_Table")
oTableTitle ="FIELD VERIFICATION DIMENSIONS"
' Create a custom table with specified dimensions and titles
Dim oFVerTable As CustomTable
Dim oInsDimCt As Integer
oInsDimCt = 0
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oPt2d As Point2d=oTG.CreatePoint2d(0.635, oSheet.Height - 0.635)
' Populate the table with inspection dimension data
For Each oInsDim In oSheet.DrawingDimensions
If oInsDim.IsInspectionDimension Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt =1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 5,oInsDimCt, oColumnTitle)
Else
oFVerTable.Rows.Add
End If
oInsDimText = oInsDim.Text
oInsDimString = oInsDimText.Text
Dim oDimShape As InspectionDimensionShapeEnum
Dim oDimLabel As String
Dim oDimRate As String
oInsDim.GetInspectionDimensionData(oDimShape,oDimLabel,oDimRate)
' Replace the letter "n" with the diameter symbol (Ø) in the dimension text
oInsDimString = Replace(oInsDimString, "n", ChrW(&H00D8)) ' Ø character
' Extract symbols from the dimension string
Dim symbolPrefix As String
Dim symbolSuffix As String
symbolPrefix = ""
symbolSuffix = ""
' Check for symbols at the start and end of the string
If Len(oInsDimString) > 0 And Not IsNumeric(Left(oInsDimString, 1)) Then
symbolPrefix = Left(oInsDimString, 1)
End If
If Len(oInsDimString) > 1 And Not IsNumeric(Right(oInsDimString, 1)) Then
symbolSuffix = Right(oInsDimString, 1)
End If
' Assign values to table cells
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oDimLabel
'"K" & oInsDimCt ' Prefix "K" to inspection number
oCellInspectionDimension = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInspectionDimension.Value = oInsDimString
' Check if the dimension is an angle
Dim isAngle As Boolean
isAngle = InStr(oInsDimString, "°") > 0
If isAngle Then
' If it is an angle, calculate values as nominal - 2° and nominal + 2°
Dim nominalAngle As Double
nominalAngle = CDbl(Replace(oInsDimString, "°", "")) ' Remove the ° symbol and convert to double
Dim lowestAngle As Double
Dim highestAngle As Double
lowestAngle = nominalAngle - 2
highestAngle = nominalAngle + 2
' Format the angles to include the ° symbol and two decimal places
Dim formattedLowestAngle As String
formattedLowestAngle = Format(lowestAngle, "0.00") & "°"
Dim formattedHighestAngle As String
formattedHighestAngle = Format(highestAngle, "0.00") & "°"
' Add lowest angle to the table
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = formattedLowestAngle
' Add highest angle to the table
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = formattedHighestAngle
Else
' Calculate the lowest and highest values for non-angle dimensions
Dim nominalValue As Double
nominalValue = oInsDim.ModelValue
Dim upperTolerance As Double
upperTolerance = oInsDim.Tolerance.Upper
' Calculate lowest value using symmetrical tolerance
Dim lowestValue As Double
lowestValue = (nominalValue - upperTolerance) * 10 ' Assuming a scaling factor of 10
' Calculate highest value
Dim highestValue As Double
highestValue = (nominalValue + upperTolerance) * 10 ' Assuming a scaling factor of 10
' Format lowest and highest values to 2 decimal places
Dim formattedLowestValue As String
formattedLowestValue = Format(lowestValue, "0.00")
Dim formattedHighestValue As String
formattedHighestValue = Format(highestValue, "0.00")
' Add lowest value to the table with symbols
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = symbolPrefix & formattedLowestValue & symbolSuffix
' Add highest value to the table with symbols
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = symbolPrefix & formattedHighestValue & symbolSuffix
End If
' Add measurement value to the table
oCellMsValue = oFVerTable.Rows.Item(oInsDimCt).Item("Measurement Value")
oCellMsValue.Value = "" ' Assign your measurement value here
End If
Next
For Each oFtConFrame As FeatureControlFrame In oSheet.FeatureControlFrames
If oFtConFrame .DatumIdentifier <> "" Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt =1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 5,oInsDimCt, oColumnTitle)
Else
oFVerTable.Rows.Add
End If
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oFtConFrame .DatumIdentifier
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInsDimItem.Value =oFtConFrame .FeatureControlFrameRows.Item(1).Tolerance
End If
Next
' Apply the table style to the created table
oFVerTable.Style = oActiveTableStyle
' Ensure that the document updates after the script execution
iLogicVb.UpdateWhenDone = True
HI，As shown in the figure, the labels in the inspection dimensions and the Datum Identifier and tolerance in the control features frame can be automatically extracted into the table.Can this meet your requirements?
Dim oDrawingDocument As DrawingDocument
oDrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawingDocument.ActiveSheet
Dim oCustomTable As CustomTable
Dim oCustomTables As CustomTables
oCustomTables = oSheet.CustomTables
' Delete existing table if it exists
For Each oCustomTable In oCustomTables
If oCustomTable.Title = "FIELD VERIFICATION DIMENSIONS" Then
oCustomTable.Delete()
End If
Next
Dim oInsDim As DrawingDimension
Dim oInsDimText As DimensionText
Dim oInsDimString As String
Dim oCellInsDimItem As Cell
Dim oCellInspectionDimension As Cell
Dim oCellLowestValue As Cell
Dim oCellHighestValue As Cell
Dim oCellMsValue As Cell
Dim oColumnTitle(0 To 4) As String ' Adjust size to 5 since we removed the symbol column
oColumnTitle(0) = "Inspection Number"
oColumnTitle(1) = "Inspection Dimension"
oColumnTitle(2) = "Lowest value"
oColumnTitle(3) = "Highest value"
oColumnTitle(4) = "Measurement Value"
' Get the table style and title
Dim oActiveTableStyle As TableStyle
Dim oTableTitle As String
oActiveTableStyle = oDrawingDocument.StylesManager.TableStyles("Inspection_Table")
oTableTitle ="FIELD VERIFICATION DIMENSIONS"
' Create a custom table with specified dimensions and titles
Dim oFVerTable As CustomTable
Dim oInsDimCt As Integer
oInsDimCt = 0
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oPt2d As Point2d=oTG.CreatePoint2d(0.635, oSheet.Height - 0.635)
' Populate the table with inspection dimension data
For Each oInsDim In oSheet.DrawingDimensions
If oInsDim.IsInspectionDimension Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt =1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 5,oInsDimCt, oColumnTitle)
Else
oFVerTable.Rows.Add
End If
oInsDimText = oInsDim.Text
oInsDimString = oInsDimText.Text
Dim oDimShape As InspectionDimensionShapeEnum
Dim oDimLabel As String
Dim oDimRate As String
oInsDim.GetInspectionDimensionData(oDimShape,oDimLabel,oDimRate)
' Replace the letter "n" with the diameter symbol (Ø) in the dimension text
oInsDimString = Replace(oInsDimString, "n", ChrW(&H00D8)) ' Ø character
' Extract symbols from the dimension string
Dim symbolPrefix As String
Dim symbolSuffix As String
symbolPrefix = ""
symbolSuffix = ""
' Check for symbols at the start and end of the string
If Len(oInsDimString) > 0 And Not IsNumeric(Left(oInsDimString, 1)) Then
symbolPrefix = Left(oInsDimString, 1)
End If
If Len(oInsDimString) > 1 And Not IsNumeric(Right(oInsDimString, 1)) Then
symbolSuffix = Right(oInsDimString, 1)
End If
' Assign values to table cells
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oDimLabel
'"K" & oInsDimCt ' Prefix "K" to inspection number
oCellInspectionDimension = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInspectionDimension.Value = oInsDimString
' Check if the dimension is an angle
Dim isAngle As Boolean
isAngle = InStr(oInsDimString, "°") > 0
If isAngle Then
' If it is an angle, calculate values as nominal - 2° and nominal + 2°
Dim nominalAngle As Double
nominalAngle = CDbl(Replace(oInsDimString, "°", "")) ' Remove the ° symbol and convert to double
Dim lowestAngle As Double
Dim highestAngle As Double
lowestAngle = nominalAngle - 2
highestAngle = nominalAngle + 2
' Format the angles to include the ° symbol and two decimal places
Dim formattedLowestAngle As String
formattedLowestAngle = Format(lowestAngle, "0.00") & "°"
Dim formattedHighestAngle As String
formattedHighestAngle = Format(highestAngle, "0.00") & "°"
' Add lowest angle to the table
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = formattedLowestAngle
' Add highest angle to the table
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = formattedHighestAngle
Else
' Calculate the lowest and highest values for non-angle dimensions
Dim nominalValue As Double
nominalValue = oInsDim.ModelValue
Dim upperTolerance As Double
upperTolerance = oInsDim.Tolerance.Upper
' Calculate lowest value using symmetrical tolerance
Dim lowestValue As Double
lowestValue = (nominalValue - upperTolerance) * 10 ' Assuming a scaling factor of 10
' Calculate highest value
Dim highestValue As Double
highestValue = (nominalValue + upperTolerance) * 10 ' Assuming a scaling factor of 10
' Format lowest and highest values to 2 decimal places
Dim formattedLowestValue As String
formattedLowestValue = Format(lowestValue, "0.00")
Dim formattedHighestValue As String
formattedHighestValue = Format(highestValue, "0.00")
' Add lowest value to the table with symbols
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = symbolPrefix & formattedLowestValue & symbolSuffix
' Add highest value to the table with symbols
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = symbolPrefix & formattedHighestValue & symbolSuffix
End If
' Add measurement value to the table
oCellMsValue = oFVerTable.Rows.Item(oInsDimCt).Item("Measurement Value")
oCellMsValue.Value = "" ' Assign your measurement value here
End If
Next
For Each oFtConFrame As FeatureControlFrame In oSheet.FeatureControlFrames
If oFtConFrame .DatumIdentifier <> "" Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt =1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 5,oInsDimCt, oColumnTitle)
Else
oFVerTable.Rows.Add
End If
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oFtConFrame .DatumIdentifier
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInsDimItem.Value =oFtConFrame .FeatureControlFrameRows.Item(1).Tolerance
End If
Next
' Apply the table style to the created table
oFVerTable.Style = oActiveTableStyle
' Ensure that the document updates after the script execution
iLogicVb.UpdateWhenDone = True
Hello, thank you very much. That goes in the right direction, I have extended the code again. However, I still have further problems. I replace the symbols such as diameter in the code. In other words, the diameter symbol has the letter n and so that it is displayed correctly in the table, I replace it. However, as soon as I give a dimension a tolerance, the symbols in front of the dimension are no longer displayed. I would also like to see the symbol in front of the shape and position tolerances in the table.
Dim oDrawingDocument As DrawingDocument
oDrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawingDocument.ActiveSheet
Dim oCustomTable As CustomTable
Dim oCustomTables As CustomTables
oCustomTables = oSheet.CustomTables
' Delete existing table if it exists
For Each oCustomTable In oCustomTables
If oCustomTable.Title = "FIELD VERIFICATION DIMENSIONS" Then
oCustomTable.Delete()
End If
Next
Dim oInsDim As DrawingDimension
Dim oInsDimText As DimensionText
Dim oInsDimString As String
Dim oCellInsDimItem As Cell
Dim oCellInspectionDimension As Cell
Dim oCellLowestValue As Cell
Dim oCellHighestValue As Cell
Dim oCellMsValue As Cell
Dim oColumnTitle(0 To 4) As String ' Adjust size to 5 since we removed the symbol column
oColumnTitle(0) = "Inspection Number"
oColumnTitle(1) = "Inspection Dimension"
oColumnTitle(2) = "Lowest value"
oColumnTitle(3) = "Highest value"
oColumnTitle(4) = "Measurement Value"
' Get the table style and title
Dim oActiveTableStyle As TableStyle
Dim oTableTitle As String
oActiveTableStyle = oDrawingDocument.StylesManager.TableStyles("Inspection_Table")
oTableTitle ="FIELD VERIFICATION DIMENSIONS"
' Create a custom table with specified dimensions and titles
Dim oFVerTable As CustomTable
Dim oInsDimCt As Integer
oInsDimCt = 0
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oPt2d As Point2d=oTG.CreatePoint2d(0.635, oSheet.Height - 0.635)
' Populate the table with inspection dimension data
For Each oInsDim In oSheet.DrawingDimensions
If oInsDim.IsInspectionDimension Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt =1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 5,oInsDimCt, oColumnTitle)
Else
oFVerTable.Rows.Add
End If
oInsDimText = oInsDim.Text
oInsDimString = oInsDimText.Text
Dim oDimShape As InspectionDimensionShapeEnum
Dim oDimLabel As String
Dim oDimRate As String
oInsDim.GetInspectionDimensionData(oDimShape,oDimLabel,oDimRate)
' Replace the letter "n" with the diameter symbol (Ø) in the dimension text
oInsDimString = Replace(oInsDimString, "n", ChrW(&H00D8)) ' Ø character
oInsDimString = Replace(oInsDimString, "j", ChrW(&H2316))
oInsDimString = Replace(oInsDimString, "e", ChrW(&H25EF))
oInsDimString = Replace(oInsDimString, "t", ChrW(9008))
oInsDimString = Replace(oInsDimString, "k", ChrW(8978))
oInsDimString = Replace(oInsDimString, "d", ChrW(8979))
oInsDimString = Replace(oInsDimString, "i", ChrW(9007))
oInsDimString = Replace(oInsDimString, "g", ChrW(9005))
oInsDimString = Replace(oInsDimString, "r", ChrW(9022))
oInsDimString = Replace(oInsDimString, "h", ChrW(8599))
oInsDimString = Replace(oInsDimString, "c", ChrW(&H23E5))
oInsDimString = Replace(oInsDimString, "b", ChrW(&H221F))
' Extract symbols from the dimension string
Dim symbolPrefix As String
Dim symbolSuffix As String
symbolPrefix = ""
symbolSuffix = ""
' Check for symbols at the start and end of the string
If Len(oInsDimString) > 0 And Not IsNumeric(Left(oInsDimString, 1)) Then
symbolPrefix = Left(oInsDimString, 1)
End If
If Len(oInsDimString) > 1 And Not IsNumeric(Right(oInsDimString, 1)) Then
symbolSuffix = Right(oInsDimString, 1)
End If
' Assign values to table cells
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oDimLabel
'"K" & oInsDimCt ' Prefix "K" to inspection number
oCellInspectionDimension = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInspectionDimension.Value = oInsDimString
' Check if the dimension is an angle
Dim isAngle As Boolean
isAngle = InStr(oInsDimString, "°") > 0
If isAngle Then
' If it is an angle, calculate values as nominal - 2° and nominal + 2°
Dim nominalAngle As Double
nominalAngle = CDbl(Replace(oInsDimString, "°", "")) ' Remove the ° symbol and convert to double
Dim lowestAngle As Double
Dim highestAngle As Double
lowestAngle = nominalAngle - 2
highestAngle = nominalAngle + 2
' Format the angles to include the ° symbol and two decimal places
Dim formattedLowestAngle As String
formattedLowestAngle = Format(lowestAngle, "0.00") & "°"
Dim formattedHighestAngle As String
formattedHighestAngle = Format(highestAngle, "0.00") & "°"
' Add lowest angle to the table
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = formattedLowestAngle
' Add highest angle to the table
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = formattedHighestAngle
Else
' Calculate the lowest and highest values for non-angle dimensions
Dim nominalValue As Double
nominalValue = oInsDim.ModelValue
Dim upperTolerance As Double
upperTolerance = oInsDim.Tolerance.Upper
' Calculate lowest value using symmetrical tolerance
Dim lowestValue As Double
lowestValue = (nominalValue - upperTolerance) * 10 ' Assuming a scaling factor of 10
' Calculate highest value
Dim highestValue As Double
highestValue = (nominalValue + upperTolerance) * 10 ' Assuming a scaling factor of 10
' Format lowest and highest values to 2 decimal places
Dim formattedLowestValue As String
formattedLowestValue = Format(lowestValue, "0.00")
Dim formattedHighestValue As String
formattedHighestValue = Format(highestValue, "0.00")
' Add lowest value to the table with symbols
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = symbolPrefix & formattedLowestValue & symbolSuffix
' Add highest value to the table with symbols
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = symbolPrefix & formattedHighestValue & symbolSuffix
End If
' Add measurement value to the table
oCellMsValue = oFVerTable.Rows.Item(oInsDimCt).Item("Measurement Value")
oCellMsValue.Value = "" ' Assign your measurement value here
End If
Next
For Each oFtConFrame As FeatureControlFrame In oSheet.FeatureControlFrames
If oFtConFrame .DatumIdentifier <> "" Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt =1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 5,oInsDimCt, oColumnTitle)
Else
oFVerTable.Rows.Add
End If
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oFtConFrame .DatumIdentifier
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInsDimItem.Value =oFtConFrame .FeatureControlFrameRows.Item(1).Tolerance
End If
Next
' Apply the table style to the created table
oFVerTable.Style = oActiveTableStyle
' Ensure that the document updates after the script execution
iLogicVb.UpdateWhenDone = True
Hello,
unfortunately I have not made any progress with my problem. As soon as a tolerance is defined for a radius or diameter. The diameter symbol is no longer displayed or the R.
Does anyone have any ideas?
Sub Main()
Dim oDrawingDocument As DrawingDocument
oDrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawingDocument.ActiveSheet
Dim oCustomTable As CustomTable
Dim oCustomTables As CustomTables
oCustomTables = oSheet.CustomTables
' Delete existing table if it exists
For Each oCustomTable In oCustomTables
If oCustomTable.Title = "Inspection Dimensions" Then
oCustomTable.Delete()
End If
Next
Dim oInsDim As DrawingDimension
Dim oInsDimText As DimensionText
Dim oInsDimString As String
Dim oCellInsDimItem As Cell
Dim oCellInspectionDimension As Cell
Dim oCellLowestValue As Cell
Dim oCellHighestValue As Cell
Dim oCellMsValue As Cell
Dim oCellTolerance As Cell
Dim oColumnTitle(0 To 6) As String ' Adjust size to 6 since we added the tolerance column
oColumnTitle(0) = "Inspection Number"
oColumnTitle(1) = "Symbol"
oColumnTitle(2) = "Inspection Dimension"
oColumnTitle(3) = "Tolerance"
oColumnTitle(5) = "Lowest value"
oColumnTitle(4) = "Highest value"
oColumnTitle(6) = "Measurement Value"
' Get the table style and title
Dim oActiveTableStyle As TableStyle
Dim oTableTitle As String
Try
oActiveTableStyle = oDrawingDocument.StylesManager.TableStyles("Inspection_Table")
Catch ex As Exception
MsgBox("Table style 'Inspection_Table' not found.")
Exit Sub
End Try
oTableTitle = "Inspection Dimensions"
' Create a custom table with specified dimensions and titles
Dim oFVerTable As CustomTable
Dim oInsDimCt As Integer
oInsDimCt = 0
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oPt2d As Point2d = oTG.CreatePoint2d(0.635, oSheet.Height - 0.635)
' Populate the table with inspection dimension data
For Each oInsDim In oSheet.DrawingDimensions
If oInsDim.IsInspectionDimension Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt = 1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 7, 1, oColumnTitle) ' Ensure correct number of columns
Else
oFVerTable.Rows.Add()
End If
oInsDimText = oInsDim.Text
oInsDimString = oInsDimText.Text
Dim oDimShape As InspectionDimensionShapeEnum
Dim oDimLabel As String
Dim oDimRate As String
oInsDim.GetInspectionDimensionData(oDimShape, oDimLabel, oDimRate)
' Replace specific characters with symbols
oInsDimString = Replace(oInsDimString, "n", ChrW(&H00D8)) ' Ø character
oInsDimString = Replace(oInsDimString, "j", ChrW(&H2316))
oInsDimString = Replace(oInsDimString, "e", ChrW(&H25EF))
oInsDimString = Replace(oInsDimString, "t", ChrW(9008))
oInsDimString = Replace(oInsDimString, "k", ChrW(8978))
oInsDimString = Replace(oInsDimString, "d", ChrW(8979))
oInsDimString = Replace(oInsDimString, "i", ChrW(9007))
oInsDimString = Replace(oInsDimString, "g", ChrW(9005))
oInsDimString = Replace(oInsDimString, "r", ChrW(9022))
oInsDimString = Replace(oInsDimString, "h", ChrW(8599))
oInsDimString = Replace(oInsDimString, "c", ChrW(&H23E5))
oInsDimString = Replace(oInsDimString, "b", ChrW(&H221F))
' Extract symbols from the dimension string
Dim symbolPrefix As String
Dim symbolSuffix As String
symbolPrefix = ""
symbolSuffix = ""
' Check for symbols at the start and end of the string
If Len(oInsDimString) > 0 And Not IsNumeric(Left(oInsDimString, 1)) Then
symbolPrefix = Left(oInsDimString, 1)
End If
If Len(oInsDimString) > 1 And Not IsNumeric(Right(oInsDimString, 1)) Then
symbolSuffix = Right(oInsDimString, 1)
End If
' Assign values to table cells
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oDimLabel
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Symbol")
oCellInsDimItem.Value = symbolPrefix &" " & symbolSuffix
oCellInspectionDimension = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInspectionDimension.Value = oInsDimString
' Add tolerance value to the table
oCellTolerance = oFVerTable.Rows.Item(oInsDimCt).Item("Tolerance")
Dim tol As Tolerance
tol = oInsDim.Tolerance
If tol.ToleranceType = ToleranceTypeEnum.kSymmetricTolerance Then
oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / -" & Format(tol.Upper * 10, "0.00")
Else
If tol.Upper = tol.Lower Then
oCellTolerance.Value = "±" & Format(tol.Lower * 10, "0.00")
Else
If tol.Lower = 0 Then
oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / 0.00"
Else
oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / " & Format(tol.Lower * 10, "0.00")
End If
End If
End If
' Set tolerance cell to empty if no tolerance
If tol.Upper = 0 And tol.Lower = 0 Then
oCellTolerance.Value = ""
End If
' Check if the dimension is an angle
Dim isAngle As Boolean
isAngle = InStr(oInsDimString, "°") > 0
' Calculate the lowest and highest values for non-angle dimensions
Dim nominalValue As Double
nominalValue = oInsDim.ModelValue
If oCellTolerance.Value = "" Or isAngle Then
' If there is no tolerance or it is an angle, leave Lowest value and Highest value empty
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = ""
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = ""
Else
' Calculate lowest value
Dim lowestValue As Double
If tol.ToleranceType = ToleranceTypeEnum.kSymmetricTolerance Then
lowestValue = (nominalValue - tol.Upper) * 10
Else
lowestValue = (nominalValue -- tol.Lower) * 10
End If
' Calculate highest value
Dim highestValue As Double
highestValue = (nominalValue + tol.Upper) * 10
' Format lowest and highest values to 2 decimal places
Dim formattedLowestValue As String
formattedLowestValue = FormatNumber(lowestValue, 2)
Dim formattedHighestValue As String
formattedHighestValue = FormatNumber(highestValue, 2)
' Add lowest value to the table without symbols
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = formattedLowestValue
' Add highest value to the table without symbols
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = formattedHighestValue
End If
oCellMsValue = oFVerTable.Rows.Item(oInsDimCt).Item("Measurement Value")
oCellMsValue.Value = "" ' Assign your measurement value here
End If
Next
' Process FeatureControlFrames
For Each oFtConFrame As FeatureControlFrame In oSheet.FeatureControlFrames
If oFtConFrame.DatumIdentifier <> "" Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt = 1 Then
' Adjust column titles for FeatureControlFrames
Dim oColumnTitleFC(0 To 1) As String
oColumnTitleFC(0) = "Inspection Number"
oColumnTitleFC(1) = "Inspection Dimension"
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 2, 1, oColumnTitleFC)
Else
oFVerTable.Rows.Add()
End If
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oFtConFrame.DatumIdentifier
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInsDimItem.Value = oFtConFrame.FeatureControlFrameRows.Item(1).Tolerance
End If
Next
' Apply the table style to the created table
oFVerTable.Style = oActiveTableStyle
' Ensure that the document updates after the script execution
iLogicVb.UpdateWhenDone = True
End Sub
Thank you for testing.
The error is indeed no longer present in version 2024. I have tried this with version 2021.
I have now cleaned up my code again.
Now I still have the problem that I can't get the symbols of the shape and position tolerances into the "Symbol" column.
Sub Main()
Dim oDrawingDocument As DrawingDocument
oDrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawingDocument.ActiveSheet
Dim oCustomTable As CustomTable
Dim oCustomTables As CustomTables
oCustomTables = oSheet.CustomTables
' Delete existing table if it exists
For Each oCustomTable In oCustomTables
If oCustomTable.Title = "Inspection Dimensions" Then
oCustomTable.Delete()
End If
Next
Dim oInsDim As DrawingDimension
Dim oInsDimText As DimensionText
Dim oInsDimString As String
Dim oCellInsDimItem As Cell
Dim oCellInspectionDimension As Cell
Dim oCellLowestValue As Cell
Dim oCellHighestValue As Cell
Dim oCellMsValue As Cell
Dim oCellTolerance As Cell
Dim oColumnTitle(0 To 6) As String ' Adjust size to 6 since we added the tolerance column
oColumnTitle(0) = "Inspection Number"
oColumnTitle(1) = "Symbol"
oColumnTitle(2) = "Inspection Dimension"
oColumnTitle(3) = "Tolerance"
oColumnTitle(4) = "Highest value"
oColumnTitle(5) = "Lowest value"
oColumnTitle(6) = "Measurement Value"
' Get the table style and title
Dim oActiveTableStyle As TableStyle
Dim oTableTitle As String
Try
oActiveTableStyle = oDrawingDocument.StylesManager.TableStyles("Inspection_Table")
Catch ex As Exception
MsgBox("Table style 'Inspection_Table' not found.")
Exit Sub
End Try
oTableTitle = "Inspection Dimensions"
' Create a custom table with specified dimensions and titles
Dim oFVerTable As CustomTable
Dim oInsDimCt As Integer
oInsDimCt = 0
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oPt2d As Point2d = oTG.CreatePoint2d(0.635, oSheet.Height - 0.635)
' Populate the table with inspection dimension data
For Each oInsDim In oSheet.DrawingDimensions
If oInsDim.IsInspectionDimension Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt = 1 Then
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 7, 1, oColumnTitle) ' Ensure correct number of columns
Else
oFVerTable.Rows.Add()
End If
oInsDimText = oInsDim.Text
oInsDimString = oInsDimText.Text
Dim oDimShape As InspectionDimensionShapeEnum
Dim oDimLabel As String
Dim oDimRate As String
oInsDim.GetInspectionDimensionData(oDimShape, oDimLabel, oDimRate)
' Replace specific characters with symbols
oInsDimString = Replace(oInsDimString, "n", ChrW(&H00D8)) ' Ø character
oInsDimString = Replace(oInsDimString, "j", ChrW(&H2316))
oInsDimString = Replace(oInsDimString, "e", ChrW(&H25EF))
oInsDimString = Replace(oInsDimString, "t", ChrW(9008))
oInsDimString = Replace(oInsDimString, "k", ChrW(8978))
oInsDimString = Replace(oInsDimString, "d", ChrW(8979))
oInsDimString = Replace(oInsDimString, "i", ChrW(9007))
oInsDimString = Replace(oInsDimString, "g", ChrW(9005))
oInsDimString = Replace(oInsDimString, "r", ChrW(9022))
oInsDimString = Replace(oInsDimString, "h", ChrW(8599))
oInsDimString = Replace(oInsDimString, "c", ChrW(&H23E5))
oInsDimString = Replace(oInsDimString, "b", ChrW(&H221F))
' Extract symbols from the dimension string
Dim symbolPrefix As String
Dim symbolSuffix As String
symbolPrefix = ""
symbolSuffix = ""
' Check for symbols at the start and end of the string
If Len(oInsDimString) > 0 And Not IsNumeric(Left(oInsDimString, 1)) Then
symbolPrefix = Left(oInsDimString, 1)
oInsDimString = Mid(oInsDimString, 2) ' Remove prefix
End If
If Len(oInsDimString) > 1 And Not IsNumeric(Right(oInsDimString, 1)) Then
symbolSuffix = Right(oInsDimString, 1)
oInsDimString = Left(oInsDimString, Len(oInsDimString) - 1) ' Remove suffix
End If
' Assign values to table cells
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oDimLabel
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Symbol")
oCellInsDimItem.Value = symbolPrefix & " " & symbolSuffix
oCellInspectionDimension = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInspectionDimension.Value = oInsDimString
' Add tolerance value to the table
oCellTolerance = oFVerTable.Rows.Item(oInsDimCt).Item("Tolerance")
Dim tol As Tolerance
tol = oInsDim.Tolerance
If tol.ToleranceType = ToleranceTypeEnum.kSymmetricTolerance Then
oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / -" & Format(tol.Upper * 10, "0.00")
Else
If tol.Upper = tol.Lower Then
oCellTolerance.Value = "±" & Format(tol.Lower * 10, "0.00")
Else
If tol.Lower = 0 Then
oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / 0.00"
Else
oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / " & Format(tol.Lower * 10, "0.00")
End If
End If
End If
' Set tolerance cell to empty if no tolerance
If tol.Upper = 0 And tol.Lower = 0 Then
oCellTolerance.Value = ""
End If
' Check if the dimension is an angle
Dim isAngle As Boolean
isAngle = InStr(oInsDimString, "°") > 0
' Calculate the lowest and highest values for non-angle dimensions
Dim nominalValue As Double
nominalValue = oInsDim.ModelValue
If oCellTolerance.Value = "" Or isAngle Then
' If there is no tolerance or it is an angle, leave Lowest value and Highest value empty
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = ""
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = ""
Else
' Calculate lowest value
Dim lowestValue As Double
If tol.ToleranceType = ToleranceTypeEnum.kSymmetricTolerance Then
lowestValue = (nominalValue - tol.Upper) * 10
Else
lowestValue = (nominalValue - tol.Lower) * 10
End If
' Calculate highest value
Dim highestValue As Double
highestValue = (nominalValue + tol.Upper) * 10
' Format lowest and highest values to 2 decimal places
Dim formattedLowestValue As String
formattedLowestValue = FormatNumber(lowestValue, 2)
Dim formattedHighestValue As String
formattedHighestValue = FormatNumber(highestValue, 2)
' Add lowest value to the table without symbols
oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value")
oCellLowestValue.Value = formattedLowestValue
' Add highest value to the table without symbols
oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value")
oCellHighestValue.Value = formattedHighestValue
End If
oCellMsValue = oFVerTable.Rows.Item(oInsDimCt).Item("Measurement Value")
oCellMsValue.Value = "" ' Assign your measurement value here
End If
Next
' Process FeatureControlFrames
For Each oFtConFrame As FeatureControlFrame In oSheet.FeatureControlFrames
If oFtConFrame.DatumIdentifier <> "" Then
oInsDimCt = oInsDimCt + 1
If oInsDimCt = 1 Then
' Adjust column titles for FeatureControlFrames
Dim oColumnTitleFC(0 To 1) As String
oColumnTitleFC(0) = "Inspection Number"
oColumnTitleFC(1) = "Inspection Dimension"
oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 2, 1, oColumnTitleFC)
Else
oFVerTable.Rows.Add()
End If
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number")
oCellInsDimItem.Value = oFtConFrame.DatumIdentifier
oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension")
oCellInsDimItem.Value = oFtConFrame.FeatureControlFrameRows.Item(1).Tolerance
End If
Next
' Apply the table style to the created table
oFVerTable.Style = oActiveTableStyle
' Ensure that the document updates after the script execution
iLogicVb.UpdateWhenDone = True
End Sub
Function GetDimensionIdentifier(ByVal oInsDim As DrawingDimension) As String
Dim oDimIdentifier As String = "K" ' Initialize with "K" prefix
If TypeOf oInsDim Is LinearGeneralDimension Then
oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00")
ElseIf TypeOf oInsDim Is DiameterGeneralDimension Then
oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00")
ElseIf TypeOf oInsDim Is RadiusGeneralDimension Then
oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00")
ElseIf TypeOf oInsDim Is AngularGeneralDimension Then
oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00")
End If
Return oDimIdentifier
End FunctionHi, you can grab the symbol from an featurecontrol frame whit this
Dim oGeoChar As String = oRow.GeometricCharacteristic.ToString
You have to expand the list
Dim oDimTextValue = oGeoChar ' Replace the symbols oDimTextValue = Replace(oDimTextValue, "kCircularity", ChrW(&H25EF)) oDimTextValue = Replace(oDimTextValue, "kTotalRunout", ChrW(9008)) oDimTextValue = Replace(oDimTextValue, "kPosition", ChrW(&H2316))
I have reworked the code to check if this is right.
Sub Main() Dim oDrawingDocument As DrawingDocument oDrawingDocument = ThisApplication.ActiveDocument Dim oSheet As Sheet oSheet = oDrawingDocument.ActiveSheet Dim oCustomTable As CustomTable Dim oCustomTables As CustomTables oCustomTables = oSheet.CustomTables ' Delete existing table if it exists For Each oCustomTable In oCustomTables If oCustomTable.Title = "Inspection Dimensions" Then oCustomTable.Delete() End If Next Dim oInsDim As DrawingDimension Dim oInsDimText As DimensionText Dim oInsDimString As String Dim oCellInsDimItem As Cell Dim oCellInspectionDimension As Cell Dim oCellLowestValue As Cell Dim oCellHighestValue As Cell Dim oCellMsValue As Cell Dim oCellTolerance As Cell Dim oColumnTitle(0 To 6) As String ' Adjust size to 6 since we added the tolerance column oColumnTitle(0) = "Inspection Number" oColumnTitle(1) = "Symbol" oColumnTitle(2) = "Inspection Dimension" oColumnTitle(3) = "Tolerance" oColumnTitle(4) = "Highest value" oColumnTitle(5) = "Lowest value" oColumnTitle(6) = "Measurement Value" ' Get the table style and title Dim oActiveTableStyle As TableStyle Dim oTableTitle As String Try oActiveTableStyle = oDrawingDocument.StylesManager.TableStyles("Inspection_Table") Catch ex As Exception MsgBox("Table style 'Inspection_Table' not found.") Exit Sub End Try oTableTitle = "Inspection Dimensions" ' Create a custom table with specified dimensions and titles Dim oFVerTable As CustomTable Dim oInsDimCt As Integer oInsDimCt = 0 Dim oTG As TransientGeometry = ThisApplication.TransientGeometry Dim oPt2d As Point2d = oTG.CreatePoint2d(0.635, oSheet.Height - 0.635) ' Populate the table with inspection dimension data For Each oInsDim In oSheet.DrawingDimensions If oInsDim.IsInspectionDimension Then oInsDimCt = oInsDimCt + 1 If oInsDimCt = 1 Then oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 7, 1, oColumnTitle) ' Ensure correct number of columns Else oFVerTable.Rows.Add() End If oInsDimText = oInsDim.Text oInsDimString = oInsDimText.Text Dim oDimShape As InspectionDimensionShapeEnum Dim oDimLabel As String Dim oDimRate As String oInsDim.GetInspectionDimensionData(oDimShape, oDimLabel, oDimRate) ' Replace specific characters with symbols oInsDimString = Replace(oInsDimString, "n", ChrW(&H00D8)) ' Ø character oInsDimString = Replace(oInsDimString, "j", ChrW(&H2316)) oInsDimString = Replace(oInsDimString, "e", ChrW(&H25EF)) oInsDimString = Replace(oInsDimString, "t", ChrW(9008)) oInsDimString = Replace(oInsDimString, "k", ChrW(8978)) oInsDimString = Replace(oInsDimString, "d", ChrW(8979)) oInsDimString = Replace(oInsDimString, "i", ChrW(9007)) oInsDimString = Replace(oInsDimString, "g", ChrW(9005)) oInsDimString = Replace(oInsDimString, "r", ChrW(9022)) oInsDimString = Replace(oInsDimString, "h", ChrW(8599)) oInsDimString = Replace(oInsDimString, "c", ChrW(&H23E5)) oInsDimString = Replace(oInsDimString, "b", ChrW(&H221F)) ' Extract symbols from the dimension string Dim symbolPrefix As String Dim symbolSuffix As String symbolPrefix = "" symbolSuffix = "" ' Check for symbols at the start and end of the string If Len(oInsDimString) > 0 And Not IsNumeric(Left(oInsDimString, 1)) Then symbolPrefix = Left(oInsDimString, 1) oInsDimString = Mid(oInsDimString, 2) ' Remove prefix End If If Len(oInsDimString) > 1 And Not IsNumeric(Right(oInsDimString, 1)) Then symbolSuffix = Right(oInsDimString, 1) oInsDimString = Left(oInsDimString, Len(oInsDimString) - 1) ' Remove suffix End If ' Assign values to table cells oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number") oCellInsDimItem.Value = oDimLabel oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Symbol") oCellInsDimItem.Value = symbolPrefix & " " & symbolSuffix oCellInspectionDimension = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension") oCellInspectionDimension.Value = oInsDimString ' Add tolerance value to the table oCellTolerance = oFVerTable.Rows.Item(oInsDimCt).Item("Tolerance") Dim tol As Tolerance tol = oInsDim.Tolerance If tol.ToleranceType = ToleranceTypeEnum.kSymmetricTolerance Then oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / -" & Format(tol.Upper * 10, "0.00") Else If tol.Upper = tol.Lower Then oCellTolerance.Value = "±" & Format(tol.Lower * 10, "0.00") Else If tol.Lower = 0 Then oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / 0.00" Else oCellTolerance.Value = "+" & Format(tol.Upper * 10, "0.00") & " / " & Format(tol.Lower * 10, "0.00") End If End If End If ' Set tolerance cell to empty if no tolerance If tol.Upper = 0 And tol.Lower = 0 Then oCellTolerance.Value = "" End If ' Check if the dimension is an angle Dim isAngle As Boolean isAngle = InStr(oInsDimString, "°") > 0 ' Calculate the lowest and highest values for non-angle dimensions Dim nominalValue As Double nominalValue = oInsDim.ModelValue If oCellTolerance.Value = "" Or isAngle Then ' If there is no tolerance or it is an angle, leave Lowest value and Highest value empty oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value") oCellLowestValue.Value = "" oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value") oCellHighestValue.Value = "" Else ' Calculate lowest value Dim lowestValue As Double If tol.ToleranceType = ToleranceTypeEnum.kSymmetricTolerance Then lowestValue = (nominalValue - tol.Upper) * 10 Else lowestValue = (nominalValue - tol.Lower) * 10 End If ' Calculate highest value Dim highestValue As Double highestValue = (nominalValue + tol.Upper) * 10 ' Format lowest and highest values to 2 decimal places Dim formattedLowestValue As String formattedLowestValue = FormatNumber(lowestValue, 2) Dim formattedHighestValue As String formattedHighestValue = FormatNumber(highestValue, 2) ' Add lowest value to the table without symbols oCellLowestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Lowest value") oCellLowestValue.Value = formattedLowestValue ' Add highest value to the table without symbols oCellHighestValue = oFVerTable.Rows.Item(oInsDimCt).Item("Highest value") oCellHighestValue.Value = formattedHighestValue End If oCellMsValue = oFVerTable.Rows.Item(oInsDimCt).Item("Measurement Value") oCellMsValue.Value = "" ' Assign your measurement value here End If Next ' Process FeatureControlFrames For Each oFtConFrame As FeatureControlFrame In oSheet.FeatureControlFrames If oFtConFrame.DatumIdentifier <> "" Then oInsDimCt = oInsDimCt + 1 If oInsDimCt = 1 Then ' Adjust column titles for FeatureControlFrames Dim oColumnTitleFC(0 To 2) As String oColumnTitleFC(0) = "Inspection Number" oColumnTitleFC(1) = "Symbol" oColumnTitleFC(2) = "Inspection Dimension" oFVerTable = oSheet.CustomTables.Add(oTableTitle, oPt2d, 2, 1, oColumnTitleFC) Else oFVerTable.Rows.Add() End If ' Create a FeatureControlFrameRows object to define the symbol's rows Dim oRows As FeatureControlFrameRows = oFtConFrame.FeatureControlFrameRows Dim oRow As FeatureControlFrameRow = oRows.Item(1) Dim oGeoChar As String = oRow.GeometricCharacteristic.ToString Dim oDimTextValue = oGeoChar ' Replace the symbols oDimTextValue = Replace(oDimTextValue, "kCircularity", ChrW(&H25EF)) oDimTextValue = Replace(oDimTextValue, "kTotalRunout", ChrW(9008)) oDimTextValue = Replace(oDimTextValue, "kPosition", ChrW(&H2316)) oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Number") oCellInsDimItem.Value = oFtConFrame.DatumIdentifier oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Symbol") oCellInsDimItem.Value = oDimTextValue oCellInsDimItem = oFVerTable.Rows.Item(oInsDimCt).Item("Inspection Dimension") oCellInsDimItem.Value = oFtConFrame.FeatureControlFrameRows.Item(1).Tolerance End If Next ' Apply the table style to the created table oFVerTable.Style = oActiveTableStyle ' Ensure that the document updates after the script execution iLogicVb.UpdateWhenDone = True End Sub Function GetDimensionIdentifier(ByVal oInsDim As DrawingDimension) As String Dim oDimIdentifier As String = "K" ' Initialize with "K" prefix If TypeOf oInsDim Is LinearGeneralDimension Then oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00") ElseIf TypeOf oInsDim Is DiameterGeneralDimension Then oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00") ElseIf TypeOf oInsDim Is RadiusGeneralDimension Then oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00") ElseIf TypeOf oInsDim Is AngularGeneralDimension Then oDimIdentifier = oDimIdentifier & Format(oInsDim.ModelValue, "0.00") End If Return oDimIdentifier End Function
If a response answers your question, please use ACCEPT SOLUTION to assist other users later.
Also be generous with Likes! Thank you and enjoy!
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
