2007 和插入块

hendie · 发表于 2006-8-7 12:23:00

有没有人弄清楚插入块功能在07中是如何变化的？我一直得到一个文件管理器错误使用此代码

ThisDrawing.PaperSpace.InsertBlock inst, "u:\titleblocks\PP-VTITLINFO.DWG", 1, 1, 1, 0

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

DaveW · 发表于 2006-8-7 14:00:39

据我所知，块插入在2007年没有改变。
文件管理器错误通常指向文件问题，而不是vba问题
我假设您已经检查了路径和块名称
我们在Acad 2000到'2007中运行了一些代码~相同的代码，没有问题

hendie · 发表于 2006-8-7 14:03:10

它在第一个dwg上工作，然后在之后的每个dwg上崩溃。我尝试过路径、无路径、w/the. dwg和w/o它。它总是在第一个dwg上工作，然后崩溃。

hendie · 发表于 2006-8-7 23:00:18

不久前，我编写了一些代码来处理块，但后来不需要它并将其删除。我在动态创建块并插入它。我建议您在尝试插入块之前先查看它的实例是否存在

copy

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

小心这行：
如果对象锁定。名称类似于BlockName&“*”，然后＜br＞要获得精确匹配，请将其修改为：＜br＞If oBlock。像BlockName这样的名称，然后是“&”*”
上面的代码最初是由Bell，R.Robert在Autodesk论坛上发布的，用于查看是否存在层。我现在为集合集提供了多种风格的代码
一个重要的注意事项是，如果多次使用add方法，如果该方法存在，它将返回当前值，因此您根本不需要检查。我在那里也读到了，但直到我写了一些代码才明白，这样做并没有因为添加了这样存在的层而崩溃
以下是我使用的一些其他方法：

copy

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

DaveW · 发表于 2006-8-8 03:43:30

您确定是这一行导致了崩溃吗？代码的其余部分是什么？错误是什么？
我们的代码毫无问题地运行了40或50个块插入，本质上与您的代码没有什么不同
(好吧，反正就是那一行)

DaveW · 发表于 2006-8-8 09:56:38

这是模块代码3]
和您一样，我在插入积木时从未遇到过任何问题。当我使用F8单步执行代码时，或者当我让它因出错而中断时，它总是突出显示那一行。它也只有在打开超过1个dwg时才会崩溃。
我将此问题告诉了autodesk，如果他们打开了不止一个dwg，就可以重复出现此问题。他们把它放在发展中，看看发生了什么。

DaveW · 发表于 2006-9-29 14:30:50

我仍然没有听到Autodesk的解决方案(大惊喜),但我确实找到了一个持续有效的解决方案。
通过创建变量，它可以一致地工作

2007 和插入块

发表回复

精选推荐