Tuesday, July 19, 2016

Zebedee SLAM

http://www.csiro.au/en/Research/D61/Areas/Robotics-and-autonomous-systems/Sensing-and-mapping-our-environment/Zebedee

Creascan

http://www.creaform3d.com/pulp/metrascan-3d-scanner/

Go slam for interior mapping

http://www.3dlasermapping.com/zeb1/

Wednesday, July 13, 2016

La Ruina Habitada (Porquera de los Infantes (Palencia), in Spain)

http://homeworlddesign.com/la-ruina-habitada-jesus-castillo-oli/

La Ruina Habitada is located in the town of Porquera de los Infantes (Palencia), in the region of Valdivia, Spain, historically known for being the home of the parents of Pedro de Valdivia who discovered Chile.

Project energyplus cloud graduated to insight 360

http://labs.blogs.com/its_alive_in_the_lab/2016/07/project-energyplus-cloud-to-graduate-to-insight-360.html

Autodesk energy plus about to be part of A360

https://energyplus.net/

Revit Import/Export for families- name this the same as the family(with a .txt not rvt extension) for creating an excel based family library manager!

Sub AddReferences()
''---------------------------------------------------------------------------------------------------------------------------------
'' REFERENCES CURRENTLY AVAILABLE:
AddReferenceGUID ("{000204EF-0000-0000-C000-000000000046}") ''VBA                              C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL
AddReferenceGUID ("{00020813-0000-0000-C000-000000000046}") ''Excel                            C:\Program Files\Microsoft Office\Office14\EXCEL.EXE
AddReferenceGUID ("{0D452EE1-E08F-101A-852E-02608C4D0BB4}") ''MSForms                          C:\Windows\system32\FM20.DLL
AddReferenceGUID ("{420B2830-E718-11CF-893D-00A0C9054228}") ''Scripting                        C:\Windows\system32\scrrun.dll
AddReferenceGUID ("{F935DC20-1CF0-11D0-ADB9-00C04FD58A0B}") ''IWshRuntimeLibrary               C:\Windows\system32\wshom.ocx
AddReferenceGUID ("{3F4DACA7-160D-11D2-A8E9-00104B365C9F}") ''VBScript_RegExp_55               C:\Windows\System32\vbscript.dll\3
AddReferenceGUID ("{565783C6-CB41-11D1-8B02-00600806D9B6}") ''WbemScripting                    C:\Windows\system32\wbem\wbemdisp.TLB
AddReferenceGUID ("{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}") ''Office                           C:\Program Files\Common Files\Microsoft Shared\OFFICE14\MSO.DLL
''---------------------------------------------------------------------------------------------------------------------------------
End Sub

Sub REVIT_SAVE_TO_CSV_TXT_FILE()
'
' SAVE_TO_CSV_TXT_FILE Macro
'
Dim FN As String
Dim FNtxt As String

    FN = ActiveWorkbook.Name
   
    FN = ReturnMatch(FN, "(.*)\.(xl[smx]{1,2}|txt)")   ''regexp to stroup xl?? or txt from filename
   
    FNtxt = ActiveWorkbook.path & "\" & FN & ".TXT"
    FN = ActiveWorkbook.path & "\" & FN & ".XLSm"
   
    Application.DisplayAlerts = False
   
    ActiveWorkbook.SaveAs _
       Filename:=FNtxt, _
       FileFormat:=xlCSV, _
       CreateBackup:=True, _
       ConflictResolution:=xlLocalSessionChanges, _
       AddToMru:=False
   
    ActiveWorkbook.SaveAs _
       Filename:=FN, _
       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
       CreateBackup:=True, _
       ConflictResolution:=xlLocalSessionChanges, _
       AddToMru:=True
   
    Application.DisplayAlerts = True

End Sub

Sub Revit_Reload_Current()
    Dim FN As String
    Dim I As Integer

    If MsgBox("This will erase everything and relaod the current file- continue?", vbCritical + vbYesNoCancel) <> vbYes Then
        MsgBox "Cancelled."
        Exit Sub
    End If

    ''strip extension
    FN = ThisWorkbook.FullName
    I = Len(FN)
   
    Do While Mid(FN, I, 1) <> "." And I > 0
    I = I - 1
    Loop
   
    I = I - 1
   
    If I = 0 Then
        MsgBox "Error extracting file Name- nothing updated", vbCritical
        Exit Sub
    End If
   
    FN = Left(FN, I) & ".txt"
'
    Range("A1").Select
    With ActiveSheet.QueryTables.add(Connection:= _
        "TEXT;" & FN _
        , Destination:=Range("$A$1"))
        .Name = "acm_LAYOUT"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Sub REVIT_OPEN_TXT()

