Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

3D Experience VBA

Status
Not open for further replies.

Jeremy.H

Student
Feb 2, 2022
2
Hi!
I'm fairly new to VBA, started learning it a couple of hours ago. I have very limited knowledge so excuse the lack of knowledge. I am attempting to find annotations, flagnotes etc in a part and list them but nothing i've tried seems to work. I am also trying to take a screenshot of a capture including the notes using VBA.

This code is what i've hunted and found through different forums

Fist one is for finding annotations but its for solidworks not sure how to make is suitable for 3D Experience
Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension


iAnnoCnt = swModelDocExt.GetAnnotationCount()


If iAnnoCnt > 0 Then


arrAnnotation = swModelDocExt.GetAnnotations()


For i = LBound(arrAnnotation) To UBound(arrAnnotation)


Set swAnnotation = arrAnnotation(i)


IAnnoType = swAnnotation.GetType()


Select Case IAnnoType


Case 1
Debug.Print "Annotation: Thread"


Case 2
Debug.Print "Annotation: Datum Tag"


Case 3
Debug.Print "Annotation: Datum Target Symbol"


Case 4
Debug.Print "Annotation: Display Diamension"


Case 5
Debug.Print "Annotation: Gtol"


Case 6
Debug.Print "Annotation: Note"


Case 7
Debug.Print "Annotation: SFS Symbol"


Case 8
Debug.Print "Annotation: Weld Symbol"


Case 9
Debug.Print "Annotation: Custom Symbol"


Case 10
Debug.Print "Annotation: Dowel Symbol"


Case 11
Debug.Print "Annotation: Leader"


Case 12
Debug.Print "Annotation: Block"


Case 13
Debug.Print "Annotation: Center Mark symbol"


Case 14
Debug.Print "Annotation: Table Annotation"


Case 15
Debug.Print "Annotation: Center Line"


Case 16
Debug.Print "Annotation: Datum Origin"



End Select


Next


End If

End Sub

This second one should be for the captures, not sure how to link my part does not work

'change text to black

'Dim oAnnotationSets As AnnotationSets
'Dim oAnnotationSet As AnnotationSet
'Dim oAnnotations As Annotations
'Dim oAnnotation As Annotation
Dim oSel As Selection
Dim visProperties1 As INFITF.VisPropertySet

Set partDoc = CATIA.ActiveDocument
Set Part = partDoc.Part
Set oAnnotationSets = Part.AnnotationSets
Set oSel = CATIA.ActiveDocument.Selection

'Dim ObjViewer3D As Viewer3D
Set objViewer3D = CATIA.ActiveWindow.ActiveViewer

For IdxSet = 1 To oAnnotationSets.Count
Set oAnnotationSet = oAnnotationSets.Item(IdxSet)
Set oAnnotations = oAnnotationSet.Annotations
For IdxAnnot = 1 To oAnnotations.Count
Set oAnnotation = oAnnotations.Item(IdxAnnot)

If Not oAnnotation Is Nothing Then
With oSel
.Clear
.Add oAnnotation
Call .VisProperties.SetVisibleColor(0, 0, 0, 0)
End With
oAnnotation.ModifyVisu
End If
Next
Next

Im completely new to this, so it could be horribly wrong
Thanks!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor