catia 二次开发：查找点和面，代码label,listbox,textbox,右上角关闭失效，vb的第一个小程序

查找点和面

Private Sub CommandButton2_Click()  '查找点和面

Dim productDocument1 As PartDocument '或ProductDocument
Set productDocument1 = CATIA.ActiveDocument

Set selection1 = productDocument1.Selection

If (PointCheck.Value = flase And PlaneCheck.Value = True) Then
selection1.Search "CATPrtSearch.Plane,all"
End If

If (PointCheck.Value = True And PlaneCheck.Value = False) Then
selection1.Search "CATPrtSearch.Point,all"
End If

If (PointCheck.Value = True And PlaneCheck.Value = True) Then
selection1.Search "(CATPrtSearch.Plane+CATPrtSearch.Point),all"
End If

End Sub

代码添加部件，label

Set Label = UserForm3.Controls.Add("Forms.Label.1")'要用具体的userfom1,2,3这种，不能用userform
Label.Caption = "ffffff"
Label.Left = 0
Label.Font.Size = 20
Label.Top = 7.5
Label.Width = 80
Label.Height = 30
CATIA.Visible = False

listbox用数组添加元素

listbox将product中的所有part列出来

Set productDocument1 = CATIA.ActiveDocument
Set product1 = productDocument1.Product
Set products1 = product1.Products
    For ip = 1 To product1.Products.Count
        iss = False
        str1 = product1.Products.Item(ip).ReferenceProduct.Name
        
        For jp = 0 To UserForm3.ListBox1.ListCount - 1
            If str1 = UserForm3.ListBox1.List(jp) Then
            iss = True
            End If
        Next jp
        
        If iss = False Then
            UserForm3.ListBox1.AddItem str1
        End If
    Next

textbox光标定位

使窗体，右上角的x（关闭），失效

vb与catia链接

vb执行代码如果弹出的是窗体，就先把窗体删除掉

Sub main()

On Error Resume Next
MsgBox Err.Number
    Set catia = GetObject(, "CATIA.Application") '如果catia处于打开状态，则直接建立连接
    MsgBox Err.Number
    If Err.Number <> 0 Then '如果出现错误
        Set catia = CreateObject("CATIA.Application") '打开catia
        catia.Visible = True
    End If

On Error GoTo 0
'MsgBox catia.activedocument.Name
End Sub

vb添加库

否则

可以把所有的catia v5的库都添加上，项目保存，作为模板项目。不然新建的项目，还需要添加库，比较麻烦。
查看类

'partdocument的一些属性，单独提取出来
Dim opartdoc As partdocument
Set opartdoc = catia.activedocument
Dim opart As part
Set opart = opartdoc.part
MsgBox opart.Name

Dim obodies As Bodies
Set obodies = opart.Bodies

Dim obody As Body
Set obody = obodies.Item(1)
MsgBox obody.Name

关闭，catia中打开的所有文件

Sub CATMain()
For Each Document In CATIA.Documents '关闭，catia中打开的所有文件
Document.Close
Next
End Sub

vb编辑的第一个小程序，catia录制宏，中编辑完导出，到vb中编辑运行

实现定制创建圆柱的个数，和间距

Dim catia '多个函数都要用到，catia，所以设为全局的
Private Sub CommandButton1_Click()

Set documents1 = catia.Documents
Set partDocument1 = documents1.Add("Part")
Dim part1 As Part
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("PartBody")


Xdistance = 0
For icount = 1 To TextBox1.Value



Set sketches1 = body1.Sketches
Set originElements1 = part1.OriginElements
Set reference1 = originElements1.PlaneZX
Set sketch1 = sketches1.Add(reference1)
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



'Set circle2D1 = factory2D1.CreateClosedCircle(0#, 0#, 5#)
Set circle2D1 = factory2D1.CreateClosedCircle(Xdistance, 0#, 5#)



Set point2D1 = axis2D1.GetItem("Origin")
circle2D1.ReportName = 3
Set constraints1 = sketch1.Constraints
Set reference2 = part1.CreateReferenceFromObject(circle2D1)
Set constraint1 = constraints1.AddMonoEltCst(catCstTypeRadius, reference2)
constraint1.Mode = catCstModeDrivingDimension
Set Length1 = constraint1.Dimension
Length1.Value = 5#
Set reference3 = part1.CreateReferenceFromObject(circle2D1)
Set constraint2 = constraints1.AddMonoEltCst(catCstTypeRadius, reference3)
constraint2.Mode = catCstModeDrivenDimension
sketch1.CloseEdition
part1.InWorkObject = sketch1
part1.Update
Set shapeFactory1 = part1.ShapeFactory
Set pad1 = shapeFactory1.AddNewPad(sketch1, 20#)
part1.Update



Xdistance = Xdistance + TextBox2.Value
Next



End Sub

Private Sub UserForm_Initialize()
On Error Resume Next
    Set catia = GetObject(, "CATIA.Application") '如果catia处于打开状态，则直接建立连接
    MsgBox Err.Number
    If Err.Number = 0 Then
        MsgBox "connect successfully"
    End If

On Error GoTo 0
End Sub