Dim strFn As String

strFn = Application.GetOpenFilename _
(Title:="Please choose a file to open", _
FileFilter:="TEXT FILES (*.TXT),")

    If LCase(strFn) = "false" Then
       MsgBox "Nothing selected"
       Exit Sub
    End If
OPEN_TXT strFn

End Sub
Sub OPEN_TXT(strFn As String)
Dim wb As Workbook
    Excel.Workbooks.OpenText Filename:=strFn, _
        Origin:=437, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
        Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _
        29, 1), Array(30, 1), Array(31, 1)), TrailingMinusNumbers:=True
   
    wb.Columns("A:BB").EntireColumn.AutoFit
   
    'Do While Len(strFN) > 1 And Right(strFN, 1) <> "\"
    '  strFN = Left(strFN, Len(strFN) - 1)
    'Loop
    'strFN = ActiveWorkbook.Name

strFn = ReturnMatch(strFn, "(.*)\\(.*)\.(xl[smx]{1,2}|txt)", 1)  ''regexp to stroup xl?? or txt from filename

strFn = ActiveWorkbook.path & "\" & strFn & ".XLSX"
ActiveWorkbook.SaveAs Filename:=strFn, FileFormat:=xlCSV, CreateBackup:=True, _
   ConflictResolution:=xlLocalSessionChanges, AddToMru:=False
  
End Sub


Function ReturnMatch(strStr, strMatch, Optional SUBMATCH As Integer)
    ''VBA include Microsoft VBSCript Regular Expressions 5_5
    Dim r 'As New RegExp       ''Regexp engine
    Dim m 'As MatchCollection  ''Return value
    Dim I, X()
    'Dim StrMatch ''as pattern match
    If InStr(1, strMatch, "(") + InStr(1, strMatch, ")") = 0 Then     ''add () for subexpression to return something...
        If Left(strMatch, 1) <> "(" Then strMatch = "(" & strMatch
        If Right(strMatch, 1) <> ")" Then strMatch = strMatch & ")"
    End If
   
    Set r = New regexp
    r.Pattern = strMatch
    r.IgnoreCase = True
   
    Set m = r.Execute(strStr)
   
    ''Regexp os base-o arrays so info rturned starts at (0) not (1)
    On Error Resume Next
    If m.count = 0 Then
        ReturnMatch = ""    ''return null
        Exit Function       ''nomatch
    Else
        ReturnMatch = m(0).SubMatches(SUBMATCH) ''return 1st submatch
    End If
End Function


''================================================================================================================================
''===REFERENCES TOOLS SECTION=====================================================================================================
''================================================================================================================================
''RESOLUTION
''For any Automation client to be able to access the VBA object model programmatically, the user running the code must explicitly
''grant access. To turn on access, the user must follow these steps.
''
''Office 2003 and Office XP
''Open the Office 2003 or Office XP application in question. On the Tools menu, click Macro, and
''then click Security to open the Macro Security dialog box.
''
''On the Trusted Sources tab, click to select the Trust access to Visual Basic Project check box to turn on access.
''Click OK to apply the setting. You may need to restart the application for the code to run properly if you automate from a
''Component Object Model (COM) add-in or template.
''
''Office 2007
''Open the 2007 Microsoft Office system application in question. Click the Microsoft Office button, and then click Application Options.
''Click the Trust Center tab, and then click Trust Center Settings.
''Click the Macro Settings tab, click to select the Trust access to the VBA project object model check box, and then click OK.
''Click OK.
''
''---------------------------------------------------------------------------------------------------------------------------------
'' REFERENCES CURRENTLY AVAILABLE:
'' VBA                 {000204EF-0000-0000-C000-000000000046}     C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL
'' Excel               {00020813-0000-0000-C000-000000000046}     C:\Program Files\Microsoft Office\Office14\EXCEL.EXE
'' stdole              {00020430-0000-0000-C000-000000000046}     C:\Windows\system32\stdole2.tlb
'' Office              {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}     C:\Program Files\Common Files\Microsoft Shared\OFFICE14\MSO.DLL
'' Scripting           {420B2830-E718-11CF-893D-00A0C9054228}     C:\Windows\system32\scrrun.dll
'' IWshRuntimeLibrary  {F935DC20-1CF0-11D0-ADB9-00C04FD58A0B}     C:\Windows\system32\wshom.ocx
''---------------------------------------------------------------------------------------------------------------------------------

