Extracting data from your drawing using a Macro?

[a0r0t]

Can one create a Macro that would extract data (dimensions, tolerances, maybe even notes) from a drawing and place it in an Excel Spreadsheet? Does anyone have anything like this that they would be willing to share?

Thanks~


Art

SolidWorks 2004

 

[aamoroso]

This will create a file on your C:drive called Annotations If I had more time I would try to get it to excel but this will open in note pad.

'Paste the following code into a new macro file
'Paste the following code into a new macro file

Global swApp As Object
Global Document As Object
Global boolstatus As Boolean
Global longstatus As Long
Global SelMgr As Object
Global PickPt As Variant
Global Const swDocDRAWING = 3


Sub main()
Set swApp = Application.SldWorks
Set Document = swApp.ActiveDoc
If Document Is Nothing Then
MsgBox "No model loaded."
Else

FileTyp = Document.GetType ' Get type
If FileTyp = swDocDRAWING Then ' If doc = drawing ?
SheetNames = Document.GetSheetNames ' Get sheet names
Document.EditTemplate
Document.EditSketch
Document.ClearSelection2 True

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\annotations.txt", True)
For i = 0 To Document.GetSheetCount - 1
Document.ActivateSheet (SheetNames(i))
Set View = Document.GetFirstView ' Get first view
Set Annotation = View.GetFirstAnnotation2 ' Get first annot
While Not Annotation Is Nothing 'When a valid annotation is found
If Annotation.GetType = swNote Then 'Check if annotation a Note
Set note = Annotation.GetSpecificAnnotation
revnoteval = note.GetText
a.WriteLine "note=" & revnoteval
End If
Set Annotation = Annotation.GetNext2 ' Next annotation
Document.DeleteSelection True ' Delete selection
Wend ' View is valid
Next i ' Next sheet
If i > 0 Then ' More than 1 sheet
Document.ActivateSheet (SheetNames(0)) ' back to 1st sheet
End If
End If
End If
Document.EditSheet
Document.ForceRebuild
a.Close

End Sub

 

[aamoroso]

This file will overwrite itself each time the macro is run. I probably should have thrown that information in there.

 

[a0r0t]

I created a new macro and inserted your text into the macro window. I'm new to SW and creating macros, what must I do next to run the macro?

I appreciate your help.


Is this correct?



Dim swApp As Object
Sub main()
Global swApp As Object
Global Document As Object
Global boolstatus As Boolean
Global longstatus As Long
Global SelMgr As Object
Global PickPt As Variant
Global Const swDocDRAWING = 3


Sub main()
Set swApp = Application.SldWorks
Set Document = swApp.ActiveDoc
If Document Is Nothing Then
MsgBox "No model loaded."
Else

FileTyp = Document.GetType ' Get type
If FileTyp = swDocDRAWING Then ' If doc = drawing ?
SheetNames = Document.GetSheetNames ' Get sheet names
Document.EditTemplate
Document.EditSketch
Document.ClearSelection2 True

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\annotations.txt", True)
For i = 0 To Document.GetSheetCount - 1
Document.ActivateSheet (SheetNames(i))
Set View = Document.GetFirstView ' Get first view
Set Annotation = View.GetFirstAnnotation2 ' Get first annot
While Not Annotation Is Nothing 'When a valid annotation is found
If Annotation.GetType = swNote Then 'Check if annotation a Note
Set note = Annotation.GetSpecificAnnotation
revnoteval = note.GetText
a.WriteLine "note=" & revnoteval
End If
Set Annotation = Annotation.GetNext2 ' Next annotation
Document.DeleteSelection True ' Delete selection
Wend ' View is valid
Next i ' Next sheet
If i > 0 Then ' More than 1 sheet
Document.ActivateSheet (SheetNames(0)) ' back to 1st sheet
End If
End If
End If
Document.EditSheet
Document.ForceRebuild
a.Close

End Sub
Set swApp = Application.SldWorks
End Sub

 

[aamoroso]

Delete the first two lines and the last two lines. To run the macro: In SolidWorks, Click on Tools, Macros, Run and then browse to your macro. Then just go to your C drive to find the file annotations.txt To put the file elsewhere just change the path of the file inside the macro.