catia二次开发：检查文件类型 检查部件类型 产品名称 通过交互选择约束两个零件轴系重合 添加自定义属性,MasterShapeRepresentation

检查文件类型

InStr函数作用是检查字符串，开始于第几个字符。

检查部件类型

产品名称

通过交互选择约束两个零件轴系重合

Sub CATMain()

CATIA.DisplayFileAlerts = False
    Dim Message, Style, Title, Response, MyString
    Message = ("This macro will constrain Part-A to Part-B" & _
                            (Chr(13)) & _
                         "  - The active document must be a CATProduct" & _
                            (Chr(13)) & _
                        "   - The first axis selected will be the axis to move" & _
                            (Chr(13)) & _
                        "" & (Chr(13)) & _
"   Do you want to continue ?")
    Style = vbYesNo + vbDefaultButton2    'Define buttons.
    Title = "Purpose "
    Response = MsgBox(Message, Style, Title)
        If Response = vbYes Then    ' User chose Yes.
             MyString = "Yes"


Dim productDocument1 As Document
Set productDocument1 = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = productDocument1.Product

Dim RootProduct As Product
Set RootProduct = productDocument1.Product

Dim selection 'As selection
Set selection = CATIA.ActiveDocument.selection

Dim SelectedAxis(0)

            ReDim sFilter(0)
            MsgBox "Select a local axis "
            sFilter(0) = "AxisSystem"
            sStatus = selection.SelectElement2(sFilter, "select a  local axis", False)

Set SelectedAxis(0) = selection.Item(1).Value
Set Axis1 = selection.Item(1)

Set oProd = selection.FindObject("CATIAProduct")
'可以用Set oProd = selection.Item(1).LeafProduct

Name = InputBox("Input Axis name", "Description", "")
Axis1.Value.Name = (Name)

Sel1 = Axis1.Value.Name
Sel2 = RootProduct.Parent.Name
Sel3 = oProd.Name

'Else

'If Response = vbNo Then

selection.Clear

Set selection = CATIA.ActiveDocument.selection

            ReDim sFilter(0)
            MsgBox "Select a local axis "
            sFilter(0) = "AxisSystem"
            sStatus = selection.SelectElement2(sFilter, "select a  local axis", False)

Set SelectedAxis(0) = selection.Item(1).Value
Set Axis1 = selection.Item(1)

Set oProd = selection.FindObject("CATIAProduct")

Name = InputBox("Input Axis name", "Description", "")
Axis1.Value.Name = (Name)

Sel4 = Axis1.Value.Name
Sel5 = RootProduct.Parent.Name
Sel6 = oProd.Name

selection.Clear

Dim constraints1 'As Collection
Set constraints1 = product1.Connections("CATIAConstraints")

Dim reference1 As Reference
Set reference1 = product1.CreateReferenceFromName("" & Sel2 & "/" & Sel3 & "/!" & Sel1 & "")

Dim reference2 As Reference
Set reference2 = product1.CreateReferenceFromName("" & Sel5 & "/" & Sel6 & "/!" & Sel4 & "")

Dim constraint1 As Constraint
Set constraint1 = constraints1.AddBiEltCst(catCstTypeOn, reference2, reference1)

'~ product1.Update ' if you let this line without comment you will have an error due to constrains error in updaze process

CATIA.DisplayFileAlerts = False
    Message = ("Save as IGS file " & _
                        "" & (Chr(13)) & _
"   Do you want to continue ?")
    Style = vbYesNo + vbDefaultButton2    'Define buttons.
    Title = "Purpose "
    Response = MsgBox(Message, Style, Title)
        If Response = vbYes Then

Dim File, Folder, FoleCollection
Dim fso, ff As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set ff = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please select a folder", 0, "c:\\")

Dim tmpStr, strLine As String

If Not ff Is Nothing Then
GetFolder = ff.Items.Item.Path

Else

GetFolder = vbNullString

End If

Set Folder = fso.GetFolder(GetFolder)
Set FileCollection = Folder.Files

MsgBox (Folder)

FN = InputBox("Inupt File Name")
'productDocument1.ExportData "" & Folder & "\" & FN & ".igs", "igs"

Else
    
   If Response = vbNo Then
             MyString = "No"

Exit Sub

   End If
End If
End If
'End If


End Sub

添加自定义属性

MasterShapeRepresentation