Month: February 2019

I wanted to get an Excel table with fixed dimensions (in millimeters). But Excel works with different units, not to say that column width and row heights are handled completely different. Searching the web, did get to a viable code, but it was extremelly slow (when a bunch of resizes has to be performed). So I tunned the code a bit, with a first approximation to the final width objective, so less resize operations had to be carried out. Here is the code, hope it helps:

Option Explicit

Sub ChangeWidthAndHeight()
    SetColumnWidthMM 1, 10
    SetRowHeightMM 1, 10
End Sub

Private Sub SetRowHeightMM(ByVal RowNo As Long, _
                           ByVal mmHeight As Integer)
' changes the Row Height to mm Height
    With ActiveSheet
        If RowNo < 1 Or RowNo > .Rows.Count Then Exit Sub
    End With
    
    With Application
        .ScreenUpdating = False
        ActiveSheet.Rows(RowNo).RowHeight = .CentimetersToPoints(mmHeight / 10)
        .ScreenUpdating = True
    End With
End Sub

Private Sub SetColumnWidthMM(ByVal ColNo As Long, _
                             ByVal mmWidth As Integer)
' changes the column width to mm Width
' Column widths are not really measured in any "unit" as such.
' Instead, the number refers to the number of characters which can be displayed in the column.
' For variable width fonts such as Arial, the "0" character is used.
' In VBA, the ColumnWidth property uses this measure of width, and the Width property uses Points.
' 1 inch = 72 points
' 1 pointH = 1/72 inches.
' 1 pointH = 0.0353 centimeters (or .353 millimetre)
' 1 pointH = ... x pixels
    
    Dim w As Single
    Dim wSize As Single
    
    With ActiveSheet
        If ColNo < 1 Or ColNo > .Columns.Count Then Exit Sub
    End With
    
    Application.ScreenUpdating = False
    
    w = Application.CentimetersToPoints(mmWidth / 10)
    With ActiveSheet
        wSize = (.Columns(ColNo + 1).Left - .Columns(ColNo).Left)
        
        ' First approximation:
        With .Columns(ColNo)
            .ColumnWidth = .ColumnWidth * (w / wSize)
        End With
        
        While .Columns(ColNo + 1).Left - .Columns(ColNo).Left - 0.1 > w
            '.Columns(ColNo).ColumnWidth = .Columns(ColNo).ColumnWidth - wMove
            With .Columns(ColNo)
                'Debug.Print .ColumnWidth
                .ColumnWidth = .ColumnWidth - 0.1
            End With
        Wend
        While .Columns(ColNo + 1).Left - .Columns(ColNo).Left + 0.1 < w
            With .Columns(ColNo)
                'Debug.Print .ColumnWidth
                .ColumnWidth = .ColumnWidth + 0.1
            End With
        Wend
    End With
    
    Application.ScreenUpdating = True
End Sub

BIM got this thing of GUID to reference the different elements/components inside the file. But somewhen in the future, I’ll need to get my own GUID function to reference elements. In Excel is a bit hard to produce via function with this formula:

= CONCATENATE(DEC2HEX(RANDBETWEEN(0,4294967295),8),"-",DEC2HEX(RANDBETWEEN(0,6553??5),4),"-",DEC2HEX(RANDBETWEEN(16384,20479),4),"-",DEC2HEX(RANDBETWEEN(32768,49151??),4),"-",DEC2HEX(RANDBETWEEN(0,65535),4),DEC2HEX(RANDBETWEEN(0,4294967295),8))

To get a more consistent method, we can rely on VBA. Here is the code:

' No VT_GUID available so must declare type GUID
Private Type GUID_TYPE
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (Guid As GUID_TYPE) As LongPtr
    Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (Guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr

    Public Function GenerateGUID() As String
        Dim Guid As GUID_TYPE
        Dim strGuid As String
        Dim retValue As Long 'Ptr
        Const guidLength As Long = 39 'registry GUID format with null terminator {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}
    
        retValue = CoCreateGuid(Guid)
        If retValue = 0 Then
            strGuid = String$(guidLength, vbNullChar)
            retValue = StringFromGUID2(Guid, StrPtr(strGuid), guidLength)
            If retValue = guidLength Then
                ' valid GUID as a string
                GenerateGUID = strGuid
            End If
        End If
    End Function
#Else
    Private Declare Function CoCreateGuid Lib "ole32" (ByRef Guid As Byte) As Long

    Public Function GenerateGUID() As String
        Dim ID(0 To 15) As Byte
        Dim N As Long
        Dim Guid As String
        Dim Res As Long
        
        Res = CoCreateGuid(ID(0))
        For N = 0 To 15
            Guid = Guid & IIf(ID(N) < 16, "0", "") & Hex$(ID(N))
            If Len(Guid) = 8 Or Len(Guid) = 13 Or Len(Guid) = 18 Or Len(Guid) = 23 Then
                Guid = Guid & "-"
            End If
            Next N
        GenerateGUID = Guid
    End Function

    'Private Declare Function CoCreateGuid_2 Lib "ole32" (ByRef Guid As GUID_TYPE) As Long
    'Public Function NewGUID() As String
    ''(c) 2000 Gus Molina
    '' Not working!
    '
    '    Dim udtGUID As GUID_TYPE
    '
    '    If (CoCreateGuid_2(udtGUID) = 0) Then
    '        GetGUID = _
                String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _
                String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _
                String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _
                IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _
                IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _
                IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _
                IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _
                IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _
                IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _
                IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _
                IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7))
    '    End If
    'End Function
#End If

Public Sub sGenerateGUID()
    MsgBox GenerateGUID ' NewGUID
End Sub

I’m not for the Revit thing, but following the BIM master class I have to deal with this kind of software. The practices needs to perform some repeated tasks, not a lot by now, but they will reach a point when they will start to bother me if I repeat them. So I looked for some automatization in the Revit world. For my desesperation, no VBA there, only C# and VB.Net rubbish. First I must state that coming from the Excel VBA environment, the Revit macro manager environment looked like a baby (to say it pollitely). I’m shocked on how it performs every task so slow, and the little power for debugging that has been put there. At the end of the day, playing around with Revit and the code I had found so far, I get the idea that Revit is very very very raw, still changing how to access the core components. Most of the code was not working because it has been deprecated, or some methods are not there anymore to be called. I feel frustrated. From this point, it starts the history of my struggle to get the thing working. Continue reading “Revit VB.Net programming”