Hello
I tried a lot of hacks to get there but nothing worked
I want to remove the wobbly dimensions, on a drawing, automatically via a macro. So I used macro recording for this, but the latter after recording doesn't work when I play it again. She launches herself but doesn't change anything...
Do you have a solution?
Ps: I absolutely want to manage it in VBA via Excel and I'm a novice.
Thank you
The ribs of a piece or those of a drawing?
For one room:
Option Explicit
Dim swModel As SldWorks.ModelDoc2
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim swDispDim As SldWorks.DisplayDimension
Dim swAnn As SldWorks.Annotation
Dim boolstatus As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeat = swModel.FirstFeature
Do While Not swFeat Is Nothing
'Debug.Print " " + swFeat.Name
Set swSubFeat = swFeat.GetFirstSubFeature
Do While Not swSubFeat Is Nothing
' Debug.Print " " + swSubFeat.Name
DeleteFeatureDim swSubFeat
Set swSubFeat = swSubFeat.GetNextSubFeature
Loop
DeleteFeatureDim swFeat
Set swFeat = swFeat.GetNextFeature
Loop
End Sub
Sub DeleteFeatureDim(ByVal swFeat As SldWorks.Feature)
Dim swDispDim As SldWorks.DisplayDimension
Dim swAnn As SldWorks.Annotation
Dim boolstatus As Boolean
Set swDispDim = swFeat.GetFirstDisplayDimension
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
'Debug.Print " [" & swDim.FullName & "] = " & swDim.GetSystemValue2("")
If swAnn.IsDangling Then
boolstatus = swFeat.Select2(False, 0)
swModel.EditSketch
boolstatus = swAnn.Select3(False, Nothing)
boolstatus = swModel.Extension.DeleteSelection2(0)
swModel.InsertSketch2 True
End If
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
Loop
End Sub
For a drawing:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swDraw As DrawingDoc
Dim swSheet As Sheet
Dim swView As View
Dim boolstatus As Boolean
Dim swAnn As Annotation
Dim swDispDim As DisplayDimension
Dim vSheetNames As Variant
Dim i As Integer
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType <> SwConst.swDocumentTypes_e.swDocDRAWING Then Exit Sub
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
boolstatus = swAnn.Select3(True, Nothing)
End If
Set swAnn = swAnn.GetNext3
Loop
Set swView = swView.GetNextView
Loop
boolstatus = swModel.DeleteSelection(True)
swModel.ClearSelection2 (True)
Next
swModel.ClearSelection2 (True)
End Sub
Thank you for your solution but unfortunately, I can't get it to work. The problem probably doesn't come from your solution but more from my skills.
I manage my entire project by Excel macro with the SolidWorks reference tools enabled. I also integrate all the "Dim" and other things into the method because I don't yet master all the subtleties. And I'm looking at your method but I can't understand which parameters need to be modified.
What macro do you use? Piece or drawing?
Macros work as a SolidWorks macro (saved in a swp file). First of all, can you try to see if it works like that?
After the problem can only come from the way it is embedded in the Excel file. Can you attach the file?
I use the macro drawings
I tried to get around my problem by marking the imported dimensions from 3D to 2D, but I'm also a blank...
Unfortunately the for the company this is a sensitive file, so I can only pass you a few snippets. So I was forced to delete a large part of the data, I don't yet practice object-oriented programming but this will be my next step.
I just tested by stupidly copying your macro into a new Solidworks macro file, it runs but there are no results. I took the one for the drawings. I really don't understand what I'm doing wrong...
If you can't join your piece, you can create a cube with a drawing and a wobbly dimension as it is done on your piece. Check that the macro doesn't work on this drawing, then attach the sldprt, slddrw, and swp.
Otherwise you can try this (adapted from https://www.eng-tips.com/faqs.cfm?fid=153 )
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.DrawingDoc
Dim dwgView As SldWorks.View
Dim dispDimension As SldWorks.DisplayDimension
Dim dwgDimension As SldWorks.Dimension
Dim dwgNote As SldWorks.Note
Dim dwgWeld As SldWorks.WeldSymbol
Dim dwgAnnotation As SldWorks.Annotation
Dim attachedEntitiesArray As Variant
Dim attachedEntityTypes As Variant
Dim bRemoveLastFlag As Boolean
Dim s1 As String
Dim sViewName As String, sDwgName As String
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set dwgView = Part.GetFirstView
Do While Not dwgView Is Nothing
'Travserse Through the Dimensions
Set dwgView = dwgView.GetNextView
If Not dwgView Is Nothing Then
sViewName = dwgView.Name
'Travserse through all of the dimensions in this view
Set dispDimension = dwgView.GetFirstDisplayDimension3
Do While Not dispDimension Is Nothing
Set dwgDimension = dispDimension.GetDimension
bRemoveLastFlag = False
If dwgDimension.Value = 0 Then
'Delete the Dimension
If InStr(1, dwgDimension.FullName, "Annotations") Then
'The next dimension must be selected before this one can be removed
bRemoveLastFlag = True
s1 = dwgDimension.Name & "@" & sViewName
End If
End If
Set dispDimension = dispDimension.GetNext3
If bRemoveLastFlag = True Then
Part.SelectByID s1, "DIMENSION", 0, 0, 0
Part.DeleteSelection False
bRemoveLastFlag = False
End If
Loop
'Travserse through all of the reference dimensions in this view
Set dispDimension = dwgView.GetFirstDisplayDimension3
Do While Not dispDimension Is Nothing
Set dwgAnnotation = dispDimension.GetAnnotation
'Only allow this to act on Reference Dimensions
If dwgAnnotation.GetName Like "RD*" Then
attachedEntitiesArray = dwgAnnotation.GetAttachedEntities
attachedEntityTypes = dwgAnnotation.GetAttachedEntityTypes
If IsEmpty(attachedEntitiesArray) Or IsNull(attachedEntitiesArray) Then
'Delete the Ref Dim
bRemoveLastFlag = True
s1 = dwgAnnotation.GetName & "@" & dwgView.Name
ElseIf attachedEntityTypes(0) = 0 Or attachedEntitiesArray(0) Is Nothing Then
'Delete the Ref Dim
bRemoveLastFlag = True
s1 = dwgAnnotation.GetName & "@" & dwgView.Name
ElseIf (UBound(attachedEntitiesArray) + 1) >= 2 Then
If attachedEntityTypes(1) = 0 Or attachedEntitiesArray(1) Is Nothing Then
'Delete the Ref Dim
bRemoveLastFlag = True
s1 = dwgAnnotation.GetName & "@" & dwgView.Name
End If
Else
'Attached
End If
End If
Set dispDimension = dispDimension.GetNext3
If bRemoveLastFlag = True Then
Part.SelectByID s1, "DIMENSION", 0, 0, 0
Part.DeleteSelection False
bRemoveLastFlag = False
End If
Loop
End If
Loop
MsgBox "Done!"
End Sub
I just tested what you gave me. I do have the "Done" that is displayed at the end, but I still have my wobbly rating on the map. I followed your advice to make a simple piece for testing. I enclose it to you.
And here's the situation I'm trying to solve.
I grade all my piercings beforehand but some may become disabled. As a result, the dimensions that are already present are no longer useful, so they are superfluous and wobbly. With my macro, I would like to eliminate the latter.
I tried on your part with SW2016 and the first macro works (not the last one though)
Here it is in swp format
Thank you for its perfect work and I even managed to adapt it for Excel.