hexagon logo
Register Sign in
  • Replies 22 replies
  • Subscribers 34 subscribers
  • Views 537 views
  • Users 0 members are here
Options
Related

PC-Dmis to Excel, through PC-Dmis Script

Rploughe
I know there is currently a VB project that runs in Excel during execution that will pull information into the workbook during execution. I decided to venture out and try some of my own approaches with a combination of data I found online here and there.

What I have is a script that can be executed in program, without too much setup and hassle, that will export data into an excel workbook like a print command would. I feel this script offers a little more versatility.

I will not claim ownership of this program. I just tweaked it to fit my needs. So far I have it running, and it works quite well.

I will answer what questions I can, but for the most part I wanted to post it to have as a reference.

It's a long program........
  • Hi, thanks for this scipt.
    It works fine for me if I switch PCDMIS to english language. If I use it with german language than it exports only some of the dimension labels and no single measurement. Do you have any suggestion what to change to make it run in other languages than english?
  • Hello Ralf,

    Honestly that is beyond my scripting experience. I know there are some on here who have/can do this. So i apologize and hope that one of the more experienced users on here can answer your question.
  • Hello Rploughe,

    thats ok, maybe one of the specialists will post an answer.
    In the meantime I am in contact with the german support team and ask them about the differences between scrips for english and german version of PCDMIS. But I still have no answer. So lets wait and see.
  • For every place where a GETTEXT-result is compared to a "text" you need to verify the German translation of that text. Like in 

    ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
              If ReportDim = "BOTH" Or ReportDim = "REPORT" Then


    For Swedish, the "BOTH" should be "BÅDA" and "REPORT" should be "RAPPORT", my guess for German is "BEIDE" and "RAPPORT".

    I often write scripts that work both in English and Swedish, the above excerpt would then be changed to 

    ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
              If ReportDim = "BOTH" Or ReportDim = "REPORT" Or ReportDim = "BÅDA" or ReportDim = "RAPPORT" Then


    which gets rather unwieldy when more languages are needed.


    In the latest versions of PC-DMIS there is a function for getting a string in the current language, given the English word, 

    ASSIGN/V1=GETSETTING("Langstr(Yes)")


    will give "JA" when I run in Swedish, but this function is very limited in its vocabulary, and "BOTH" is not there Disappointed so you have to use a numeric ID instead - good luck finding the numbers, there are about 10000 different ones (-4000 to +6000, approx.)...
  • can you tell me how to insert that monster plz. I never used a script before
    I know there is currently a VB project that runs in Excel during execution that will pull information into the workbook during execution. I decided to venture out and try some of my own approaches with a combination of data I found online here and there.

    What I have is a script that can be executed in program, without too much setup and hassle, that will export data into an excel workbook like a print command would. I feel this script offers a little more versatility.

    I will not claim ownership of this program. I just tweaked it to fit my needs. So far I have it running, and it works quite well.

    I will answer what questions I can, but for the most part I wanted to post it to have as a reference.

    It's a long program........
  • Hi,

    thanks for your assistance. I will try that later. Maybe I find the right IDs.
    For the moment I have just skipped this query because it is ok for me to export all dimensions.
  • Hi,

    thanks for your assistance. I will try that later. Maybe I find the right IDs.
    For the moment I have just skipped this query because it is ok for me to export all dimensions.

    Ralf (and all),

    Look up SetToggleString for OUTPUT_TYPE instead of going directly for the strings.
    I use this method to set the output value in one of my automation scripts: 

    retval = PCDCommand.SetToggleString (1, OUTPUT_TYPE, 0)


    Incorporated into a dimension evaluation (creating it): 

    Set PCDCommand = PCDCommands.Add (DIMENSION_START_LOCATION, True)
    retval = PCDCommand.PutText ("P" & cnt, ID, 0)
    retval = PCDCommand.PutText ("MP" & cnt, REF_ID, 0)

    retval = PCDCommand.SetToggleString (1, OUTPUT_TYPE, 0)

    retval = PCDCommand.SetToggleString (2, UNIT_TYPE, 0)
  Set PCDCommand = PCDCommands.Add (DIMENSION_X_LOCATION, True)
  Set PCDCommand = PCDCommands.Add (DIMENSION_Y_LOCATION, True)
  Set PCDCommand = PCDCommands.Add (DIMENSION_Z_LOCATION, True)
  Set PCDCommand = PCDCommands.Add (DIMENSION_D_LOCATION, True)
  Set PCDCommand = PCDCommands.Add (DIMENSION_END_LOCATION, True)
    PCDCommand.Marked = True
  • hello,

    this is very helpful information. I am new to VB programming. It would be highly appreciated if you provide with simple script for exporting feature result to specific location like "A2" in Excel without opening the Excel sheet.
  • Hey looky, my script stuffs. Hmm seems like an older version. I will have to post updates.
  • First Half 

    Sub Main 


'pcdlrn declarations And Open ppg
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 Object
Dim DCmd As Object
Dim DcmdID As Object


'Excel Declarations
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim xlSheets As Object
Dim fncSheet As Object
Dim count As Integer
Dim xlWorksheets As String 
Dim xlWorksheet As String 


Dim fs As Object 
Dim DimID As String 
Dim ReportDim As String
Dim CheckDim As String 
Dim Cavity As String  
Dim myValue As String 
Dim message, title, defaultValue As String
Dim FolderList$ ( )  
Dim objFSO, objFolder, objShell, found
Dim serverpath
Dim foldername As String
Dim strDirectory, strDirectory1, strDirectory2, strDirectory3, strDirectory4, strDirectory5
Dim CMDline, CMDvar, CMDval, Delimpos, CMDfind


Set prognam = Part.GetVariableValue("CMMPROGRAM")
Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
Set Partnu = Part.GetVariableValue("PARTNUM")
Set Partna = Part.GetVariableValue("PARTNAM")
Set Printrevver = Part.GetVariableValue("PRINTREV1")
Set Locater = Part.GetVariableValue("RPTPATH")
Set Jobber = Part.GetVariableValue("JOB")
Set Opper = Part.GetVariableValue("OPERATOR")


' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")


'Check To see If results file exists
FilePath = Locater.Stringvalue
ResFileExists = FilePath & prognam.Stringvalue & ".xlsx"


Dim TempFilename


If objFSO.FileExists(ResFileExists) = False Then
    TempFilename = "Z:\" & "Program Template.xlsx"
Else
    TempFilename = ResFileExists
End If


On Error GoTo ErrorCheck


'Open Excel And Base form
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
App.Visible = False


Set xlWorkbooks = xlapp.Workbooks
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
Set xlSheet = xlWorkbook.Worksheets("#Main Page")
Set xlsheets = xlworkbook.worksheets
Set fncSheet = xlApp.WorkSheetFunction
Dim Nomi, Plustol, Minustol,Meas, WidthSet


Dim sh As Worksheet, flg As Boolean
For Each sh In xlworkbook.worksheets
    If sh.Name = "Job #" & Jobber.Stringvalue Then flg = True : Exit For
Next


If flg = False Then
  xlsheets(1).Copy After:=xlsheets(1)
    xlsheets(2).Name = "Job #" & Jobber.StringValue
End If


Set xlSheet = xlWorkbook.Worksheets("Job #" & Jobber.StringValue)


