AnsweredAssumed Answered

Macro find geometry with dangling relations on drawing

Question asked by Alexey Kovalov on Feb 16, 2017
Latest reply on Apr 7, 2017 by Alexey Kovalov

Like • Show 0 Likes0
Comment • 15

Hello all!

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

Raghvendra Bhargava Mar 31, 2017 8:38 PM

Correct Answer

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

See the reply in context

Attachments

No one else had this question

Outcomes

Raghvendra Bhargava Feb 16, 2017 1:17 PM

Relations are always attached to entities so instead of magnifying relations, we can select and magnify Related entities.

Actions

Alexey Kovalov @ Raghvendra Bhargava on Feb 16, 2017 3:47 PM

Thanks for colaboration. Its exactly that I need - to find entitie (geometry) with dangling relations, select it and magnify.

So how can I do this?

Regards,

Alexey

Actions

Alexey Kovalov Mar 24, 2017 9:26 AM

Hello!

In macro by handleman (see first post) dangling dimensions finding and magnifing by means of code

For i = i To UBound(aShts)

swDwg.ActivateSheet aShts(i)

Set swView = swDwg.GetFirstView

While Not (swView Is Nothing)

Set swAnnot = swView.GetFirstAnnotation3

While Not swAnnot Is Nothing

If swAnnot.IsDangling Then

swAnnot.Select3 False, Nothing

swDoc.ViewZoomToSelection

Exit For

End If

Set swAnnot = swAnnot.GetNext3

Wend

Set swView = swView.GetNextView

How must I change it to find entities with dangling relations and magnify its?

Regards,

Alexey

Actions

Raghvendra Bhargava @ Alexey Kovalov on Mar 24, 2017 1:18 PM

Hi Alexey,

Maybe this is what you are looking for:

Dim swApp As SldWorks.SldWorks

Dim Count As Integer

Dim swModel As ModelDoc2

Dim vEnt As Variant

Dim vEntTyp As Variant

Dim swAnnot As Annotation

Dim swDw As DrawingDoc

Dim swView As View

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swDw = swModel

Set swView = swDw.GetFirstView

Set swView = swView.GetNextView

While Not (swView Is Nothing)

Set swAnnot = swView.GetFirstAnnotation3

While Not swAnnot Is Nothing

If swAnnot.IsDangling Then

Debug.Print swAnnot.GetAttachedEntityCount3

vEnt = swAnnot.GetAttachedEntities3 'Getting Entities

vEntTyp = swAnnot.GetAttachedEntityTypes 'Gettign Entities Types

swAnnot.Select3 False, Nothing

swModel.ViewZoomToSelection

'Exit For

End If

Set swAnnot = swAnnot.GetNext3

Wend

Set swView = swView.GetNextView

Wend

End Sub

Actions

Alexey Kovalov @ Raghvendra Bhargava on Mar 24, 2017 9:31 PM

Hi, Raghvendra!

Thank you for your time.

Added your code to the macro, but unfortunately it does not work.

On the drawing still there is an axial line with a dangling relation (see attached pictures), but the macro does not find it.

Below is the full code of the macro, maybe I made a mistake somewhere?

Dim swApp As SldWorks.SldWorks

Dim Count As Integer

Dim vEnt As Variant

Dim vEntTyp As Variant

Dim swDoc As SldWorks.ModelDoc2

Dim swDwg As SldWorks.DrawingDoc

Dim swView As SldWorks.View

Dim sMsg As String

Dim aShts As Variant

Dim swAnnot As SldWorks.Annotation

Dim swSht As SldWorks.Sheet

Sub FindNextDangler()

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

aShts = swDwg.GetSheetNames

For i = 0 To UBound(aShts)

Set swSht = swDwg.GetCurrentSheet

If aShts(i) = swSht.GetName Then

Exit For

End If

Next i

For i = i To UBound(aShts)

swDwg.ActivateSheet aShts(i)

Set swView = swDwg.GetFirstView

Set swView = swView.GetNextView

While Not (swView Is Nothing)

Set swAnnot = swView.GetFirstAnnotation3

While Not swAnnot Is Nothing

If swAnnot.IsDangling Then

Debug.Print swAnnot.GetAttachedEntityCount3

vEnt = swAnnot.GetAttachedEntities3 'Getting Entities

vEntTyp = swAnnot.GetAttachedEntityTypes 'Gettign Entities Types

swAnnot.Select3 False, Nothing

swModel.ViewZoomToSelection

'Exit For

