code.bas

CATIA二次开发

Attribute VB_Name = "Module1"
Sub CreateTitanic()

    InitCATIAProduct
    
    '获取Titanic产品文档的根节点
    Dim oTitanic As Product
    Set oTitanic = oProductDoc.Product
    
    '定义Titanic的零部件号和名称
    oTitanic.PartNumber = "Titanic"
    oTitanic.Name = "Steam_Ship_Titanic"
    
    '获取Titanic的Products集合
    Dim oTitanicProducts As Products
    Set oTitanicProducts = oTitanic.Products
    
    '加入hull船体组件
    Dim oHull As Product
    Set oHull = oTitanicProducts.AddNewProduct("Hull_Type")
    oHull.PartNumber = "Titanic's_Hull"
    oHull.Name = "Unsinkable_Hull"
    
    '为hull船体组件添加缺省表达
    oHull.AddMasterShapeRepresentation App.Path & "\Hull.CATPart"
    CATIA.ActiveWindow.ActiveViewer.Reframe
    
    '添加第一个funnel烟囱组件
    Dim oFunnel1 As Product
    Set oFunnel1 = oTitanicProducts.AddNewProduct("Funnel_Type")
    oFunnel1.PartNumber = "Titanic's_Funnel"
    oFunnel1.Name = "Fore_Funnel"
    
    '为funnel烟囱组件添加缺省表达
    oFunnel1.AddMasterShapeRepresentation App.Path & "\Funnel.CATPart"
    
    '定义funnel烟囱组件的位置
    Dim iMatrix(11)
    iMatrix(0) = 1
    iMatrix(1) = 0
    iMatrix(2) = 0
    iMatrix(3) = 0
    iMatrix(4) = 1
    iMatrix(5) = 0
    iMatrix(6) = 0
    iMatrix(7) = 0
    iMatrix(8) = 1
    iMatrix(9) = 0
    iMatrix(10) = 0
    iMatrix(11) = 0
    
    '获取funnel烟囱组件的引用
    Dim oFunnelRef 'As Product
    Set oFunnelRef = oFunnel1.ReferenceProduct
    
    '添加第二个funnel烟囱组件
    Dim oFunnel2 'As Product
    Set oFunnel2 = oTitanicProducts.AddComponent(oFunnelRef)
    oFunnel2.Name = "Second_Funnel"
    '平移funnel烟囱组件
    iMatrix(9) = -40
    oFunnel2.Move.Apply iMatrix
    
    '添加第三个funnel烟囱组件
    Dim oFunnel3 'As Product
    Set oFunnel3 = oTitanicProducts.AddComponent(oFunnelRef)
    oFunnel3.Name = "Third_Funnel"
    '平移funnel烟囱组件
    iMatrix(9) = -80
    oFunnel3.Move.Apply iMatrix
    
    '添加第四个funnel烟囱组件
    Dim oFunnel4 'As Product
    Set oFunnel4 = oTitanicProducts.AddComponent(oFunnelRef)
    oFunnel4.Name = "Fourth_Funnel"
    '平移funnel烟囱组件
    iMatrix(9) = -120
    oFunnel4.Move.Apply iMatrix
    
End Sub