Mã nguồn nằm trong series xây dựng công cụ ghi kích thước tự động trong bản vẽ 2D (môi trường idw) trên phần mềm inventor. Series có sự góp mặt đồng hành của LAB302 và anh Chu Đình Quý, cựu sinh viên lớp 66ME.
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As DrawingDocument = TryCast(oApp.ActiveDocument, DrawingDocument)
If oDoc Is Nothing Then Return
Dim oSheet As Sheet = oDoc.ActiveSheet
' ==========================================
' 1. CHỌN HÌNH CHIẾU & KHỞI TẠO BIẾN
' ==========================================
Dim oView As DrawingView = TryCast(oApp.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "Click chọn hình chiếu..."), DrawingView)
If oView Is Nothing Then Return
Dim oTG As TransientGeometry = oApp.TransientGeometry
Dim oGeneralDims As GeneralDimensions = oSheet.DrawingDimensions.GeneralDimensions
Dim viewCenterX As Double = oView.Center.X
Dim viewCenterY As Double = oView.Center.Y
Dim viewLeft As Double = oView.Left
Dim viewBottom As Double = oView.Top - oView.Height
Dim markCount As Integer = 0
Dim dimCount As Integer = 0
Dim cylinderLines As New System.Collections.Generic.List(Of DrawingCurve)
Dim holeGroups As New System.Collections.Generic.Dictionary(Of Double, System.Collections.Generic.List(Of DrawingCurve))
Dim allHoles As New System.Collections.Generic.List(Of DrawingCurve)
' Khai báo biến dùng chung để né lỗi Scope
Dim sharedIntent As GeometryIntent = Nothing
Dim cx As Double, cy As Double
Dim dx As Double, dy As Double
Dim bestAngle As Double
' ==========================================
' 2. QUÉT VÀ PHÂN NHÓM LỖ
' ==========================================
For Each oCurve As DrawingCurve In oView.DrawingCurves
If oCurve.CurveType = CurveTypeEnum.kCircleCurve Then
Try
sharedIntent = oSheet.CreateGeometryIntent(oCurve)
Try
oSheet.Centermarks.Add(sharedIntent)
markCount += 1
Catch
End Try
Dim oCircle2D As Circle2d = TryCast(oCurve.Segments.Item(1).Geometry, Circle2d)
If oCircle2D IsNot Nothing Then
allHoles.Add(oCurve)
Dim r As Double = Math.Round(oCircle2D.Radius, 3)
If Not holeGroups.ContainsKey(r) Then
holeGroups.Add(r, New System.Collections.Generic.List(Of DrawingCurve))
End If
holeGroups(r).Add(oCurve)
End If
Catch
End Try
ElseIf oCurve.CurveType = CurveTypeEnum.kLineCurve Then
Try
If TypeOf oCurve.ModelGeometry Is Cylinder Then
cylinderLines.Add(oCurve)
End If
Catch
End Try
End If
Next
' ==========================================
' 3. TẠO STYLE 0 SỐ THẬP PHÂN CHUẨN MILIMET
' ==========================================
Dim styleName As String = "DimStyle_0_Decimal"
Dim zeroDecimalStyle As DimensionStyle = Nothing
Try
zeroDecimalStyle = oDoc.StylesManager.DimensionStyles.Item(styleName)
Catch
Try
Dim activeStyle As DimensionStyle = oDoc.StylesManager.ActiveStandardStyle.ActiveObjectDefaults.LinearDimensionStyle
zeroDecimalStyle = activeStyle.Copy(styleName)
zeroDecimalStyle.LinearPrecision = LinearPrecisionEnum.kZeroDecimalPlaceLinearPrecision
Catch
End Try
End Try
' ==========================================
' 4. GHI KÍCH THƯỚC ĐƯỜNG KÍNH LỖ (PHI)
' ==========================================
For Each kvp In holeGroups
Dim radiusOnSheet As Double = kvp.Key
Dim curvesInGroup As System.Collections.Generic.List(Of DrawingCurve) = kvp.Value
Dim holeCount As Integer = curvesInGroup.Count
Dim representativeCurve As DrawingCurve = curvesInGroup(0)
Dim maxDist As Double = -1
Dim repCircle2D As Circle2d = Nothing
For Each c In curvesInGroup
Dim tempCirc As Circle2d = TryCast(c.Segments.Item(1).Geometry, Circle2d)
If tempCirc IsNot Nothing Then
Dim dist As Double = Math.Sqrt(Math.Pow(tempCirc.Center.X - viewCenterX, 2) + Math.Pow(tempCirc.Center.Y - viewCenterY, 2))
If dist > maxDist Then
maxDist = dist
representativeCurve = c
repCircle2D = tempCirc
End If
End If
Next
If repCircle2D IsNot Nothing Then
cx = repCircle2D.Center.X
cy = repCircle2D.Center.Y
sharedIntent = oSheet.CreateGeometryIntent(representativeCurve)
dx = cx - viewCenterX
dy = cy - viewCenterY
If dx >= 0 And dy >= 0 Then
bestAngle = Math.PI / 4
ElseIf dx < 0 And dy >= 0 Then
bestAngle = 3 * Math.PI / 4
ElseIf dx < 0 And dy < 0 Then
bestAngle = 5 * Math.PI / 4
Else
bestAngle = 7 * Math.PI / 4
End If
Dim dimDistance As Double = radiusOnSheet + 1.5
Dim textX As Double = cx + (dimDistance * Math.Cos(bestAngle))
Dim textY As Double = cy + (dimDistance * Math.Sin(bestAngle))
Dim textOrigin As Point2d = oTG.CreatePoint2d(textX, textY)
Try
Dim newDim As DiameterGeneralDimension = oGeneralDims.AddDiameter(textOrigin, sharedIntent)
Try : newDim.SingleLine = True : Catch : End Try
If zeroDecimalStyle IsNot Nothing Then Try : newDim.Style = zeroDecimalStyle : Catch : End Try
Try
If holeCount > 1 Then
newDim.Text.FormattedText = holeCount.ToString() & "-<DimensionValue/>"
End If
Catch
End Try
dimCount += 1
Catch
End Try
End If
Next
' ==========================================
' 5. ĐO KHOẢNG CÁCH LỖ BẰNG BASELINE SET
' ==========================================
If allHoles.Count > 1 Then
' TÌM LỖ GỐC TỌA ĐỘ (Ưu tiên Trái nhất, nếu trùng X thì lấy Dưới nhất)
Dim datumHole As DrawingCurve = allHoles(0)
Dim minX As Double = Double.MaxValue
Dim minY As Double = Double.MaxValue
Dim datumPt As Point2d = Nothing
For Each c In allHoles
Dim pt As Point2d = TryCast(c.Segments.Item(1).Geometry, Circle2d).Center
If Math.Round(pt.X, 3) < minX Then
minX = Math.Round(pt.X, 3)
minY = Math.Round(pt.Y, 3)
datumHole = c
datumPt = pt
ElseIf Math.Round(pt.X, 3) = minX AndAlso Math.Round(pt.Y, 3) < minY Then
minY = Math.Round(pt.Y, 3)
datumHole = c
datumPt = pt
End If
Next
Dim datumIntent As GeometryIntent = oSheet.CreateGeometryIntent(datumHole)
Dim intentsX As ObjectCollection = oApp.TransientObjects.CreateObjectCollection()
Dim intentsY As ObjectCollection = oApp.TransientObjects.CreateObjectCollection()
intentsX.Add(datumIntent)
intentsY.Add(datumIntent)
Dim dimensionedX As New System.Collections.Generic.List(Of Double)
Dim dimensionedY As New System.Collections.Generic.List(Of Double)
For Each targetHole In allHoles
If targetHole Is datumHole Then Continue For
Dim targetPt As Point2d = TryCast(targetHole.Segments.Item(1).Geometry, Circle2d).Center
Dim targetIntent As GeometryIntent = oSheet.CreateGeometryIntent(targetHole)
Dim rX As Double = Math.Round(targetPt.X, 3)
Dim rY As Double = Math.Round(targetPt.Y, 3)
' Đổi tên biến để không bị đụng với dx, dy ở trên
Dim datumX As Double = Math.Round(datumPt.X, 3)
Dim datumY As Double = Math.Round(datumPt.Y, 3)
' THUẬT TOÁN TÌM TRỤC X: Chỉ cần X khác nhau là đo
If Math.Abs(rX - datumX) > 0.001 AndAlso Not dimensionedX.Contains(rX) Then
dimensionedX.Add(rX)
intentsX.Add(targetIntent)
End If
' THUẬT TOÁN TÌM TRỤC Y: Chỉ cần Y khác nhau là đo
If Math.Abs(rY - datumY) > 0.001 AndAlso Not dimensionedY.Contains(rY) Then
dimensionedY.Add(rY)
intentsY.Add(targetIntent)
End If
Next
' XUẤT CHÙM BASELINE TRỤC X (Nằm ngang dưới đáy)
If intentsX.Count > 1 Then
Try
Dim placePtX As Point2d = oTG.CreatePoint2d(viewCenterX, viewBottom - 1.5)
Dim baseSetX As BaselineDimensionSet = oSheet.DrawingDimensions.BaselineDimensionSets.Add(intentsX, placePtX, DimensionTypeEnum.kHorizontalDimensionType)
If zeroDecimalStyle IsNot Nothing Then
For Each mem As LinearGeneralDimension In baseSetX.Members
Try : mem.Style = zeroDecimalStyle : Catch : End Try
Next
End If
Catch
End Try
End If
' XUẤT CHÙM BASELINE TRỤC Y (Nằm dọc bên trái)
If intentsY.Count > 1 Then
Try
Dim placePtY As Point2d = oTG.CreatePoint2d(viewLeft - 1.5, viewCenterY)
Dim baseSetY As BaselineDimensionSet = oSheet.DrawingDimensions.BaselineDimensionSets.Add(intentsY, placePtY, DimensionTypeEnum.kVerticalDimensionType)
If zeroDecimalStyle IsNot Nothing Then
For Each mem As LinearGeneralDimension In baseSetY.Members
Try : mem.Style = zeroDecimalStyle : Catch : End Try
Next
End If
Catch
End Try
End If
End If
MessageBox.Show("Tâm lỗ: " & markCount & vbCrLf & _
"Nhóm kích thước lỗ: " & dimCount, _
"Auto-Dim v1.0.0", _
MessageBoxButtons.OK, _
MessageBoxIcon.Information)