Extracting 3D DWF Model Properties Using Autodesk Design Review API and AutoCAD VBA

A while ago I came across a situation where I had to extract line lists, valve lists, equipment lists and fittings lists from a DWF file. The DWF file was converted from a PDS model review file (DRI) using NavisWorks. After a few hours research on Autodesk Design Review API, I could extract all the required lists with a few lines of code. Ofcourse, with the help of fast dying AutoCAD VBA.

As the code makes use of CExpressViewerContol, you need to place it inside a form before running the code. You may use any COM compliant development environment in place of AutoCAD VBA. But I would like to stick to AutoCAD VBA till its last breath due to ease of use.

Sub ExtractDwfProps()
'### Extracts properties from model components of a 3D DWF file
'### By zoomharis@gmail.com
'### Date: 09/09/09

'### Based on Autodesk Design Review 2010 API

'### DWF specific references
'    -----------------------
'### AdCommon 1.0 Type Library
'### ECompositeViewer 1.0 Type Library
'### ExpressViewerDll 1.0 Type Library

'### DWF specific controls
'    ---------------------
'### CExpressViewerContol

On Error Resume Next
Dim oECV As ECompositeViewer.IAdECompositeViewer
Dim oSec As ECompositeViewer.IAdSection
Dim oEnt As AdCommon.IAdObject
Dim oProp As AdCommon.IAdProperty
Dim oCol As AdCommon.CAdCollection
Dim oCont As ECompositeViewer.IAdContent
Dim strDwfLoc As String
Dim strPropName As String
Dim strPropValue As String
'## Let me use a sample 3D dwf file
strDwfLoc = "C:\Dwf\3DModel.dwf"
strPropName = ""
strPropValue = ""
'## Open the dwf file in the viewer
CExpressViewerContol1.SourcePath = strDwfLoc
Set oECV = CExpressViewerContol1.ECompositeViewer
'## Iterate through the dwf model
For Each oSec In oECV.Sections
    Set oCont = oSec.Content
    Set oCol = oCont.Objects(0)
    For Each oEnt In oCol
        For Each oProp In oEnt.Properties
           strPropName = oProp.Name
           strPropValue = oProp.value
        Next
        '## Write code here to apply conditions to filter the list
        '## and send the extracted info into a text or excel file.
        '## Then clear the property name and property value strings
        strPropName = ""
        strPropValue = ""
    Next
Next
Set oProp = Nothing
Set oEnt = Nothing
Set oCol = Nothing
Set oCont = Nothing
Set oSec = Nothing
Set oECV = Nothing
End Sub

I have stripped down some of the code portion as it was specific my purpose. This is mostly in a general form and you may need to add/modify wherever necessary in order to run it in your system.

An Automated Guiding System for Newcomers Using AutoCAD VBA and Microsoft Speech

Have you found the title a little bit confusing? Let me elaborate it. What we are going to see is a simple event oriented AutoCAD VBA program to guide newcomers in a company through proper way until they get familiar with Dos and Don'ts as well as company standards. The program given below is pretty simple and is only intented to show how the system can be implemented. It requires Microsoft Speech (Text-to-speech) to be available in your system. If you wish to implement a comprehensive system, you would better write your code in class modules. Again, this system is not recommended for experienced users as it will definitely check their patience. Here goes the code.

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)

On Error Resume Next

Dim objSSV As Object

Set objSSV = CreateObject("Sapi.SpVoice")

With objSSV

    Select Case CommandName

        Case "SAVEAS", "QSAVE", "SAVE"

            .speak "Please make sure that the saved drawing version is as per client standard"

        Case "BLOCK", "WBLOCK"

            .speak "All blocks shall be made in zero layer"

        Case "LAYER"

            .speak "Please refer CAD manual for standard layering system"

        Case "EXPLODE"

            .speak "No standard blocks shall be exploded for editing"

        Case "REFEDIT", "BEDIT"

            .speak "Please contact CAD support before editing any standard blocks"

    End Select

End With

Set objSSV = Nothing

End Sub

Keep the above code inside the 'ThisDrawing' section of Visual Basic Editor (for testing purpose) and turn the speakers on. Run any of the fore-mentioned commands inside AutoCAD. You will hear instructions based on the commands. Hope this system will help senior guys to avoid running behind the newcomers for correction and teaching purposes.

Renaming an Active Drawing from the Command Prompt

Is it really possible to rename an opened file? Normally the operating system will not allow you to do that. But it is REALLY possible to do it inside AutoCAD by adapting a tricky way as explained below. Here are the steps involved in the process.

1. Get the new drawing name from the user


2. Check any drawing is existing in the current folder with the name provided.


3. If not, save and close the current drawing and copy it in the new drawing name.


4. After verification, delete the old file.


5. Open the copied file in AutoCAD

Though it seems like a long procedure, practically it all finish within a moment. The user never get the feeling of all those background processing. Users are encouraged to set system variable ISAVEBAK to 1 in order to eliminate the chances of possible data loss due to any unexpected errors. The following is an implimentation of above logic in AutoCAD VBA

'*****************************************************************
'<--  Active Drawing Renaming Utility                        -->
'<--  Renames the current drawing from the command prompt.   -->
'<--  By Mohamed Haris (zoomharis@gmail.com)                 -->
'*****************************************************************
Sub RenameOnline()
On Error GoTo ErrDet
Dim objFS, objFL As Object
Dim strFilePath As String, strNewFileName As String, strNewFileFullName As String
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFL = objFS.getfile(ThisDrawing.FullName)
strFilePath = ThisDrawing.Path
strNewFileName = ThisDrawing.Utility.GetString(True, vbCr & "Enter new file name to rename: ")
strNewFileFullName = strFilePath & "\" & strNewFileName & ".dwg"
'*** Check for a valid windows filename
If Not FileNameIsValid(strNewFileName) Then
    MsgBox "Please provide a valid name to rename....", vbExclamation
    GoTo ClearMem
ElseIf objFS.fileExists(strNewFileFullName) Then
    MsgBox "A file with new filename already exists...!!!" & vbCrLf & _
    "Please check the existing filenames...", vbExclamation
    GoTo ClearMem
Else
    ThisDrawing.Save
    objFL.Copy (strNewFileFullName), False
End If
'*** Make sure that the file has been copied before deleting the old one
If objFS.fileExists(strNewFileFullName) Then
    ThisDrawing.Close True
    objFL.Delete
    Application.Documents.Open strNewFileFullName
Else
    MsgBox "Couldn't rename the file. Please try again...!!!", vbExclamation
End If
ErrDet:
If Err.Number <> 0 Then
    MsgBox "An error occured while renaming the file....!!!" & vbCrLf & vbCrLf & _
    "Error Description: " & vbCrLf & Err.Description, vbExclamation
End If
ClearMem:
Set objFL = Nothing
Set objFS = Nothing
End Sub


'*** NOTE: A regular expression could serve better for this purpose
Function FileNameIsValid(ByVal strFileName As String) As Boolean
Dim i As Integer
If Trim(strFileName) = "" Then
    FileNameIsValid = False
    Exit Function
End If
arInvalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "")
For i = 0 To UBound(arInvalidChars) - 1
    If InStr(1, strFileName, arInvalidChars(i), vbTextCompare) <> 0 Then
        FileNameIsValid = False
        Exit Function
    End If
Next
FileNameIsValid = True
End Function

Normally I don't provide the new file name in the command prompt. Instead, there is another VBA routine which takes the the drawing name attribute value from the title blocks and provide it as the input for the RenameOnline utitlity. You could also implement this logic in any of your favourite programming languages.