关于在VB.net中采用GetBoundingBox或者图块文字坐标的问题
各位大哥好，有个问题想请教一下，不知道能不能帮忙看看啊，谢谢。我想在VB.net编制的程序（独立的exe文件）中实现这么一个功能：程序自动根据excel表格的数据，调取对应的图块，并把图块插入cad文件中，然后图块中的各个属性需根据excel表格的内容进行修改，有的属性修改后文字超出了图块的范围，为保证美观需要对该文字进行缩放。这个功能已经在VBA中实现了，但是VBA需要依靠CAD 才能运行，因此单独编制了基于VB.net的程序。VBA代码拷贝到VB.net中基本能用，只是无法实现文字缩放，问题截图及代码如下，麻烦帮忙看看是哪里的问题啊，谢谢！（代码有所简化，个别不需要缩放的属性对应的代码没贴）调试中发现这句代码：attVars(k).GetBoundingBox(minExt, maxExt)，对某一个块的第一个属性修改后，它能计算出修改后的文字的坐标，但是后面修改的其他属性的坐标无法计算，结果始终保持为第一个属性的文字的坐标，在VBA中没有这个问题。
代码如下：
Imports System.Windows.Forms
Imports Microsoft.Office.Interop
Imports System.IO
Imports System.Threading '导入命名空间
Imports AutoCAD
Public Class Form1
Private Sub Button1_Click_1(sender As System.Object, e As System.EventArgs) Handles Button1.Click
'读取excel负荷表
Dim ExcelApp As Microsoft.Office.Interop.Excel.Application '声明Excel对象
Dim ExcelWorkBook As Excel.Workbook '声明工作簿对象
Dim ExcelWorkSheet As Excel.Worksheet '声明工作表对象
Dim arr_FuHeBiao
ExcelApp = New Microsoft.Office.Interop.Excel.Application '实例化Excel对象
ExcelWorkBook = ExcelApp.Workbooks.Open("D:\桌面文件\VB.net测试\output1.xlsx")
ExcelApp.Visible = False '隐藏Excel文件
ExcelWorkBook = ExcelApp.Workbooks(1)
arr_FuHeBiao = ExcelWorkBook.Sheets("sheet1").UsedRange.value '负荷表读入数组
ExcelWorkBook.Close(True) '关闭工作簿
ExcelApp.Quit() '结束EXCEL对象
ExcelApp = Nothing '释放xlApp对象
ExcelWorkBook = Nothing
ExcelWorkSheet = Nothing
'关闭excel进程
Dim arrProcesses As Process() = Process.GetProcessesByName("excel")
Dim objNewExcelProcess As Process = (From objProcess As Process In Process.GetProcessesByName("excel")
Where Not arrProcesses.Contains(objProcess))(0)
objNewExcelProcess.Kill()
Dim xx As Integer
Dim yy As Integer
xx = UBound(arr_FuHeBiao, 2) 'excel表格列数
yy = UBound(arr_FuHeBiao, 1) 'excel表格行数
Dim AcadApp As AcadApplication
Dim AcadDoc As AcadDocument
On Error Resume Next
AcadApp = GetObject(, "AutoCAD.Application") '如果CAD已经运行，则返回对CAD应用程序对象的引用，否则发生一个错误
If Err.Number Then '如果Err.Number非零（为真）
Err.Clear()
AcadApp = CreateObject("AutoCAD.Application")
If Err.Number Then
MsgBox(Err.Description)
Exit Sub
End If
End If
AcadApp.Visible = True '设置界面可视
AcadApp.WindowState = AutoCAD.AcWindowState.acMax '设置界面最大化
AppActivate(AcadApp.Caption) '显示AutoCAD界面
Dim count As Integer
Dim i As Integer
Dim dir_dwg As String
dir_dwg = "d:\400V\shigong\"
Dim j As Integer
Dim blk As String
Dim blk_obj As Object
Dim startp(0 To 2) As Double
Dim countg As Integer
Dim attVars As Object
Dim k As Integer
Dim mulian As Integer
Dim guihao As Integer '1、柜号
Dim xinghao As Integer '2、型号
Dim chicun As Integer '3、尺寸
Dim huiluhao As Integer '4、回路号
Dim xiaoshiguige As Integer '5、模数
Dim kaiguanhao As Integer '6、开关号
Dim duanluqi As Integer '7、断路器型号
Dim tuokouqi As Integer '8、脱扣器型号
Dim liuhu As Integer '9、流互
Dim dianliubiao As Integer '10、电流表
Dim diandubiao As Integer '11、电度表
Dim langyong As Integer '浪涌保护器
Dim mingcheng As Integer '17、回路名称
Dim shebeirongliang As Integer '18、设备容量
Dim jisuanrongliang As Integer '19、计算容量
Dim jisuandianliu As Integer '20、计算电流
Dim zhengding As Integer '21、整定
Dim peidianxiang As Integer '22、配电箱
Dim dianlan As Integer '23、电缆
Dim xiajizhengding As Integer '24、下级整定
Dim fuhedengji As Integer '25、负荷等级
Dim sanyao As Integer '26、三遥
Dim jiankong As Integer '27、监控
Dim fujian As Integer '28、接地保护及定值
Dim xiaofang As Integer '29、负荷类型
Dim beizhu As Integer '30、备注
Dim muxianduan As Integer '31、母线段
Dim duanyanshi As Integer '32、短延时整定值
Dim shundong As Integer '33、瞬动整定值
Dim xiangxian As Integer '34、相线截面
Dim nxian As Integer '35、N线截面
Dim pexian As Integer '36、PE线截面
Dim m As Integer
Dim deng As Integer
count = yy '行数
For i = 1 To xx
Select Case arr_FuHeBiao(1, i)
Case "开关柜编号"
guihao = i
Case "开关柜型号"
xinghao = i
Case "外型尺寸"
chicun = i
Case "回路编号"
huiluhao = i
Case "模数"
xiaoshiguige = i
Case "主回路开关编号"
kaiguanhao = i
Case "断路器型号"
duanluqi = i
Case "脱扣器型号"
tuokouqi = i
Case "电流互感器"
liuhu = i
Case "电流表"
dianliubiao = i
Case "电度表"
diandubiao = i
Case "浪涌保护器"
langyong = i
Case "回路名称"
mingcheng = i
Case "设备容量"
shebeirongliang = i
Case "计算容量"
jisuanrongliang = i
Case "计算电流"
jisuandianliu = i
Case "长延时整定值"
zhengding = i
Case "下级配电箱编号"
peidianxiang = i
Case "馈线电缆截面"
dianlan = i
Case "下级配电箱整定值"
xiajizhengding = i
Case "负荷等级"
fuhedengji = i
Case "操作机构"
sanyao = i
Case "电气火灾监控模块"
jiankong = i
Case "接地保护及定值"
fujian = i
Case "负荷类型"
xiaofang = i
Case "备注"
beizhu = i
Case "母线段"
muxianduan = i
Case "短延时整定值"
duanyanshi = i
Case "瞬动整定值"
shundong = i
Case "相线截面"
xiangxian = i
Case "N线截面"
nxian = i
Case "PE线截面"
pexian = i
End Select
Next i
Me.Visible = False
AcadDoc = AcadApp.ActiveDocument
Dim intp(0 To 2) As Double
'CAD中块插入的初始坐标
intp(0) = 0
intp(1) = 0
intp(2) = 0
Dim fitPoint(0 To 2) As Double
Dim minExt As Object
Dim maxExt As Object
Dim intp_gui(0 To 2) As Double
mulian = 0
Dim ij As Integer
Dim gui As String
Dim guishu As Integer
Dim kk As Integer
blk = dir_dwg + "表头" + ".dwg" '图块路径及图块名称
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0) '插入块InsertBlock（插入点，名称，1，1，1，0）
intp(0) = intp(0) + 20 '下一个图块插入点的x坐标
i = 2
While i <= count
Select Case LTrim(RTrim(arr_FuHeBiao(i, mingcheng)))
Case "变压器" '表格总名称为变压器时，插入变压器图块
blk = dir_dwg + "变压器（左-右）" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
attVars = blk_obj.GetAttributes '获取图块属性
For k = 0 To UBound(attVars)
Select Case attVars(k).TagString
Case "回路编号"
attVars(k).TextString = arr_FuHeBiao(i, huiluhao) '将图块属性修改为表格中的数据
Case "回路名称"
attVars(k).TextString = arr_FuHeBiao(i, mingcheng)
Case "设备容量"
attVars(k).TextString = arr_FuHeBiao(i, shebeirongliang) + "kVA"
Case "计算电流"
If arr_FuHeBiao(i, jisuandianliu) <> "" Then
attVars(k).TextString = System.Math.Round(arr_FuHeBiao(i, jisuandianliu), 2)
Else
attVars(k).TextString = ""
End If
End Select
Next k
Case "进线"
blk = dir_dwg + "进线" + ".dwg" '图块路径及图块名称
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0) '插入图块InsertBlock（插入点，名称，1，1，1，0）
attVars = blk_obj.GetAttributes 'GetAttributes获得图块的属性
For k = 0 To UBound(attVars)
Select Case attVars(k).TagString
Case "断路器型号"
attVars(k).TextString = arr_FuHeBiao(i, duanluqi)
attVars(k).GetBoundingBox(minExt, maxExt) 'GetBoundingBox(minExt, maxExt)获取文字的左端和右端的坐标
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then '文字左端坐标小于方框的左端坐标，或者文字右端坐标大于方框右端的坐标，即可判断为文字已超出方框
attVars(k).Alignment = acAlignmentFit() '文字对齐方式：调整
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "脱扣器型号"
attVars(k).TextString = arr_FuHeBiao(i, tuokouqi)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "电流互感器"
attVars(k).TextString = arr_FuHeBiao(i, liuhu)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "馈线电缆截面"
attVars(k).TextString = arr_FuHeBiao(i, dianlan)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
End Select
Next k
Case "有源滤波"
blk = dir_dwg + "有源滤波" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
attVars = blk_obj.GetAttributes
For k = 0 To UBound(attVars)
Select Case attVars(k).TagString
Case "断路器型号"
attVars(k).TextString = arr_FuHeBiao(i, duanluqi)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "脱扣器型号"
attVars(k).TextString = arr_FuHeBiao(i, tuokouqi)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "电流互感器"
attVars(k).TextString = arr_FuHeBiao(i, liuhu)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "馈线电缆截面"
attVars(k).TextString = arr_FuHeBiao(i, dianlan)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
End Select
Next k
Case "母联"
blk = dir_dwg + "母联1" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
attVars = blk_obj.GetAttributes
For k = 0 To UBound(attVars)
Select Case attVars(k).TagString
Case "断路器型号"
attVars(k).TextString = arr_FuHeBiao(i, duanluqi)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "脱扣器型号"
attVars(k).TextString = arr_FuHeBiao(i, tuokouqi)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "电流互感器"
attVars(k).TextString = arr_FuHeBiao(i, liuhu)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "馈线电缆截面"
attVars(k).TextString = arr_FuHeBiao(i, dianlan)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
End Select
Next k
Case Else
Select Case arr_FuHeBiao(i, muxianduan)
Case "11"
blk = dir_dwg + "12级馈线" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
Case "111"
blk = dir_dwg + "12级馈线（三相流互）" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
Case "12"
blk = dir_dwg + "照明馈线" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
Case "121"
blk = dir_dwg + "照明馈线（三相流互）" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
Case "14"
blk = dir_dwg + "照明总开关（左-右）" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
Case "141"
blk = dir_dwg + "照明总开关（三相流互）（左-右）" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
Case "15"
blk = dir_dwg + "照明总计量（左-右）" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
Case "151"
blk = dir_dwg + "照明总计量（三相流互）（左-右）" + ".dwg"
blk_obj = AcadApp.ActiveDocument.ModelSpace.InsertBlock(intp, blk, 1, 1, 1, 0)
End Select
attVars = blk_obj.GetAttributes
For k = 0 To UBound(attVars)
Select Case attVars(k).TagString
Case "断路器型号"
attVars(k).TextString = arr_FuHeBiao(i, duanluqi)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "脱扣器型号"
attVars(k).TextString = arr_FuHeBiao(i, tuokouqi)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "电流互感器"
attVars(k).TextString = arr_FuHeBiao(i, liuhu)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "回路名称"
attVars(k).TextString = arr_FuHeBiao(i, mingcheng)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
Case "馈线电缆截面"
attVars(k).TextString = arr_FuHeBiao(i, dianlan)
attVars(k).GetBoundingBox(minExt, maxExt)
If minExt(0) < intp(0) Or maxExt(0) > (intp(0) + 20) Then
attVars(k).Alignment = acAlignmentFit()
fitPoint(0) = intp(0) + 0.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).InsertionPoint = fitPoint
fitPoint(0) = intp(0) + 19.5 : fitPoint(1) = minExt(1) : fitPoint(2) = minExt(2)
attVars(k).TextAlignmentPoint = fitPoint
End If
End Select
Next k
End Select
intp(0) = intp(0) + 20
i = i + 1
End While
MsgBox("已完成排列图绘制，请核查！")
Me.Visible = True
End Sub
Private Function acAlignmentFit() As Object
Throw New NotImplementedException
End Function
End Class
已解决，获取下一个文本外框坐标前，需要将上一个文本的外框坐标清除。 操作Excel，别用微软自己的Microsoft.Office.Interop.Excel.Application。这个实在太难用，读、写均是龟速。且操作不当，经常你的程序退出了，但是系统中存留一大堆Excel的线程。
推荐EPPlus，超级简单，速度快。
页:
[1]