VB Script, Using PutText to enter an expression

I want to write a script that can modify the THEO and TARG values of a feature to be an expression, such as "1+0" or "2*VX+4". So far I can change the values to other values but if I give it an expression it always seems to evaluate it first and insert the result rather than the expression itself.

Not sure if what I want to do is possible but after scouring the forum for any examples I am sure that if it is possible someone on here will know how to do it.

Parents

Kp61dude! over 7 years ago

This is what VBA looks like:

Option Explicit
Sub GetTheos()
' Post: http://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/411735-vb-script-using-puttext-to-enter-an-expression

Dim PCDApp As PCDLRN.Application
Dim PCDPartPrograms As PCDLRN.PartPrograms
Dim PCDPartProgram As PCDLRN.PartProgram
Dim PCDCommands As PCDLRN.Commands
Dim cmd As PCDLRN.Command
Dim editWin As PCDLRN.EditWindow

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
Set editWin = PCDPartProgram.EditWindow

Dim fcntr As Integer
Dim FeatureList$(99999)
Dim TX, TY, TZ, NewTX, NewTY, NewTZ, txtBlock, txtBlockTmp, MSG As String
Dim lastChr, findTHEO, findChr, firstComma, secondComma As Integer

fcntr = 0

For Each cmd In PCDCommands
    If cmd.IsDCCFeature Or cmd.IsMeasuredFeature Then
        If cmd.Marked Then

            FeatureList(fcntr) = cmd.ID

            ' Eliminate spaces and linefeeds
            txtBlock = editWin.GetCommandText(cmd)
            txtBlock = Replace(txtBlock, " ", "")
            txtBlock = Replace(txtBlock, vbCr, "")
            txtBlock = Replace(txtBlock, vbCrLf, "")

            lastChr = Len(txtBlock)
            findTHEO = InStr(txtBlock, "THEO") - 1

            ' Eliminate text before THEO and after. Results THEO/<X,Y,Z>
            txtBlock = Right(txtBlock, lastChr - findTHEO)
            findChr = InStr(txtBlock, ">,<")
            txtBlock = Left(txtBlock, findChr)

            ' Strip the block of text down to X,Y,Z
            txtBlock = Replace(txtBlock, "THEO/", "")
            txtBlock = Replace(txtBlock, "<", "")
            txtBlock = Replace(txtBlock, ">", "")

            firstComma = InStr(txtBlock, ",")
            secondComma = InStrRev(txtBlock, ",")

            MSG = "feature ID = " & FeatureList(fcntr)

            TX = Mid(txtBlock, 1, firstComma - 1)
            TY = Mid(txtBlock, firstComma + 1, (secondComma - firstComma) - 1)
            TZ = Mid(txtBlock, secondComma + 1, lastChr)

            NewTX = TX & "+0"
            NewTY = TY & "+0"
            NewTZ = TZ & "+0"

            MSG = MSG & Chr(10) & Chr(10) & "XTheo = " & TX
            MSG = MSG & Chr(10) & Chr(10) & "YTheo = " & TY
            MSG = MSG & Chr(10) & Chr(10) & "ZTheo = " & TZ
            MSG = MSG & Chr(10) & Chr(10) & "NewXTheo = " & NewTX
            MSG = MSG & Chr(10) & Chr(10) & "NewYTheo = " & NewTY
            MSG = MSG & Chr(10) & Chr(10) & "NewZTheo = " & NewTZ

            MsgBox MSG

        End If
    End If
Next cmd

Set PCDApp = Nothing
Set PCDPartPrograms = Nothing
Set PCDPartProgram = Nothing

End Sub

Still trying to figure out which functions don't work in PcDmis script editor chingaderas...

UPDATE:
Yep sorry will try again tomorrow if I get a little time. There is no "Replace" Function so will have to come up with a different approach on how to eliminate unwanted characters.

Try it in Excel works like a charm!

Reply

Kp61dude! over 7 years ago

This is what VBA looks like:

Option Explicit
Sub GetTheos()
' Post: http://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/411735-vb-script-using-puttext-to-enter-an-expression

Dim PCDApp As PCDLRN.Application
Dim PCDPartPrograms As PCDLRN.PartPrograms
Dim PCDPartProgram As PCDLRN.PartProgram
Dim PCDCommands As PCDLRN.Commands
Dim cmd As PCDLRN.Command
Dim editWin As PCDLRN.EditWindow

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
Set editWin = PCDPartProgram.EditWindow

Dim fcntr As Integer
Dim FeatureList$(99999)
Dim TX, TY, TZ, NewTX, NewTY, NewTZ, txtBlock, txtBlockTmp, MSG As String
Dim lastChr, findTHEO, findChr, firstComma, secondComma As Integer

fcntr = 0

For Each cmd In PCDCommands
    If cmd.IsDCCFeature Or cmd.IsMeasuredFeature Then
        If cmd.Marked Then

            FeatureList(fcntr) = cmd.ID

            ' Eliminate spaces and linefeeds
            txtBlock = editWin.GetCommandText(cmd)
            txtBlock = Replace(txtBlock, " ", "")
            txtBlock = Replace(txtBlock, vbCr, "")
            txtBlock = Replace(txtBlock, vbCrLf, "")

            lastChr = Len(txtBlock)
            findTHEO = InStr(txtBlock, "THEO") - 1

            ' Eliminate text before THEO and after. Results THEO/<X,Y,Z>
            txtBlock = Right(txtBlock, lastChr - findTHEO)
            findChr = InStr(txtBlock, ">,<")
            txtBlock = Left(txtBlock, findChr)

            ' Strip the block of text down to X,Y,Z
            txtBlock = Replace(txtBlock, "THEO/", "")
            txtBlock = Replace(txtBlock, "<", "")
            txtBlock = Replace(txtBlock, ">", "")

            firstComma = InStr(txtBlock, ",")
            secondComma = InStrRev(txtBlock, ",")

            MSG = "feature ID = " & FeatureList(fcntr)

            TX = Mid(txtBlock, 1, firstComma - 1)
            TY = Mid(txtBlock, firstComma + 1, (secondComma - firstComma) - 1)
            TZ = Mid(txtBlock, secondComma + 1, lastChr)

            NewTX = TX & "+0"
            NewTY = TY & "+0"
            NewTZ = TZ & "+0"

            MSG = MSG & Chr(10) & Chr(10) & "XTheo = " & TX
            MSG = MSG & Chr(10) & Chr(10) & "YTheo = " & TY
            MSG = MSG & Chr(10) & Chr(10) & "ZTheo = " & TZ
            MSG = MSG & Chr(10) & Chr(10) & "NewXTheo = " & NewTX
            MSG = MSG & Chr(10) & Chr(10) & "NewYTheo = " & NewTY
            MSG = MSG & Chr(10) & Chr(10) & "NewZTheo = " & NewTZ

            MsgBox MSG

        End If
    End If
Next cmd

Set PCDApp = Nothing
Set PCDPartPrograms = Nothing
Set PCDPartProgram = Nothing

End Sub

Children

No Data