CATIA二次开发关于自动提点和创建测量机程序
本帖最后由 lixiaoqiang 于 2021-12-31 10:57 编辑上次发布了关于CATIA编程的一些软件
今天发布一个关于CATIA和三坐标之间的插件。
主要功能：
1.创建点位
2.给点位创建注释
3.导出点位坐标
4.自动生成点位程序
使用方法：
用CATIA软件加载宏程序，运行计量软件
Public PCDApp, SL_Point
Function LaunchPCDMIS()
Set PCDApp = CreateObject("PCDLRN.Application")
Set AppEvents = PCDApp.ApplicationEvents
PCDApp.Visible = True
Set LaunchPCDMIS = PCDApp
End Function
Function new_pcd(AppEvents, 图号 As String) '新建
Set new_pcd = AppEvents.PartPrograms.Add(图号, 1, "Offline", ".prb")
End Function
Function CEJ(PCDApp) '插入测量机
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
Dim CEi
Set CEi = cmd.Add(171, True)
CEi.PutText "GLOBAL_B&S_7-10-7", 227, True 'MACHINE_TYPE
End Function
Function CATpart(PCDApp, CATpart_path) '插入数模
Set ACT_pcd = PCDApp.ActivePartProgram
ACT_pcd.Import CATpart_path
End Function
Function safeplan(PCDApp) '安全平面
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
Dim sd
Set sd = cmd.Add(CLEARANCE_PLANE, True) '创建安全平面130
sd.SetToggleString 1, DIM_PLANE_PROJECTION_LENGTH, True
End Function
Function SPEED(PCDApp) '移动速度
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
Dim sd
Set sd = cmd.Add(103, False) '手动模式开启MAN_DCC_MODE
Dim YDSU
Set YDSU = cmd.Add(45, True) '移动速度 MOVE_SPEED,
YDSU.PutText 60, 95, True 'F_MOVESPEED
Dim CCSU
Set CCSU = cmd.Add(46, True) '触测速度 TOUCH_SPEED
CCSU.PutText 5, 96, True 'F_TOUCHSPEED,
Dim CZSU
Set CZSU = cmd.Add(49, True) '测座速度 WRIST_SPEED
CZSU.PutText 60, 96, True 'F_TOUCHSPEED
Dim BJJL
Set BJJL = cmd.Add(100, True) '逼近距离 PREHIT_DISTANCE
BJJL.PutText 3, 1051, True
Dim HTJL
Set HTJL = cmd.Add(101, True) '回退距离 PETRACT_DISTANCE
HTJL.PutText 3, 1052, True
Dim txt
Set txt = cmd.Add(180, True) '文本格式
txt.DimFormatCommand.SetHeadingType 1, 3
txt.DimFormatCommand.SetHeadingType 2, 1
txt.DimFormatCommand.SetHeadingType 3, 5
txt.DimFormatCommand.SetHeadingType 4, 2
txt.DimFormatCommand.SetHeadingType 6, 6
End Function
Function SLD(PCDApp, x, y, z, i, j, k, 名称) '矢量点
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
cmd.Add 151, True
Set SL_Point = cmd.Add(602, True) '特征/触测/矢量点/默认,直角坐标 CONTACT_VECTOR_POINT_FEATURE
SL_Point.Marked = True
SL_Point.Id = 名称
point_x SL_Point, x
point_y SL_Point, y
point_z SL_Point, z
point_i SL_Point, i
point_j SL_Point, j
point_k SL_Point, k
SLD = SL_Point
End Function
Function DIM_point(PCDApp, SL_Point, 上偏差, 下偏差)
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
Dim DIM_point_x, DIM_point_y, DIM_point_z, DIM_point_t
Set DIM_point = cmd.AddDimensionWithValues(1000, SL_Point, 10, "Both", True)
DIM_point.DimensionCommand.OutputMode = 2 '输出方式
DIM_point.DimensionCommand.Plus = 上偏差 '上偏差
DIM_point.DimensionCommand.Minus = 下偏差 '下偏差
DIM_point.DimensionCommand.Units = 1 '单位mm
Set DIM_point_x = cmd.AddDimensionWithValues(1002, SL_Point, 10, "Both", True)
'DIM_point_x.DimensionCommand.OutputMode = 2 '输出方式
'DIM_point_x.DimensionCommand.Plus = 上偏差 '上偏差
'DIM_point_x.DimensionCommand.Minus = 下偏差 '下偏差
'DIM_point_x.DimensionCommand.Units = 1 '单位mm
Set DIM_point_y = cmd.AddDimensionWithValues(1003, SL_Point, 10, "Both", True)
'DIM_point_y.DimensionCommand.OutputMode = 2 '输出方式
'DIM_point_y.DimensionCommand.Plus = 上偏差 '上偏差
'DIM_point_y.DimensionCommand.Minus = 下偏差 '下偏差
'DIM_point_y.DimensionCommand.Units = 1 '单位mm
Set DIM_point_z = cmd.AddDimensionWithValues(1004, SL_Point, 10, "Both", True)
'DIM_point_z.DimensionCommand.OutputMode = 2 '输出方式
'DIM_point_z.DimensionCommand.Plus = 上偏差 '上偏差
'DIM_point_z.DimensionCommand.Minus = 下偏差 '下偏差
'DIM_point_z.DimensionCommand.Units = 1 '单位mm
Set DIM_point_t = cmd.AddDimensionWithValues(1008, SL_Point, 10, "Both", True)
'DIM_point_t.DimensionCommand.OutputMode = 2 '输出方式
'DIM_point_t.DimensionCommand.Plus = 上偏差 '上偏差
'DIM_point_t.DimensionCommand.Minus = 下偏差 '下偏差
'DIM_point_t.DimensionCommand.Units = 1 '单位mm
cmd.AddDimensionWithValues 1001, "PNT1", 10, "Both", True
End Function
Function BAOGAO_850(PCDApp, 质量编号, 图号, 文本名称) '题头信息
Dim sen_line, five_line
Dim riqi_850
riqi_850 = Format(Date, "yyyy-dd-mm")
sen_line = "DRAWING-NO.：" & 图号 & Space(39 - Len(图号)) & "PART-NO: " & 质量编号
five_line = "FILE-NAME:" & 文本名称 & ".MDA" & Space(34 - Len(文本名称)) & "MEAS DATE: " & riqi_850
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
Set SL_Point = cmd.Add(170, True) '注释报告SET_COMMENT
SL_Point.Marked = True
'SL_Point.IsDimension = True
SL_Point.SetToggleString 4, 190, 5 '2-"Report" 4-"Document" 3-"Input" 5-"Yes/No" 6-"Readout"
SL_Point.PutText "*************************************************************************", 189, 1
SL_Point.PutText sen_line, 189, 2
SL_Point.PutText "CMMM-S/N: N/A UNIT: mm", 189, 3
SL_Point.PutText "点位图： N/A", 189, 4
SL_Point.PutText five_line, 189, 5
SL_Point.PutText "*************************************************************************", 189, 6
Set SL_Point = cmd.Add(170, True) '注释报告SET_COMMENT
SL_Point.SetToggleString 2, 190, 5 '2-"Report" 4-"Document" 3-"Input" 5-"Yes/No" 6-"Readout"
SL_Point.PutText "项目 实测值 名义值 偏差 上偏差 下偏差 评价", 189, 1
End Function
''===================================================================
'
Function BAOGAO_830(PCDApp, 质量编号, 图号, 文本名称) '题头信息
Dim sen_line, five_line
Dim riqi_830
riqi_830 = Format(Date, "mm/dd/yyyy")
sen_line = "DRAWING-NO.：" & 图号 & Space(39 - Len(图号)) & "PART-NO: " & 质量编号
five_line = "FILE-NAME:" & 文本名称 & ".MDA" & Space(34 - Len(文本名称)) & "MEAS DATE: " & riqi_830
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
Set SL_Point = cmd.Add(170, True) '注释报告SET_COMMENT
SL_Point.SetToggleString 4, 190, 5 '2-"Report" 4-"Document" 3-"Input" 5-"Yes/No" 6-"Readout"
SL_Point.PutText "*************************************************************************", 189, 1
SL_Point.PutText sen_line, 189, 2
SL_Point.PutText five_line, 189, 5
SL_Point.PutText "*************************************************************************", 189, 6
Set SL_Point = cmd.Add(170, True) '注释报告SET_COMMENT
SL_Point.SetToggleString 2, 190, 5 '2-"Report" 4-"Document" 3-"Input" 5-"Yes/No" 6-"Readout"
SL_Point.PutText " MEAS NOM DEV +UPTOL -DNTOL OUT", 189, 1
End Function
''===================================================================
Function point_x(SL_Point, x)
SL_Point.PutText x, 7, 0'理论值 THEO_X'7
SL_Point.PutText x, 22, 0 '实际值 MEAS_X
SL_Point.PutText x, 19, 0 '目标值 TARG_X
End Function
''===================================================================
Function point_y(SL_Point, y)
SL_Point.PutText y, 8, 0'理论值 THEO_Y
SL_Point.PutText y, 23, 0 '实际值 MEAS_Y
SL_Point.PutText y, 20, 0 '目标值 TARG_Y
End Function
''===================================================================
Function point_z(SL_Point, z)
SL_Point.PutText z, 9, 0'理论值 THEO_Z
SL_Point.PutText z, 24, 0 '实际值 MEAS_Y
SL_Point.PutText z, 21, 0 '目标值 TARG_Z
End Function
''===================================================================
Function point_i(SL_Point, i)
SL_Point.PutText i, 16, 0'理论值 THEO_I
SL_Point.PutText i, 25, 0'实际值 MEAS_I
SL_Point.PutText i, 31, 0'目标值 TARG_I
End Function
''===================================================================
Function point_j(SL_Point, j)
SL_Point.PutText j, 17, 0'理论值 THEO_J
SL_Point.PutText j, 26, 0'实际值 MEAS_J
SL_Point.PutText j, 32, 0'目标值 TARG_J
End Function
''===================================================================
Function point_k(SL_Point, k)
SL_Point.PutText k, 18, 0'理论值 THEO_K
SL_Point.PutText k, 27, 0'实际值 MEAS_K
SL_Point.PutText k, 33, 0'目标值 TARG_K
End Function
''===================================================================
'
Function cir_cle(PCDApp, x, y, z, i, j, k, 直径, 名称)
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
cmd.Add 151, True
Set SL_Point = cmd.Add(612, True) '圆内，最小二乘法
SL_Point.Id = 名称
point_x (x)
point_y (y)
point_z (z)
point_i (i)
point_j (j)
point_k (k)
SL_Point.PutText 直径, 29, 0 '圆实际直径
SL_Point.PutText 直径, 34, 0 '圆理论直径
SL_Point.PutText 4, 70, 0 '测点数
SL_Point.PutText 0, 72, 0 '起始样例点
SL_Point.PutText 0, 73, 0 '样例点数
SL_Point.PutText 0, 75, 0 '间隙
SL_Point.PutText 0, 76, 0 '螺距
SL_Point.PutText 0, 77, 0 '厚度
SL_Point.PutText 0, 78, 0 '深度
SL_Point.PutText 10, 79, 0 '距离
SL_Point.PutText 0, 98, 0 '起始角度
SL_Point.PutText 360, 99, 0 '终止角度
End Function
''===================================================================
Function cylin(PCDApp, x, y, z, i, j, k, x1, y1, z1, i1, j1, k1, 直径, 名称)
Set ACT_pcd = PCD.ActivePartProgram
Set cmd = ACT_pcd.Commands
cmd.Add 151, True
Dim zhuti_1, zhuti_2
Set zhuti_1 = cmd.Add(616, True) '柱体
zhuti_1.Id = 名称
Set SL_Point = zhuti_1
point_x x
point_y y
point_z z
point_i i
point_j j
point_k k
'SL_Point.PutText 深度, 28, 0 '深度
SL_Point.PutText 直径, 29, 0 '圆实际直径
SL_Point.PutText 直径, 34, 0 '圆理论直径
'SL_Point.puttext 10, 35, 0 '深度
'SL_Point.PutText 深度, 36, 0 '直径
SL_Point.PutText 4, 70, 0 '测点数
SL_Point.PutText 2, 71, 0 '层数
SL_Point.PutText 0, 72, 0 '起始样例点
SL_Point.PutText 0, 73, 0 '样例点数
SL_Point.PutText 0, 75, 0 '间隙
SL_Point.PutText 0, 76, 0 '螺距
SL_Point.PutText 0, 77, 0 '厚度
SL_Point.PutText 0, 78, 0 '深度
SL_Point.PutText 10, 79, 0 '距离
SL_Point.PutText 0, 98, 0 '起始角度
SL_Point.PutText 360, 99, 0 '终止角度
Dim plan_1, plan_2
Set plan_1 = cmd.AddCmdOfName(597, True, "SL_Point_1")
plan_1.FeatureCommand.GenericType = 1
plan_1.FeatureCommand.GenericAlignMode = 0
plan_1.PutText x, 7, 0
plan_1.PutText y, 8, 0
plan_1.PutText z, 9, 0
plan_1.PutText x, 22, 0
plan_1.PutText y, 23, 0
plan_1.PutText z, 24, 0
plan_1.PutText i, 16, 0
plan_1.PutText j, 17, 0
plan_1.PutText k, 18, 0
plan_1.PutText i, 25, 0
plan_1.PutText j, 26, 0
plan_1.PutText k, 27, 0
Set plan_2 = cmd.AddCmdOfName(597, True, "SL_Point_2")
plan_2.FeatureCommand.GenericType = 1
plan_2.FeatureCommand.GenericAlignMode = 0
plan_2.PutText x1, 7, 0
plan_2.PutText y1, 8, 0
plan_2.PutText z1, 9, 0
plan_2.PutText i1, 16, 0
plan_2.PutText j1, 17, 0
plan_2.PutText k1, 18, 0
plan_2.PutText x1, 22, 0
plan_2.PutText y1, 23, 0
plan_2.PutText z1, 24, 0
plan_2.PutText i1, 25, 0
plan_2.PutText j1, 26, 0
plan_2.PutText k1, 27, 0
Set zhuti_1 = cmd.Add(515, True) '点
zhuti_1.FeatureCommand.AddInputFeat plan_1.Id
zhuti_1.FeatureCommand.AddInputFeat SL_Point.Id
zhuti_1.PutText x, 7, 0
zhuti_1.PutText y, 8, 0
zhuti_1.PutText z, 9, 0
zhuti_1.PutText x, 22, 0
zhuti_1.PutText y, 23, 0
zhuti_1.PutText z, 24, 0
zhuti_1.PutText i, 16, 0
zhuti_1.PutText j, 17, 0
zhuti_1.PutText k, 18, 0
zhuti_1.PutText i, 25, 0
zhuti_1.PutText j, 26, 0
zhuti_1.PutText k, 27, 0
Set zhuti_2 = cmd.Add(515, True) '点
zhuti_2.FeatureCommand.AddInputFeat plan_2.Id
zhuti_2.FeatureCommand.AddInputFeat SL_Point.Id
zhuti_2.PutText x1, 7, 0
zhuti_2.PutText y1, 8, 0
zhuti_2.PutText z1, 9, 0
zhuti_2.PutText i1, 16, 0
zhuti_2.PutText j1, 17, 0
zhuti_2.PutText k1, 18, 0
zhuti_2.PutText x1, 22, 0
zhuti_2.PutText y1, 23, 0
zhuti_2.PutText z1, 24, 0
zhuti_2.PutText i1, 25, 0
zhuti_2.PutText j1, 26, 0
zhuti_2.PutText k1, 27, 0
End Function
'
Function ArcSin(x) As Double '反正弦
On Error Resume Next
ArcSin = Atn(x / Sqr(-x * x + 1))
If x = 1 Then
ArcSin = 3.1415926
End If
If x = -1 Then
ArcSin = -3.1415926
End If
If x = 0 Then
ArcSin = 0
End If
End Function
'===================================================================
Function ArcCos(x) As Double '反余弦
On Error Resume Next
ArcCos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
If x = 1 Then
ArcCos = 0
End If
If x = -1 Then
ArcCos = 3.1415926
End If
If x = 0 Then
ArcCos = 1
End If
End Function
'===================================================================
Function ArcSec(x) As Double '反正割
On Error Resume Next
ArcSec = Atn(-x / Sqr(x * x - 1)) + Sgn((x) - 1) * (2 * Atn(1))
If x = -1 Then
ArcSec = 3.1415926
End If
If x = 1 Then
ArcSec = 0
End If
End Function
'===================================================================
Function ArcCsc(x) As Double '反余割
On Error Resume Next
ArcCsc = Atn(x / Sqr(x * x - 1)) + Sgn((x) - 1) * (2 * Atn(1))
If x = -1 Then
ArcCsc = -3.1415926
End If
If x = 1 Then
ArcCsc = 3.145926
End If
End Function
'===================================================================
Function ArcCot(x) As Double '反余切
On Error Resume Next
ArcCot = Atn(x) + 2 * Atn(1)
End Function
'===================================================================
Function HSin(x) As Double '双曲正弦
On Error Resume Next
HSin = (Exp(x) - Exp(-x)) / 2
End Function
'===================================================================
Function HCos(x) As Double '双曲余弦.
On Error Resume Next
HCos = (Exp(x) + Exp(-x)) / 2
End Function
'===================================================================
Function HTan(x) As Double '双曲正切
On Error Resume Next
HTan = (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))
End Function
''===================================================================
'
Function ZHOU_A(II, JJ, kk)
If kk = 1 Then
ZHOU_A = 0
End If
If kk = 0 Then
ZHOU_A = 90
End If
If kk <> 0 And kk <> 1 Then
ZHOU_A = ArcCos(kk / Sqr(II * II + JJ * JJ + kk * kk)) * 180 / 3.1415926
If ZHOU_A Mod 7.5 <> 0 Then
ZHOU_A = Abs(Int(ZHOU_A / 7.5) * 7.5 + 7.5)
End If
End If
End Function
'
''===================================================================
'
Function ZHOU_B(II, JJ, kk)
If II < 0 And JJ > 1 Then
ZHOU_B = 0
End If
If II < 0 And JJ < -1 Then
ZHOU_B = 180
End If
If II > 1 And JJ > 0 Then
ZHOU_B = -90
End If
If II < -1 And JJ < 0 Then
ZHOU_B = 90
End If
If II > 0 And JJ > 0 And kk > 0 Then '+++
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926
End If
If II < 0 And JJ > 0 And kk > 0 Then '-++
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926 + 180
End If
If II < 0 And JJ < 0 And kk > 0 Then '--+
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926 - 180
End If
If II > 0 And JJ < 0 And kk > 0 Then '+-+
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926
End If
If II > 0 And JJ > 0 And kk < 0 Then '++-
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926
End If
If II < 0 And JJ > 0 And kk < 0 Then '-+-
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926 + 180
End If
If II < 0 And JJ < 0 And kk < 0 Then '---
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926 - 180
End If
If II > 0 And JJ < 0 And kk < 0 Then '+--
ZHOU_B = Atn(JJ / II) * 180 / 3.1415926
End If
If ZHOU_B Mod 7.5 <> 0 Then
ZHOU_B = Int(ZHOU_B / 7.5) * 7.5 + 7.5
End If
End Function
''===================================================================
Function TIP_A(PCDApp, II, JJ, kk, ZHOUAA, ZHOUBB)
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
Set SL_Point = cmd.Add(60, True)
SL_Point.Id = "T1A" & ZHOUAA & "B" & ZHOUBB
End Function
''===================================================================
Sub get_TIP_A(PCDApp)
Set ACT_pcd = PCDApp.ActivePartProgram
Set cmd = ACT_pcd.Commands
On Error Resume Next
Set SL_Point = cmd.Item(60)
End Sub
''===================================================================
Function GetAxis(t) As String
Dim S As String
Select Case t
Case DIMENSION_D_LOCATION: S = "D"
Case DIMENSION_A_LOCATION: S = "A"
Case DIMENSION_H_LOCATION: S = "H"
Case DIMENSION_L_LOCATION: S = "L"
Case DIMENSION_PA_LOCATION: S = "PA"
Case DIMENSION_PD_LOCATION: S = "PD"
Case DIMENSION_PR_LOCATION: S = "PR"
Case DIMENSION_R_LOCATION: S = "R"
Case DIMENSION_RS_LOCATION: S = "RS"
Case DIMENSION_RT_LOCATION: S = "RT"
Case DIMENSION_S_LOCATION: S = "S"
Case DIMENSION_T_LOCATION: S = "T"
Case DIMENSION_V_LOCATION: S = "V"
Case DIMENSION_X_LOCATION: S = "X"
Case DIMENSION_Y_LOCATION: S = "Y"
Case DIMENSION_Z_LOCATION: S = "Z"
Case DIMENSION_TRUE_DD_LOCATION: S = "DD"
Case DIMENSION_TRUE_DF_LOCATION: S = "DF"
Case DIMENSION_TRUE_DIAM_LOCATION: S = "TP"
Case DIMENSION_TRUE_D1_LOCATION: S = "D1"
Case DIMENSION_TRUE_D2_LOCATION: S = "D2"
Case DIMENSION_TRUE_D3_LOCATION: S = "D3"
Case DIMENSION_TRUE_PA_LOCATION: S = "PA"
Case DIMENSION_TRUE_PR_LOCATION: S = "PR"
Case DIMENSION_TRUE_X_LOCATION: S = "X"
Case DIMENSION_TRUE_Y_LOCATION: S = "Y"
Case DIMENSION_TRUE_Z_LOCATION: S = "Z"
Case Else: S = "M"
End Select
GetAxis = S
End Function
放出一部分
软件有好多BUG，希望大家可以指正。
支持原创，支持楼主！ 自从用了NX12就告别了Catia，就感觉鸟枪换机关枪的感觉 JuncoJet 发表于 2021-12-31 11:11
自从用了NX12就告别了Catia，就感觉鸟枪换机关枪的感觉
怎么说呢？
各有各的好处。
可以两个都用起来 夏夜吉他 发表于 2021-12-31 11:07
支持原创，支持楼主！
感谢！更有动力了:lol 闲逛路过。感谢分享！ 感谢分享，支持一下 非常实用，感谢分享 支持一下，用用试试，谢谢
页:
[1]