End If

Set swAnnot = swAnnot.GetNext3

Wend

Set swView = swView.GetNextView

Wend

If i <> UBound(aShts) Then

MsgBox "No more danglers on " & aShts(i) & ". Switching to " & aShts(i + 1)

Else

MsgBox "No more danglers found in this drawing."

End If

Next i

Set swSht = Nothing

Set swAnnot = Nothing

Set swDoc = Nothing

Set swDwg = Nothing

Set swApp = Nothing

Set swView = Nothing

End Sub

Attachments

Screenshot_2.png21.4 KB
Screenshot_1.png13.4 KB

Actions

Raghvendra Bhargava @ Alexey Kovalov on Mar 29, 2017 12:45 PM

In your attached pictures, I saw a line i.e. Sketch segment which is not an annotation that's why it is not treated as an annotation in code.

You can use Centerline annotation instead of a line.

Or if I am missing something then please attach some fail drawing I will check and let you know

Thanks

Actions

Alexey Kovalov @ Raghvendra Bhargava on Mar 30, 2017 2:34 AM

Hi, Raghvendra!

Thanks for your answer.

You are absolutely right.

We always use line with relation “symmetric”. If it became dangling I can replace relation “Display/Delete Relation” and all dimensions from that line will be correct. On some drawing we have several dozens of such dimensions from line of symmetric. Also we often use dimensions from TIP (true intersection point) so I need to find lines with dangling relation “symmetric” and point with dangling “intersection” which are sketch segments.

Is it possible to modify a macro above to find, select and magnify its?

I attached screenshots and example part and drawing.

Regards,

Alexey

Attachments

Actions

Raghvendra Bhargava @ Alexey Kovalov on Mar 31, 2017 8:38 PM

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

Actions

Alexey Kovalov @ Raghvendra Bhargava on Apr 3, 2017 12:56 AM

Hello, Raghvendra!

Thank you for your answer.

I'm using SW2010 at my work and unfortunately it doesn't support method GetDifinitionEntities2.

Actions

Raghvendra Bhargava @ Alexey Kovalov on Apr 3, 2017 12:32 PM

replace:

vEntArr = SketchRel.GetDefinitionEntities2

with:

vEntArr = SketchRel.GetDefinitionEntities

Dim obj as object

Actions

Alexey Kovalov @ Raghvendra Bhargava on Apr 5, 2017 11:56 AM

Hello, Raghvendra!

The macro works great!

