表格绘制程序原代码!

myfreemind

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