Code:
Sub CATMain()Dim productDocument1 As Document
Set productDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = productDocument1.Selection
selection1.Search "CATPrtSearch.MechanicalFeature,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 211, 178, 125, 1 'rgba(211,178,125,255)
Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
visProperties1.SetRealOpacity 255, 1
selection1.Clear
selection1.Search "CATAsmSearch.Part,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 211, 178, 125, 1 'rgba(211,178,125,255)
Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
visProperties1.SetRealOpacity 255, 1
selection1.Clear
selection1.Search "((((((FreeStyle.Curve + '2D Layout for 3D Design'.Curve) + Sketcher.Curve) + Drafting.Curve) + 'Part Design'.Curve) + 'Generative Shape Design'.Curve) + 'Functional Molded Part'.Curve),all"
If selection1.Count <> 0 Then selection1.Delete
selection1.Clear
selection1.Search "(((FreeStyle.'Geometrical Set' + 'Part Design'.'Geometrical Set') + 'Generative Shape Design'.'Geometrical Set') + 'Functional Molded Part'.'Geometrical Set'),all"
If selection1.Count <> 0 Then
Dim oGS As HybridBody
Dim oCol As New VBA.Collection
For i = 1 To selection1.Count
Set oGS = selection1.Item(i).Value
If oGS.HybridShapes.Count = 0 And oGS.HybridBodies.Count = 0 Then
oCol.Add oGS
End If
Next
selection1.Clear
If oCol.Count <> 0 Then
For j = 1 To oCol.Count
selection1.Add oCol.Item(j)
Next
selection1.Delete
End If
End If
selection1.Clear
Dim specsAndGeomWindow1 As Window
Set specsAndGeomWindow1 = CATIA.ActiveWindow
Dim viewer3D1 As Viewer
Set viewer3D1 = specsAndGeomWindow1.ActiveViewer
viewer3D1.Reframe
Dim viewpoint3D1 As Viewpoint3D
Set viewpoint3D1 = viewer3D1.Viewpoint3D
MsgBox ("Done!")
End Sub
Foren auf CAD.de
| 
