There is useful macro made by handleman (http://www.eng-tips.com/viewthread.cfm?qid=368678). Its find dangling dimension, select it and magnify its area.
Is it possible to change it macro or make new one for dangling geometry relations? Find, select and magnify. Dangling dimensions on drawing changes its color and dangling relations have no any visual changes.
On example pictures I have a plate with axis of symmetry with relation "symmetric" (Screenshot_1) and point with "intersection" (2). After losing right face of part dimension "120" bacame dangling and change its color (on green in my settings - Screen_3). And axis of symmetry stay black but have dangling relation (Screen_4) and now its not axis of symmetry of the part. And all dimensions from this axis is wrong.
The same with point (5).
Thanks in advance.
Alexey
Attachments
- Screenshot_5.png33.0 KB
- Screenshot_4.png37.3 KB
- Screenshot_3.png34.5 KB
- Screenshot_2.png33.7 KB
- Screenshot_1.png37.7 KB
Try this:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSketchSeg As SketchSegment
Dim swSketch As SldWorks.Sketch
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swViewSketch As SldWorks.Sketch
Dim bRet As Boolean
Dim vEntArr As Variant
Dim vRel As Variant
Dim SketchRel As SketchRelation
Dim swSkRelMgr As SketchRelationManager
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swView = swDraw.GetFirstView
Do While Not Nothing Is swView
Set swViewSketch = swView.GetSketch
Set swSkRelMgr = swViewSketch.RelationManager
vRel = swSkRelMgr.GetRelations(swDangling)
If IsEmpty(vRel) = False Then
Dim count As Integer
For count = 0 To UBound(vRel)
Set SketchRel = vRel(count)
vEntArr = SketchRel.GetDefinitionEntities2
Dim RelCount As Integer
For RelCount = 0 To UBound(vEntArr)
Set obj = vEntArr(RelCount)
obj.Select False ' It will select all entities related to Dangling relation.
swModel.ViewZoomToSelection
Next RelCount
Next count
End If
Set swView = swView.GetNextView
Loop
End Sub