[原创]AUTOCAD表格绘制程序

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