I am new to Solidworks VBA (not new to Excel VBA).
I would like to create a macro that adds a balloon to a drawing if two faces of two different parts (or connecting edge between two parts) are selected in a drawing (not in a part or assembly).
For each of the two selected parts in the drawing I would need the custom properties of those parts to be exported to an Excel file.
So in a drawing:
- click on 1 face
- click on 2nd face of different part
- place a balloon on the edge of the two parts (or on the loacation of a third click) with an ascending number
- export the balloon number and the custom properties of the two parts that one balloon refers to.
The code I have so far (a lot comes from this site):
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawModel As SldWorks.ModelDoc2
Dim Sheet As Object
Dim CusPropMgr As CustomPropertyManager
Dim swDwg As SldWorks.drawingDoc
Dim swView As SldWorks.View
Dim vCustPropNames As Variant
Dim strVal As String
Dim strResVal As String
Dim k As Integer
Dim myNote As SldWorks.Note
Dim myAnnotation As SldWorks.Annotation
Dim myTextFormat As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Sub Fire_Event_After_Selection_Made()
'Select two faces, and this macro will create a balloon (hopefully)
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDwg = swApp.ActiveDoc
' Determine the document type
If swModel.GetType = swDocPART Then
'do nothing
ElseIf swModel.GetType = swDocASSEMBLY Then
'do nothing
ElseIf swModel.GetType = swDocDRAWING Then
Set swSelMgr = swModel.SelectionManager
If swSelMgr.GetSelectedObjectCount2(-1) <> 3 Then
MsgBox "You must select 2 entities (excl drawingview), no more, no less"
Exit Sub
Else
Dim selEdge1 As Integer
Dim selEdge2 As Integer
Dim selFace1 As Integer
Dim selFace2 As Integer
Dim selVertice1 As Integer
Dim selVertice2 As Integer
Dim selDrawingview As Integer
'swSelEDGES=1
'swSelFACES=2
'swSelVERTICES=3
'swSelDRAWINGVIEWS = 12
Select Case swSelMgr.GetSelectedObjectType3(1, -1)
Case 1
selEdge1 = 1
Case 2
selFace1 = 2
Case 3
selVertice1 = 3
Case 12
selDrawingview = 12
End Select
Select Case swSelMgr.GetSelectedObjectType3(2, -1)
Case 1
If selEdge1 = 0 Then
selEdge1 = 1
Else: selEdge2 = 1
End If
Case 2
If selFace1 = 0 Then
selFace1 = 2
Else: selFace2 = 2
End If
Case 3
If selVertice1 = 0 Then
selVertice1 = 3
Else: selVertice2 = 3
End If
Case 12
selDrawingview = 12
End Select
Select Case swSelMgr.GetSelectedObjectType3(3, -1)
Case 1
If selEdge1 = 0 Then
selEdge1 = 1
Else: selEdge2 = 1
End If
Case 2
If selFace1 = 0 Then
selFace1 = 2
Else: selFace2 = 2
End If
Case 3
If selVertice1 = 0 Then
selVertice1 = 3
Else: selVertice2 = 3
End If
Case 12
selDrawingview = 12
End Select
If (selEdge1 <> swSelEDGES And selFace1 <> swSelFACES And selVertice1 <> swSelVERTICES) Or (selEdge2 <> swSelEDGES And selFace2 <> swSelFACES And selVertice2 <> swSelVERTICES) Then
MsgBox "You must select only edges, faces or vertices"
Exit Sub
Else
'create balloon:
Set myNote = swModel.InsertNote("1") 'add ascending number for each time this macro runs
If Not myNote Is Nothing Then
myNote.Angle = 0
boolstatus = myNote.SetBalloon(3, 2) 'place hexagon balloon
Set myAnnotation = myNote.GetAnnotation()
If Not myAnnotation Is Nothing Then
longstatus = myAnnotation.SetLeader3(swLeaderStyle_e.swSTRAIGHT, 1, True, False, False, False)
'boolstatus = myAnnotation.SetPosition(X + 0.01, Y + 0.01, Z) 'length and location of balloon needs to be adjusted
boolstatus = myAnnotation.SetTextFormat(0, True, myTextFormat)
End If
End If
'this part is not correct:
'We assume here a simple case of the first view referring to the desired model
'The first view returned is the sheet--we'll skip that one
Set swView = swDwg.GetFirstView
Set swView = swView.GetNextView
Set swDrawModel = swView.ReferencedDocument
'this does not show the custom properties of the selected parts!!!
'To extract a config specific property, give the config name as string
Set CusPropMgr = swDrawModel.Extension.CustomPropertyManager("")
vCustPropNames = CusPropMgr.GetNames
If IsEmpty(vCustPropNames) = False Then
For k = 0 To UBound(vCustPropNames)
CusPropMgr.Get4 vCustPropNames(k), True, strVal, strResVal
Debug.Print k + 1 & ") " & vCustPropNames(k) & " " & strVal & " " & strResVal
Next k
End If
End If
End If
End If
End Sub
Can somebody assist me in this please?
Frank
Because of the persistent refusal to really help me with the questions posed in this post and my eagerness to fulfill my goal and my willingness to help others make progress in writing and understanding VBA, I am very happy to share my completed macro.