mans.joling

This script does not work inside Visual Studio 2005 why

Discussion created by mans.joling on Jul 26, 2010
Latest reply on Jul 26, 2010 by mans.joling

Hi,

 

I have this script when I do open script form in Expedition and do F5 it works fine.

When I do mgcscript thisscript.vbs I get epcbSelectPlaced not defined.

When I take the scriptrunner and run him with this script on commandline it works fine.

When I make a executable from this script and I run  thisscript.exe on commandline it does not work

In Visual Studio 2005 I have this piece of code and it won't work.

Can somebody help me so that I can run this script inside Visual studio 2005.

The reason for all of my discussions are that I try to make a new output program whitout using HKP

 

Public Sub Test()
        Dim myProcess As New Process()
        Dim I As Integer
        Dim plc As String
        Try                ' Get the path that stores user documents.

 

            myProcess.StartInfo.UseShellExecute = True
            ' You can start any process, HelloWorld is a do-nothing example.
           myProcess.StartInfo.FileName = "thisscript.exe" this does not work
            myProcess.StartInfo.CreateNoWindow = False
            myProcess.Start()
            ' This code assumes the process you are starting will terminate itself.
            ' Given that is is started without a window so you cannot terminate it
            ' on the desktop, it must terminate itself or you can do it programmatically
            ' from this application using the Kill method.
        Catch e As Exception
            Console.WriteLine((e.Message))
        End Try
       Sleep(3000) Gives a Pinvoke exception
        Do
            I = ProcessesRunning("MGCPCBScriptRunner.exe")
            MsgBox(I)
        Loop Until I = 0

 

    End Sub

 

Option Explicit    
' Add any type libraries to be used.
Scripting.AddTypeLibrary("MGCPCB.ExpeditionPCBApplication")

 

' Global variables
Dim pcbAppObj                'Application object
Dim pcbDoc                'Document object
Dim excelAppObj              'Excel application
Dim RefdesInt
Dim rowInt
Dim GlobalNMarray(128)
Dim NMarray(512)
Dim arrTemp
Dim strTemp,strTextFile,OutputFileName,strNotMountedFile
Dim Proj
Dim ProjPcbPath
Dim ProjPath

 

' output not in nice columns
' Get the application object.
Set pcbAppObj = Application
strTextFile = "V:\Programs\Ttmg_2005\GlobalNm.txt"
' Get the active document
Set pcbDoc = pcbAppObj.ActiveDocument

 

' License the document
ValidateServer(pcbDoc)
RefdesInt = 1000   
    Proj = Projectfile(pcbDoc)
    ProjPcbPath=ProjectPcbPath (pcbdoc)
    ProjPath=ProjectPath (pcbdoc)
' Create the excel applicatoin
strNotMountedFile =ProjPcbPath &"Vbreport\Output\nm.txt"
ReadingGlbalNmFile
ReadNotMountedFile
pcbAppObj.LockServer ' Lock the server for blinding speed.
OutputFileName = ProjPath & "Carca\lst\"&proj&"plc"
Dim fso
Dim sPath

 

Set fso = CreateObject("Scripting.FileSystemObject")
Dim f
Set f = fso.CreateTextFile(OutputFileName, True)
  
' Load excel
Call LoadExcel()
If FileExists ("V:\Programs\Dos_programs\Dos2Unix.exe") = 1 Then
DosTounix OutputFileName
Else
msgBox("Program V:\Programs\Dos_programs\Dos2Unix.exe not foun (exit)")
End If

 

