form1.frm

CATIA二次开发

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "创建圆柱体"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3870
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   3870
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdCreate 
      Caption         =   "创建"
      Height          =   465
      Left            =   1260
      TabIndex        =   4
      Top             =   2250
      Width           =   1320
   End
   Begin VB.TextBox txtDis 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   1980
      TabIndex        =   1
      Text            =   "125"
      Top             =   1035
      Width           =   1185
   End
   Begin VB.TextBox txtCount 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   390
      Left            =   1980
      TabIndex        =   0
      Text            =   "5"
      Top             =   450
      Width           =   1185
   End
   Begin VB.Label lblDis 
      Alignment       =   2  'Center
      Caption         =   "间距："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   390
      Left            =   630
      TabIndex        =   3
      Top             =   1080
      Width           =   1185
   End
   Begin VB.Label lblCount 
      Alignment       =   2  'Center
      Caption         =   "个数："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   390
      Left            =   630
      TabIndex        =   2
      Top             =   495
      Width           =   1185
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ***********************************************************************
'   Purpose:      Create cylinders
'   Assumtions:
'   Author:       SUNNYTECH
'   Languages:    VBScript
'   Locales:      Chinese
'   CATIA Level:  V5R14
' ***********************************************************************

' ***********************************************************************
'   Purpose:      创建圆柱体的主程序
'
'   Inputs:       iCount:   圆柱体的数量
'                 iDis:     圆柱体圆心之间的距离
' ***********************************************************************
Sub CreateCylinder(iCount As Integer, iDis As Integer)
    
    ' --------------------------------------------------------------
    ' 连接到CATIA，如果CATIA未启动，启动它
    ' --------------------------------------------------------------
    Dim CATIA As Object
      
    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

    ' --------------------------------------------------------------
    ' 创建一个零件文档
    ' --------------------------------------------------------------
    Set documents1 = CATIA.Documents
    Set partDocument1 = documents1.Add("Part")
    Set part1 = partDocument1.Part
    Set bodies1 = part1.Bodies
    Set body1 = bodies1.Item("PartBody")

    Dim arrayOfVariantOfDouble1(8)
    arrayOfVariantOfDouble1(0) = 0#
    arrayOfVariantOfDouble1(1) = 0#
    arrayOfVariantOfDouble1(2) = 0#
    arrayOfVariantOfDouble1(3) = 1#
    arrayOfVariantOfDouble1(4) = 0#
    arrayOfVariantOfDouble1(5) = 0#
    arrayOfVariantOfDouble1(6) = 0#
    arrayOfVariantOfDouble1(7) = 1#
    arrayOfVariantOfDouble1(8) = 0#

    X = 0
    For I = 1 To iCount

        ' --------------------------------------------------------------
        ' 创建草图特征
        ' --------------------------------------------------------------
        Set sketches1 = body1.Sketches
        Set originElements1 = part1.OriginElements
        Set reference1 = originElements1.PlaneXY
        Set sketch1 = sketches1.Add(reference1)
        sketch1.SetAbsoluteAxisData arrayOfVariantOfDouble1

        part1.InWorkObject = sketch1

        Set factory2D1 = sketch1.OpenEdition()
        
        Set geometricElements1 = sketch1.GeometricElements
        Set axis2D1 = geometricElements1.Item("AbsoluteAxis")
        Set line2D1 = axis2D1.GetItem("HDirection")
        line2D1.ReportName = 1

        Set line2D2 = axis2D1.GetItem("VDirection")
        line2D2.ReportName = 2

        ' --------------------------------------------------------------
        ' 在草图中创建一个半径为50的圆
        ' --------------------------------------------------------------
        Set circle2D1 = factory2D1.CreateClosedCircle(X, 0#, 50)

        sketch1.CloseEdition

        part1.InWorkObject = body1
        part1.Update

        ' --------------------------------------------------------------
        ' 创建Pad特征
        ' --------------------------------------------------------------
        part1.InWorkObject = body1
        Set shapeFactory1 = part1.ShapeFactory
        Set pad1 = shapeFactory1.AddNewPad(sketch1, 20#)

        part1.Update

        X = X + iDis
    Next

End Sub

' ***********************************************************************
'   Purpose:      单击按纽，以文本框中的数值来创建圆柱体
'
'   Inputs:       txtCount.Text
'                 txtDis.Text
' ***********************************************************************
Private Sub cmdCreate_Click()
    
    CreateCylinder Val(txtCount.Text), Val(txtDis.Text)
    
End Sub