Extracting data from your drawing using a Macro?
Extracting data from your drawing using a Macro?
(OP)
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
Thanks~
Art
SolidWorks 2004






RE: Extracting data from your drawing using a Macro?
'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
RE: Extracting data from your drawing using a Macro?
RE: Extracting data from your drawing using a 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
RE: Extracting data from your drawing using a Macro?