How do I create a macro to find dangling dimensions?
How do I create a macro to find dangling dimensions?
(OP)
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.






RE: How do I create a macro to find dangling dimensions?
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)
RE: How do I create a macro to find dangling dimensions?
http://www.EsoxRepublic.com-SolidWorks API VB programming help
RE: How do I create a macro to find dangling dimensions?
RE: How do I create a macro to find dangling dimensions?
RE: How do I create a macro to find dangling dimensions?
-handleman, CSWP (The new, easy test)
RE: How do I create a macro to find dangling dimensions?
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.
RE: How do I create a macro to find dangling dimensions?
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)
RE: How do I create a macro to find dangling dimensions?
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!
CODE
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)
RE: How do I create a macro to find dangling dimensions?
Thank you so much.
RE: How do I create a macro to find dangling dimensions?
RE: How do I create a macro to find dangling dimensions?
Do you know why and what I would do to correct this? I'm running SW14 sp 4.0.
Thanks, Diego
RE: How do I create a macro to find dangling dimensions?
-handleman, CSWP (The new, easy test)
RE: How do I create a macro to find dangling dimensions?
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
RE: How do I create a macro to find dangling dimensions?
Dim i as Long
up at the very top along with all the other Dim statements.
-handleman, CSWP (The new, easy test)
RE: How do I create a macro to find dangling dimensions?
I appreciate your help. Diego