07-30-2020
11:59 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-30-2020
11:59 PM
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
Please vote for my suggestions:
Please check also these other suggestions:
Please check also these other suggestions: