[V8i Ss2/4/10 VBA] Checking Model Settings - Line Style Scaling

We have projects in two different CAD Standards that can be accessed in a single workspace. We would like to check that the user is using the correct standard when they open a file and one "flag" is the Model Properties for how linestyles should be scaled. We tried using code found from a post many years ago, but the results were inconclusive.

(GetCExpressionValue("modManInfoP->bLineStyleScaleEqualsAnnotationScale") = 1)

Always returns False. If I open and close the Model Properties dialog box, then it returns the correct value (either True or False).

Is there some other method that could be used in VBA?

TIA

Parents
  • The Line Style Scale. This was added sometime after V8 was released and our original standard used the setting as shown here. The other option is to set it to Annotation Scale. When referencing files, you cannot mix files that these two settings are not synchronized.


    Charles (Chuck) Rheault
    CADD Manager

    MDOT State Highway Administration

    • MicroStation user since IGDS, InRoads user since TDP.
    • AutoCAD, Land Desktop and Civil 3D, off and on since 1996
  • Hi ,

    The MicroStation VBA Help Topic "Common Element Properties" provides an PropertyHandler example that should provide some linestyle properties that you are looking to use for your identification criteria.

    ShowDisplayString oPH, "LineStyleParams.LSScale"
    ShowDisplayString oPH, "LineStyleParams.LSWidthMode"
    ShowDisplayString oPH, "LineStyleParams.LSStartWidth"
    ShowDisplayString oPH, "LineStyleParams.LSEndWidth"
    ShowDisplayString oPH, "LineStyleParams.LSGlobalWidth"
    ShowDisplayString oPH, "LineStyleParams.LSTrueWidth"
    ShowDisplayString oPH, "LineStyleParams.LSShiftMode"
    ShowDisplayString oPH, "LineStyleParams.LSDistancePhase"
    ShowDisplayString oPH, "LineStyleParams.LSFractionPhase"
    ShowDisplayString oPH, "LineStyleParams.LSCornerMode"
    ShowDisplayString oPH, "LineStyleParams.LSThroughCorner"

    HTH,
    Bob



  • We are looking for model properties related to line styles. These are two different things.


    Charles (Chuck) Rheault
    CADD Manager

    MDOT State Highway Administration

    • MicroStation user since IGDS, InRoads user since TDP.
    • AutoCAD, Land Desktop and Civil 3D, off and on since 1996
  • Hi ,

    My apologies for loosing context of "models" as being the source.  MicroStation VBA PropertyHandlers work equally well for: Elements, Models, and DgnFiles; to list/access extended properties.  I believe for a Model you want to examine the property "LineStyleScale".  Here is sample output I can provide showing the available model properties and values that you can expect when using a PropertyHandler for a model

    ModelReference Object Properties:
        [ModelReference] object id (N/A) has (44) defined properties: 
        [1] Type: 0
        [2] Is3D: 3D
        [3] IsMarkup: False
        [4] CanbePlacedAsCell: True
        [5] UpdateFieldsAutomatically: True
        [6] CanbePlacedAsAnnotationCell: False
        [7] IsActive: True
        [8] IsMaster: True
        [9] TreatAs3D: True
        [10] CellType: 8
        [11] PropagateAnnotationScale: On
        [12] AnnotationScale: 1
        [13] DesignScale: 1
        [14] PaperScale: 1
        [15] ModelId: 0
        [16] Hidden: False
        [17] LineStyleScale: Annotation Scale
        [18] Format: 1
        [19] MasterUnit: 2075
        [20] SubUnit: 2125
        [21] Accuracy: 0.123
        [22] AngleReadoutFormat: ~DD.DDDD
        [23] AngleReadoutAccuracy: 0.12345678
        [24] DirectionMode: Azimuth
        [25] DirectionBase: East
        [26] Direction: AntiClockwise
        [27] GlobalLineStyleScaleFactor: 1
        [28] GridLock: False
        [29] GridMaster: 1
        [30] GridReference: 10
        [31] GridConfig: Ortho
        [32] GridAspect: 1
        [33] IsometricLock: False
        [34] IsometricPlane: Top
        [35] ACSPlane: False
        [36] Name: 3D Metric Design Model
        [37] Description: 
        [38] DefaultRefLogical: 
        [39] MasterUnitLabel: m
        [40] SubUnitLabel: mm
        [41] Resolution: 10000 per Distance Meter
        [42] WorkingArea: 9.0072E+08 Kilometers
        [43] SolidArea: 1 Kilometers
        [44] SolidAccuracy: 1E-08 Meters
    
    [SUMMARY] (44 of 44) properties are available.

    HTH,
    Bob



    Answer Verified By: caddcop 

  • Can you provide the code/project that generates this?


    Charles (Chuck) Rheault
    CADD Manager

    MDOT State Highway Administration

    • MicroStation user since IGDS, InRoads user since TDP.
    • AutoCAD, Land Desktop and Civil 3D, off and on since 1996
  • Let me see if I can safely isolate the minimal code needed (derived from the VBA PropertyHandler Example Help topic) since my MBVA project is a sprawling mess of lots of test functions and utility methods that are hard to gather as-is.



  • We can look at that topic and see what wrings out. 


    Charles (Chuck) Rheault
    CADD Manager

    MDOT State Highway Administration

    • MicroStation user since IGDS, InRoads user since TDP.
    • AutoCAD, Land Desktop and Civil 3D, off and on since 1996
  • Hi ,

    Here is an imperfect and mostly functioning version (though certainly needs more clean up, error handling and tuning) though should hopefully provide you with most of what you needed when simplified further. 

    Option Explicit
    
    Sub TEST_Models()
        Dim oModel As ModelReference
        For Each oModel In ActiveDesignFile.Models
            DisplayProperties oModel
        Next
    End Sub
    
    Sub DisplayProperties(o As Object)
        
        ' Validate input and object types
        If (IsObject(o) = False) Then Exit Sub
        
        Dim bDisplayInfo As Boolean, bIsValid As Boolean
        bIsValid = False     ' FUTURE: Some objects (models, attachments, etc.) may require further tests/validation for processing.
        bDisplayInfo = True
        
        Dim oEl As Element, oModel As ModelReference, oAtt As Attachment, oDgn As DesignFile
        Dim sObjType As String, sObjId As String
        sObjType = TypeName(o)
        Debug.Print "[PROCESSING] ObjectType: " & sObjType
        Select Case sObjType
            Case "Attachment"
                Set oAtt = o
                bIsValid = oAtt.IsReadOnly
                sObjId = oAtt.DesignFile.FullName
            Case "DesignFile"
                Set oDgn = o
                bIsValid = oDgn.IsActive
                sObjId = oDgn.FullName
            Case "ModelReference"
                Set oModel = o
                bIsValid = oModel.IsReadOnly
                sObjId = oModel.Name
            Case Else
            ' Allow All MicroStation "Element" types
            If sObjType Like "*Element*" Then
                Set oEl = o
                bIsValid = oEl.IsValid
                sObjId = "Type: " & sObjType & ", ID: " & DLongToString(oEl.ID)
                If bDisplayInfo Then Debug.Print "Element Object: " & sObjType
            Else
                ' Explicitly report any unexpected object types for troubleshooting purposes.
                Debug.Print vbTab & "WARNING: Not Expecting Object Type Named - " & sObjType
                Exit Sub
            End If
        End Select
    
        ' Create property handler for object
        On Error GoTo ErrorHandler
        Dim oPH As PropertyHandler
        Set oPH = CreatePropertyHandler(o)
        
        ' Interate property handler Access Strings array
        Dim lCount As Long
        Dim lTotalProperties As Long
        Dim lTotalCanAccess As Long
        Dim sArr() As String, sMessage As String, sValue As String
        Dim bRtc As Boolean
        Dim oProperty As Variant
        sArr = oPH.GetAccessStrings
        lTotalProperties = UBound(sArr) + 1
        If bDisplayInfo Then Debug.Print "[" & sObjType & "] object id (" & sObjId & ") has (" & lTotalProperties & ") defined properties: "
        If lTotalProperties <= 0 Then Exit Sub 'Function
        For Each oProperty In sArr
            ' Get AccessString item by its name, and respective value
            sMessage = ""
            sValue = ""
            lCount = lCount + 1
            bRtc = oPH.SelectByAccessString(CStr(oProperty))
                    
            ' Attempt to get the value regardless of bRawValue to set warning
            sValue = oPH.GetValue
            If sValue = "" Then sValue = oPH.GetDisplayString ' Use display string as last resort
            If (bRtc = True And Len(sMessage) = 0) Then
                If Not IsEmpty(oPH) Then
                    lTotalCanAccess = lTotalCanAccess + 1
                    sMessage = "[" & lCount & "] " & oProperty & ": " & sValue
                End If
            End If
            ' Report valid items and values.
            If (Len(sMessage) > 0 And bDisplayInfo = True) Then Debug.Print sMessage
        Next
        ' Provide summary if requested.
        If bDisplayInfo Then Debug.Print vbCrLf & "[SUMMARY] (" & lTotalCanAccess & " of " & lTotalProperties & ") properties are available."
        Exit Sub 'Function
        
    ' Unhandled error handler
    ErrorHandler:
        lTotalCanAccess = lTotalCanAccess - 1
        Select Case Err.Number
            Case -2147218366    ' "Property - No Access"
                ' Return useful error details to display
                'sMessage = "[" & lCount & "] ElID: " & DLongToString(oEl.ID) & ", Property: " & oProperty & ": " & ", Error: " & Err.Description
                sMessage = "[" & lCount & ", Property: " & oProperty & ": " & ", Error: " & Err.Description
        End Select
        Resume Next
    
    End Sub

    HTH,
    Bob



