Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Dim swApp As SldWorks.SldWorks
- Dim swModel As SldWorks.ModelDoc2
- Dim swDraw As DrawingDoc
- Dim swRefModel As SldWorks.ModelDoc2
- Dim swView As SldWorks.View
- Dim lerr As Long
- Dim bstatus As Boolean
- Dim allSheetViewArrays As Variant
- Dim sheetViews As Variant
- Dim swNote As Note
- Dim swConfig As Configuration
- Dim BOM_PN As String
- Dim assembly As SldWorks.AssemblyDoc
- Dim swExtension As ModelDocExtension
- Dim cusPropMgr As SldWorks.CustomPropertyManager
- Sub main()
- Set swApp = Application.SldWorks
- Set swModel = swApp.ActiveDoc
- MsgBox "Doing stuff"
- If swModel.GetType <> swDocDRAWING Then
- Msg = "Only Allowed on Drawings" ' Define message
- Style = vbOKOnly ' OK Button only
- Title = "Error" ' Define title
- Call MsgBox(Msg, Style, Title) ' Display error message
- Exit Sub ' Exit this program
- End If
- Set swDraw = swModel
- allSheetViewArrays = swDraw.GetViews
- For i = 0 To UBound(allSheetViewArrays)
- sheetViews = allSheetViewArrays(i)
- For j = 0 To UBound(sheetViews)
- Set swView = sheetViews(j)
- Set swRefModel = swView.ReferencedDocument
- Dim componentCunt As Integer
- Dim components As Variant
- Dim component As Component2
- Dim swModelPart As SldWorks.ModelDoc2
- Dim longstatus As Long
- Dim boolstatus As Boolean
- Dim swAnn As Annotation
- If Not swRefModel Is Nothing Then
- If swRefModel.GetType = swDocASSEMBLY Then
- componentCount = swRefModel.GetComponentCount(True)
- components = swRefModel.GetComponents(False)
- For k = LBound(components) To UBound(components)
- Set component = components(k)
- Set swModelPart = component.GetModelDoc2
- If swModelPart.GetType = swDocPART Then
- Set swConfig = swModelPart.GetActiveConfiguration
- Set cusPropMgr = swConfig.CustomPropertyManager
- Set swNote = swRefModel.InsertNote("note my friend")
- If Not swNote Is Nothing Then
- swNote.LockPosition = False
- swNote.Angle = 0
- boolstatus = swNote.SetBalloon(9, 0)
- Set swAnn = swNote.GetAnnotation()
- End If
- End If
- Next k
- End If
- End If
- Set swView = swView.GetNextView
- Next j
- Next i
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement