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

 

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