DWG to PowerPoint
Introduction
This application will take a selected directory of drawings, convert them to WMF format and insert them into Powerpoint as individual slide.
Usage
- Open the Powerpoint file dwg2slide.ppt.
- Run the macro ‘dwg2slide’.
- Choose any file in the directory you wish to process.
- Select ‘OK’ to proceed and sit back.
- After a couple of minutes (depending on how many drawing files are in the directory you choose), your slides will have been created.
Here is the coding for the entire application (remember, this is written in Powerpoint VBA) :
First create a module named Module1:
Public dirname As String Sub Dwg2Slide() Dim selname As String Dim SelName1 As String Dim InCounter As Integer Dim InFoundpos As Integer UserForm1.CommonDialog1.Filter = "dwg Files (*.dwg)|*.dwg" 'set default file type UserForm1.CommonDialog1.Flags = cdlOFNHideReadOnly 'switch off read only UserForm1.CommonDialog1.ShowOpen 'open dialog box selname = UserForm1.CommonDialog1.filename 'retrieve the file name InCounter = 1 'initilize counter InFoundpos = InStr(InCounter, selname, "\") 'look for the \ While InFoundpos <> 0 'check for the last \ SelName1 = Mid$(selname, InCounter, InFoundpos - InCounter) 'extract the directory name InCounter = InFoundpos + 1 'increase the counter InFoundpos = InStr(InCounter, selname, "\") 'find the next \ dirname = dirname & SelName1 & "\" 'construct the path Wend UserForm1.Show 'show the dialog End Sub
Next create a userform named Userform1. The following coding goes under the event procedures of the userforms controls :
Private Sub CommandButton1_Click() Dim filename As String Dim sl As Integer Dim acadApp As Object Dim acadDoc As Object Dim sset As Object Dim pViewport As Object 'declare variables Set acadApp = CreateObject("Autocad.Application") 'open AutoCAD If Err Then 'if there is an error MsgBox Err.Description 'inform user Exit Sub 'exit application End If 'end if acadApp.Visible = True 'Make Autocad Visible Set acadDoc = acadApp.ActiveDocument 'set reference to active document Me.Hide 'Hide the dialogue box filename = Dir(dirname, vbNormal) 'retrieve the first entry Do While filename <> "" 'start the loop If UCase(Right$(filename, 4)) = ".DWG" Then 'ignore files that do not end with .DWG If (GetAttr(dirname & filename) And vbNormal) = vbNormal Then 'use bitwise comparison to make sure filename is not a directory acadDoc.Open dirname & filename 'open drawing to purge mylen = Len(filename) 'get the length of the filename mylen = mylen - 4 'subtract the .DWG Extension filename1 = Left(filename, mylen) 'retrieve the drawing name Set pViewport = acadDoc.ActiveViewport 'set reference to the viewports pViewport.ZoomExtents 'zoom to extents Set sset = acadDoc.SelectionSets.Add("NEWSS") 'set reference to election set sset.Select acSelectionSetAll 'select the whole drawing acadDoc.Export dirname & filename1, "WMF", sset 'export the drawing acadDoc.Save 'save the drawing End If End If filename = Dir 'get the next entry Loop 'carry on looping acadApp.Quit 'Close Autocad filename = Dir(dirname, vbNormal) 'retrieve the first entry sl = 1 Do While filename <> "" 'start the loop If UCase(Right$(filename, 4)) = ".WMF" Then 'ignore files that do not end with .WMF If (GetAttr(dirname & filename) And vbNormal) = vbNormal Then 'use bitwise comparison to make sure filename is not a directory ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add _ (Index:=sl, Layout:=ppLayoutBlank).SlideIndex 'insert a new slide ActiveWindow.Selection.SlideRange.Shapes.AddPicture _ (filename:=filename, LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, Left:=-2, Top:=58, Width:=727, _ Height:=423).Select 'import WMF File into slide sl = 1 + sl 'increment the slide number End If End If filename = Dir 'get the next entry Loop 'carry on looping MsgBox ("Process Complete.."), , "Drawings to Slide" 'inform user that we have finished End End Sub Private Sub CommandButton2_Click() End End Sub
If you would like a copy of this module, just click here. Enjoy…