This macro deletes all dangling dimensions from all sheets in the active drawing document.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 |
' Delete all dangling dimensions ' Conditions = Active document must be drawing ' Results = Dangling dimensions deleted ' www.bluebyte.biz Dim swApp As Object Dim swModel As Object Dim swDraw As Object Dim swSheet As Object Dim swView As Object Dim boolstatus As Boolean Dim swAnn As Object Dim swDispDim As Object Dim vSheetNames As Variant Public Enum swDocumentTypes_e swDocNONE = 0 ' Used to be TYPE_NONE swDocPART = 1 ' Used to be TYPE_PART swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY swDocDRAWING = 3 ' Used to be TYPE_DRAWING End Enum Sub main() Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc If swModel Is Nothing Then swApp.SendMsgToUser ("Macro failed because there is no active drawing document.") ElseIf swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then swApp.SendMsgToUser ("Macro failed because active document is not a drawing.") Else Set swDraw = swModel swModel.ClearSelection2 (True) vSheetNames = swDraw.GetSheetNames For i = 0 To UBound(vSheetNames) swDraw.ActivateSheet vSheetNames(i) Set swSheet = swDraw.Sheet(vSheetNames(i)) Set swView = swDraw.GetFirstView Do While Not swView Is Nothing Set swAnn = swView.GetFirstAnnotation3 Do While Not swAnn Is Nothing If swAnn.IsDangling Then swAnn.Select2 True, -1 End If Set swAnn = swAnn.GetNext3 Loop Set swView = swView.GetNextView Loop boolstatus = swModel.DeleteSelection(True) If boolstatus Then swModel.ClearSelection2 (True) End If Next i End If End Sub |