Author Topic: 2007 and Insert block  (Read 2916 times)

0 Members and 1 Guest are viewing this topic.

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4042
2007 and Insert block
« on: August 07, 2006, 12:23:00 PM »
Has anyone figured out how the insert block function changed in 07?  I keep getting a filer err using this code
Code: [Select]
ThisDrawing.PaperSpace.InsertBlock inst, "u:\titleblocks\PP-VTITLINFO.DWG", 1, 1, 1, 0
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

hendie

  • Guest
Re: 2007 and Insert block
« Reply #1 on: August 07, 2006, 02:00:39 PM »
as far as I'm aware, the block insert has not changed in 2007.
the filer error normally points to a file problem, not a vba problem.
I assume you have checked the path and block name. ?

we've got some code running in Acad 2000 thru' 2007 ~ same code, no problem

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4042
Re: 2007 and Insert block
« Reply #2 on: August 07, 2006, 02:03:10 PM »
it works on the first dwg, then crashes on each and every dwg after that.  I have tried pathing, no-pathing, w/ the .dwg and w/o it.  It always works on the first dwg and then crashes.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

DaveW

  • Guest
Re: 2007 and Insert block
« Reply #3 on: August 07, 2006, 11:00:18 PM »
I wrote some code a while back for dealing with blocks, but then did not need it and removed it. I was creating the block on the fly and inserting it. I suggest you look to see if an instance of the block exists before you try and insert it.

Code: [Select]
Public Function BlockExists(BlockName As String) As Boolean
Dim oBlock As AcadBlock
Dim thisdrawing As AcadDocument
'iterate through the Block collection object
Set entity = thisdrawing.Application.ActiveDocument
For Each oBlock In thisdrawing.Blocks
If oBlock.Name Like BlockName & "*" Then
'found a match, so it exist
BlockExists = True
'so, exit the function with True
Exit Function
End If
Next oBlock
'lblock does not exist
BlockExists = False
End Function


Be careful of this line:
If oBlock.Name Like BlockName & "*" Then

For an exact match, modify it to:
If oBlock.Name Like BlockName then '& "*" Then


The code above was originally post in Autodesk's forum for seeing if a layer exists by  Bell, R. Robert . I have so many flavors of it now for collection sets.

An important note is that many times if you use the add method, if it exists, it will return the current, so you do  not need to check at all. I read that there too, but did not understand until I just wrote some code that was doing it and it did not crash adding layer that existed that way.

Of course you could be seeing a bug in 2007 or something new too.
Sorry I could not be more help.

Here are some of the others I use:

Code: [Select]
Public Function TextStyleExists(TextStyle As String) As Boolean
Dim oStyle As ACADTextStyle
Dim entity As AcadDocument
'iterate through the Layers collection object
Set entity = thisdrawing.Application.ActiveDocument
For Each oStyle In entity.TextStyles
If LCase(oStyle.Name) Like LCase(TextStyle) Then '& "*" Then
'found a match, so it exist
TextStyleExists = True
'so, exit the function with True
Exit Function
End If
Next oStyle
'layer does not exist
TextStyleExists = False
End Function



Public Function DimStyleExists(DimStyle As String) As Boolean
Dim oStyle As ACADDimStyle
Dim entity As AcadDocument
'iterate through the Layers collection object
Set entity = thisdrawing.Application.ActiveDocument
For Each oStyle In entity.DimStyles
If LCase(oStyle.Name) Like LCase(DimStyle) Then '& "*" Then
'found a match, so it exist
DimStyleExists = True
'so, exit the function with True
Exit Function
End If
Next oStyle
'layer does not exist
DimStyleExists = False
End Function



Public Function GroupExists(grpName As String) As Boolean
Dim oGroup As AcadGroup
Dim thisdrawing As AcadDocument
'Dim entity As AcadDocument
'iterate through the Layers collection object
Set thisdrawing = AutoCAD_Application.ActiveDocument
For Each oGroup In thisdrawing.Groups
If oGroup.Name Like grpName & "*" Then
'found a match, so it exist
GroupExists = True
'so, exit the function with True
Exit Function
End If
Next oGroup
'layer does not exist
GroupExists = False
End Function



Public Function LayerExists(LayerName As String) As Boolean
Dim oLayer As AcadLayer
Dim entity As AcadDocument
'iterate through the Layers collection object
Set entity = thisdrawing.Application.ActiveDocument
For Each oLayer In entity.Layers
If oLayer.Name Like LayerName & "*" Then
'found a match, so it exist
LayerExists = True
'so, exit the function with True
Exit Function
End If
Next oLayer
'layer does not exist
LayerExists = False
End Function



