Friday, January 22, 2016

VBSCRIPT to localize revit INI settings to current user (Points to MyDocs folders)

Option Explicit
Dim Wscript ''As New objWSCRIPT_Emulator    '' GLOBAL initiated in Main - also For
Debug in Excel
Dim objFSO ''As New FileSystemObject -      '' GLOBAL initiated in MAIN

Dim intTristate ''if file is unicode this variable helpw sith read/write
Const TristateTrue =
-
1
Const TristateFalse =
0
Const ForReading =
1
Const ForWriting =
2
Const ForAppending =
8
   
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Make changes in MainResetUserINI() Subroutine.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MainResetUserINI    ''runs the function to execute the change in the ini

Sub MainResetUserINI()
    Dim objNetwork
    Set objNetwork =
CreateObject(
"Wscript.Network")

    If MsgBox("WARNING: This will change Revit data File paths to
'"
& UCase(objNetwork.UserName)
&
"'s  folders." & _
              vbCr &
_
              vbCr &
_
              "Typically modificatios in clude repathing for the
Project Path, RootFileFor PointClouds, etc. "
& _
              vbCr &
_
              vbCr &
_
              vbCr &
_
              "Once run this cannot be undone - Continue?", _
              
vbYesNo + vbExclamation, _
              "Revit localize Reference Folders To " & objNetwork.UserName & " User Profile") _
              <>
vbYes
Then
              MsgBox
"Exiting- no changes made"
              Exit Sub
              End If
    '''''''''''''''''''''''''
    ''''GLOBAL INITIALIZE''''
    Set Wscript =
CreateObject(
"WScript.Shell")             ''Sets GLOBAL WSCRIPT for use in all functions/subs
    Set objFSO = CreateObject("Scripting.FileSystemObject") ''Sets GLOBAL File System Object for use in all
functions/subs
    ''''GLOBAL INITIALIZE END'''
    ''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''Local Filepath references
    Dim strREVITlocalProjectPath                            ''local destination for 'local' project files
    Dim fpRevitINI                                          ''Revit INI file location

        ''Revit INI location- can be reset to scan for multiple versions
(2015, 2016, etc)
        fpRevitINI =
Wscript.ExpandEnvironmentStrings(
"%APPDATA%") & "\Autodesk\Revit\Autodesk Revit 2016\Revit.ini"
       
        ''Set local project path relative to User's
"MyDocuments"
       
strREVITlocalProjectPath = Wscript.SpecialFolders(
"MyDocuments") & "\Revit\Revit_LOCAL_PROJ\"
       
        ''Reset [directiories] ProjectPath
        WriteIni
fpRevitINI,
"Directories", "ProjectPath", strREVITlocalProjectPath
        ''Reset [directiories] RootPathForPointClouds
        WriteIni
