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






Comments

Post a Comment

Popular posts from this blog

Powerpoint countdown and current time in slides VBA

Add text fields- this VBA searches through the objects in the first frame until it finds " " in the text some where, truncates everything from and to the right and replaces it with an active countdown timer or current time in the box. Refreshes every 500ms with a prtsafe call so it doesn't bog down the CPU. Add a slide advance to start the next slide and begin automated slide advancement. Attribute VB_Name = "Countdown" Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long Public Sub Wait ( Seconds As Double ) ''non cpu-intensive wait timer '' https://stackoverflow.com/questions/57268161/sleep-wait-timer-in-powerpoint-vba-thats-not-cpu-intensive Dim endtime As Double endtime = DateTime.Timer + Seconds Do WaitMessage DoEvents Loop While DateTime.Timer < endtime End Sub Sub Countdown_from_Start () Dim Time As Date Dim Count As ...
Read more

Revit area plans adding new types and references (Gross and rentable)

Image
Note to self: Add additional (duplicate) gross area and net area schemed under Area Plans And Area schemes... Really counter-intuitive place to put this instead of say...  Area Plans> New Type> Edit Type (ADD) or Create an area plan, then Go to Properties, Edit Type and Duplicate... Always seem to forget this one! 2015-10-16-And for the calculation type... To update: this also applies to Revit as well as LT- The gross calculations cannot be overridden, however the 'rentable' comes in various flavors... From AD Revit help: Applies to Revit LT 2015 Rules are determined by one type of space bordering another space. The following table shows area measurement rules. To find the appropriate measurement rule, find the selected Area Type and the corresponding Bordering Area Type. Gross Building Area Scheme Types Gross Building Area Scheme Types Area Type Selected Bordering Area Type Measurement Rule Gross Building Area Gross Buil...
Read more