社区 › VB › 分享一个excel表格转CAD的

qwh923820 发表于 2018-8-23 16:52:00

分享一个excel表格转CAD的

程序是几个星期前写的，因为懒，就不改了，需要的人可以根据注释修改，很容易移植的。用了很久，暂时没发现BUG。
Sub 画表格填内容(ByVal pt, ByVal i, ByVal j, ByVal A, ByVal B)
'B存放列宽，行高，字体大小
'B第一行是列宽，第二行是行高，第三行是字高
'p是左下角插入点,pt是左下角插入点
'i行，j列
'列从左至右，行从下至上
'A是EXCEL 里面要放的表格数据
Dim p1(0 To 2) As Double, p2(0 To 2) As Double, p3(0 To 2) As Double
Dim k&, x As Double, y As Double, z As Object
Dim zg As Double, p(0 To 2) As Double, w As Double, h As Double
zg = B(3, 1) * 35 / 50
h = B(3, 1)
'求左下角插入点p
p(1) = pt(1)
p(0) = pt(0)
For k = 1 To j
    p(0) = p(0) - B(1, k)
Next k
'画竖线
For k = 1 To i
   p2(1) = p2(1) + B(2, k)
Next k
p1(0) = p(0): p1(1) = p(1)
p2(0) = p1(0): p2(1) = p1(1) + p2(1)
Set z = acadDoc.modelspace.AddLine(p1, p2)
For k = 1 To j
    p1(0) = p1(0) + B(1, k)
    p2(0) = p1(0)
    Set z = acadDoc.modelspace.AddLine(p1, p2)
Next k
'画横线
p1(0) = p(0)
p2(1) = p(1)
Set z = acadDoc.modelspace.AddLine(p1, p2)
For k = 1 To i
    p1(1) = p1(1) + B(2, k)
    p2(1) = p1(1)
    Set z = acadDoc.modelspace.AddLine(p1, p2)
Next k
'放文字内容
'文字宽度 英文是35/50*zg，中文35/50*zg*2
p3(0) = p(0): p3(1) = p(1)
For y = 1 To j
    p3(0) = p3(0) + B(1, y)
    p3(1) = p(1)
    For x = 1 To i
      p3(1) = p3(1) + B(2, x)
      If A(x, y)"" Then
            w = 0
            For k = 1 To Len(A(x, y))
                If Asc(Mid(A(x, y), k, 1)) > 0 Then
                  w = w + zg
                Else
                  w = w + zg * 2
                End If
            Next k
            p1(0) = p3(0) - w - (B(1, y) - w) / 2
            p1(1) = p3(1) - h - (B(2, x) - h) / 2
            Set z = acadDoc.modelspace.addtext(A(x, y), p1, h)
      End If
    Next x
Next y
End Sub

新鲜8 发表于 2018-10-3 10:53:00

LZ代码全吗怎么使用呀

hefeilac 发表于 2018-12-21 09:32:00

代码不全，能不能给个全面的代码？

t502435282 发表于 2019-4-15 15:39:00

代码不全，能不能给个全面的代码？

雁苍山下人 发表于 2019-4-30 00:31:00

非常感谢

yangchao2005090 发表于 2019-6-3 06:26:00

可否介绍一下使用方法

查看完整版本: 分享一个excel表格转CAD的