Wednesday, February 24, 2016

TABLE FORMAT v2.0

Table Format V2.0



Option Explicit

Sub Table_Format_bottom_right()
    Dim objTable As Table
    Dim I As Integer
    
    Set objTable = Selection.Tables(1)
    
    With objTable
        ''format colors
        For I = objTable.Columns.Count To 1 Step -1
            ''Shading
            ShadeMod .Columns(I), I
            ShadeMod .Rows(I), I
            
            ''borders
            BDR_NONE objTable.Columns(I).Borders(wdBorderHorizontal)

            BDR_NONE objTable.Rows(I).Borders(wdBorderVertical)

            BDR_Single objTable.Columns(I).Borders(wdBorderLeft)

            BDR_Single objTable.Rows(I).Borders(wdBorderTop)

        Next I
        

        I = objTable.Rows.Count
        'objTable.Columns(I).Borders(wdBorderVertical).LineStyle = wdLineStyleDashSmallGap
        BDR_Dash objTable.Rows(objTable.Rows.Count).Borders(wdBorderVertical)
        
        BDR_Double objTable.Rows(objTable.Rows.Count).Borders(wdBorderTop)
        
        BDR_Thin objTable.Columns(objTable.Columns.Count).Borders(wdBorderLeft)
        
        For I = -4 To -1
            BDR_Thick objTable.Borders(I)
        Next I
        
        With objTable
            With .Rows(objTable.Rows.Count)   ''last row
                ''''.Alignment = wdAlignRowCenter ''screws up table row centering it in the page- shifting it from the rest of table.
                With .Range
                    .ParagraphFormat.Alignment = wdAlignParagraphCenter
                    .Cells.VerticalAlignment = wdCellAlignVerticalTop
                    .Font.Bold = True
                End With
            End With
            objTable.Cell(.Rows.Count, .Columns.Count).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
        End With
        TableInsertCaption
    End With
End Sub
Sub ShadeMod(ObjVar As Variant, I As Integer)
    ObjVar.Shading.BackgroundPatternColor = ModColor(I)
End Sub

Public Sub TableInsertCaption(Optional objTable As Table)
    On Error Resume Next
    
    If objTable Is Nothing Then Set objTable = Selection.Tables(1)
    If objTable Is Nothing Then
        MsgBox "Please select a table first.", vbExclamation, "Error"
        Exit Sub
     End If
            
        
        objTable.Range.InsertCaption _
            Label:=wdCaptionTable, _
            Position:=wdCaptionPositionAbove
End Sub

Sub BDR_NONE(Bdr As Border) ''clear borders
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth100pt
        .LineStyle = wdLineStyleNone
    End With
End Sub

Sub BDR_Single(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth100pt
    End With
End Sub

Sub BDR_Thin(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth025pt
    End With
End Sub

Sub BDR_Dash(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleDashLargeGap
        .LineWidth = wdLineWidth025pt
    End With
End Sub

Sub BDR_Thick(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth150pt
    End With
End Sub
Sub BDR_Double(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleDouble
        ''.LineWidth = wdLineWidth100pt  '' no line width for complex line styles
    End With
End Sub

Function ModColor(I As Integer) As Long
Dim Colors As New Collection
    ''add colors for order of rotation
        Colors.Add -603914241   ''white
        Colors.Add -603923969   ''gray
        Colors.Add -721354957   ''light purple

ModColor = Colors.Item((I Mod Colors.Count) + 1)

End Function

Tuesday, February 2, 2016

Outlook add headers and tags for project IDs


Sub AddHeader(m As Outlook.MailItem, strProjectNumber As String)
'Dim m As Outlook.MailItem
    Dim pa As Outlook.PropertyAccessor
    Dim myOlFormat As Integer
    myOlFormat = m.BodyFormat
    m.BodyFormat = olFormatUnspecified
    'Set m = Application.CreateItem(olMailItem)
    'm.Body = m.Subject
    Set pa = m.PropertyAccessor
    pa.SetProperty "http://schemas.microsoft.com/mapi/string/{00020386-0000-0000-C000-000000000046}/X-MS-Exchange-Organization-AECOM-Project", strProjectNumber
    Select Case myOlFormat
        Case olFormatHTML
            m.HTMLBody = m.HTMLBody & vbCr & "[X-MS-Exchange-Organization-AECOM-Project:" & strProjectNumber & "]"
            m.HTMLBody = m.HTMLBody & vbCr & " & strProjectNumber & "]
"
        Case olFormatPlain, olFormatRichText, olFormatUnspecified
            m.Body = m.Body & vbCr & "[X-MS-Exchange-Organization-AECOM-Project:" & strProjectNumber & "]"
    End Select
End Sub

Monday, February 1, 2016

Revit Split and reorganize content for implementation in Library content by revit version.

''outline version of VBS from CMS file below
''Takes default Revit library and splits it into metric, Imperial and reorganizes IES files and similar to more logical locations.
Option Explicit
'''''''''''''''''
''Dim Wscript As New objWSCRIPT_Emulator
''main
'''''''''''''''''
Const VBQT = """"
Sub main()

    ''take path from drag and drop
    ''  e.g. ObjArgs(=) should be C:\ProgramData\Autodesk\RVT 2015
    ''  Set it as the source path
    ''
    Dim ObjArgs
    Dim i
    ''for drag-n-drop
    Set ObjArgs = Wscript.Arguments ''
    For i = 0 To ObjArgs.count - 1  ''
       Wscript.Echo ObjArgs(i)      ''
    Next
End Sub

Sub SplitRevitLibrary()
    ''use src path
        ''determine if the target folders are where they should be
End Sub

Sub Xcopy(strSource As String, strDest As String)
    Dim strLogFilename
    strLogFilename = " /LOG+:C:\temp\RVT_%version%_SPLIT.txt "
    strSource = " " & VBQT & strSource & VBQT & " "
    strDest = " " & VBQT & strDest & VBQT & " "
    ''wscript.ObjShell.Run ("c:\windows\system32\robocopy.exe " & strSource & strDest & " /e /Z /DCOPY:T /MT:8 /XO /IT /XJ /FFT /DST /XJD /XJF /R:0 /TBD /TEE" & strLogFilename)
End Sub

'@echo off
'Rem file-folder path for drag and drop
'Set source=%~1
'echo %source%'
'
'Rem set source=C:\ProgramData\Autodesk\RVT 2015
'Echo
'Set Version = 2015
'set NewPath=C:\ProgramData\Autodesk
'Echo
'set USImperial=%newpath%\RVT-[client]-I(US)-%Version%
'set USMetric=%newpath%\RVT-[client]-M(US)-%Version%
'set CANMetric=%newpath%\RVT-[client]-M(CAN)-%Version%
'
'Set RoboPrefs=/e /Z /DCOPY:T /MT:8 /XO /IT /XJ /FFT /DST /XJD /XJF /R:0 /TBD /LOG+:%newpath%\RVT_%version%_SPLIT.txt /TEE
'Rem --SET COPY  English Templates (US)
'set Src=%source%\Family Templates\English_I\
'set Dest=%USImperial%\Family_Templates
'robocopy "%Src%" "%Dest%" %RoboPrefs%
'
'Rem --SET COPY **METRIC TEMPLATES**
'set Src=%source%\Family Templates\English\
'set Dest=%USMetric%\Family_Templates
'robocopy "%Src%" "%dest%" %RoboPrefs%
'set Dest=%CANMetric%\Family_Templates
'robocopy "%Src%" "%dest%" %RoboPrefs%'

'Rem --SET COPY IES For Metric & Imperial
'set Src=%source%\ies\
'set Dest=%USImperial%\Libraries\Lighting\IES
'robocopy "%Src%" "%dest%" %RoboPrefs%
'set Dest=%CANmetric%\Libraries\Lighting\IES
'robocopy "%Src%" "%dest%" %RoboPrefs%


'Rem --SET COPY Imperial Library<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'set Src=%source%\Libraries\US Imperial
'set Dest=%USImperial%\Libraries
'robocopy "%Src%" "%dest%" %RoboPrefs%'

'Rem --SET COPY US Metric Libraries<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'set Src=%source%\Libraries\US Metric
'set Dest=%USmetric%\Libraries
'robocopy "%Src%" "%dest%"  %RoboPrefs%

'Rem --SET COPY CAN METRIC LIBRARIES
'set Src=%source%\Libraries\Canada
'set Dest=%CANmetric%\Libraries\
'robocopy "%Src%" "%dest%" %RoboPrefs%

'Rem --SET COPY CONDUIT TABLES - Metric & Imperial
'set Src=%source%\Lookup Tables\Conduit
'set Dest=%USImperial%\Libraries\Conduit\Lookup_Conduit
'robocopy "%Src%" "%dest%" %RoboPrefs%
'set Dest=%USMetric%\Libraries\Conduit\Lookup_Conduit
'robocopy "%Src%" "%dest%" %RoboPrefs%
'set Dest=%CANmetric%\Libraries\Conduit\Lookup_Conduit
'robocopy "%Src%" "%dest%" %RoboPrefs%

'Rem --SET COPY Metric & Imperial
'set Src=%source%\Lookup Tables\Pipe
'set Dest=%USImperial%\Libraries\PIPE\Lookup_Pipe
'robocopy "%Src%" "%dest%" %RoboPrefs%
'set Dest=%USMetric%\Libraries\PIPE\Lookup_Pipe
'robocopy "%Src%" "%dest%" %RoboPrefs%
'set Dest=%CANmetric%\Libraries\PIPE\Lookup_Pipe
'robocopy "%Src%" "%dest%" %RoboPrefs%

'Rem --SET COPY Project Templates
'set Src=%source%\Templates\US Imperial
'set Dest=%USImperial%\Project_Templates
'robocopy "%Src%" "%dest%" %RoboPrefs%'

'set Src=%source%\Templates\US Metric
'set Dest=%USMetric%\Project_Templates
'robocopy "%Src%" "%dest%" %RoboPrefs%

'set Src=%source%\Templates\Canada
'set Dest=%CANMetric%\Project_Templates
'robocopy "%Src%" "%dest%" %RoboPrefs%

'Rem --SET COPY Dictionaries
'set Src=%source%
'set Dest=%USImperial%
'robocopy "%Src%" "%dest%"  revitEN?.dic
'set Dest=%USMetric%
'robocopy "%Src%" "%dest%"  revitEN?.dic
'set Dest=%CANMetric%
'robocopy "%Src%" "%dest%"  revitEN?.dic




'pause