Bentley Communities
Bentley Communities
  • Site
  • User
  • Site
  • Search
  • User
MicroStation
  • Product Communities
MicroStation
MicroStation Wiki Avoiding Inaccuracies in VBA Methods - .FacetSolidAsShapes for SmartSolids
    • Sign In

    • -MicroStation Wiki
      • +Learning Tips
      • -MicroStation
        • +3D Printing - MicroStation
        • +Animation - MicroStation
        • +Archive / Backup - MicroStation
        • +Base Geometry - MicroStation
        • +Batch Processing - MicroStation
        • +CONNECT Advisor - MicroStation
        • CONNECT Integration - MicroStation
        • +CONNECTION Client
        • +Cells - MicroStation
        • +Change Tracking - MicroStation
        • +Configuration - MicroStation
        • +Coordinate Systems - MicroStation
        • +Curves - MicroStation
        • +Custom Linestyles - MicroStation
        • +DGN - MicroStation
        • +DWG - MicroStation
        • +Database - MicroStation
        • +Detailing Symbols - MicroStation
        • +Dimensions - MicroStation
        • +Documentation & Help - MicroStation
        • +Drawing Aids - MicroStation
        • +Exception - MicroStation
        • +FAQ - MicroStation
        • +Feature Based Solids Modeling - MicroStation
        • +File Access - MicroStation
        • +GUI - MicroStation
        • +General - MicroStation
        • +Graphics Display - MicroStation
        • +Groups - MicroStation
        • +Hardware / Input Devices - MicroStation
        • +Import/Export - MicroStation
        • +Installation - MicroStation
        • +Interchange - MicroStation
        • +Interference - MicroStation
        • +Internationalization - MicroStation
        • +Levels - MicroStation
        • +Licensing - MicroStation
        • +Manipulation - MicroStation
        • +Markup / Redline - MicroStation
        • +Measure - MicroStation
        • +Mesh - MicroStation
        • +Models - MicroStation
        • +Multi-Lines - MicroStation
        • +OLE - MicroStation
        • +Other - MicroStation
        • +Parametrics - MicroStation
        • +Patterning - MicroStation
        • +Point Cloud - MicroStation
        • +Printing - MicroStation
        • -Programming - MicroStation
          • +General - Programming - MicroStation
          • +Macro Recorder - Programming - MicroStation
          • +MDL - Programming - MicroStation
          • -VBA - Programming - MicroStation
            • Automatic execution when opening or closing drawings
            • Automatic Subroutine Loading
            • Automatically generate plots with VBA
            • Avoiding Inaccuracies in VBA Methods - .FacetSolidAsShapes for SmartSolids
            • Bring All Text to a New Level with VBA
            • Browsing References for Specific Items
            • Calculating the range of Rotated Cells
            • Changing Colors of Levels in VBA
            • Changing display priority for references
            • Changing Element Colors from RGB to Indexed Color
            • Changing Layer Colors from RGB to an Indexed Color
            • Changing the Alignment of All Texts with VBA
            • Changing the display order of elements
            • Changing the presentation order of Layers
            • Changing the Transparency Settings of Levels with VBA
            • Cleaning Property Data with VBA
            • COM Server error
            • Create Engineering (HTML) Links in VBA
            • Creating Coordinates as Latitude and Longitude using VBA Lines
            • Creating VBA Levels - 'Level name is duplicate'
            • Deleting Lines of Length 0 Using VBA
            • Errors Attempting to Load VBA Projects
            • Errors while attempting to load VBA
            • Exporting the RGB Values of the Color Table to a Text File in VBA
            • Forms in an .mvba do not open some pc's
            • How to read the RGB values of the Attached Color Table
            • Keyin to load the VBA Project Manager in MicroStation Connect
            • Leaving a VBA Tools Dialog Box Open
            • Linking to VBA Elements with User Attributes
            • New Text Font Cannot be Assigned
            • Placing annotation cells with VBA
            • Print Organizer Control with VBA
            • Printing all Sheet Models to PDF Using VBA
            • Reading the Length of All Arcs
            • Removing All Object Data from Selected Cells in VBA
            • Replacing Points with Circles Using VBA
            • Replacing Text with VBA - Part 1: Introduction
            • Replacing Text with VBA - Part 2: Complex Structures
            • Running a VBA Routine by Keyin
            • +Searching and Evaluating Data in a drawing with VBA
            • Searching and Selecting Text Fields with VBA
            • Updating sequence control with VBA
            • Using a VBA Macro
            • Using the VBA object PropertyHandler to change the Element Information
            • VBA - Interface Error: 0x80040502
            • VBA Error in Execution: Project or Library Not Found
            • What are these "Default.mvba" files?
        • +Project Navigation - MicroStation
        • +Properties - MicroStation
        • +RSS Feeds - MicroStation
        • +Reference - MicroStation
        • +Security - MicroStation
        • +Selection - MicroStation
        • +Settings - MicroStation
        • +Sheet Composition - MicroStation
        • +Solids - MicroStation
        • +Standards - MicroStation
        • +Surfaces - MicroStation
        • +Tables - MicroStation
        • +Text - MicroStation
        • +UI Customization - MicroStation
        • +Units - MicroStation
        • +View - MicroStation
        • +Visualization - MicroStation
        • Welcome Page - MicroStation
        • +Accreditation - MicroStation
        • +i.Models - MicroStation
        • +ProjectWise Integration
        • +Raster - MicroStation
    • +Administration Wiki
    • +Annotations Wiki
    • +Bentley View Wiki
    • +MicroStation PowerDraft
    • +Printing and Plotting
    • +Programming Wiki
    • +Visualization Wiki
    • Window List Dialog for Missing Tool Dialog Boxes

     
     Questions about this article, topic, or product? Click here. 

    Avoiding Inaccuracies in VBA Methods - .FacetSolidAsShapes for SmartSolids

       
      Applies To 
       
      Product(s): MicroStation
      Version(s): 08.11.09.578
      Environment:  Windows 7 32 bit,Windows 7 64 bit
      Area:  Programming
      Subarea:  VBA
      Original Author: Tristan Anderson, Bentley Technical Support Group
       

     Problem

    The surfaces of SmartSolids can be extracted with the .FacetSolidAsShapes method. These areas could, for example, be added into the drawing to compare positions and size. When the SmartSolid element is not at zero, slight inaccuracies can be found when zoomed in due to rounding errors. This uncertainty is also present when the Smart Solid is withing the SWA (Solid Working Area). Here is an example of how to extract such shapes from SmartSolids and add them into the drawing:

    ' Somewhat inaccurate result:
    Sub extractshapefromsolid_inaccurate()
    Dim Enumerator As ElementEnumerator
    Dim enumShapes As ElementEnumerator
    Dim Sc As New ElementScanCriteria
    Sc.ExcludeAllTypes
    Sc.IncludeType msdElementTypeCellHeader
    Set Enumerator = ActiveModelReference.GraphicalElementCache.Scan
    Do While Enumerator.MoveNext
         If Enumerator.Current.IsSmartSolidElement Then
            'Extract all shapes from the SmartSolid:
            Set enumShapes = Enumerator.Current.AsSmartSolidElement.FacetSolidAsShapes(100, 1000, 1000, 2 * Pi)
            Do While enumShapes.MoveNext
                ' Represent filled for comparing shapes
                enumShapes.Current.AsClosedElement.FillMode = msdFillModeFilled
                ' Insert shape into the drawing:
                ActiveModelReference.AddElement enumShapes.Current
                enumShapes.Current.Color = 3
                ' The extracted shapes are at the point zero and need to be pushed towards the SmartSolid to compare their positions:
                enumShapes.Current.Move Enumerator.Current.AsSmartSolidElement.Origin
                ' Save the shift:
                enumShapes.Current.Rewrite
            Loop
         End If
    Loop
    End Sub

    Lets start from a simple SmartSolid:

    Then, after the above routine shapes, inaccuracies can be seen at each corner. The shape is shown here filled in with red:

    A closer zoom shows this clearer:

    Troubleshooting

    If one shifts for extracting the SmartSolid element to zero, the result could be modified so that it provides accurate results as in the following example:

    'Solution:
    Sub extractshapefromsolid_exact()
    Dim Enumerator As ElementEnumerator
    Dim enumShapes As ElementEnumerator
    Dim Sc As New ElementScanCriteria
    Dim pOrigin As Point3d
    Dim pOriginTemp As Point3d
     
    Sc.ExcludeAllTypes
    Sc.IncludeType msdElementTypeCellHeader
    Set Enumerator = ActiveModelReference.GraphicalElementCache.Scan
    Do While Enumerator.MoveNext
         If Enumerator.Current.IsSmartSolidElement Then
            pOrigin = Enumerator.Current.AsSmartSolidElement.Origin
            pOriginTemp.x = -pOrigin.x
            pOriginTemp.y = -pOrigin.y
            pOriginTemp.Z = -pOrigin.Z
             
            ' Temporary move of SmartSolids before extracting the Shapes
            ' This does not have to be referced because the shift only temporarily takes place and is not saved in the drawing
            Enumerator.Current.Move pOriginTemp
            Set enumShapes = Enumerator.Current.AsSmartSolidElement.FacetSolidAsShapes(100, 1000, 1000, 2 * Pi)
            Do While enumShapes.MoveNext
                enumShapes.Current.AsClosedElement.FillMode = msdFillModeFilled
                ActiveModelReference.AddElement enumShapes.Current
                enumShapes.Current.Color = 1
                ' The shapes need to be moved to the same position
                ' The value for this must now be cached, because the SmartSolid was moved temporarily in between:
                enumShapes.Current.Move pOrigin
                enumShapes.Current.Rewrite
            Loop
         End If
    Loop
    End Sub

    The exact result is shown in blue below. Here is the comparison:

    • VBAWindows 7 32 bit
    • MicroStation
    • Windows 7 64 bit
    • Programming
    • en
    • 08.11.09.578
    • SELECTsupport
    • Share
    • History
    • More
    • Cancel
    • Tristan Anderson Created by Bentley Colleague Tristan Anderson
    • When: Tue, Jul 14 2015 10:57 AM
    • Tristan Anderson Last revision by Bentley Colleague Tristan Anderson
    • When: Tue, Jul 14 2015 10:59 AM
    • Revisions: 2
    • Comments: 0
    Recommended
    Related
    Communities
    • Home
    • Getting Started
    • Community Central
    • Products
    • Support
    • Secure File Upload
    • Feedback
    Support and Services
    • Home
    • Product Support
    • Downloads
    • Subscription Services Portal
    Training and Learning
    • Home
    • About Bentley Institute
    • My Learning History
    • Reference Books
    Social Media
    •    LinkedIn
    •    Facebook
    •    Twitter
    •    YouTube
    •    RSS Feed
    •    Email

    © 2023 Bentley Systems, Incorporated  |  Contact Us  |  Privacy |  Terms of Use  |  Cookies