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

yswu

怎么用呀

CQBOY

下面的代码是我借鉴前面的代码编写的，但是为什么有些代码不能执行呢？ Dim etobj As EFCAD.Table
Sub ZBBG()
'创建名为"坐标表格"的新图层
Dim layerObj As AcadLayer
Set layerObj = ThisDrawing.Layers.Add("坐标表格")
layerObj.Color = acRed
'设置为当前图层
Dim newlayer As AcadLayer
Set newlayer = ThisDrawing.Layers("坐标表格")
ThisDrawing.ActiveLayer = newlayer Dim ZBBG As AcadTextStyle '文字样式
Set ZBBG = ThisDrawing.TextStyles.Add("ZBBG") '设定文字样式
Set ZBBG = ThisDrawing.ActiveTextStyle
ZBBG.BigFontFile = "hztxt1.shx"
'ZBBG.FontFile = "c:\windows\fonts\simsun.ttf" ' 这行代码不能执行
Dim ipt As Variant
Dim entobj As AcadEntity
Dim pts As Variant
Dim i As Integer
On Error GoTo err
Set etobj = New EFCAD.Table
Set etobj.Application = Application
etobj.DisplayHeadings False ' 这行代码不能执行
ipt = etobj.GetPoint(, "指定表格的插入点：")
If IsEmpty(ipt) Then Exit Sub
'在ipt点生成1行3列，方向从上到下的表格，默认行高为5，列宽为30
etobj.AddTable ipt, 1, 6, 1, 5, 30
'设置1行1列的值为“点号”，以下同
etobj.Range("A1").Value = "点号"
etobj.Range("B1").Value = "桩形"
etobj.Range("C1").Value = "X（m）"
etobj.Range("D1").Value = "Y（m）"
etobj.Range("E1").Value = "高程"
etobj.Range("F1").Value = "备注"
'设置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 50
'在表格中插入1行
etobj.AddRow etobj.Rows.Count + 1
etobj.Cells(etobj.Rows.Count, 1).Value = etobj.Rows.Count - 1
etobj.Cells(etobj.Rows.Count, 3).Value = Round(pts(i), 3)
etobj.Cells(etobj.Rows.Count, 4).Value = Round(pts(i + 1), 3)
Next
Set entobj = etobj.GetEntity(, "选择对象：")
Loop
'etobj.Range("A1:F" & etobj.Rows.Count).Alignment = 5 ' 这行代码不能执行
ThisDrawing.Regen acActiveViewport
Set entobj = Nothing
Set etobj = Nothing
Exit Sub
err:
On Error GoTo 0
End Sub [glow=255,red,2]文字[/glow][glow=255,red,2]文字[/glow]

leer

不知道有什么用，其实用truetanble之类的东西就能把cad的表格很好的处理，这里生成的表格不能很方便的操作，实用起来困难啊，不过，确实是个不错的东西。

pppk

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

阿笨狼

很好

leer

用了一下，觉得做得好，可是不实用

hiperin

太好了!找了好久了

雁苍山下人

zzyong00

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