Public Function LayerExists2(LayerName As String) As Boolean
Dim oLayer As AcadLayer
Dim entity As AcadDocument
'iterate through the Layers collection object
Set entity = thisdrawing.Application.ActiveDocument
For Each oLayer In entity.Layers
If oLayer.Name Like LayerName Then '& "*" Then
'found a match, so it exist
LayerExists2 = True
'so, exit the function with True
Exit Function
End If
Next oLayer
'layer does not exist
LayerExists2 = False
End Function

« Last Edit: August 07, 2006, 11:13:41 PM by DaveW »

hendie

  • Guest
Re: 2007 and Insert block
« Reply #4 on: August 08, 2006, 03:43:30 AM »
it works on the first dwg, then crashes on each and every dwg after that.  I have tried pathing, no-pathing, w/ the .dwg and w/o it.  It always works on the first dwg and then crashes.

are you sure it's that line that causes the crash ? what is the rest of the code ? and what is the error ?

our code runs through 40 or 50 block insertions with no problem and in essence it's no different from yours
(well, that line anyway)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4042
Re: 2007 and Insert block
« Reply #5 on: August 08, 2006, 09:56:38 AM »
Here is the module
Code: [Select]
Option Explicit
Public Sub eppictitl()
    Dim SysvarName As String
    Dim intdata As Long, OBJvp As AcadPViewport
    Dim strData As String, inst(0 To 2) As Double, MIDPT(0 To 2) As Double
    Dim X As Double, Y As Double
    ThisDrawing.ActiveSpace = acPaperSpace
    inst(0) = 0: inst(1) = 0: inst(2) = 0
    MIDPT(0) = 16.96367147: MIDPT(1) = 12: MIDPT(2) = 0
    X = 33.0473
    Y = 23.1
    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Add("ANNO-TITL")
    ThisDrawing.Layers.Item("ANNO-TITL").color = 8
    SysvarName = "FILEDIA"
    intdata = 1
    ThisDrawing.SetVariable SysvarName, intdata
    SysvarName = "CMDDIA"
    intdata = 1
    ThisDrawing.SetVariable SysvarName, intdata
    SysvarName = "PROJECTNAME"
    strData = "."
    ThisDrawing.SetVariable SysvarName, strData
    SysvarName = "snapmode"
    intdata = "0"
    ThisDrawing.SetVariable SysvarName, intdata
    SysvarName = "cecolor"
    strData = "bylayer"
    ThisDrawing.SetVariable SysvarName, strData
    SysvarName = "CELTYPE"
    strData = "bylayer"
    ThisDrawing.SetVariable SysvarName, strData
    SysvarName = "CELWEIGHT"
    intdata = "-1"
    ThisDrawing.SetVariable SysvarName, intdata
    ThisDrawing.PaperSpace.AttachExternalReference "u:\titleblocks\pp-vtep.dwg", "pp-vtep", inst, 1, 1, 1, 0, False

    Set OBJvp = ThisDrawing.PaperSpace.AddPViewport(MIDPT, X, Y)
    OBJvp.Display True
    ThisDrawing.Regen acAllViewports
    ThisDrawing.MSpace = True
    ZoomExtents
    ThisDrawing.MSpace = False
    ZoomExtents
    ThisDrawing.PaperSpace.InsertBlock inst, "PP-VTITLINFO.DWG", 1, 1, 1, 0
    ThisDrawing.Regen acAllViewports
    ThisDrawing.Save
   
End Sub
Like you, I have never had any problems inserting blocks until now.  When I step through the code using F8, or when I have it break on error, it always highlights that line.  It also only crashes when there is more than 1 dwg open.

I told autodesk about the problem, and they were able to repeat the problem if they had more than 1 dwg open.  They have esculated it to developement to see what is going on.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4042
Re: 2007 and Insert block
« Reply #6 on: September 29, 2006, 02:30:50 PM »
Well I still have not heard from Autodesk for a solution (BIG Suprise) but I did find a work around that works consistently.

Quote
    Dim file As String
    file = "u:\titleblocks\pp-vtitlinfo.dwg"
ThisDrawing.PaperSpace.InsertBlock inspt, file, 1, 1, 1, 0

by making a variable , it works consistently
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second