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
Comments
0 B
|0 👍
/0 👎
0 B
|👍
/👎