efan2000 发表于 2003-9-13 10:43:00

[测试]:AutoCAD表格制作工具的接口

该组件可供所有支持ActiveX的编程语言调用,目前仅供测试。部分说明如下:

1、AddTable
Sub AddTable(ByVal InsertionPoint, ByVal NumRows As Integer, ByVal NumColumns As Integer, , , )
创建表格,需指定表格的插入点、行数和列数,以及插入方向、默认的行高和列宽。
插入方向:1代表从上到下,2代表从下到上。

ETObj.AddTable iPt,3,2,1,8,10
表示创建一个3行2列的表格,默认方向是从上到下,行高是8,列宽是10。

2、SelectTable
Sub SetTable(ByVal EntObj As Object)
选取现有的表格作为当前表格,仅供后续操作之用。
EntObj:表示表格的块引用对象。

ETObj.SetTable EntObj

3、ConvertExcel
将Excel中的表格插入到AutoCAD,需指定表格的插入点。
注:Excel需要先行启动。
Sub ConvertTableFromExcel(ByVal RangeObj As Object, ByVal InsertionPoint, ByVal InsertoinDirection As Integer)
RangeObj:代表Excel表格中要转换的单元格区域对象。
InsertionPoint:代表表格在AutoCAD中的插入点。
InsertoinDirection:代表表格在AutoCAD中的方向。

ETObj.ConvertTableFromExcel xlSheet.Selection,iPt,2
从Excel中以当前选定的区域插入一个从下到上的表格。

4、ConvertAutoCAD
将AutoCAD中的表格插入到Excel。
注:Excel需要先行启动。
Sub ConvertTableFromAutoCAD(SheetObj As Object)

ETObj.ConvertTableFromExcel xlSheet
从AutoCAD中转换当前表格到Excel中。

5、AddColumn
往当前表格中添加列,需指定列的索引。
注:列的索引为列插入后的位置。
Sub AddColumn(ByVal Index As Integer)

ETObj.AddColumn 1
在当前表格中的第一列位置插入一列。

6、RemoveColumn
从当前表格中删除列,需指定列的索引。
Sub RemoveColumn(ByVal Index As Integer)

ETObj.RemoveColumn 1
在当前表格中删除第一列。

7、SetColumnWidth
更改当前表格中某一列的列宽,需指定列的索引。
Public Property Width As Variant

ETObj.Range("A:A").Width=20
在当前表格中将第一列的列宽设置为20mm。

15、DisplayHeadings
设置当前表格是否隐藏行号列标
Sub DisplayHeadings(ByVal bShow As Boolean)

ETObj.DisplayHeadings False
隐藏当前表格的行号列标。

16、DisplayGridlines
设置当前表格是否隐藏网格线
Sub DisplayGridlines(ByVal bShow As Boolean)

ETObj.DisplayHeadings False
隐藏当前表格的网格线。


DLL文件:

zzyong00 发表于 2019-4-30 13:01:48

多少年前的老贴子,今日有幸拜读,荣幸之至!
作者应该是重新定义一些接口了,虽然没有帮助文档,但顾思义,也能看懂!

mccad 发表于 2003-9-13 17:41:00

真不错,以后的表格程序完全可以抛开EXCEL了。

myfreemind 发表于 2003-9-13 18:03:00

太好了!

zeng29 发表于 2003-9-17 14:09:00

以下程序调用AddTable无任何输出,无任何提示.(AutoCAD2k4,Win2K)


Sub Test()
   Dim NewTable As EFCAD.Table
   Dim InsertP As Variant, RowCount As Integer, ColCount As Integer, TableDir As Integer, _
       RowHeight As Double, ColHeight As Double
      
   With ThisDrawing.Utility
      InsertP = (.GetPoint(, "请输入表格插入点:"))
      'MsgBox InsertP(0) & vbCr & InsertP(1) & vbCr & InsertP(2)
      RowCount = (.GetInteger("请输入表格的行数:"))
      'MsgBox RowCount
      ColCount = (.GetInteger("请输入表格的列数:"))
      'MsgBox ColCount
      TableDir = (.GetInteger("表格的方向(1从上到下,2从下到上):"))
      'MsgBox TableDir
      RowHeight = (.GetDistance(, "请输入行高:"))
      'MsgBox RowHeight
      ColHeight = (.GetDistance(, "请输入列宽:"))
      'MsgBox ColHeight
   End With
   Set NewTable = New EFCAD.Table
   NewTable.AddTable InsertP, RowCount, ColCount , TableDir, RowHeight, ColHeight
End Sub

zeng29 发表于 2003-9-20 10:26:00

有人试过吗?

efan2000 发表于 2003-9-20 20:18:00

在Set NewTable = New EFCAD.Table之后,使用Set NewTable.Application=Application初始化应用程序对象。

efan2000 发表于 2003-9-21 14:37:00

这是一段生成坐标数据输入到表格中的程序。

Dim etObj As EFCAD.Table

'创建表格并选择要输入坐标的对象
Sub test()
    Dim iPt As Variant
    Dim EntObj As AcadEntity
    Dim Pts As Variant
    Dim i As Integer
   
    On Error GoTo ErrTrap
    Set etObj = New EFCAD.Table
    Set etObj.Application = Application
    iPt = etObj.GetPoint(, "指定表格的插入点: ")
    If IsEmpty(iPt) Then Exit Sub
    '在iPt点生成1行3列,方向从上到下的表格,默认行高为5,列宽为30
    etObj.AddTable iPt, 1, 3, 1, 5, 30
    '设置1行1列的值为“角点”,以下同
    etObj.Range("A1").Text = "角点"
    etObj.Range("B1").Text = "X坐标"
    etObj.Range("C1").Text = "Y坐标"
    '设置1行的文字对齐方式为正中对齐
    etObj.Range("A1:C1").Alignment = 5
    Set EntObj = etObj.GetEntity(, "选择对象: ")
    Do While Not (EntObj Is Nothing)
      Pts = EntObj.Coordinates
      For i = 0 To UBound(Pts) Step 2
            '在表格中插入1行
            etObj.AddRow etObj.Rows.Count + 1
            etObj.Cells(etObj.Rows.Count, 1).Text = etObj.Rows.Count - 1
            etObj.Cells(etObj.Rows.Count, 2).Text = Round(Pts(i) + 0.0000000001, 4)
            etObj.Cells(etObj.Rows.Count, 3).Text = Round(Pts(i + 1) + 0.0000000001, 4)
      Next
      Set EntObj = etObj.GetEntity(, "选择对象: ")
    Loop
    etObj.Range("A1:C" & etObj.Rows.Count).Alignment = 5
    ThisDrawing.Regen acActiveViewport
    Set EntObj = Nothing
    Set etObj = Nothing
    Exit Sub
   
ErrTrap:
    On Error GoTo 0
End Sub


citykunan 发表于 2003-9-24 13:31:00

请问各位版主,我何时才有浏览精华帖子的权限?

mccad 发表于 2003-9-24 20:41:00

citykunan发表于2003-9-24 13:31:00static/image/common/back.gif请问各位版主,我何时才有浏览精华帖子的权限?


努力一点,很快你就可以看到了

zeng29 发表于 2003-9-25 15:11:00

为什么我以前能更改自己的基本资料,而现在总是出错!!!???
页: [1] 2 3
查看完整版本: [测试]:AutoCAD表格制作工具的接口