' Hang around to listen to events
Scripting.DontExit = True
pcbAppObj.UnlockServer
'******************************************************************************
Sub DeleteFile(file)
Dim FSO,aFile
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists (file) Then
Set afile = FSO.Getfile (file)
aFile.Delete
Else
'Msgbox("File " &File &" for deleting not found")
ErrorCode = 1
Exit Sub
End If
End Sub
'******************************************************************************
Sub DeleteFolder(aFolder)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists (aFolder) Then
Set afolder = FSO.Getfolder (aFolder)
aFolder.Delete
Else
Msgbox("Directory " &aFolder &" for deleting not found")
ErrorCode = 1
Exit Sub
End If
End Sub
'******************************************************************************
Sub RenameFile(file,Dest)
Dim FSO,aFile
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists (file) Then
Set afile = FSO.Getfile (file)
aFile.Move(Dest)
Else
Msgbox("File " &File &" for renaming not found")
ErrorCode = 1
Exit Sub
End If
End Sub
'******************************************************************************
Function FileExists(file)
Dim FSO,aFile
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists (file) Then
FileExists = 1
Else
FileExists = 0
End if
End Function
'******************************************************************************
Function DosTounix(file)
Dim FSO,aFile,WshShell
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists (file) Then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "V:\Programs\Dos_programs\Dos2Unix.exe File File"
Else
Msgbox("Plc List " &File &"Not found")
ErrorCode = 1
Exit Function
End if
End Function
'******************************************************************************
Function ProjectPath (doc)
    Dim sTmp,sTemp,StartPos,MyLen,StrPos
     sTmp= doc.FullName
     StrPos = Instr(sTmp, "PCB\")
     sTemp = left(sTmp,StrPos -1)
     ProjectPath = sTemp
End Function
'******************************************************************************
Sub ReadNotMountedFile
Dim FSO,  strData, strLine, sLine,I
Dim FP
I = 0
'Create a File System Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists (strTextFile) Then
Set FP = FSO.OpenTextFile(strNotMountedFile)
Do While Not FP.AtEndOfStream
   sLine = Trim(FP.ReadLine)
nmArray(I) = sLine
I = I + 1
Loop
FP.Close
Else
Msgbox("Not Mounted File "&strNotMountedFile & "Not found")
ErrorCode = 1
Exit sub
End if
'Cleanup
Set FSO = Nothing
End Sub
'******************************************************************************
Sub ReadingGlbalNmFile
Dim FSO,  strData, strLine, sLine,I
Dim FP
I = 0
'Create a File System Object
Set FSO = CreateObject("Scripting.FileSystemObject")

 

Set FP = FSO.OpenTextFile(strTextFile)
If FSO.FileExists (strTextFile) Then
Do While Not FP.AtEndOfStream
   sLine = Trim(FP.ReadLine)
'   msgbox(sline)
GlobalnmArray(I) = sLine
I = I + 1
Loop
FP.Close
Else
Msgbox("Global Not Mounted File "&strTextFile & "Not found")
ErrorCode = 1
Exit sub
End if
Set FSO = Nothing
End Sub
'******************************************************************************
Sub AddComponent(cmpObj)
Dim Smd,iSide,iRefdes,cmp,cmps,iLayer,sLabel,N,I
Dim sName,iFound,sPartnumber,sRefdes,iMech,iMFound,sComponentname,iPart,sRotation
Dim iPosX,iPosY
iMFound = 0
iFound = 0
Imech = 0
iPart = 0
    sComponentname = cmpObj.Name
    If len(cmpObj.Name) > 0 Then
    sRefdes = cmpObj.Name
    iPart = 1
    End If
    If len(cmpObj.Name) <= 0 Then
    RefdesInt = RefdesInt +1
    iMech = 1
    sComponentname = RefdesInt
    End If
    sPartnumber = cmpObj.PartNumber
    For I = 0 To 127 Step 1
    sName = GlobalNMarray(I)
    If sName = sPartNumber Then
'    msgbox(sName& "   "&sPartNumber )
    iMFound = 1
    End if
    Next
    For N = 0 To 511 Step 1
    sName = NMarray(N)
'    msgbox(sName)
    If sName = sRefdes Then
    iFound = 1
    End if
    Next
    iSide = cmpObj.Side
    If iSide = "1" Then
    iLayer  = 2
    End If
    iSide = cmpObj.Side
    If iSide = "512" Then
    iLayer  = 1   
    End If
    Smd = cmpObj.IsSMD()
    If Smd = "True"  Then
    sLabel = "S"
    End If
    If Smd = "False"   Then
    sLabel = "W"
    End If
    If len(cmpObj.Name) = 0 Then
    sLabel = "W"
    End If
    IposX = cmpObj.PositionX
    IposY = cmpObj.PositionY
    IposX = FormatNumber (IposX ,2)
    IposY = FormatNumber (IposY ,2)
'==============================================================================
    If len(sRefdes) > 0 And ifound = 0 Then
    f.WriteLine (sComponentname &"   "&sPartnumber&"   "&cmpObj.Cellname&"   "&sRotation&"   "&iLayer&"   "&IposX&"   "&IposY&"   "&sLabel)
    End If
    If len(sRefdes) > 0 And ifound = 1 Then
    f.WriteLine (sComponentname&"   "&"NM   "&cmpObj.Cellname&"   "&sRotation&"   "&iLayer&"   "&IposX&"   "&IposY&"   "&sLabel)
    End If
    If Imech = 1  And Imfound = 0 Then
    f.WriteLine (sComponentname &"   "&sPartnumber&"   "&cmpObj.Cellname&"   "&sRotation&"   "&iLayer&"   "&IposX&"   "&IposY&"   "&sLabel)
    End If
End Sub
'******************************************************************************
Sub LoadExcel()
    ' Create a workbook
    ' Get the first sheet
    Dim cmpCollm
    Set cmpCollm = pcbDoc.Components(epcbSelectPlaced, epcbCompGeneral, epcbCelltypeMechanical)
   
    ' Sort the component collection
    Call cmpCollm.Sort()
   
    ' Add the collection
    Call AddComponents(cmpCollm)
    ' Get the components
    Dim cmpColl
    Set cmpColl = pcbDoc.Components(epcbSelectPlaced)
    ' Sort the component collection
    Call cmpColl.Sort()
   
    ' Add the collection
    Call AddComponents(cmpColl)
End Sub

 

'******************************************************************************
Sub AddComponents(cmpColl)
    Dim cmpObj
    For Each cmpObj In cmpColl
        Call AddComponent(cmpObj)
    Next   
End Sub
'******************************************************************************
Function Projectfile (doc)
    Dim sTmp,sTemp,StartPos,CharCount,MyLen,StrPos
     sTmp= doc.FullName
     StrPos = Instr(sTmp, "\PCB\")
     MyLen=Len(sTmp)
     If MyLen = 43 Then
     StartPos = StrPos + 5
     CharCount = 9
     sTemp = Mid(sTmp,StartPos,CharCount)
     Projectfile = sTemp
'     MsgBox(sTemp)
    End If
End Function
'************************************************************************
Function ProjectPcbPath (doc)
    Dim sTmp,sTemp,StartPos,MyLen,StrPos
     sTmp= doc.FullName
     StrPos = Instr(sTmp, "\PCB\")
     MyLen=Len(sTmp)
     If MyLen = 43 Then
     StartPos = StrPos + 4
     sTemp = Mid(sTmp,1,StartPos)
     ProjectPcbPath = sTemp
'     MsgBox(sTemp)
    End If
End Function
'************************************************************************
' Validate server function
Private Function ValidateServer(doc)
   
    Dim key, licenseServer, licenseToken

 

    ' Ask Expedition’s document for the key
    key = doc.Validate(0)

 

    ' Get license server
    Set licenseServer = CreateObject("MGCPCBAutomationLicensing.Application")

 

    ' Ask the license server for the license token
    licenseToken = licenseServer.GetToken(key)

 

    ' Release license server
    Set licenseServer = nothing

 

    ' Turn off error messages.  Validate may fail if the token is incorrect
    On Error Resume Next
    Err.Clear

 

    ' Ask the document to validate the license token
    doc.Validate(licenseToken)
    If Err Then
        ValidateServer = 0   
    Else
        ValidateServer = 1
    End If

 

End Function

Outcomes