Auto Comment Script

Would you like to add Comments to your PC-DMIS program without typing the entire message each time? Use this script to display a message sowing a variety of "canned" comments that you use on a regular basis. It has been some time since I've used this... If I remember correctly the script can be called from a User Defined Toolbar button from PC-DMIS. There should be an option to run the script without adding it to the Program. You will of course need to modify the script to include your own custom Comments.

Note: There is some special handling that modifies the part name & ser num string. Remove the "Pname = Right(Pname, StrLen - 3)" lines to retain the full text Strings.

'Attribute VB_Name = "Module1"
Sub Main()

Dim buttonval As Integer
Dim StrLen As Integer

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 PartProg As Object
Set PartProg = App.ActivePartProgram

Dim Pname As String
Pname = PartProg.PartName
StrLen = Len(Pname)
Pname = Right(Pname, StrLen - 3)

Dim Rnum As String
Rnum = PartProg.RevisionNumber

Dim Snum As String
Snum = PartProg.SerialNumber
StrLen = Len(Snum)
Snum = Right(Snum, StrLen - 4)

Dim MyDate As String
MyDate = Date
'MsgBox MyDate

Dim MyTime As String
MyTime = Time()
'MsgBox MyTime

'Dim Fname As String
'Fname = PartProg.Name
'MsgBox Fname

'On Error
'GoTo label1

Dim Cmd As Object

Begin Dialog DLG_REPORT_COMMENT 50, 32, 150, 150, "What Comments Do You Need?"
OKButton 90, 8, 40, 14
CancelButton 90, 32, 40, 14
CheckBox 12, 8, 50, 8, "Points", .CheckBox1
CheckBox 12, 24, 50, 8, "Align Bowls", .CheckBox2
CheckBox 12, 40, 50, 8, "Sqr Corner", .CheckBox3
CheckBox 12, 56, 50, 8, "Tube Dia's", .CheckBox4
CheckBox 12, 72, 50, 8, "Pin Dia's", .CheckBox5
CheckBox 12, 88, 35, 8, "Custom", .CheckBox6
TextBox 50, 85, 80, 12, .EditBox1
TextBox 50, 100, 80, 12, .EditBox2
CheckBox 12, 116, 50, 8, "Footer", .CheckBox7
CheckBox 30, 132, 120, 8, "Double Space Comments?",.CheckBox8
End Dialog

Dim dlg1 As DLG_REPORT_COMMENT
buttonval = Dialog(dlg1)

Dim customstr As String
customstr = dlg1.EditBox1
Dim customstr2 As String
customstr2 = dlg1.EditBox2

Dim lenstr As Integer
lenstr = Len(dlg1.EditBox2)

'first command
If dlg1.CheckBox1 = 1 Then

Set Cmd = Cmds.Add(SET_COMMENT, True)

retvaltype = Cmd.PutText("REPT", COMMENT_TYPE, 0)
If dlg1.CheckBox8 = 1 Then
retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText("Verification Of Intersection Points", COMMENT_FIELD, 2)
Else
retvaltype = Cmd.PutText("Verification Of Intersection Points", COMMENT_FIELD, 1)
End If
Cmd.ReDraw
End If

'second command
If dlg1.CheckBox2 = 1 Then

Set Cmd = Cmds.Add(SET_COMMENT, True)

retvaltype = Cmd.PutText("REPT", COMMENT_TYPE, 0)
If dlg1.CheckBox8 = 1 Then
retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText("Verification Of Alignment Points", COMMENT_FIELD, 2)
Else
retvaltype = Cmd.PutText("Verification Of Alignment Points", COMMENT_FIELD, 1)
End If
Cmd.ReDraw
End If

'third command
If dlg1.CheckBox3 = 1 Then

Set Cmd = Cmds.Add(SET_COMMENT, True)

retvaltype = Cmd.PutText("REPT", COMMENT_TYPE, 0)
If dlg1.CheckBox8 = 1 Then
retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText("Verification Of Square Corner", COMMENT_FIELD, 2)
Else
retvaltype = Cmd.PutText("Verification Of Square Corner", COMMENT_FIELD, 1)
End If

Cmd.ReDraw
End If

'forth command
If dlg1.CheckBox4 = 1 Then

Set Cmd = Cmds.Add(SET_COMMENT, True)

retvaltype = Cmd.PutText("REPT", COMMENT_TYPE, 0)
If dlg1.CheckBox8 = 1 Then
retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText("Verification Of Tube Cavity Diameters", COMMENT_FIELD, 2)
Else
retvaltype = Cmd.PutText("Verification Of Tube Cavity Diameters", COMMENT_FIELD, 1)
End If

Cmd.ReDraw
End If

'fifth command
If dlg1.CheckBox5 = 1 Then

Set Cmd = Cmds.Add(SET_COMMENT, True)

retvaltype = Cmd.PutText("REPT", COMMENT_TYPE, 0)
If dlg1.CheckBox8 = 1 Then
retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText("Verification Of Pin Diameters", COMMENT_FIELD, 2)
Else
retvaltype = Cmd.PutText("Verification Of Pin Diameters", COMMENT_FIELD, 1)
End If

Cmd.ReDraw
End If

'sixth command
If dlg1.CheckBox6 = 1 Then

Set Cmd = Cmds.Add(SET_COMMENT, True)

retvaltype = Cmd.PutText("REPT", COMMENT_TYPE, 0)

'retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText(customstr, COMMENT_FIELD, 1)
If lenstr > 0 Then
retvaltype = Cmd.PutText(customstr2, COMMENT_FIELD, 2)
End If
Cmd.ReDraw
End If

'seventh command
If dlg1.CheckBox7 = 1 Then

Set Cmd = Cmds.Add(SET_COMMENT, True)

retvaltype = Cmd.PutText("REPT", COMMENT_TYPE, 0)

'retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText(" ", COMMENT_FIELD, 1)
retvaltype = Cmd.PutText(" End Of Report:", COMMENT_FIELD, 2)
retvaltype = Cmd.PutText("CMM Number: " & Pname & " Part Number: " & Rnum, COMMENT_FIELD, 3)
retvaltype = Cmd.PutText("TRC Number: " & Snum & " " & MyDate & " " & MyTime, COMMENT_FIELD, 4)

Cmd.ReDraw
End If

End Sub

'label1:

'End Sub