Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Hi Justin,

 

I made a VBA script to iterate through my assemblies and check if they already have a drawing file.

If not, it creates them (and does some extra's).

 

Here some functions of my script to set you going: (I'm not saying this is the most efficient way to do this, but hey, for now it works :-), feedback always welcome!)

 

Private Function Excecute(ByVal oDoc As Document, textLocation As String)
        
        Debug.Print oDoc.FullFileName
        
        If CheckNaam(oDoc) Then
                
            Dim drawingFilename As String
                drawingFilename = FindDrawingFile(oDoc)
            
            Dim tempName As String
                tempName = Right(oDoc.FullFileName, 15)
            
            Dim saveName As String
                saveName = Left(oDoc.FullFileName, Len(oDoc.FullFileName) - 4) & ".idw"
            
            If drawingFilename <> "" Then
                Call TextFile(textLocation, "The drawing for """ & tempName & """ was found: " & vbCr & drawingFilename)
                'MsgBox "The drawing for """ & tempName & """ was found: " & vbCr & drawingFilename
                            
            Else
                Dim oNewName As String
                oNewName = oDoc.FullDocumentName
                
                'Call TextFile(textLocation, "Trying: " & oNewName)
                
                ThisApplication.SilentOperation = True
                
                Dim oDrawing As DrawingDocument
                Set oDrawing = ThisApplication.Documents.Add(kDrawingDocumentObject, **insert your desired .idw template location here**, False)
                 
                Call PlaceView(oDrawing, oDoc)
                
                Select Case oDoc.DocumentType
                    Case DocumentTypeEnum.kAssemblyDocumentObject:
                        'Call to parts list insertion function
                        'Call to correct assy titleblock insertion
                    Case DocumentTypeEnum.kPartDocumentObject:
                    Case Else: Exit Function
                End Select
                
                'MsgBox saveName
                
                saveName = Left(oNewName, Len(oNewName) - 4) + ".idw"
                
                Call oDrawing.SaveAs(saveName, False)
                oDrawing.Close (True)
                
                ThisApplication.SilentOperation = True
                
                'Call TextFile(textLocation, "A drawingdocument was created for '" & saveName & "'")
                            
            End If
        End If
    
End Function

 

Private Function PlaceView(ByVal oDrawing As DrawingDocument, oRefDoc As Document)

    Dim oSheet As Sheet
    Set oSheet = oDrawing.ActiveSheet

    Dim oPlacementPoint1 As Point2d
    Dim oPlacementPoint2 As Point2d
    Dim oPlacementPoint3 As Point2d
    
    Set oPlacementPoint1 = ThisApplication.TransientGeometry.CreatePoint2d(12.5, 20)
    Set oPlacementPoint2 = ThisApplication.TransientGeometry.CreatePoint2d(25, 20)
    Set oPlacementPoint3 = ThisApplication.TransientGeometry.CreatePoint2d(12.5, 10)

    ' Define the view scales that we need.
    Dim ViewScale1 As Double
    If oRefDoc.DocumentType = kPartDocumentObject Then
        ViewScale1 = CalculateScale(getRangeboxLargest(oRefDoc)) '1#
    Else
        ViewScale1 = 1#
    End If
    
    ' define the view orientation for each view
    Dim ViewOrientation1 As ViewOrientationTypeEnum
        ViewOrientation1 = ViewOrientationTypeEnum.kFrontViewOrientation

    ' define the view style for each view
    Dim ViewStyle1 As DrawingViewStyleEnum
        ViewStyle1 = DrawingViewStyleEnum.kHiddenLineDrawingViewStyle
 
    ' now create our view
    Dim oView1 As DrawingView
    Dim oView2 As DrawingView
    Dim oView3 As DrawingView
    
    Set oView1 = oSheet.DrawingViews.AddBaseView(oRefDoc, oPlacementPoint1, ViewScale1, ViewOrientation1, ViewStyle1)
    If Not oView1.ActiveLevelOfDetailRepresentation = "Master" Then
        oView1.ActiveLevelOfDetailRepresentation = "Master"
    End If
    
    If oRefDoc.DocumentType = kPartDocumentObject Then
        Set oView2 = oSheet.DrawingViews.AddProjectedView(oView1, oPlacementPoint2, DrawingViewStyleEnum.kFromBaseDrawingViewStyle)
        Set oView3 = oSheet.DrawingViews.AddProjectedView(oView1, oPlacementPoint3, DrawingViewStyleEnum.kFromBaseDrawingViewStyle)
    End If

End Function

 

Public Function FindDrawingFile(PartOrAssemblyDoc As Document)

    Dim FullFileName As String
    FullFileName = PartOrAssemblyDoc.FullFileName
    
    ' Extract the path from the full filename.
    Dim path As String
    path = Left$(FullFileName, InStrRev(FullFileName, "\"))
    
    ' Extract the filename from the full filename.
    Dim filename As String
    filename = Right$(FullFileName, Len(FullFileName) - InStrRev(FullFileName, "\"))
    
    ' Replace the extension with "idw"
    filename = Left$(filename, InStrRev(filename, ".")) & "idw"
    
    ' Find if the drawing exists.
    Dim drawingFilename As String
    drawingFilename = ThisApplication.DesignProjectManager.ResolveFile(path, filename)
    
    ' Return the result.
    If drawingFilename <> "" Then
        FindDrawingFile = drawingFilename
    Else
        FindDrawingFile = ""
    End If
End Function