How do I create a macro to find dangling dimensions? 3

[Muttzy]

In a previous thread I started I asked how to find dangling dimensions in a very large drawing file and handleman mentioned that I can use a macro to find them. This leads to my next question - how do I write a macro to find dangling dimensions? I do not want the macro to automatically delete them for me because I want to fix the dimensions as I go.

 

[handleman]

The way I would envision this macro to work:

1. Scan the entire document for dangling dimensions. Make a table in memory of all the dangling ones and which page they are on.
2. Load the list into a list box on a user form on screen.
3. Clicking on an entry in the list box takes you to the page in question, highlights the dimension, and zooms to fit.
4. Once you click on another entry in the list, the macro checks to verify that the previously selected dimension isn't dangling anymore. If not, it's removed from the list.

As far as how to write it, if you've not written macros before this would be pretty challenging. However, I do know a guy... I may be able to get you in touch if you're interested.

-handleman, CSWP (The new, easy test)

 

[TheTick]

Since the dimensions and constraints belong to their respective views, you need to cycle through each of the drawing views and find the constraints in each view. I don't think you'll be able to fish out the dimensions from the drawing object.

Honesty may be the best policy, but insanity is a better defense.

http://www.EsoxRepublic.com

-SolidWorks API VB programming help

 

[DiegoLGraves]

There is a macro called DIMOVERRIDEFINDER.swp that finds over-ridden dimensions. It may be similar to, or a starting point for this macro. i use it for peer reviewing my co-workers drawings, and drawings we receive from customers. The source code that I have does not include who the author was - I would have guessed it's from handleman, TheTick, Lennie or Deepak Gupta.

 

[TheTick]

No mine.

 

[handleman]

I wrote one that adds a star to overridden dimensions. The problem with that macro is that all it does is visually identify overridden dimensions. SolidWorks already visually identifies dangling dimensions by color. What I'm pretty sure you're looking for here is one that will actually navigate to them wherever they are in a huge drawing whose sheets may take a long time to load.

-handleman, CSWP (The new, easy test)

 

[Muttzy]

TheTick or DiegoLGraves - do you think I could get a copy of the macro DIMOVERRIDEFINDER.swp. It may not be what I am looking for exactly but it will give me a place to start.

Handleman - you are right, I am looking for a way for the macro to bring me to the problems but adding a star to the dimensions that are generating errors will make them stand out more. Maybe a better way is for the macro to search for the errors and just give me the sheet number that they are on. I think that is what you are suggesting. If I have the list of page numbers I can manually go to each page and since dangling dimensions are a different color I should be able to manually correct the problems. I do not have any experience with coding macros and limited coding experience in general. If I had a place to start I will give it a shot. It would be helpful if you could put me in contact with the person you suggested.

 

[handleman]

Here's a copy of AddStarToOverrideDims.

It currently only works on the active sheet, so it doesn't search all sheets.

If you send a message to my gmail (joshville) I should be able to help you get where you need to go.

-handleman, CSWP (The new, easy test)

 

[handleman]

On thinking about it a little more, I think this macro would fit your workflow pretty well, and it's a freebie, which is nice. Just map it to a button on your toolbar for convenience.

It will start on the currently active sheet and look for dangling dimensions. The first one it finds, it will highlight and zoom to it. Once you fix that one, just run the macro again and it will find the next one. If there are no more danglers on the current sheet, the macro will switch to the next sheet. It will continue to find the next dangling dimension until there are no more in the drawing.

Limitation is that it won't find the next one until you have fixed the one it just found.

Enjoy!

Dim swApp As SldWorks.SldWorks
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
    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
    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

-handleman, CSWP (The new, easy test)

 

[Muttzy]

My word handleman, that is brilliant. It works like a charm.

Thank you so much.

 

[Muttzy]

The only thing it needs is a way to shut it off instead of running through every sheet but I think I can figure that out.

 

[DiegoLGraves]

handleman, I created a drawing with a dangling dimension, an angle on a suface loft. When I run the macro it opens the VBA window with the cursor in the space after Sub FindNextDangler(). I ran it again on a drawing of a sheet metal part with a dangling dimension between a hole and the centermark of a hole that I removed. I got the same result of the macro not running.

Do you know why and what I would do to correct this? I'm running SW14 sp 4.0.

Thanks, Diego

 

[handleman]

Sorry... Works fine for me. Here it is in completed macro form rather than a copy/paste.



-handleman, CSWP (The new, easy test)

 

[DiegoLGraves]

Thanks handleman. Now when running the macro I get a compile error: Can't find project or library, at For i = 0 To UBound(aShts).


Here's the code for the dimensions over-ride finder macro I mentioned above. Again, I don't know who wrote it, but it's been very helpful at times.

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swDwg As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swAnnot As SldWorks.Annotation
Const OVERRIDDENDIMCOLOR As Integer = 255
Dim CurAnnotOverrides As Integer
Dim swDim As SldWorks.Dimension
Dim KillFlag As Integer
Dim OverRiddenFlag As Boolean
Dim sMsg As String


Sub ColorOverridden()

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

sMsg = "This macro will color" & _
vbCrLf & "all overridden dimensions in this drawing." & _
vbCrLf & vbCrLf & _
"To add color to overridden dimensions, choose ""Yes""" & vbCrLf & _
"To remove color, choose ""No""" & _
vbCrLf & "To quit, choose ""Cancel"""
KillFlag = MsgBox(sMsg, vbYesNoCancel, "Add stars?")

If KillFlag = vbCancel Then
Exit Sub
End If


Set swDwg = swDoc


Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
Set swDispDim = swView.GetFirstDisplayDimension5
While Not swDispDim Is Nothing
Set swAnnot = swDispDim.GetAnnotation
CurAnnotOverrides = swAnnot.LayerOverride
OverRiddenFlag = False
If CBool(swDispDim.GetOverride) Then
OverRiddenFlag = True
End If
''''Delete the section from here to "END OF SECTION TO DELETE" to only
''''color dimensions with the "Override" box checked
If CBool(swDispDim.ShowDimensionValue) Then
'do nothing
Else
OverRiddenFlag = True
End If
''''END OF SECTION TO DELETE
If (OverRiddenFlag And (KillFlag = vbYes)) Then
If CurAnnotOverrides Mod 2 <> 1 Then
swAnnot.LayerOverride = CurAnnotOverrides + 1
End If
swAnnot.Color = OVERRIDDENDIMCOLOR
Else
If CurAnnotOverrides Mod 2 = 1 Then
swAnnot.LayerOverride = CurAnnotOverrides - 1
End If
End If
Set swDispDim = swDispDim.GetNext5
Wend
Set swView = swView.GetNextView
Wend


End Sub

 

[handleman]

You may need to add:

Dim i as Long

up at the very top along with all the other Dim statements.

-handleman, CSWP (The new, easy test)

 

[DiegoLGraves]

handleman, thank you, adding the Dim statement worked great.

I appreciate your help. Diego