社区 › 编程申请 › 表格绘制程序原代码!

myfreemind 发表于 2003-7-26 19:56:00

表格绘制程序原代码!

Option Explicit
Const pi = 3.1415926
Private Sub CommandButton1_Click()
Me.Hide
On Error GoTo err
'On Error Resume Next

Dim hs As Double
Dim ls As Double
Dim w As Double
Dim h As Double
Dim lobj As AcadLine
hs = CLng(UserForm1.TextBox1.Text)
ls = CLng(UserForm1.TextBox2.Text)
w = CDbl(UserForm1.TextBox3.Text)
h = CDbl(UserForm1.TextBox4.Text)


'阵列声明
    Dim numberOfRows As Long
    Dim numberOfColumns As Long
    Dim numberOfLevels As Long
    Dim distanceBwtnRows As Double
    Dim distanceBwtnColumns As Double
    Dim distanceBwtnLevels As Double
   

Dim llpnt As Variant
Dim upnt As Variant
Dim rpnt As Variant
Dim bgobj As Variant
UserForm1.Hide
llpnt = ThisDrawing.Utility.GetPoint(, "请在屏幕上确定表格左下角点")
upnt = ThisDrawing.Utility.PolarPoint(llpnt, pi / 2, hs * h)
rpnt = ThisDrawing.Utility.PolarPoint(llpnt, 0, ls * w)

   
Set lobj = ThisDrawing.ModelSpace.AddLine(llpnt, upnt)
    numberOfRows = 1
    numberOfColumns = ls + 1
    numberOfLevels = 1
    distanceBwtnRows = 0
    distanceBwtnColumns = w
    distanceBwtnLevels = 1
bgobj = lobj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)


   
Set lobj = ThisDrawing.ModelSpace.AddLine(llpnt, rpnt)
numberOfRows = hs + 1
    numberOfColumns = 1
    numberOfLevels = 1
    distanceBwtnRows = h
    distanceBwtnColumns = 0
    distanceBwtnLevels = 1
bgobj = lobj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)
ThisDrawing.Application.ZoomExtents
Exit Sub
err:
Resume
End Sub

查看完整版本: 表格绘制程序原代码!