Private Sub ListReferencePaths()
    ''http://www.vbaexpress.com/kb/getarticle.php?kb_id=278
     'Macro purpose:  To determine full path and Globally Unique Identifier (GUID)
     'to each referenced library.  Select the reference in the Tools\References
     'window, then run this code to get the information on the reference's library
     'OUTPUT TO DEBUG WINDOW FOR COPY-PASTE ABOVE EACH MODULE
     Dim strFormat
    On Error Resume Next
    Dim I As Long
    'With ThisWorkbook.Sheets(1)
    '    .Cells.Clear
    '    .Range("A1") = "Reference name"
    '    .Range("B1") = "Full path to reference"
    '    .Range("C1") = "Reference GUID"
    'End With
    Debug.Print "''---------------------------------------------------------------------------------------------------------------------------------"
    Debug.Print "'' REFERENCES CURRENTLY AVAILABLE:"
    On Error GoTo ListReferencePathsErr
    For I = 1 To ThisWorkbook.VBProject.References.count
        With ThisWorkbook.VBProject.References(I)
        Debug.Print "AddReferenceGUID(" & VBQT & Trim(Format(.Guid, "!" & String(40, "@"))) & VBQT & ") ''" & Format(.Name, "!" & String(32, "@")) & " " & Format(.FullPath, "!" & String(64, "@"))
            'ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = .name
            'ThisWorkbook.Sheets(1 ).Range("A65536").End(xlUp).Offset(0, 1) = .FullPath
            'ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 2) = .GUID
        End With
    Next I
   
    Debug.Print "''---------------------------------------------------------------------------------------------------------------------------------"
On Error GoTo 0
Exit Sub
   
ListReferencePathsErr:
    Debug.Print "''---------------------------------------------------------------------------------------------------------------------------------"
    Debug.Print "''ERROR-- VBA INACCESSIBLE"
    On Error GoTo 0
End Sub

''ThisWorkbook.VBProject.References.AddFromGuid _
''    GUID:="{0002E157-0000-0000-C000-000000000046}", _
''    Major:=5, Minor:=3
Sub AddReference()
    ''http://stackoverflow.com/questions/9879825/how-to-add-a-reference-programmatically
   
    Dim VBAEditor 'As VBIDE.VBE
    Dim VBProj 'As VBIDE.VBProject
    Dim chkRef 'As VBIDE.Reference
    Dim BoolExists As Boolean

    Set VBAEditor = Application.VBE
    Set VBProj = ActiveWorkbook.VBProject

    '~~> Check if "Microsoft VBScript Regular Expressions 5.5" is already added
    For Each chkRef In VBProj.References
        If chkRef.Name = "VBScript_RegExp_55" Then
            BoolExists = True
            GoTo CleanUp
        End If
    Next

    VBProj.References.AddFromFile "C:\WINDOWS\system32\vbscript.dll\3"

CleanUp:
    If BoolExists = True Then
        MsgBox "Reference already exists"
    Else
        MsgBox "Reference Added Successfully"
    End If

    Set VBProj = Nothing
    Set VBAEditor = Nothing
End Sub


''''''------------------------------------------------------------------------------------------------
''http://www.vbaexpress.com/kb/getarticle.php?kb_id=267
Sub AddReferenceGUID(strGUID As String)
     'Macro purpose:  To add a reference to the project using the GUID for the
     'reference library
   
    If strGUID = "" Then Exit Sub
    
    Dim theRef As Variant, I As Long
    
     'Update the GUID you need below.
    ''strGUID = "{00020905-0000-0000-C000-000000000046}"
    
     'Set to continue in case of error
    On Error Resume Next
    
     'Remove any missing references
    For I = ThisWorkbook.VBProject.References.count To 1 Step -1
        Set theRef = ThisWorkbook.VBProject.References.Item(I)
        If theRef.isbroken = True Then
            ThisWorkbook.VBProject.References.Remove theRef
        End If
    Next I
    
     'Clear any errors so that error trapping for GUID additions can be evaluated
    Err.Clear
    
     'Add the reference
    ThisWorkbook.VBProject.References.AddFromGuid _
    Guid:=strGUID, Major:=1, Minor:=0
    
     'If an error was encountered, inform the user
    Select Case Err.Number
    Case Is = 32813
         'Reference already in use.  No action necessary
    Case Is = vbNullString
         'Reference added without issue
    Case Else
         'An unknown error was encountered, so alert the user
        MsgBox "A problem was encountered trying to" & vbNewLine _
        & "add or remove a reference in this file" & vbNewLine & "Please check the " _
        & "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
    End Select
    On Error GoTo 0
End Sub