fpRevitINI,
"Directories", "RootPathForPointClouds",
strREVITlocalProjectPath
   
    Set objFSO = Nothing
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    MsgBox "completed changes. Plesae re-open Revit to see
changes."
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''DO NOT EDIT BELOW THIS LINE- MAKE CHANGES IN
MainResetUserINI''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Begin INI reading code matrix
''Probably don't need to edit anything below this line
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Borrowed from:
'''http://www.robvanderwoude.com/vbstech_files_ini.php
''Ron E. Allen added functions for unicode INI files 2016
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ReadIni(myFilePath,
mySection, myKey)
    ' This function returns a value read from an INI file
    '
    ' Arguments:
    ' myFilePath 
[string]  the (path and) file name
of the INI file
    ' mySection  
[string]  the section in the INI
file to be searched
    ' myKey      
[string]  the key whose value is
to be returned
    '
    ' Returns:
    ' the [string] value for the specified key in the
specified section
    '
    ' CAVEAT:     Will
return a space if key exists but value is blank
    '
    ' Written by Keith Lacelle
    ' Modified by Denis St-Pierre and Rob van der Woude And
Ron E. Allen

    Dim intEqualPos
    Dim ObjIniFile
    Dim strFilePath, strKey,
strLeftString, strLine, strSection

    ReadIni =
""
    strFilePath =
Trim(myFilePath)
    strSection =
Trim(mySection)
    strKey =
Trim(myKey)

    If objFSO.FileExists(strFilePath)
Then

       
CheckSetUnicode (strFilePath)
       
        Set ObjIniFile =
objFSO.OpenTextFile(strFilePath, ForReading,
False, intTristate) ''tristatetrue
opens unicode file tristatefalse opens as ascII which may add nulls between
characters
       
        Do While
ObjIniFile.AtEndOfStream =
False
            strLine =
Trim(ObjIniFile.ReadLine)

            ' Check if section is found in the current line
            If LCase(strLine)
=
"[" & LCase(strSection) &
"]" Then
               
strLine = Trim(ObjIniFile.ReadLine)

                ' Parse lines until the next section is reached
                Do While Left(strLine,
1) <> "["
                    ' Find position of equal sign in the line
                   
intEqualPos = InStr(
1, strLine,
"=", 1)
                    If intEqualPos > 0 Then
                       
strLeftString = Trim(Left(strLine, intEqualPos
-
1))
                       
' Check if item is found in
the current line
                       
If LCase(strLeftString) = LCase(strKey)
Then
                           
ReadIni = Trim(
Mid(strLine,
intEqualPos +
1))
                           
' In case the item exists but
value is blank
                           
If ReadIni = "" Then
                                ReadIni =
" "
                           
End If
                           
' Abort loop when item is
found
                           
Exit Do
                       
End If
                    End If

                    ' Abort if the end of the INI file is reached
                    If ObjIniFile.AtEndOfStream Then Exit Do

                    ' Continue with next line
                   
strLine = Trim(ObjIniFile.ReadLine)
                Loop
            Exit Do
            End If
        Loop
       
ObjIniFile.Close
    Else
        Wscript.Echo
strFilePath &
" doesn't exists.
Exiting..."
        Wscript.quit
1
    End If
End Function

Sub WriteIni(myFilePath,
mySection, myKey, myValue)
    ' This subroutine writes a value to an INI file
    '
    ' Arguments:
    ' myFilePath 
[string]  the (path and) file name
of the INI file
    ' mySection  
[string]  the section in the INI
file to be searched
    ' myKey      
[string]  the key whose value is
to be written
    ' myValue    
[string]  the value to be written
(myKey will be
    '                      
deleted if myValue is <DELETE_THIS_VALUE>)
    '
    ' Returns:
    ' N/A
    '
    ' CAVEAT:    
WriteIni function needs ReadIni function to run
    '
    ' Written by Keith Lacelle
    ' Modified by Denis St-Pierre, Johan Pol and Rob van der
Woude

    Const ForReading =
1
    Const ForWriting =
2
    Const ForAppending =
8

    Dim blnInSection,
blnKeyExists, blnSectionExists, blnWritten
    Dim intEqualPos
    Dim objNewIni, objOrgIni,
wshShell
    Dim strFilePath,
strFolderPath, strKey, strLeftString
    Dim strLine, strSection,
strTempDir, strTempFile, strValue

    strFilePath =
Trim(myFilePath)
    strSection =
Trim(mySection)
    strKey =
Trim(myKey)
    strValue =
Trim(myValue)

    Set wshShell =
CreateObject(
"WScript.Shell")

    strTempDir =
wshShell.ExpandEnvironmentStrings(
"%TEMP%")
    strTempFile =
objFSO.BuildPath(strTempDir, objFSO.GetTempName)

   
    CheckSetUnicode (strFilePath)
   
    Set objOrgIni =
objFSO.OpenTextFile(strFilePath, ForReading,
True, intTristate)
   
    If objFSO.FileExists(strTempFile)
Then
objFSO.DeleteFile strTempFile
   
    Set objNewIni =
objFSO.CreateTextFile(strTempFile,
False, intTristate)
    blnInSection =
False
    blnSectionExists
=
False
    ' Check if the specified key already exists
    blnKeyExists =
(ReadIni(strFilePath, strSection, strKey) <>
"")
    blnWritten =
False

    ' Check if path to INI file exists, quit if not
    strFolderPath =
Mid(strFilePath, 1, InStrRev(strFilePath,
"\"))
    If Not objFSO.FolderExists(strFolderPath)
Then
        Wscript.Echo
"Error: WriteIni failed, folder path
("
_
                   &
strFolderPath &
") to ini
file "
_
                   &
strFilePath &
" not found!"
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Wscript.quit
1
    End If

    While
objOrgIni.AtEndOfStream =
False
        strLine =
Trim(objOrgIni.ReadLine)
        If blnWritten = False Then
            If LCase(strLine)
=
"[" & LCase(strSection) &
"]" Then
               
blnSectionExists =
True
               
blnInSection =
True
            ElseIf InStr(strLine,
"[") = 1 Then
               
blnInSection =
False
            End If
        End If

        If blnInSection Then
            If blnKeyExists Then
               
intEqualPos = InStr(
1, strLine,
"=", vbTextCompare)
                If intEqualPos > 0 Then
                   
strLeftString = Trim(Left(strLine,
intEqualPos -
1))
                    If LCase(strLeftString)
= LCase(strKey)
Then
                        ' Only write the key if the value isn't empty
                       
' Modification by Johan Pol
                       
If strValue <> "<DELETE_THIS_VALUE>" Then
                           
objNewIni.WriteLine strKey &
"=" & strValue
                       
End If
                       
blnWritten =
True
                       
blnInSection =
False
                    End If
                End If
                If Not blnWritten Then
                   
objNewIni.WriteLine strLine
                End If
            Else
               
objNewIni.WriteLine strLine
                    ' Only write the key if the value isn't empty
                    ' Modification by Johan Pol
                    If strValue <> "<DELETE_THIS_VALUE>" Then
                       
objNewIni.WriteLine strKey &
"=" & strValue
                    End If
               
blnWritten =
True
               
blnInSection =
False
            End If
        Else
           
objNewIni.WriteLine strLine
        End If
    Wend

    If blnSectionExists = False Then ' section doesn't exist
       
objNewIni.WriteLine
       
objNewIni.WriteLine
"[" & strSection & "]"
            ' Only write the key if the value isn't empty
            ' Modification by Johan Pol
            If strValue <> "<DELETE_THIS_VALUE>" Then
               
objNewIni.WriteLine strKey &
"=" & strValue
            End If
    End If

    objOrgIni.Close
    objNewIni.Close

    ' Delete old INI file
   
objFSO.DeleteFile strFilePath,
True
    ' Rename new INI file
    objFSO.MoveFile
strTempFile, strFilePath

    Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set wshShell = Nothing
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Ron Allen Functions

Function IsUnicode(strFilePath)
''As Boolean

    ''Set objFSO =
CreateObject("Scripting.FileSystemObject") ''create fso
    Dim ObjTestFile

    Set ObjTestFile =
objFSO.OpenTextFile(strFilePath, ForReading,
False)
        Dim char1, char2
            char1 =
ObjTestFile.Read(
1)
            char2 =
ObjTestFile.Read(
1)
            If Asc(char1) =
255 And Asc(char2) = 254 Then IsUnicode = True
           
           
ObjTestFile.Close
            ''Set objFSO = Nothing
End Function

Function
CheckSetUnicode(strFilePath)
        If IsUnicode(strFilePath)
Then
           
intTristate = TristateTrue
            Else
           
intTristate = TristateFalse
        End If
    CheckSetUnicode =
intTristate
End Function