insert block or note into all sheets of a dwg in the same location?

Hi All,

I've been working a large project for a client. Near the end now and I'm looking at 9 10+ pg drawings and about 20 2 page drawings. I've belatedly realized a deficiency in my rev code documentation! Because of the way these drawings are being distributed I need to insert a note that contains

3 file properties but I need that note on every page of every drawings in the same place...

I've made a block of the note but that's about it. I thought I would seek professional help first. ie: existing macros or other automated techniques.

TIA

Zander

Reply to
Zander
Loading thread data ...

Here is some code that I have used it isn't my best work I was just learning when I wrote it and I didn't do great error handling. It will get you started anyway.

'this function will insert the block at a location 'depending on which template is used Function insertBlock() As SldWorks.BlockDefinition

Dim x As Double Dim y As Double Dim Bscale As Double Dim RevLev As Object Dim RLX As Double Dim RLY As Double Dim RLHeight As Double Dim RevLevTxt As String Dim SheetSize As String Dim blockDef As SldWorks.BlockDefinition Dim MyBlock As SldWorks.BlockInstance

SheetSize = LCase(Right(sheet.GetTemplateName, 8))

Select Case SheetSize Case "a.slddrt" x = 4.33 * 0.0254 'dimension in inches comvert to metric y = 0.2 * 0.0254 Bscale = 1 RLX = 10.36 * 0.0254 RLY = 8.05 * 0.0254 RLHeight = 0.187 * 0.0254 Case "b.slddrt" x = 8 * 0.0254 'dimension in inches comvert to metric y = 0.25 * 0.0254 Bscale = 1 RLX = 13.81 * 0.0254 RLY = 10.7 * 0.0254 RLHeight = 0.187 * 0.0254 Case "c.slddrt" x = 8.66 * 0.0254 'dimension in inches comvert to metric y = 0.4 * 0.0254 Bscale = 2 RLX = 10.36 * 2 * 0.0254 RLY = 8.05 * 2 * 0.0254 RLHeight = 0.187 * 2 * 0.0254 Case Else x = 0 * 0.0254 'dimension in inches comvert to metric y = 0 * 0.0254 Bscale = 1 RLX = 10.36 * 0.0254 RLY = 8.05 * 0.0254 RLHeight = 0.187 * 0.0254 End Select dwgdoc.EditTemplate PathName = swApp.GetCurrentMacroPathName PathOnly = Mid(PathName, 1, InStr(1, PathName, "A CHANGE.swp") - 2) 'dwgdoc.InsertNewNote2 RevLev, "", True, False, swNO_ARROWHEAD, swLS_SMART, 0#, swBS_None, swBF_Tightest, 0, 0 'insert a revision level note. If RevLev Is Nothing Then RevLevTxt = "" Set RevLev = dwgdoc.CreateText2(RevLevTxt, RLX, RLY, 0, RLHeight, 0) RevLev.SetName "Revision Level" End If

Set MyBlock = dwgdoc.insertBlock(PathOnly + "\A Change.SLDBLK", x, y,

0#, Bscale) 'set all text to an empty string MyBlock.SetAttributeValue "TOP LETTER", "" MyBlock.SetAttributeValue "TOP DESC", "" MyBlock.SetAttributeValue "TOP DATE", "" MyBlock.SetAttributeValue "MID LETTER", "" MyBlock.SetAttributeValue "MID DESC", "" MyBlock.SetAttributeValue "MID DATE", "" MyBlock.SetAttributeValue "BOT LETTER", "" MyBlock.SetAttributeValue "BOT DESC", "" MyBlock.SetAttributeValue "BOT DATE", ""

Set blockDef = dwgdoc.GetBlockDefinition("A CHANGE") dwgdoc.EditSheet

If blockDef Is Nothing Then MsgBox "There was a problem finding the block." & VBA.Chr(vbKeyReturn) & _ "Make sure " & VBA.Chr(34) & "A Change.SLDBLK" & VBA.Chr(34) & "is in the same directory as this macro." End End If Set insertBlock = blockDef

End Function

'this will update the fields of the block with the text typed into the form fields. Public Sub UpdateBlock(BlockName As SldWorks.BlockInstance)

BlockName.SetAttributeValue "TOP DESC", RevisionForm.Description1.Text BlockName.SetAttributeValue "TOP DATE", RevisionForm.Date1.Text BlockName.SetAttributeValue "MID DESC", RevisionForm.Description2.Text BlockName.SetAttributeValue "MID DATE", RevisionForm.Date2.Text BlockName.SetAttributeValue "BOT DESC", RevisionForm.Description3.Text BlockName.SetAttributeValue "BOT DATE", RevisionForm.Date3.Text

End Sub

"Zander" wrote in message news:Xns94C99ADCADD88sig6667.245txjh@216.40.28.71...

Reply to
Corey Scheich

You can insert an Excel workbook object on the first sheet and it will show on all sheets, right click over the object to for the toggle. I believe you can insert file properties into an Excel workbook, by renaming the columns or cells , but I don't remember the procedure.

Reply to
Warren

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.