Tell me, please, is it possible to make active Property Tab when entity is selected (see attached pictures?

Thanks. Regards,

Alexey

Attachments

Screenshot_12.png71.5 KB
Screenshot_11.png59.2 KB

Actions

Raghvendra Bhargava @ Alexey Kovalov on Apr 5, 2017 3:55 PM

Hi Alexey,

Why do you want to active the Property Tab when Entity is selected?

Raghvendra

Actions

Alexey Kovalov @ Raghvendra Bhargava on Apr 7, 2017 11:47 AM

Hi, Raghvendra!

When I select entitie by mouse the Property Tab is activated and I immediately see its relations including dangling ones.

It's more comfortable for me, but it's not a matter of principle. Macro works good.

Thanks.

Regards,

Alexey

Actions

Raghvendra Bhargava @ Alexey Kovalov on Apr 7, 2017 3:00 PM

Cool!

Please mark my reply as a correct answer...

Raghvendra

Actions

Alexey Kovalov @ Raghvendra Bhargava on Apr 7, 2017 3:42 PM

Of course. Thank you for your help, Raghvendra.

Best regards,

Alexey

Actions

15 Replies

Raghvendra Bhargava Feb 16, 2017 1:17 PM
Mark Correct
Correct Answer
Relations are always attached to entities so instead of magnifying relations, we can select and magnify Related entities.
Like • Show 0 Likes0
Actions
- Alexey Kovalov @ Raghvendra Bhargava on Feb 16, 2017 3:47 PM
  Mark Correct
  Correct Answer
  Thanks for colaboration. Its exactly that I need - to find entitie (geometry) with dangling relations, select it and magnify.
  So how can I do this?
  Regards,
  Alexey
  Like • Show 0 Likes0
  Actions
Alexey Kovalov Mar 24, 2017 9:26 AM
Mark Correct
Correct Answer
Hello!
In macro by handleman (see first post) dangling dimensions finding and magnifing by means of code
For i = i To UBound(aShts)
     swDwg.ActivateSheet aShts(i)
     Set swView = swDwg.GetFirstView
     While Not (swView Is Nothing)
         Set swAnnot = swView.GetFirstAnnotation3
         While Not swAnnot Is Nothing
             If swAnnot.IsDangling Then
                 swAnnot.Select3 False, Nothing
                 swDoc.ViewZoomToSelection
                 Exit For
             End If
             Set swAnnot = swAnnot.GetNext3
         Wend
         Set swView = swView.GetNextView
How must I change it to find entities with dangling relations and magnify its?
Regards,
Alexey
Like • Show 0 Likes0
Actions
- Raghvendra Bhargava @ Alexey Kovalov on Mar 24, 2017 1:18 PM
  Mark Correct
  Correct Answer
  Hi Alexey,
  Maybe this is what you are looking for:
  
  Dim swApp   As SldWorks.SldWorks
  Dim Count   As Integer
  Dim swModel As ModelDoc2
  Dim vEnt    As Variant
  Dim vEntTyp As Variant
  Dim swAnnot As Annotation
  Dim swDw    As DrawingDoc
  Dim swView As View
  
  Sub main()
  
  Set swApp = Application.SldWorks
  Set swModel = swApp.ActiveDoc
  Set swDw = swModel
  
  Set swView = swDw.GetFirstView
  Set swView = swView.GetNextView
  
  While Not (swView Is Nothing)
      Set swAnnot = swView.GetFirstAnnotation3
      While Not swAnnot Is Nothing
          If swAnnot.IsDangling Then
              Debug.Print swAnnot.GetAttachedEntityCount3
              vEnt = swAnnot.GetAttachedEntities3     'Getting Entities
              vEntTyp = swAnnot.GetAttachedEntityTypes     'Gettign Entities Types
              swAnnot.Select3 False, Nothing
              swModel.ViewZoomToSelection
              'Exit For
          End If
          Set swAnnot = swAnnot.GetNext3
      Wend
      Set swView = swView.GetNextView
     Wend
  End Sub
  Like • Show 0 Likes0
  Actions
  - Alexey Kovalov @ Raghvendra Bhargava on Mar 24, 2017 9:31 PM
    Mark Correct
    Correct Answer
    Hi, Raghvendra!
    Thank you for your time.
    Added your code to the macro, but unfortunately it does not work.
    On the drawing still there is an axial line with a dangling relation (see attached pictures), but the macro does not find it.
    Below is the full code of the macro, maybe I made a mistake somewhere?
    
    Dim swApp As SldWorks.SldWorks
    Dim Count   As Integer
    Dim vEnt    As Variant
    Dim vEntTyp As Variant
    Dim swDoc As SldWorks.ModelDoc2
    Dim swDwg As SldWorks.DrawingDoc
    Dim swView As SldWorks.View
    Dim sMsg As String
    Dim aShts As Variant
    Dim swAnnot As SldWorks.Annotation
    Dim swSht As SldWorks.Sheet
    
    Sub FindNextDangler()
    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
    aShts = swDwg.GetSheetNames
    
    For i = 0 To UBound(aShts)
         Set swSht = swDwg.GetCurrentSheet
         If aShts(i) = swSht.GetName Then
             Exit For
         End If
    Next i
    
    For i = i To UBound(aShts)
         swDwg.ActivateSheet aShts(i)
         Set swView = swDwg.GetFirstView
         Set swView = swView.GetNextView
         While Not (swView Is Nothing)
        Set swAnnot = swView.GetFirstAnnotation3
        While Not swAnnot Is Nothing
            If swAnnot.IsDangling Then
                Debug.Print swAnnot.GetAttachedEntityCount3
                vEnt = swAnnot.GetAttachedEntities3     'Getting Entities
                vEntTyp = swAnnot.GetAttachedEntityTypes     'Gettign Entities Types
                swAnnot.Select3 False, Nothing
                swModel.ViewZoomToSelection
                'Exit For
            End If
            Set swAnnot = swAnnot.GetNext3
        Wend
        Set swView = swView.GetNextView
       Wend
         If i <> UBound(aShts) Then
             MsgBox "No more danglers on " & aShts(i) & ". Switching to " & aShts(i + 1)
         Else
             MsgBox "No more danglers found in this drawing."
         End If
    Next i
    
    Set swSht = Nothing
    Set swAnnot = Nothing
    Set swDoc = Nothing
    Set swDwg = Nothing
    Set swApp = Nothing
    Set swView = Nothing
    
    End Sub
    Attachments
    Screenshot_2.png21.4 KB
    Screenshot_1.png13.4 KB
    Like • Show 0 Likes0
    Actions
    - Raghvendra Bhargava @ Alexey Kovalov on Mar 29, 2017 12:45 PM
      Mark Correct
      Correct Answer
      In your attached pictures, I saw a line i.e. Sketch segment which is not an annotation that's why it is not treated as an annotation in code.
      You can use Centerline annotation instead of a line.
      
      Or if I am missing something then please attach some fail drawing I will check and let you know
      
      Thanks
      Like • Show 0 Likes0
      Actions
      - Alexey Kovalov @ Raghvendra Bhargava on Mar 30, 2017 2:34 AM
        Mark Correct
        Correct Answer
        Hi, Raghvendra!
        Thanks for your answer.
        You are absolutely right.
        We always use line with relation “symmetric”. If it became dangling I can replace relation “Display/Delete Relation” and all dimensions from that line will be correct. On some drawing we have several dozens of such dimensions from line of symmetric. Also we often use dimensions from TIP (true intersection point) so I need to find lines with dangling relation “symmetric” and point with dangling “intersection” which are sketch segments.
        Is it possible to modify a macro above to find, select and magnify its?
        I attached screenshots and example part and drawing.
        Regards,
        Alexey
        Attachments
        test.SLDPRT.zip76.1 KB
        test.SLDDRW.zip97.3 KB
        Screenshot_10.png82.9 KB
        Screenshot_9.png83.0 KB
        Screenshot_8.png93.0 KB
        Screenshot_7.png18.1 KB
        Screenshot_6.png18.9 KB
        Like • Show 0 Likes0
        Actions
        Raghvendra Bhargava @ Alexey Kovalov on Mar 31, 2017 8:38 PM
        Unmark Correct
        Correct Answer
        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
        Like • Show 0 Likes0
        Actions
        Alexey Kovalov @ Raghvendra Bhargava on Apr 3, 2017 12:56 AM
        Mark Correct
        Correct Answer
        Hello, Raghvendra!
        Thank you for your answer.
        I'm using SW2010 at my work and unfortunately it doesn't support method GetDifinitionEntities2.
        Like • Show 0 Likes0
        Actions
        Raghvendra Bhargava @ Alexey Kovalov on Apr 3, 2017 12:32 PM
        Mark Correct
        Correct Answer
        replace:
        vEntArr = SketchRel.GetDefinitionEntities2
        
        with:
        vEntArr = SketchRel.GetDefinitionEntities
        Dim obj as object
        Like • Show 0 Likes0
        Actions
        Alexey Kovalov @ Raghvendra Bhargava on Apr 5, 2017 11:56 AM
        Mark Correct
        Correct Answer
        Hello, Raghvendra!
        The macro works great!
        Tell me, please, is it possible to make active Property Tab when entity is selected (see attached pictures?
        Thanks. Regards,
        Alexey
        Attachments
        Screenshot_12.png71.5 KB
        Screenshot_11.png59.2 KB
        Like • Show 0 Likes0
        Actions
        Raghvendra Bhargava @ Alexey Kovalov on Apr 5, 2017 3:55 PM
        Mark Correct
        Correct Answer
        Hi Alexey,
        Why do you want to active the Property Tab when Entity is selected?
        
        Raghvendra
        Like • Show 0 Likes0
        Actions
        Alexey Kovalov @ Raghvendra Bhargava on Apr 7, 2017 11:47 AM
        Mark Correct
        Correct Answer
        Hi, Raghvendra!
        When I select entitie by mouse the Property Tab is activated and I immediately see its relations including dangling ones.
        It's more comfortable for me, but it's not a matter of principle. Macro works good.
        Thanks.
        Regards,
        
        Alexey
        Like • Show 0 Likes0
        Actions
        Raghvendra Bhargava @ Alexey Kovalov on Apr 7, 2017 3:00 PM
        Mark Correct
        Correct Answer
        Cool!
        Please mark my reply as a correct answer...
        
        Raghvendra
        Like • Show 0 Likes0
        Actions
        Alexey Kovalov @ Raghvendra Bhargava on Apr 7, 2017 3:42 PM
        Mark Correct
        Correct Answer
        Of course. Thank you for your help, Raghvendra.
        Best regards,
        Alexey
        Like • Show 0 Likes0
        Actions

Macro find geometry with dangling relations on drawing

Attachments

Outcomes

Attachments

Attachments

Attachments

Related Content

Recommended Content