If objFSO.FileExists(ResFileExists) = False Or xlsheet.cells(1,1).Value = "" Then
	RCount = 7
	CCount = 3
	
	xlSheet.Cells(1, 1).Value = "Program Name :"
	xlSheet.Cells(1, 2).Value = CMMPrognam.StringValue
	xlSheet.Cells(2, 1).Value = "Part # :"
	xlSheet.Cells(2, 2).Value = Partnu.StringValue
	xlSheet.Cells(3, 1).Value = "Part Name :"
	xlSheet.Cells(3, 2).Value = Partna.StringValue
	xlSheet.Cells(4, 1).Value = "Print Information :"
	xlSheet.Cells(4, 2).Value = Printrevver.StringValue
	WidthSet = xlSheet.Cells(4, 1).Columns.AutoFit()
	WidthSet = xlSheet.Cells(4, 2).Columns.AutoFit()


    Set Samp = Part.GetVariableValue("SAMP")


    xlSheet.Cells(RCount - 1, 2).Value = "Feature Name :"
    xlSheet.Cells(RCount + 0, 2).Value = "Dimension :"
    xlSheet.Cells(RCount + 5, 1).Value = "Operator : " & Opper.StringValue
    WidthSet = xlSheet.Cells(RCount + 5, 1).Columns.AutoFit()
    xlSheet.Cells(RCount + 5, 2).Value = "Sample # : " & Samp.StringValue
    xlSheet.Cells(RCount + 0, 1).Value = "--"
    xlSheet.Cells(RCount + 1, 1).Value = "--"
    xlSheet.Cells(RCount + 2, 1).Value = "--"
    xlSheet.Cells(RCount + 3, 1).Value = "--"
    xlSheet.Cells(RCount + 1, 2).Value = "Nominal"
    xlSheet.Cells(RCount + 2, 2).Value = "USL"
    xlSheet.Cells(RCount + 3, 2).Value = "LSL"
    xlSheet.Cells(RCount + 4, 1).Value = "--"
    xlSheet.Cells(RCount + 4, 2).Value = "--"


	For Each Cmd In Cmds
		'Do GDT
		If Cmd.Type = 184 And Cmd.Marked = True Then ' FCF
			ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
			If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
				xlSheet.Cells(RCount-1,CCount).Value = Cmd.GetText (ID, 0) 
				xlSheet.Cells(RCount+0,CCount).Value =  Cmd.GetText(GDT_SYMBOL, 0)
				xlSheet.Cells(RCount+1,CCount).Value = "0"
				xlSheet.Cells(RCount+2,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                                                If Cmd.GetText(GDT_SYMBOL,0) = "PROFILE OF SURFACE" Then
                                                Set PlusTol =  fncsheet.Sum(Abs((Cmd.GetText (LINE2_PLUSTOL, 1))),Abs((Cmd.GetText (LINE2_MINUSTOL, 1))))
				xlSheet.Cells(RCount + 2, CCount).Value = PlusTol
                                                End If
				xlSheet.Cells(RCount+3,CCount).Value = "0"
				xlSheet.Cells(RCount+4,CCount).Value = "--"
				xlSheet.Cells(RCount+5,CCount).Value = fncsheet.Round(Cmd.GetText(LINE2_DEV, 1),6)
				If xlsheet.Cells(RCount+5,CCount).value > xlsheet.cells(Rcount+2,Ccount).Value Then
					xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
				End If
                                                If Len(Cmd.GetText (ID, 0)) > Len(Cmd.GetText(GDT_SYMBOL, 0)) Then
				WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
                                                Else
				WidthSet = xlSheet.Cells(RCount+0,CCount).Columns.AutoFit()
                                                End If
                                                CCount = CCount + 1
			End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
		End If
		'Do Dimensions
		If Cmd.IsDimension And Cmd.Marked = True Then
			If Cmd.Type = DIMENSION_START_LOCATION Or _
				Cmd.Type = DIMENSION_TRUE_START_POSITION Then
				Set DcmdID = Cmd.DimensionCommand
				DimID = DcmdID.ID
				ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
				xlSheet.Cells(RCount - 1, CCount).Value = DcmdID.Id
                                                WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
			End If
			If Cmd.Type <> DIMENSION_START_LOCATION And _
				Cmd.Type <> DIMENSION_END_LOCATION And _
				Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
				Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
				Cmd.Type <> DATDEF_COMMAND Then
				Set DCmd = Cmd.DimensionCommand
				CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
				If CheckDim <> "" Then
					ReportDim = CheckDim
				End If
				If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
					If DCmd.ID = "" Then
						xlSheet.Cells(RCount, CCount).Value = DCmd.AxisLetter
					Else
						xlSheet.Cells(RCount - 1, CCount).Value = Dcmd.Id
                                                                        WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
						xlSheet.Cells(RCount, CCount).Value = "M"
					End If 'DCmd.ID = ""
					If Dcmd.Nominal < 0 Then
						Set Nomi = Abs(DCmd.Nominal)
						Set PlusTol =  fncsheet.Sum(Nomi,Abs((DCmd.Plus)))
						Set MinusTol = fncsheet.Sum(Nomi,-Abs((DCmd.Minus)))
					Else
						Set Nomi = DCmd.Nominal
						Set PlusTol =  fncsheet.Sum(Nomi,(DCmd.Plus))
						Set MinusTol = fncsheet.Sum(Nomi,-(DCmd.Minus))
					End If
					xlSheet.Cells(RCount+1,CCount).Value = Nomi
					xlSheet.Cells(RCount + 2, CCount).Value = PlusTol
					xlSheet.Cells(RCount + 3, CCount).Value = MinusTol
					xlSheet.Cells(RCount+4, CCount).Value = "--"
					'Measured Or Deviation With check For True Position
					If DCmd.AxisLetter <> "TP" Then
						Set Meas = Abs(fncsheet.Round(DCmd.Measured,6))
						xlSheet.Cells(RCount+5, CCount).Value = Meas
						If Meas > PlusTol Or _
							Meas < MinusTol Then
							xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
						End If
					Else
						Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
						xlSheet.Cells(RCount+5, CCount).Value = Meas
						If Meas > PlusTol Or _
							Meas < MinusTol Then
							xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
						End If
					End If 'DCmd.AxisLetter <> "TP" 
					'Add For Profile dimensions
					If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
						Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
						xlSheet.Cells(RCount+5, CCount).Value = Meas
						If xlsheet.Cells(RCount+5,CCount).value > PlusTol Or _
							xlsheet.Cells(RCount+5,CCount).value < MinusTol Then
							xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
						End If
					End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
				End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
				CCount = CCount + 1
			End If
		End If
	Next Cmd
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement