| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2880 人关注过本帖
标题:各位老师,帮忙给看看是哪里的问题
取消只看楼主 加入收藏
WhistleMan
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2021-2-19
收藏
 问题点数:0 回复次数:1 
各位老师,帮忙给看看是哪里的问题
老师,您好:
    我在CAD中加入了个VB,想要实现一个批量操作,但是一直没成功,麻烦各位老师给看下哪个地方有问题。
图片附件: 游客没有浏览图片的权限,请 登录注册

代码如下:
程序代码:
Sub ChangeDrawingNumb()
   Dim curFileName As String
   Dim curFileName1 As String
   Dim changeResult As String
   Dim objPath As String
   Dim objName As String
   Dim objBlkName As String
   Dim lyName As String
   Dim xlApp As Excel.Application
   Dim xlsheet As Excel.Worksheet
   Dim dwgInfo(0 To 9) As String
   Dim i As Integer
   Dim h As Integer
   Dim xlspath As String
   objBlkName = "TUHAO"
   curFileName = openfile
   curFileName1 = curFileName
   n = 0
   For i = 1 To Len(curFileName1)
   If (Mid$(curFileName1, i, 1) = "\") Then '修改路径
   Mid$(curFileName1, i, 1) = "/"
   n = i
   End If
   Next i
   xlspath = Left(curFileName1, n)
   objPath = Path(xlspath)
   UserForm1.show
   On Error Resume Next
   Set xlApp = GetObject(, "excel. application")
   If Err <> 0 Then
   Set xlApp = CreateObject("excel. application")
   End If
   xlApp.Visible = True
   xlApp.Workbooks.Open curFileName
   If Left(Err.Description, 4) = " 无法找到 " Then
   MsgBox Err.Description
   End
   ElseIf Err.Description = " 应用程序定义或对象定义错误 " Then
   xlApp.Workbooks(objName).Activate
   End If
   Set xlsheet = xlApp.ActiveWorkbook.Worksheets("sheet1")
   dwgInfo(0) = xlsheet.Cells(1, 1).Offset(1, 0) 'CAD 文件名初使化
   n = 0
   h = 0
   With xlsheet.Cells(1, 1)
   While dwgInfo(0) <> "" 'Len(dwgInfo(0))<= 3
   h = h + 1
   i = 0
   dwgInfo(0) = .Offset(h, i)
   For i = 1 To 9
   dwgInfo(i) = .Offset(h, i)
   Next i
   ' 匹配文件定义为   驱动器 :\ 目录 \*站号 *.dwg  格式
   curFileName = objPath + "*" + dwgInfo(0) + "*.dwg" ' 检查文件 _dwginfo(0) 是否空文件
   If dwgInfo(0) <> "" Then ' 检查是否找到指定文件,若找到 则进行查找修改,否则标注无匹配文件
   If Len(Dir(curFileName)) > 0 Then
   curFileName = objPath + Dir(curFileName) ' 在 cad 中打开 dwg 文件 _ dwginfo(0)
   AutoCAD.Documents.Open curFileName ' 修改 TuHao 块值
   changeResult = ChangeAtt(objBlkName, dwgInfo(1), dwgInfo(2), dwgInfo(3), dwgInfo(4), dwgInfo(5), dwgInfo(6), dwgInfo(7), dwgInfo(8), dwgInfo(9))
   .Offset(h, 10).Value = changeResult
   ZoomAll
   ThisDrawing.Save
   ThisDrawing.Close
   n = n + 1
   Else
   changeResult = " 此目录下没有相匹配的CAD文件"
   .Offset(h, 10).Value = changeResult
   End If
   End If
   Wend
   End With
   MsgBox " 修改图号完毕,您共修改了" & n & " 个图文件"
   Set xlsheet = Nothing
   Set xlApp = Nothing
End Sub



谢谢各位大佬

[此贴子已经被作者于2021-2-19 22:17编辑过]

搜索更多相关主题的帖子: If String Dim 文件 End 
2021-02-19 22:16
WhistleMan
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2021-2-19
收藏
得分:0 
回复 2楼 HVB6
那大佬这个程序应该怎么改啊,纯小白,代码是搬过来的
2021-03-15 15:07
快速回复:各位老师,帮忙给看看是哪里的问题
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.028618 second(s), 12 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved