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
本文档为【CATIA V5 Automation Detailed Steps(基于VB的catia二次开发代码)】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑,
图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
该文档来自用户分享,如有侵权行为请发邮件ishare@vip.sina.com联系网站客服,我们会及时删除。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。