前阵子看到坛子上一高手写的用VBA提取测量结果到excel的函数，请教如果我只想要特定的一点，如点38的X值，该如何操作 Private Sub CommandButton1_Click() On Error GoTo abc: Dim app As Object Set app = CreateObject("pcdlrn.application") Dim part As Object Set part = app.ActivePartProgram Dim cmds As Object Set cmds = part.Commands Dim cmd As PCDLRN.Command Dim featName As String Dim measX, measY, measZ, measT As String Dim theoX, theoY, theoZ As String Dim ii As Integer ii = 2 For Each cmd In cmds If cmd.IsMeasuredFeature Or cmd.IsDCCFeature Then featName = cmd.ID measX = cmd.GetText(MEAS_X, 0) measY = cmd.GetText(MEAS_Y, 0) measZ = cmd.GetText(MEAS_Z, 0) theoX = cmd.GetText(THEO_X, 0) theoY = cmd.GetText(THEO_Y, 0) theoZ = cmd.GetText(THEO_Z, 0) Cells(ii, 1) = featName Cells(ii, 2) = theoX Cells(ii, 3) = theoY Cells(ii, 4) = theoZ Cells(ii, 5) = measX Cells(ii, 6) = measY Cells(ii, 7) = measZ ii = ii + 1 End If Next Exit Sub abc: MsgBox "pcdmis没有打开" End Sub

在"featName = cmd.ID"后面加入判断:如果featName不等于"点38",NEXT.

这段代码貌似是我的吧？看下面的吧，增加了一个输入框，输入你想要的特征ID，注意大小写！ Const ttxx = MEAS_X -------------------------------------------------------------------------------------------------------- Private Sub CommandButton1_Click() '按钮1点击事件 On Error GoTo abc: '至Exit Sub处，程序出错则跳到标号abc处 Dim app As Object '声明变量为对象 Set app = CreateObject("pcdlrn.application") '指定app为创建一个pcdmis程序对象 Dim part As Object '声明变量为对象 Set part = app.ActivePartProgram '指定part为激活零件程序 Dim cmds As Object '声明变量为对象 Set cmds = part.Commands '指定cmds为零件程序下的命令集合 Dim cmd As Object '声明变量为pcdmis单个命令 Dim featName As String '声明变量为文本 Dim measX, measY, measZ As String '声明变量为文本 Dim theoX, theoY, theoZ As String '声明变量为文本 Dim ii As Integer '声明变量为整型 ii = 2 '给ii赋值为2 Dim sql As String, row1 As Long row1 = Range("a65536").End(xlUp).Row + 1 sql = InputBox$("请输入要提取的元素ID & 请注意大小写！") For Each cmd In cmds '循环，在命令集合的每一个命令 If cmd.IsMeasuredFeature Or cmd.IsDCCFeature Or cmd.IsDimension Then '当命令为手动，自动，尺寸特征时 featName = cmd.ID If cmd.ID = sql Then measX = cmd.GetText(ttxx, 0) '变量为获得特征实测值 Cells(row1, 1) = featName '把特征ID写入到1列最后空行 Cells(row1, 2) = measX '把特征实际值写入到2列最后空行 End If ii = ii + 1 '每循环一次，值+1 End If '结束外if块 Next '下一个 Exit Sub '当出错时，结束小组，并跳到标号abc: abc: '标号 MsgBox "pcdmis没有打开" '弹出对话框 End Sub '小组完成