AttachExternalReference

[cll]

Hi VBA Forum,

I have written a code that inserts my logo.dwg in the right place depending on papersize and scale.
I works out fine, but when the code comes to InsRef it takes about 20 sec to execute.
The full code is shown below - can anyone spot the problem?

---------------------------------code begin (take care of wordwrap)
Option Explicit

Public Sub InsLogo()

Dim BlockObj As Object
Dim BlockObj1 As Object
Dim BlockObjName As String
Dim BlockObjName1 As String
Dim L1BlockObjAttributes
Dim colLayOuts As AcadLayouts
Dim objLayoutName As String
Dim objLayOut As AcadLayout
Dim UserName As String
Dim InsRef As AcadExternalReference
Dim PathName As String
Dim InsertPoint(0 To 2) As Double
Dim Scf As Double

PathName = "\\Data\Afdelinger\Teknik\Dokumentation\Mechanical\GEN\DWG\FORMAT\Logo.dwg"

For Each BlockObj In ThisDrawing.ModelSpace
On Error Resume Next
BlockObjName = BlockObj.Name
Select Case BlockObjName
Case "PMC"
GoTo Ramme
Case "Pmc"
GoTo Ramme
End Select
Next

GoTo IngenTitel

Ramme:
For Each BlockObj1 In ThisDrawing.ModelSpace
On Error Resume Next
BlockObjName1 = BlockObj1.Name
Select Case BlockObjName1
Case "A4-V"
Scf = BlockObj1.XScaleFactor
InsertPoint(0) = 209 * Scf: InsertPoint(1) = 21.77 * Scf: InsertPoint(2) = 0
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)
End
Case "A4-H"
Scf = BlockObj1.XScaleFactor
InsertPoint(0) = 120 * Scf: InsertPoint(1) = 27.77 * Scf: InsertPoint(2) = 0
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)
End
Case "A3"
Scf = BlockObj1.XScaleFactor
InsertPoint(0) = 326 * Scf: InsertPoint(1) = 23.07 * Scf: InsertPoint(2) = 0
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)
End
Case "A2"
Scf = BlockObj1.XScaleFactor
InsertPoint(0) = 484 * Scf: InsertPoint(1) = 21.27 * Scf: InsertPoint(2) = 0
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)
End
Case "A1"
Scf = BlockObj1.XScaleFactor
InsertPoint(0) = 751 * Scf: InsertPoint(1) = 21.57 * Scf: InsertPoint(2) = 0
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)
End
Case "A0"
Scf = BlockObj1.XScaleFactor
InsertPoint(0) = 1089 * Scf: InsertPoint(1) = 26.27 * Scf: InsertPoint(2) = 0
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)
End

End Select
Next

GoTo IngenRamme

IngenTitel:
MsgBox "Der er ikke en standard titelblok"
GoTo Manuel

IngenRamme:
MsgBox "Der er ikke nogen standard tegningsramme"
GoTo Manuel

Manuel:
Dim Msg, Style, Title, Response, MyString
Msg = "Vil du indsætte Logo manuelt?" ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton1 ' Define buttons.
Title = "Indsæt Logo..." ' Define title.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
MyString = "Yes" ' Perform some action.
SendKeys "_xattach" & "{ENTER}"
Else ' User chose No.
MyString = "No" ' Perform some action.
End
End If

End Sub

-----------------------------code end

Thanks

Claus

[jwanstaett]

this 20 sec is Autocad finding the drawing Logo.dwg
And Reloading the ExternalReference
If you are add more then one logo per drawing This change will cut the number of times
Autocad need to find the drawing and reload it


PathName="\\-------------------"

add lines here
'this will set your XReference
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)
'remove the copy of the XReference that is at 0,0,0
InsRef.Delete

then replace
Set InsRef = ThisDrawing.ModelSpace.AttachExternalReference(PathName, _
"Logo", InsertPoint, Scf, Scf, Scf, 0, False)

Set InsRef = ThisDrawing.ModelSpace.InsertBlock( InsertPoint,"Logo", Scf, Scf, S

[cll]

Thanks,
normally only one logo will be inserted in each drawing -so I have to be patient.

Claus

[cll]

- besides, when executing the code by clicking a button I get this reply in the command lines:
-----------------
Macro name:
"//Data/Afdelinger/Teknik/Dokumentation/Mechanical/GEN/VBA/InsertLogo.dvb!Module
1.InsLogo"
Auditing Mechanical Data...
Number of errors found: 0 Number of errors fixed: 0
Auditing Mechanical Data complete.
Execution error
-------------------

I wonder if this auditing and execution error could have some effect on the elapsed time.

Claus

[RobertB]

Auditing, yes; the execution error, no. That error is likely due to you using the End statement to get out of a procedure prematurely. Use Unload Me or revise the execution to avoid End Sub/Function.

[cll]

Information of interest:

We found out that the time-problem was due to old server references to the logo in the registry. I am not able to explain in detail.

But now the inserting of the logo takes less than a moment (as it should)

Regards and thanks

Claus