Reply
  • Hi ,

    Here is an imperfect and mostly functioning version (though certainly needs more clean up, error handling and tuning) though should hopefully provide you with most of what you needed when simplified further. 

    Option Explicit
    
    Sub TEST_Models()
        Dim oModel As ModelReference
        For Each oModel In ActiveDesignFile.Models
            DisplayProperties oModel
        Next
    End Sub
    
    Sub DisplayProperties(o As Object)
        
        ' Validate input and object types
        If (IsObject(o) = False) Then Exit Sub
        
        Dim bDisplayInfo As Boolean, bIsValid As Boolean
        bIsValid = False     ' FUTURE: Some objects (models, attachments, etc.) may require further tests/validation for processing.
        bDisplayInfo = True
        
        Dim oEl As Element, oModel As ModelReference, oAtt As Attachment, oDgn As DesignFile
        Dim sObjType As String, sObjId As String
        sObjType = TypeName(o)
        Debug.Print "[PROCESSING] ObjectType: " & sObjType
        Select Case sObjType
            Case "Attachment"
                Set oAtt = o
                bIsValid = oAtt.IsReadOnly
                sObjId = oAtt.DesignFile.FullName
            Case "DesignFile"
                Set oDgn = o
                bIsValid = oDgn.IsActive
                sObjId = oDgn.FullName
            Case "ModelReference"
                Set oModel = o
                bIsValid = oModel.IsReadOnly
                sObjId = oModel.Name
            Case Else
            ' Allow All MicroStation "Element" types
            If sObjType Like "*Element*" Then
                Set oEl = o
                bIsValid = oEl.IsValid
                sObjId = "Type: " & sObjType & ", ID: " & DLongToString(oEl.ID)
                If bDisplayInfo Then Debug.Print "Element Object: " & sObjType
            Else
                ' Explicitly report any unexpected object types for troubleshooting purposes.
                Debug.Print vbTab & "WARNING: Not Expecting Object Type Named - " & sObjType
                Exit Sub
            End If
        End Select
    
        ' Create property handler for object
        On Error GoTo ErrorHandler
        Dim oPH As PropertyHandler
        Set oPH = CreatePropertyHandler(o)
        
        ' Interate property handler Access Strings array
        Dim lCount As Long
        Dim lTotalProperties As Long
        Dim lTotalCanAccess As Long
        Dim sArr() As String, sMessage As String, sValue As String
        Dim bRtc As Boolean
        Dim oProperty As Variant
        sArr = oPH.GetAccessStrings
        lTotalProperties = UBound(sArr) + 1
        If bDisplayInfo Then Debug.Print "[" & sObjType & "] object id (" & sObjId & ") has (" & lTotalProperties & ") defined properties: "
        If lTotalProperties <= 0 Then Exit Sub 'Function
        For Each oProperty In sArr
            ' Get AccessString item by its name, and respective value
            sMessage = ""
            sValue = ""
            lCount = lCount + 1
            bRtc = oPH.SelectByAccessString(CStr(oProperty))
                    
            ' Attempt to get the value regardless of bRawValue to set warning
            sValue = oPH.GetValue
            If sValue = "" Then sValue = oPH.GetDisplayString ' Use display string as last resort
            If (bRtc = True And Len(sMessage) = 0) Then
                If Not IsEmpty(oPH) Then
                    lTotalCanAccess = lTotalCanAccess + 1
                    sMessage = "[" & lCount & "] " & oProperty & ": " & sValue
                End If
            End If
            ' Report valid items and values.
            If (Len(sMessage) > 0 And bDisplayInfo = True) Then Debug.Print sMessage
        Next
        ' Provide summary if requested.
        If bDisplayInfo Then Debug.Print vbCrLf & "[SUMMARY] (" & lTotalCanAccess & " of " & lTotalProperties & ") properties are available."
        Exit Sub 'Function
        
    ' Unhandled error handler
    ErrorHandler:
        lTotalCanAccess = lTotalCanAccess - 1
        Select Case Err.Number
            Case -2147218366    ' "Property - No Access"
                ' Return useful error details to display
                'sMessage = "[" & lCount & "] ElID: " & DLongToString(oEl.ID) & ", Property: " & oProperty & ": " & ", Error: " & Err.Description
                sMessage = "[" & lCount & ", Property: " & oProperty & ": " & ", Error: " & Err.Description
        End Select
        Resume Next
    
    End Sub

    HTH,
    Bob



Children