乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 112|回复: 6

[求助]VBA插入块的问题

[复制链接]

3

主题

6

帖子

2

银币

初来乍到

Rank: 1

铜币
18
发表于 2009-6-25 16:37:00 | 显示全部楼层 |阅读模式
Dim blockRefObj As AcadBlockReference
    Dim insertionPnt(2) As Double
    insertionPnt(0) = 33: insertionPnt(1) = 138: insertionPnt(2) = 0
    Set blockRefObj = newdoc.ModelSpace.InsertBlock(insertionPnt, "d:\指北针.dwg", 1#, 1#, 1#, -angle)
代码如上,上面的代码在一个循环中,该循环每次都会创建一个新的CAD文件,插入一些图形后,保存,关闭。
在循环中插入上述代码后,会报错,“文件处理器错误”
郁闷的是,有时候生成每二个文件时报错,有时生成第一个就报错。不过还从来没生成成功超过两个文件。
高人指点,谢谢啦
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2009-6-25 20:56:00 | 显示全部楼层
只有上面的代码,看不出问题,能看出问题的是,在循环中重复定义变量。
回复

使用道具 举报

3

主题

6

帖子

2

银币

初来乍到

Rank: 1

铜币
18
发表于 2009-6-25 22:33:00 | 显示全部楼层
谢谢楼上。上面代码是在一个函数中定义的,然后在循环中调用这个函数的,所以不存在重复定义的问题。
原代码太麻烦,没法全贴,我写了一个很短的测试的代码,出的是同样的错误。
Option Explicit
Public Sub newdoc()
    test ("0")
    test ("1")
    test ("2")
End Sub
Private Sub test(name As String)
    Dim newdoc As AcadDocument
    Set newdoc = ThisDrawing.Application.Documents.Add("cd-road")
    Dim blockRefObj As AcadBlockReference
    Dim insertionPnt(2) As Double
    insertionPnt(0) = 33: insertionPnt(1) = 138: insertionPnt(2) = 0
    Set blockRefObj = newdoc.ModelSpace.InsertBlock(insertionPnt, "d:\指北针.dwg", 1#, 1#, 1#, 0)
    newdoc.SaveAs ThisDrawing.Path & "\" & name
    newdoc.Close
End Sub
   
麻烦各位高手帮忙再看看。
回复

使用道具 举报

3

主题

6

帖子

2

银币

初来乍到

Rank: 1

铜币
18
发表于 2009-6-26 15:43:00 | 显示全部楼层
谁帮忙再看看哈
回复

使用道具 举报

29

主题

503

帖子

8

银币

中流砥柱

Rank: 25

铜币
619
发表于 2009-6-26 18:54:00 | 显示全部楼层
看看
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2009-6-27 23:08:00 | 显示全部楼层
试下ObjectDbx吧
回复

使用道具 举报

0

主题

58

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
58
发表于 2009-6-28 07:23:00 | 显示全部楼层
Option Explicit
    Dim D As New AxDbDocument
    Dim blockRefObjs(0) As AcadBlockReference
Sub newdoc()
    Dim insertionPnt(2) As Double
    insertionPnt(0) = 33: insertionPnt(1) = 138: insertionPnt(2) = 0
    On Error Resume Next
    Set blockRefObjs(0) = D.ModelSpace.InsertBlock(insertionPnt, "d:\指北针.dwg", 1#, 1#, 1#, 0)
    test ("0")
    test ("1")
    test ("2")
End Sub
Private Sub test(name As String)
    Dim newdoc As New AcadDocument
    D.CopyObjects blockRefObjs, newdoc.ModelSpace
    newdoc.Close True, ThisDrawing.Path & "\" & name
End Sub
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-1 23:39 , Processed in 0.551140 second(s), 67 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表