CATIA V5 Automation Detailed Steps(基于VB的catia二次开发代码)

CATIA V5 Automation Detailed Steps(基于VB的catia二次开发代码) CATIA V5 Automation CATIA V5 Automation Detailed StepsDetailed Steps Table of Contents Views.vbp ..........................................................................................................................................3 PartDesign.vbp ...................................................................................................................................5 ShapeDesign.vbp ...............................................................................................................................8 Assembly.vbp ...................................................................................................................................12 Drafting.vbp......................................................................................................................................15 GetPoint.vbp ....................................................................................................................................18 TestSelections.vbp ...........................................................................................................................20 Views.vbp Option Explicit Dim CATIA As INFITF.Application Dim myDoc As PartDocument Private Sub Command1_Click() On Error Resume Next Set CATIA = GetObject(, "CATIA.Application") If Err.Number <> 0 Then Set CATIA = CreateObject("CATIA.Application") CATIA.Visible = True End If On Error GoTo 0 ' Opening Bolt.CATPart Dim myDir As String myDir = App.Path Set myDoc = CATIA.Documents.Open(myDir & "\Bolt.CATPart") Dim myViewer3 As Viewer3D Dim myViewPoint As Viewpoint3D ' Getting the active Viewer Set myViewer3 = CATIA.ActiveWindow.ActiveViewer myViewer3.RenderingMode = catRenderShading Dim myCam3d As Camera3D Dim i As Integer ' Display the number of defined cameras. MsgBox myDoc.Cameras.Count ' Scaning all the cameras of the document For i = 1 To myDoc.Cameras.Count Set myCam3d = myDoc.Cameras.Item(i) ' Modifying the Viewpoint3D of the active viewer myViewer3.Viewpoint3D = myCam3d.Viewpoint3D myViewer3.Reframe myViewer3.ZoomIn myViewer3.Update MsgBox myCam3d.Name Next ' Selecting the front camera Set myCam3d = myDoc.Cameras.Item("* front") myViewer3.Viewpoint3D = myCam3d.Viewpoint3D ' Saving the document If MsgBox("Save Bolt2", vbOKCancel) = vbOK Then On Error Resume Next Kill (myDir & "\Bolt2.CATPart") Call myDoc.SaveAs(myDir & "\Bolt2.CATPart") Call myDoc.Close On Error GoTo 0 End If End Sub PartDesign.vbp Option Explicit Dim CATIA As INFITF.Application Private Sub Command1_Click() On Error Resume Next Set CATIA = GetObject(, "CATIA.Application") If Err.Number <> 0 Then Set CATIA = CreateObject("CATIA.Application") CATIA.Visible = True End If On Error GoTo 0 ' Creating a new Part Dim MyDoc As PartDocument Set MyDoc = CATIA.Documents.Add("Part") ' Getting the default Body called "MechanicalTool.1" (internal name) Dim myBody As Body Set myBody = MyDoc.Part.Bodies.Item("MechanicalTool.1") ' Activating the body as the "InWorkObject" MyDoc.Part.InWorkObject = myBody ' Creating a reference on XY plane Dim ReferencePlane As Reference Set ReferencePlane = MyDoc.Part.CreateReferenceFromGeometry(MyDoc.Part.OriginElements.PlaneXY) ' Creating mySketch1 on XY Plane Dim mySketch1 As Sketch Set mySketch1 = myBody.Sketches.Add(ReferencePlane) ' Opening mySketch1 and getting the factory Dim MyFactory1 As Factory2D Set MyFactory1 = mySketch1.OpenEdition() ' Creating 4 lines Dim l1 As Line2D Dim l2 As Line2D Dim l3 As Line2D Dim l4 As Line2D Set l1 = MyFactory1.CreateLine(10#, 10#, 10#, 30#) Set l2 = MyFactory1.CreateLine(10#, 30#, 40#, 30#) Set l3 = MyFactory1.CreateLine(40#, 30#, 40#, 10#) Set l4 = MyFactory1.CreateLine(40#, 10#, 10#, 10#) mySketch1.CloseEdition ' Creating mySketch2 on XY Plane Dim mySketch2 As Sketch Set mySketch2 = myBody.Sketches.Add(ReferencePlane) ' Opening mySketch2 and getting the factory Dim MyFactory2 As Factory2D Set MyFactory2 = mySketch2.OpenEdition() ' Creating 1 Circle Dim c1 As Circle2D Set c1 = MyFactory2.CreateClosedCircle(40#, 30#, 10#) mySketch2.CloseEdition ' Getting the shapeFactory Dim MyFact As ShapeFactory Set MyFact = MyDoc.Part.ShapeFactory ' Creating a pad Dim myPad As Pad Set myPad = MyFact.AddNewPad(mySketch1, 20) ' Creating a Pocket Dim myPok As Pocket Set myPok = MyFact.AddNewPocket(mySketch2, -20) MyDoc.Part.Update ' Reframing the window on the part CATIA.ActiveWindow.ActiveViewer.Reframe End Sub ShapeDesign.vbp Option Explicit Dim CATIA As INFITF.Application Private Sub Command1_Click() On Error Resume Next Set CATIA = GetObject(, "CATIA.Application") If Err.Number <> 0 Then Set CATIA = CreateObject("CATIA.Application") CATIA.Visible = True End If On Error GoTo 0 Dim myPartDocument As PartDocument Set myPartDocument = CATIA.Documents.Add("Part") Dim myPart As Part Set myPart = myPartDocument.Part 'Creating an Open_body if not already existing On Error Resume Next Dim myHybridBody As HybridBody Set myHybridBody = myPart.HybridBodies.Item("Open_body.1") If myHybridBody Is Nothing Then Set myHybridBody = myPart.HybridBodies.Add End If On Error GoTo 0 Dim MyHSFact As HybridShapeFactory Set MyHSFact = myPart.HybridShapeFactory myPart.Update ' Creating 6 Points Dim HyPt1 As HybridShapePointCoord Dim HyPt2 As HybridShapePointCoord Dim HyPt3 As HybridShapePointCoord Dim HyPt4 As HybridShapePointCoord Dim HyPt5 As HybridShapePointCoord Dim HyPt6 As HybridShapePointCoord Set HyPt1 = MyHSFact.AddNewPointCoord(10#, 60#, 30#) Set HyPt2 = MyHSFact.AddNewPointCoord(70#, 75#, 35#) Set HyPt3 = MyHSFact.AddNewPointCoord(100#, 80#, 30#) Set HyPt4 = MyHSFact.AddNewPointCoord(100#, 80#, 40#) Set HyPt5 = MyHSFact.AddNewPointCoord(95#, 20#, 45#) Set HyPt6 = MyHSFact.AddNewPointCoord(100#, 10#, 50#) ' Creating references on the points Dim R1 As Reference Dim R2 As Reference Dim R3 As Reference Dim R4 As Reference Dim R5 As Reference Dim R6 As Reference Set R1 = myPart.CreateReferenceFromGeometry(HyPt1) Set R2 = myPart.CreateReferenceFromGeometry(HyPt2) Set R3 = myPart.CreateReferenceFromGeometry(HyPt3) Set R4 = myPart.CreateReferenceFromGeometry(HyPt4) Set R5 = myPart.CreateReferenceFromGeometry(HyPt5) Set R6 = myPart.CreateReferenceFromGeometry(HyPt6) Dim myControlPoint As HybridShapeControlPoint ' We can reuse the same variable: 'myControlPoint' ' Creating first Spline Dim HyLine1 As HybridShapeSpline Set HyLine1 = MyHSFact.AddNewSpline HyLine1.SetSplineType 0 HyLine1.SetClosing 0 ' Adding the control points Set myControlPoint = MyHSFact.AddNewControlPoint(R1) HyLine1.AddControlPoint myControlPoint Set myControlPoint = MyHSFact.AddNewControlPoint(R2) HyLine1.AddControlPoint myControlPoint Set myControlPoint = MyHSFact.AddNewControlPoint(R3) HyLine1.AddControlPoint myControlPoint ' Creating second Spline Dim HyLine2 As HybridShapeSpline Set HyLine2 = MyHSFact.AddNewSpline Call HyLine2.SetSplineType(0) Call HyLine2.SetClosing(0) Set myControlPoint = MyHSFact.AddNewControlPoint(R4) HyLine2.AddControlPoint myControlPoint Set myControlPoint = MyHSFact.AddNewControlPoint(R5) HyLine2.AddControlPoint myControlPoint Set myControlPoint = MyHSFact.AddNewControlPoint(R6) HyLine2.AddControlPoint myControlPoint Dim Ref1 As Reference Dim Ref2 As Reference ' Creating a Sweep Set Ref1 = myPart.CreateReferenceFromGeometry(HyLine1) Set Ref2 = myPart.CreateReferenceFromGeometry(HyLine2) Dim HybridShapeSweepExplicit1 As HybridShapeSweepExplicit Set HybridShapeSweepExplicit1 = MyHSFact.AddNewSweepExplicit(Ref1, Ref2) 'myHybridBody.AppendHybridShape HyLine1 'myHybridBody.AppendHybridShape HyLine2 myHybridBody.AppendHybridShape HybridShapeSweepExplicit1 ' Creating a 3D Point Dim HyPt7 As HybridShapePointCoord Set HyPt7 = MyHSFact.AddNewPointCoord(50#, 30#, 100#) myHybridBody.AppendHybridShape HyPt7 ' Creating the projection of "HyPt7" on the surface "HybridShapeSweepExplicit1" Dim Ref3 As Reference Dim Ref4 As Reference Set Ref3 = myPart.CreateReferenceFromGeometry(HyPt7) Set Ref4 = myPart.CreateReferenceFromGeometry(HybridShapeSweepExplicit1) Dim HybridShapeProject1 As HybridShapeProject Set HybridShapeProject1 = MyHSFact.AddNewProject(Ref3, Ref4) myHybridBody.AppendHybridShape HybridShapeProject1 myPart.Update End Sub Assembly.vbp Option Explicit Dim CATIA As Object Private Sub Command1_Click() Dim i As Integer ReDim myNames(1) 'As String On Error Resume Next Set CATIA = GetObject(, "CATIA.Application") If Err.Number <> 0 Then Set CATIA = CreateObject("CATIA.Application") CATIA.Visible = True End If On Error GoTo 0 Dim myDir As String myDir = App.Path ' Creating the root product Dim Titanic 'As ProductDocument Set Titanic = CATIA.Documents.Add("Product") ' Creating the hull at level 1 myNames(0) = myDir + "\Hull.CATPart" Call Titanic.Product.Products.AddComponentsFromFiles(myNames, "*") Titanic.Product.PartNumber = "Titanic" Dim assy1 'As Product ' Creating sub-product "ass1" at level 1 'New Product not associated with a ProductDocument file Set assy1 = Titanic.Product.Products.AddNewProduct("ass1") ' Creating the Castle under "ass1" at level 2 myNames(0) = myDir + "\Castle.CATPart" Call assy1.Products.AddComponentsFromFiles(myNames, "*") ' Creating the Funnel under "ass1" at level 2 myNames(0) = myDir + "\Funnel.CATPart" Call assy1.Products.AddComponentsFromFiles(myNames, "*") Titanic.Product.Update Dim Ass1RefProduct 'As Product Set Ass1RefProduct = assy1.ReferenceProduct ' Creating 2nd instance of subproduct "ass1" at level 1 Dim Product2 'As Product Set Product2 = Titanic.Product.Products.AddComponent(Ass1RefProduct) 'Creating the transformation matrix ReDim var1(11) var1(0) = 1# var1(1) = 0# var1(2) = 0# var1(3) = 0# var1(4) = 1# var1(5) = 0# var1(6) = 0# var1(7) = 0# var1(8) = 1# var1(9) = 60# ' translation along X var1(10) = 0# ' translation along Y var1(11) = 0# ' translation along Z ' Moving the instance Product2.Move.Apply var1 ' Creating 3rd instance of "ass1" at level 1 Dim Product3 'As Product Set Product3 = Titanic.Product.Products.AddComponent(Ass1RefProduct) var1(9) = 120# ' translation along X ' Moving the instance Product3.Move.Apply var1 ' Creating the Bill Of Material in the file TitanicBOM.txt Call Titanic.Product.ExtractBOM(catFileTypeText, myDir & "\TitanicBOM.txt") End Sub Drafting.vbp Option Explicit Dim CATIA As INFITF.Application Private Sub Command1_Click() Dim i As Integer On Error Resume Next Set CATIA = GetObject(, "CATIA.Application") If Err.Number <> 0 Then Set CATIA = CreateObject("CATIA.Application") CATIA.Visible = True End If Dim myDir As String myDir = App.Path ' Opening "Bolt.CATPart" file Dim MyPartDoc As PartDocument Set MyPartDoc = CATIA.Documents.Open(myDir & "\Bolt.CATPart") ' Opening "TitleBlock.CATDrawing" file Dim MyDrawDoc As DrawingDocument Set MyDrawDoc = CATIA.Documents.Open(myDir & "\TitleBlock.CATDrawing") Dim mySheet As DrawingSheet Set mySheet = MyDrawDoc.Sheets.ActiveSheet ' Creating the first view (Front View) Dim myView1 As DrawingView Set myView1 = mySheet.Views.Add("Front View") Call myView1.Activate ' Translating the front view (A0: 840mm X 1188mm) myView1.x = 400 myView1.y = 150 ' Defining the front view Dim myGeneB1 As DrawingViewGenerativeBehavior Set myGeneB1 = myView1.GenerativeBehavior myGeneB1.Document = MyPartDoc Call myGeneB1.DefineFrontView(1#, 0#, 0#, 0#, 1#, 0#) ' Creating a circle Call myView1.Activate Dim myFact1 As Factory2D Set myFact1 = myView1.Factory2D Dim c1 As Circle2D Set c1 = myFact1.CreateClosedCircle(30, 30, 10) myGeneB1.Update ' Creating the second view (Top View) Dim myView2 As DrawingView Set myView2 = mySheet.Views.Add("Top View") ' Translating the top view myView2.x = 400 myView2.y = 600 ' Defining the Projection view Dim myGeneB2 As DrawingViewGenerativeBehavior Set myGeneB2 = myView2.GenerativeBehavior Call myGeneB2.DefineProjectionView(myGeneB1, catTopView) myGeneB2.Document = MyPartDoc ' Creating a circle Call myView2.Activate Dim myFact2 As Factory2D Set myFact2 = myView2.Factory2D Dim c2 As Circle2D Set c2 = myFact2.CreateClosedCircle(30, 30, 20) myGeneB2.Update MyDrawDoc.Update End Sub GetPoint.vbp Class1.cls 'local variable(s) to hold property value(s) Private mvarX As Double 'local copy Private mvarY As Double 'local copy Private mvarZ As Double 'local copy Public Sub Start() Dim f As New Form1 ' Setting the default HScroll values f.HScroll1.Value = mvarX f.HScroll2.Value = mvarY f.HScroll3.Value = mvarZ ' Display the form window and Wait until the user click OK. f.Show vbModal ' Getting the HScroll values mvarX = f.HScroll1.Value mvarY = f.HScroll2.Value mvarZ = f.HScroll3.Value Set f = Nothing End Sub Public Property Let X(ByVal vData As Double) mvarX = vData End Property Public Property Get X() As Double X = mvarX End Property Public Property Let Y(ByVal vData As Double) mvarY = vData End Property Public Property Get Y() As Double Y = mvarY End Property Public Property Let Z(ByVal vData As Double) mvarZ = vData End Property Public Property Get Z() As Double Z = mvarZ End Property Form1.frm Private Sub HScroll1_Change() Label4.Caption = Str(HScroll1.Value) End Sub Private Sub HScroll2_Change() Label5.Caption = Str(HScroll2.Value) End Sub Private Sub HScroll3_Change() Label6.Caption = Str(HScroll3.Value) End Sub Private Sub OK_Click() Me.Hide End Sub TestSelections.vbp Option Explicit Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Const SWP_NOMOVE = &H2 Private Const SWP_NOSIZE = &H1 Private Const HWND_TOPMOST = -1 Private Const HWND_NOTOPMOST = -2 Dim xPt1 'As Point2D Dim xPt2 'As Point2D Dim xLine1 'As Line2D Dim xPt3d1 'As Point Dim xPt3d2 'As Point Dim CATIA As Object Dim xSel 'As INFITF.Selection Private Sub Command1_Click() ReDim Coord1(1) As Variant On Error Resume Next ' Getting the first 2D Point Set xSel = CATIA.ActiveDocument.Selection Set xPt1 = xSel.FindObject("CATIAPoint2D") If Err = 0 Then ' Display the "CATIAPoint2D" name and coordinates xPt1.GetCoordinates Coord1 Text1.Text = xPt1.Name & " (" & Coord1(0) & "," & Coord1(1) & ")" End If End Sub Private Sub Command2_Click() ReDim Coord2(1) As Variant On Error Resume Next ' Getting the second 2D Point Set xSel = CATIA.ActiveDocument.Selection Set xPt2 = xSel.FindObject("CATIAPoint2D") If Err = 0 Then ' Display the Point name and its coordinates xPt2.GetCoordinates Coord2 Text2 = xPt2.Name & " (" & Coord2(0) & "," & Coord2(1) & ")" End If End Sub Private Sub Command3_Click() On Error Resume Next ' Getting a 2D Line Set xSel = CATIA.ActiveDocument.Selection Set xLine1 = xSel.FindObject("CATIALine2D") If Err = 0 Then ' Display the 2D Line name Text3 = xLine1.Name End If End Sub Private Sub Command4_Click() ' Create 3 lines : ' - from xPt1 to xpt2 ' - from xPt1 to StartPoint of xLine1 ' - from xPt1 to EndPoint of xLine1 Dim r1 As INFITF.Reference Dim r2 As INFITF.Reference Dim xPt3 Dim xPt4 Dim l1, l2, l3 'As Line2D ReDim Coord1(1) As Variant ReDim Coord2(1) As Variant ReDim Coord3(1) As Variant ReDim Coord4(1) As Variant On Error Resume Next xPt1.GetCoordinates Coord1 xPt2.GetCoordinates Coord2 Set xPt3 = xLine1.StartPoint xPt3.GetCoordinates Coord3 Set xPt4 = xLine1.EndPoint xPt4.GetCoordinates Coord4 Dim d 'As DrawingDocument or PartDocument Dim f 'As Factory2D Dim n 'As String ' Testing if those 2D elements are in a drawing or in a sketch Set d = CATIA.Application.ActiveDocument If TypeName(d) = "PartDocument" Then 'We are in a sketch Dim sk 'As Sketch ' Getting the Factory2D and creating lines Set sk = xPt1.Parent.Parent Set f = sk.Factory2D l1 = f.CreateLine(Coord1(0), Coord1(1), Coord2(0), Coord2(1)) l2 = f.CreateLine(Coord1(0), Coord1(1), Coord3(0), Coord3(1)) l3 = f.CreateLine(Coord1(0), Coord1(1), Coord4(0), Coord4(1)) ElseIf TypeName(d) = "DrawingDocument" Then ' We are in a drawing Dim v 'As DrawingView ' Getting the Factory2D and creating lines Set v = d.Sheets.ActiveSheet.Views.ActiveView Set f = v.Factory2D l1 = f.CreateLine(Coord1(0), Coord1(1), Coord2(0), Coord2(1)) l2 = f.CreateLine(Coord1(0), Coord1(1), Coord3(0), Coord3(1)) l3 = f.CreateLine(Coord1(0), Coord1(1), Coord4(0), Coord4(1)) End If End Sub Private Sub Command7_Click() ' Creating a line in the 3D space. Dim r1 'As INFITF.Reference Dim r2 'As INFITF.Reference Dim Line3d1 Dim d 'As PartDocument Dim dd 'As DrawingDocument Dim p 'As Part Dim b 'As Body Dim hb 'As HybridBody Dim f 'As ShapeFactory Dim fh 'As HybridShapeFactory Dim f2d 'As Factory2D Dim n As String Dim typdoc As String On Error Resume Next Set xSel = CATIA.ActiveDocument.Selection ' Getting first point Set xPt3d1 = xSel.FindObject("CATIAHybridShapePoint") If Err = 0 Then ' Getting second point Set xPt3d2 = xSel.FindObject("CATIAHybridShapePoint") End If If Err <> 0 Then MsgBox "Select two Points in the 3D space" Exit Sub End If Set d = CATIA.Application.ActiveDocument typdoc = TypeName(d) If typdoc = "PartDocument" Then 'Getting the HybridShapeFactory Set p = d.Part Set f = p.ShapeFactory Set fh = p.HybridShapeFactory Set r1 = p.CreateReferenceFromGeometry(xPt3d1) Set r2 = p.CreateReferenceFromGeometry(xPt3d2) ' Creating the line Set Line3d1 = fh.AddNewLinePtPt(r1, r2) p.HybridBodies.Item(1).AppendHybridShape Line3d1 n = Line3d1.Name p.Update Else MsgBox "This is not a Part Document" End If End Sub Private Sub Command8_Click() ReDim Coord2(1) As Variant ReDim Coord3(2) As Variant Dim xPt List1.Clear On Error Resume Next ' Displaying all the "CATIAPoint2D" name and cordinates in the ListBox Set xSel = CATIA.ActiveDocument.Selection Do While Err = 0 Set xPt = xSel.FindObject("CATIAPoint2D") If Err = 0 Then xPt.GetCoordinates Coord2 List1.AddItem ("2d:" & xPt.Name & " (" & Coord2(0) & "," & Coord2(1) & ")") End If Loop Err = 0 ' Displaying all the "CATIAHybridShapePoint" name and coordiantes in the listBox Do While Err = 0 Set xPt = xSel.FindObject("CATIAHybridShapePoint") If Err = 0 Then xPt.GetCoordinates Coord3 List1.AddItem ("3d:" & xPt.Name & " (" & Coord3(0) & "," & Coord3(1) & "," & Coord3(2) & ")") End If Loop End Sub Private Sub Command9_Click() On Error Resume Next ' Highlighting in CATIA the elements corresponding to "text6.text" Set xSel = CATIA.ActiveDocument.Selection xSel.Search ("name:" & Text6.Text) End Sub Private Sub Form_Load() ' Displaying the Form1 window "on top" SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE On Error Resume Next ' Launching CATIA Set CATIA = GetObject(, "CATIA.Application") If Err.Number <> 0 Then Set CATIA = CreateObject("CATIA.Application") CATIA.Visible = True End If On Error GoTo 0 End Sub